Draw Header section drag image - delphi

Question

Im using Delphi 2006.
I have a custom header control that I wrote from scratch. Its almost finished except that I don't know how to draw the semi transparent drag image of the header section when the user is draging a header section in order to change its position.
The THeaderControl in Delphi does this quite nicely however it is a subclass of the windows header control, mine is not, its written from scratch. So I was wondering if there is a windows function that draws this for you or you have to draw it yourself.
Thank you

Answer 1

Implement GetDragImages. E.g. as follows:
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;
And if you do not want the vertical movement of the drag image (like in the default THeaderControl), then you have to rebuild the drag image every time the mouse moves. See Drag image change while drag....