delphi - 绘制标题部分拖动图像

Question

我使用的是 Delphi 2006。

我有一个从头开始编写的自定义 header 控件。它几乎完成了，只是我不知道当用户拖动标题部分以更改其位置时如何绘制标题部分的半透明拖动图像。

Delphi 中的 THeaderControl 做得很好，但它是 Windows header 控件的子类，我的不是，它是从头开始编写的。所以我想知道是否有一个Windows函数可以为你绘制它，或者你必须自己绘制它。

谢谢

Answer 1

实现GetDragImages。例如。如下:

type
  THeader = class(TCustomControl)
  private
    FColWidth: Integer;
    FDragImages: TDragImageList;
    FDragIndex: Integer;
    FDragPos: TPoint;
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    function GetDragImages: TDragImageList; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ THeader }

constructor THeader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csDisplayDragImage];
  DragCursor := crNone;
  FColWidth := 100;
end;

procedure THeader.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  FreeAndNil(FDragImages);
  // Eat inherited if you do not publish the default drag events
end;

procedure THeader.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  // Eat inherited if you do not publish the default drag events
  Accept := Source = Self;
end;

function THeader.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := FColWidth;
      Bmp.Height := Height;
      BitBlt(Bmp.Canvas.Handle, 0, 0, FColWidth, Height, Canvas.Handle,
        FDragIndex * FColWidth, 0, SRCCOPY);
      FDragImages.Width := FColWidth;
      FDragImages.Height := Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), FDragPos.X,
        FDragPos.Y);
    finally
      Bmp.Free;
    end;
  end;
  Result := FDragImages;
end;

procedure THeader.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  FDragIndex := X div FColWidth;
  FDragPos.X := X mod FColWidth;
  FDragPos.Y := Y;
end;

procedure THeader.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if ssLeft in Shift then
    BeginDrag(False, Mouse.DragThreshold);
end;

procedure THeader.Paint;
var
  i: Integer;
  R: TRect;
begin
  for i := 0 to 3 do
  begin
    SetRect(R, i * FColWidth, 0, (i + 1) * FColWidth, Height);
    Canvas.Brush.Color := clSilver;
    Canvas.Font.Color := clWhite;
    DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONPUSH or
      DFCS_PUSHED or DFCS_ADJUSTRECT);
    Canvas.TextRect(R, R.Left + 2, R.Top + 2, 'Column ' + IntToStr(i + 1));
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  with THeader.Create(Self) do
  begin
    SetBounds(0, 100, 500, 30);
    Parent := Self;
  end;
end;

如果您不希望拖动图像垂直移动(就像在默认的 THeaderControl 中一样)，那么您必须在每次鼠标移动时重建拖动图像。请参阅Drag image change while drag... .