Draw Header section drag image

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

Implement the default VCL drag&drop functionality, see e.g. [Brian Long's tutorial](http://www.blong.com/Conferences/BorCon2001/DragAndDrop/4114.htm). Prepare the dragging image yourself in `GetDragImages`, and Windows will draw it alphablended for you while dragging. — NGLN, Aug 03 '11 at 07:07

score 1 · Accepted Answer · edited May 23 '17 at 09:58

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....

Draw Header section drag image

1 Answers1