My blog has moved!

You should be automatically redirected in 6 seconds. If not, visit
http://perevoznyk.wordpress.com
and update your bookmarks.

Sunday, December 03, 2006

TMemo drag and drop



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, extctrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

type
TDragEdit = class(TMemo)
private
FLastSelStart : Integer;
FLastSelLength : Integer;
FDragImages: TDragImageList;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
protected
function GetDragImages: TDragImageList; override;
public
constructor Create(AOwner : TComponent); override;
property LastSelStart : Integer read FLastSelStart write FLastSelStart;
property LastSelLength : Integer read FLastSelLength write FLastSelLength;
end;

implementation

{$R *.dfm}

constructor TDragEdit.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csDisplayDragImage]
end;

function TDragEdit.GetDragImages: TDragImageList;
var
Bmp: TBitmap;
BmpIdx: Integer;
Pt: TPoint;
begin
if not Assigned(FDragImages) then
FDragImages := TDragImageList.Create(Self);
Bmp := TBitmap.Create;
bmp.Width := Self.Width;
Bmp.Height := 16;
Bmp.Canvas.TextOut(1,1, Self.GetSelText);
try
FDragImages.Width := Bmp.Width;
FDragImages.Height := Bmp.Height;
BmpIdx := FDragImages.AddMasked(Bmp, clSilver);
//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 TForm1.Button1Click(Sender: TObject);
var
MyMemo : TDragEdit;
begin
Mymemo := TDragEdit.Create(Self);
Mymemo.Parent := Self;
end;

procedure TDragEdit.WMLButtonDown(var Message: TWMLButtonDown);
var
Ch : Integer;
begin
if SelLength > 0 then begin
Ch := LoWord(Perform(EM_CHARFROMPOS,0,
MakeLParam(Message.XPos,Message.YPos)));
LastSelStart := SelStart;
LastSelLength := SelLength;
if (Ch >= SelStart) and (Ch <= SelStart+SelLength-1) then
BeginDrag(True)
else
inherited;
end
else
inherited;
end;

end.