12

にドラッグアンドドロップ機能を実装していTTreeViewます。そのOnStartDragイベントでDragOcject、派生クラスのを作成しています。

  TTreeDragControlObject = class(TDragObject)
  private
    FDragImages: TDragImageList;
    FText: String;
  protected
    function GetDragImages: TDragImageList; override;
  end;

procedure TfrmMain.tvTreeStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  DragObject := TTreeDragControlObject.Create;
  TTreeDragControlObject(DragObject).FText := tvTree.Selected.Text;
end;

そして、これは私のオーバーライドGetDragImages機能ですDragObcject：

function TTreeDragControlObject.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := Bmp.Canvas.TextWidth(FText) + 25;
      Bmp.Height := Bmp.Canvas.TextHeight(FText);

      Bmp.Canvas.TextOut(25, 0, FText);

      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), 0, 0);
    finally
      Bmp.Free;
    end;
  end;

  Result := FDragImages;
end;

ツリーノード上をドラッグしているときにペイントグリッチがあることを除いて、すべてが正常に機能します。

ノードグリッチ

この動作を回避するにはどうすればよいですか？

4

3 に答える 3

7

@Seanと@bummiの回答に基づいて、D5で私のために働いたコード全体と結論を投稿します。

WinXPではXPManifestは必須ではありません-Hide/ShowDragImage必要です。

Win7ではXPManifestが必要です。Hide/ShowDragImage必須ではありません。

結論-XPManifestととの両方を使用しHideDragImageてShowDragImage、TVがXP/Win7で両方で動作することを確認します。

type 
  TTreeDragControlObject = class(TDragControlObject)
  private
    FDragImages: TDragImageList;
    FText: String;
  protected
    function GetDragImages: TDragImageList; override;
  public
    destructor Destroy; override;
    procedure HideDragImage; override;
    procedure ShowDragImage; override;
    property DragText: string read FText write FText;
  end;

  TForm1 = class(TForm)
    TreeView1: TTreeView;
    procedure TreeView1StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure TreeView1EndDrag(Sender, Target: TObject; X, Y: Integer);
  private
    FDragObject: TTreeDragControlObject;
  public
  end;

...

{ TTreeDragControlObject}
destructor TTreeDragControlObject.Destroy;
begin
  FDragImages.Free;
  inherited;
end;

procedure TTreeDragControlObject.HideDragImage;
begin
  GetDragImages.HideDragImage;
end;

procedure TTreeDragControlObject.ShowDragImage;
begin
  GetDragImages.ShowDragImage;
end;

function TTreeDragControlObject.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := Bmp.Canvas.TextWidth(FText) + 25;
      Bmp.Height := Bmp.Canvas.TextHeight(FText);
      Bmp.Canvas.TextOut(25, 0, FText);
      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), 0, 0);
    finally
      Bmp.Free;
    end;
  end;
  Result := FDragImages;
end;

{ TForm1 }
procedure TForm1.TreeView1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  FDragObject := TTreeDragControlObject.Create(TTreeView(Sender));
  FDragObject.DragText := TTreeView(Sender).Selected.Text;
  DragObject := FDragObject;
end;

procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TTreeDragControlObject;
end;

procedure TForm1.TreeView1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  FDragObject.Free;
end;

コード内でとが両方ともメモリリークしていることに注意してください。代わりに使用することをお勧めします（あなたの火は今はまったくありませんか？-私にとっては火が出ませんでした）FDragImagesvar DragObjectTDragControlObjectTDragObjecttvTreeEndDrag

于 2012-12-05T13:35:30.220 に答える
4

TXPManifestを使用すると、D7のこのバグが修正されます。

Windows、メッセージ、SysUtils、バリアント、クラス、グラフィックス、コントロール、フォーム、ダイアログ、XPMan、 ComCtrlsを使用します。

追加：

procedure Win7UpdateFix(Form: TForm; CharCode: Word);
var i: Integer;
begin
  if Assigned(Form) and (Win32MajorVersion >= 6) and (Win32Platform = VER_PLATFORM_WIN32_NT) then //Vista, Win7
  begin
    case CharCode of
      VK_MENU, VK_TAB:  //Alt or Tab
      begin
        for i := 0 to Form.ComponentCount-1 do
        begin
          if Form.Components[i] is TWinControl then
          begin
            //COntrols that disappear - Buttons, Radio buttons, Checkboxes
            if (Form.Components[i] is TButton)
            or (Form.Components[i] is TRadioButton)
            or (Form.Components[i] is TCheckBox)   then
              TWinControl(Form.Components[i]).Invalidate;
          end;
        end;
      end;
    end;
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=VK_MENU then
    begin
      Win7UpdateFix(Self,key)
    end;
end;
于 2012-12-04T09:34:56.423 に答える
4

これと同じ動作がDelphi2010でも発生し、TXPManifestはそれを修正しません。偶然にも、私は最近、独立してDelphi2010アプリケーションでこの同じ問題に遭遇しました。解決策は、HideDragImage（）/ ShowDragImage（）メソッドを次のように実装することです...

TTreeDragControlObject = class(TDragObject)
private
  FDragImages: TDragImageList;
  FText: String;
protected
  function GetDragImages: TDragImageList; override;
public
  procedure HideDragImage; override;
  procedure ShowDragImage; override;
end;

... その後 ...

procedure TTreeDragControlObject.HideDragImage;
begin
  FDragImages.HideDragImage
end;

procedure TTreeDragControlObject.ShowDragImage;
begin
  FDragImages.ShowDragImage
end;

これにより、ドラッグイメージがペイントされる直前と直後にWindows API関数ImageList_DragShowNolock（）が呼び出されます（WindowsメッセージTVM_SELECTITEM（TVGN_DROPHILITE）を介して）。この関数を呼び出さないと、ドラッグイメージが適切に描画されません。TVM_SELECTITEM + TVGN_DROPHILITEを区切るImageList_DragShowNolock（False / True）の必要性は、十分に文書化されていない機能であり、他のフォーラムが判断する場合は、苦情の一般的な原因です。

于 2012-12-05T03:04:35.013 に答える