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.