Geek Answers Handbook

Draw header image header

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 a translucent image of dragging the header section when the user overlays the header section to change its position.

Delphi's THeaderControl does this pretty nicely, however it is a Windows header management subclass, mine is not, written from scratch. So I was wondering if there is a windows function that draws this for you, or if you have to do it yourself.

thanks

+4
source share
1 answer

Deploy GetDragImages. For instance. in the following way:

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 need to vertically move the drag and drop image (as in the standard THeaderControl), you need to rebuild the drag and drop image each time the mouse moves. See Dragging and dropping an image ....

+1
source

More articles:


All Articles