01]ListBox1的DragMode设置为dmAutomatic
02】Memo1的OnGragOver事件和OnDragDrop事件
procedure TForm8.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if TListBox(Source)=ListBox1 then Accept:=true;
end;
procedure TForm8.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if ListBox1.ItemIndex>-1 then
Memo1.SelText :=Listbox1.Items[ListBox1.ItemIndex];
end;
更复杂的,请参考https://prog.hu/tudastar/90383/drag-and-drop-tmemo
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Memo1: TMemo;
Label1: TLabel;
procedure Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure Memo1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
function CharPosInMemo(aMemo: TMemo; X, Y: integer): integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.CharPosInMemo(aMemo: TMemo; X, Y: integer): integer;
// Get the current character position (0-based) in the TMemo aMemo
// corresponding to the client coordinates X, Y. Returns -1 if there
// is no corresponding character.
begin
result := LoWord(SendMessage(aMemo.Handle, EM_CHARFROMPOS, 0, MAKELPARAM(X, Y)));
end;
procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
aCharPos: integer;
droptext:string;
begin
aCharPos := CharPosInMemo(Memo1, X, Y);
if (aCharPos <> -1) then
begin
droptext:=(Source as TListBox).Items[(Source as TListBox).ItemIndex];
Memo1.Perform(EM_REPLACESEL, integer(true), integer(PChar(dropText)));
Memo1.SelStart := aCharPos+length(dropText);
Memo1.SelLength := 0;
end;
end;
procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
aCharPos: integer;
begin
Memo1.SetFocus;
// Get the current position
aCharPos := CharPosInMemo(Memo1, X, Y);
// If it makes sense, then put the caret there.
if (aCharPos <> -1) then
begin
Memo1.selStart := aCharPos;
Memo1.selLength := 0;
end;
If Source is TListBox then Accept:=True;
end;
procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
ret: Longint;
begin
ret := memo1.perform(EM_CHARFROMPOS, 0, MakeLParam(X, Y));
// label1.caption := format('row: %d, character index: %d', [HiWord(ret), LoWord(ret)]);
end;
end.