ドラッグイメージチェンジながら、私はstartDragを上の私のカスタムDragObject型のインスタンスを作成していたグリッド

Question

オーバードラッグ：

procedure TForm1.SecondGridDragOver(Sender, Source: TObject; X, 
    Y: Integer; State: TDragState; var Accept: Boolean); 
begin 
    Accept := False; 
    if Source is TMyDragControlObject then 
    with TMyDragControlObject(Source) do 
     // using TcxGrid 
     if (Control is TcxGridSite) or (Control is TcxGrid) then begin 
      Accept := True    

      // checking the record value on grid 
      // the label of drag cursor will be different 
      // getting the record value works fine! 
      if RecordOnGrid.Value > 5 then 
      DragOverPaint(FImageList, 'You can drop here!'); 
      else begin 
      Accept := false; 
      DragOverPaint(FImageList, 'You can''t drop here!'); 
      end 
     end; 
end; 

マイDragOverPaint手順：

DragOver DragOverは上の別のグリッド上の最近

procedure TForm1.GridStartDrag(Sender: TObject; 
    var DragObject: TDragObject); 
begin 
    DragObject := TMyDragControlObject.Create(Sender as TcxGridSite); 
end; 

procedure TForm1.DragOverPaint(ImageList: TImageList; AValue: string); 
var ABmp: TBitmap; 
begin 
    if not Assigned(ImageList) then Exit; 

    ABmp := TBitmap.Create(); 
    try 
    with ABmp.Canvas do begin 
     ABmp.Width := TextWidth(AValue); 
     ABmp.Height := TextHeight(AValue); 
     TextOut(0, 0, AValue); 
    end; 

    ImageList.BeginUpdate; 
    ImageList.Clear; 
    ImageList.Width := ABmp.Width; 
    ImageList.Height := ABmp.Height; 
    ImageList.AddMasked(ABmp, clNone); 
    ImageList.EndUpdate; 
    finally 
    ABmp.Free(); 
    end; 

    Repaint; 
end; 

私はそれがグリッドのレコード値に応じてDragImageListを再描画したいのですが、イメージリストrefはありませんそれが既に塗られているときにresh。イメージリストのドラッグを開始したら、Windowsが特別にドラッグするために、別の一時的ブレンドイメージリストを作成するため

Answer 1

、あなたはイメージリストを変更することにより、ドラッグイメージを変更することはできません。したがって、ImageListをもう一度終了し、変更して開始する必要があります（これは、VCLの完全なドラッグ操作、つまりWinAPI ImageListの終了と開始とは異なります）。結果/欠点は、画像の変化にわずかな震えです。 （この特定の場合）変更を受け入れた場合

画像を変化させるモーメントです。は、OnDblClickでこれに対処することは可能ですが、あなたはすでに独自のDragObject型を作成しているので、あなたもTDragObjectのそのための設計された方法オーバーライドすることができます。

type 
    TControlAccess = class(TControl); 

    TMyDragControlObject = class(TDragControlObjectEx) 
    private 
    FDragImages: TDragImageList; 
    FPrevAccepted: Boolean; 
    protected 
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override; 
    function GetDragImages: TDragImageList; override; 
    public 
    destructor Destroy; override; 
    end; 

{ TMyDragControlObject } 

destructor TMyDragControlObject.Destroy; 
begin 
    FDragImages.Free; 
    inherited Destroy; 
end; 

function TMyDragControlObject.GetDragCursor(Accepted: Boolean; X, 
    Y: Integer): TCursor; 
begin 
    if FPrevAccepted <> Accepted then 
    with FDragImages do 
    begin 
     EndDrag; 
     SetDragImage(Ord(Accepted), 0, 0); 
     BeginDrag(GetDesktopWindow, X, Y); 
    end; 
    FPrevAccepted := Accepted; 
    Result := inherited GetDragCursor(Accepted, X, Y); 
end; 

function TMyDragControlObject.GetDragImages: TDragImageList; 
const 
    SNoDrop = 'You can''t drop here!!'; 
    SDrop = 'You can drop here.'; 
    Margin = 20; 
var 
    Bmp: TBitmap; 
begin 
    if FDragImages = nil then 
    begin 
    FDragImages := TDragImageList.Create(nil); 
    Bmp := TBitmap.Create; 
    try 
     Bmp.Canvas.Font.Assign(TControlAccess(Control).Font); 
     Bmp.Width := Bmp.Canvas.TextWidth(SNoDrop) + Margin; 
     Bmp.Height := Bmp.Canvas.TextHeight(SNoDrop); 
     Bmp.Canvas.TextOut(Margin, 0, SNoDrop); 
     FDragImages.Width := Bmp.Width; 
     FDragImages.Height := Bmp.Height; 
     FDragImages.Add(Bmp, nil); 
     Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height)); 
     Bmp.Canvas.TextOut(Margin, 0, SDrop); 
     FDragImages.Add(Bmp, nil); 
     FDragImages.SetDragImage(0, 0, 0); 
    finally 
     Bmp.Free; 
    end; 
    end; 
    Result := FDragImages; 
end; 

{ TForm1 } 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    Grid1.ControlStyle := Grid1.ControlStyle + [csDisplayDragImage]; 
    Grid2.ControlStyle := Grid2.ControlStyle + [csDisplayDragImage]; 
end; 

procedure TForm1.Grid1StartDrag(Sender: TObject; var DragObject: TDragObject); 
begin 
    DragObject := TMyDragControlObject.Create(Sender as TStringGrid); 
end; 

procedure TForm1.Grid2DragOver(Sender, Source: TObject; X, Y: Integer; 
    State: TDragState; var Accept: Boolean); 
begin 
    Accept := False; 
    if IsDragObject(Source) then 
    with TMyDragControlObject(Source) do 
     if Control is TGrid then 
     { Just some condition for testing } 
     if Y > Control.Height div 2 then 
      Accept := True; 
end; 

Answer 2

NGLN pointed outとして、変更の理由は取っていない効果があるがWindowsはドラッグ中に一時的なイメージリストを作成します。わずかに異なる解決策として、この一時的なリストの画像を直接変更することができます。

以下応じDragOverPaint修正されます。 NGLNの答えのように、マウスを動かすたびにリストを再作成しないために、何らかのフラグを使用する必要があることに注意してください。

procedure TForm1.DragOverPaint(ImageList: TImageList; AValue: string); 
var 
    ABmp: TBitmap; 

    ImgList: HIMAGELIST; // <- will get the temporary image list 
begin 
    if not Assigned(ImageList) then Exit; 

    ABmp := TBitmap.Create(); 
    try 
    with ABmp.Canvas do begin 
     ABmp.Width := TextWidth(AValue); 
     ABmp.Height := TextHeight(AValue); 
     TextOut(0, 0, AValue); 
    end; 

// ImageList.BeginUpdate;  // do not fiddle with the image list, 
// ImageList.Clear;    // it's not used while dragging 
// ImageList.Width := ABmp.Width; 
// ImageList.Height := ABmp.Height; 
// ImageList.AddMasked(ABmp, clNone); 
// ImageList.EndUpdate; 

    // get the temporary image list 
    ImgList := ImageList_GetDragImage(nil, nil); 
    // set the dimensions for images and empty the list 
    ImageList_SetIconSize(ImgList, ABmp.Width, ABmp.Height); 
    // add the text as the first image 
    ImageList_AddMasked(ImgList, ABmp.Handle, ColorToRGB(clWhite)); 

    finally 
    ABmp.Free(); 
    end; 

// Repaint; // <- No need to repaint the form 
end;