5

StartDrag でカスタム DragObject のインスタンスを作成しています。

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

最近、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;

私の DragOverPaint 手順:

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 を再描画したいのですが、既に描画されていると画像リストが更新されません。

4

2 に答える 2

6

ImageListがドラッグを開始すると、Windowsはドラッグ用に特別に一時的にブレンドされた別のImageListを作成するため、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; 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;
于 2011-07-07T23:57:55.113 に答える
5

NGLNが指摘したように、変更が反映されない理由は、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;
于 2011-07-08T00:06:19.760 に答える