Как перетаскивать (Drag and Drop) выделенный текст между компонентами Memo?

Code:

type

TMyMemo = class(TMemo)

private

   FLastSelStart  : Integer;

   FLastSelLength : Integer;

   procedure WMLButtonDown(var Message: TWMLButtonDown);

     message WM_LBUTTONDOWN;

published

   property LastSelStart : Integer read FLastSelStart

     write FLastSelStart;

   property LastSelLength : Integer read FLastSelLength

     write FLastSelLength;

end;

Добавьте обработчик WMLButtonDown:

procedure TMyMemo.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;

Code:

procedure TForm1.MyMemo1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept := Source is TMyMemo;

end;

Code:

procedure TForm1.MyMemo1DragDrop(Sender, Source: TObject;

                                X, Y: Integer);

var

Dst, Src : TMyMemo;

Ch       : Integer;

Temp     : String;

begin

Dst := Sender as TMyMemo;

Src := Source as TMyMemo;

Ch := LoWord(Dst.Perform(EM_CHARFROMPOS,0,MakeLParam(X,Y)));

if (Src = Dst) and (Ch >= Src.LastSelStart) and

    (Ch <= Src.LastSelStart+Src.LastSelLength-1) then

   Exit;

Dst.Text := Copy(Dst.Text,1,Ch)+Src.SelText+

             Copy(Dst.Text,Ch+1,Length(Dst.Text)-Ch);

Temp := Src.Text;

Delete(Temp,Src.LastSelStart+1,Src.LastSelLength);

Src.Text := Temp;

end;