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

我正在使用Delphi 2006.

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

Delphi中的THeaderControl做得很好但是它是windows头控件的子类,我的不是,它是从头开始编写的.所以我想知道是否有一个Windows功能为您绘制这个或者您必须自己绘制它.

谢谢

实现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….