在Memo里实现文本的拖放

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;

Make the implementation of WMLButtonDown look like this:

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;

Now, install this component into a package, start a brand new project

in Delphi 3 and drop two TMyMemos down.

Make them both have an OnDragOver event handler looking like this:

procedure TForm1.MyMemo1DragOver(Sender,Source:TObject;X,Y:Integer;State:TDragState;var Accept:Boolean);

begin

 Accept:=Source is TMyMemo;

end;

Make them both have an OnDragDrop event handler looking like this:

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

var

 Dst,Src:TMyMemo;

 Ch     :Integer;

 Temp   :String;

begin

 Dst:=SenderasTMyMemo;

 Src:=SourceasTMyMemo;

 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;