在拖动网格时拖动图像更改 [英] Drag image change while drag over grid

问题描述

 程序TForm1.GridStartDrag（发件人：TObject; 
 var DragObject：TDragObject）; 
 begin 
 DragObject：= TMyDragControlObject.Create（发件人为TcxGridSite）; 
结束
  

最近在DragOver上的另一个网格上：

  procedure TForm1.SecondGridDragOver（Sender，Source：TObject; X，
 Y：Integer; State：TDragState; var Accept：Boolean）; 
 begin 
接受：= False; 
如果Source是TMyDragControlObject然后
与TMyDragControlObject（Source）do 
 //使用TcxGrid 
如果（控件是TcxGridSite）或（控件是TcxGrid）然后开始
接受：= True 
 
 //检查网格上的记录值
 //拖动光标的标签将不同
 //获取记录值工作正常！ 
如果RecordOnGrid.Value> 5然后
 DragOverPaint（FImageList，你可以放在这里！）; 
 else begin 
接受：= false; 
 DragOverPaint（FImageList，你不能在这里！）; 
 end 
 end; 
结束
  

我的DragOverPaint过程：

  procedure TForm1.DragOverPaint（ImageList：TImageList; AValue：string）; 
 var ABmp：TBitmap; 
 begin 
如果没有分配（ImageList）然后退出; 
 
 ABmp：= TBitmap.Create（）; 
尝试
与ABmp.Canvas做开始
 ABmp.Width：= TextWidth（AValue）; 
 ABmp.Height：= TextHeight（AValue）; 
 TextOut（0，0，AValue）; 
结束
 
 ImageList.BeginUpdate; 
 ImageList.Clear; 
 ImageList.Width：= ABmp.Width; 
 ImageList.Height：= ABmp.Height; 
 ImageList.AddMasked（ABmp，clNone）; 
 ImageList.EndUpdate; 
 finally 
 ABmp.Free（）; 
结束
 
重印; 
结束
  

我想要根据网格记录值重绘DragImageList，但图像列表不刷新

解决方案

一旦ImageList开始拖动，您不能通过更改ImageList来更改拖动图像，因为Windows创建另一个临时混合的ImageList专门用于拖动。所以你必须结束，更改并启动ImageList再次拖动（这不等于结束和启动完整的VCL拖动操作，只是WinAPI ImageList）。结果/下降是图像转换时的轻微颤抖。

更改图像的时刻是接受更改（在此特定情况下）。可以在OnDragOver中处理这个问题，但是由于您已经创建了一个自己的DragObject，所以您也可以重写TDragObject的设计方法：

  type 
 TControlAccess = class（TControl）; 
 
 TMyDragControlObject = class（TDragControlObjectEx）
 private 
 FDragImages：TDragImageList; 
 FPrevAccepted：Boolean; 
 protected 
 function GetDragCursor（Accepted：Boolean; X，Y：Integer）：TCursor;覆盖; 
函数GetDragImages：TDragImageList;覆盖; 
 public 
析构函数Destroy;覆盖; 
结束
 
 {TMyDragControlObject} 
 
析构函数TMyDragControlObject.Destroy; 
 begin 
 FDragImages.Free; 
继承了Destroy; 
结束
 
函数TMyDragControlObject.GetDragCursor（Accepted：Boolean; X，
 Y：Integer）：TCursor; 
 begin 
如果FPrevAccepted<>接受然后
与FDragImages做
开始
 EndDrag; 
 SetDragImage（Ord（Accepted），0，0）; 
 BeginDrag（GetDesktopWindow，X，Y）; 
结束
 FPrev接受：=接受; 
结果：= inherited GetDragCursor（Accepted，X，Y）; 
结束
 
函数TMyDragControlObject.GetDragImages：TDragImageList; 
 const 
 SNoDrop ='你不能在这里!!' 
 SDrop ='你可以放在这里。 
保证金= 20; 
 var 
 Bmp：TBitmap; 
 begin 
如果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; 
结束
结束
结果：= FDragImages; 
结束
 
 {TForm1} 
 
程序TForm1.FormCreate（发件人：TObject）; 
 begin 
 Grid1.ControlStyle：= Grid1.ControlStyle + [csDisplayDragImage]; 
 Grid2.ControlStyle：= Grid2.ControlStyle + [csDisplayDragImage]; 
结束
 
程序TForm1.Grid1StartDrag（发件人：TObject; var DragObject：TDragObject）; 
 begin 
 DragObject：= TMyDragControlObject.Create（发件人为TStringGrid）; 
结束
 
 procedure TForm1.Grid2DragOver（Sender，Source：TObject; X，Y：Integer; 
状态：TDragState; var Accept：Boolean）; 
 begin 
接受：= False; 
如果IsDragObject（Source）然后
与TMyDragControlObject（Source）do 
如果Control是TGrid然后
 {只是一些条件进行测试} 
如果Y> Control.Height div 2 then 
接受：= True; 
结束
  

I'm creating an instance of my custom DragObject on StartDrag:

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

Lately on another grid on DragOver:

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;

My DragOverPaint procedure:

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;

I want it to repaint DragImageList depending on the grid record value, but the image list doesn't refresh when it's already painted.

解决方案

Once the ImageList has started dragging, you cannot change the drag image by changing the ImageList because Windows creates another temporarily blended ImageList specially for the dragging. So you have to end, change and start the ImageList dragging again (this is not equal to ending and starting the complete VCL dragging operation, just the WinAPI ImageList). The result/downside is a slight quiver at the transition of the images.

The moment of changing the images is when Accepted changes (in this specific case). It is possible to deal with this in OnDragOver, but since you create an own DragObject already, you can also override the therefor designed methods of 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;

这篇关于在拖动网格时拖动图像更改的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！