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

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,FColWidth,Height,Canvas.Handle,FDragIndex * FColWidth,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,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,(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….