unit MyDragButton;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Graphics, Types, QControls;
type
TMyDragButton =
class(TButton)
private
FDragImages: TDragImageList;
protected
function GetDragImages: TDragImageList;
override;
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
{ Published declarations }
end;
procedure Register;
implementation
constructor TMyDragButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csDisplayDragImage];
end;
destructor TMyDragButton.Destroy;
begin
FDragImages.Free;
inherited;
end;
function TMyDragButton.GetDragImages: TDragImageList;
var
Bmp: TBitmap;
BmpIdx: Integer;
Pt: TPoint;
begin
if not Assigned(FDragImages)
then
FDragImages := TDragImageList.Create(Self);
Bmp := TBitmap.Create;
try
Bmp.Width := Width;
Bmp.Height := Height;
Bmp.Canvas.Lock;
try
PaintTo(Bmp.Canvas.Handle, 0, 0);
finally
Bmp.Canvas.Unlock
end;
FDragImages.Width := Width;
FDragImages.Height := Height;
BmpIdx := FDragImages.AddMasked(Bmp, clBtnFace);
//Where is mouse relative to control?
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
//Specify drag image and hot spot
FDragImages.SetDragImage(BmpIdx, Pt.X, Pt.Y);
Result := FDragImages;
finally
Bmp.Free
end
end;
procedure TDragButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
//Automatically start dragging on a Ctrl-click
if ssCtrl
in Shift
then
BeginDrag(True)
end;
procedure Register;
begin
RegisterComponents('
Samples', [TMyDragButton]);
end;
end.