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

Данный способ позволяет не погружаясь глубоко в создание компонент осуществить операцию "drag and drop" выделенного текста.

Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом:

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;

Теперь установите этот компонент в package, создайте новый проект в Delphi и поместите на форму два TMyMemo. Для обоих компонент необходимо создать обработчики событий OnDragOver, которые должны выглядеть следующим образом:

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

Так же для них необходимо сделать обработчики событий OnDragDrop:

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;

Запустите приложение, поместите в поля memo какой-нибудь текст, и посмотрите что произойдёт, если перетащить текст между полями.

Недавно добавленные исходники
• DeLiKaTeS Tetris (Тетрис) 4 583 • TDictionary Custom Sort 6 599 • Fast Watermark Sources 6 369 • 3D Designer 9 319 • Sik Screen Capture 6 703 • Patch Maker 7 084 • Айболит (remote control) 7 088 • ListBox Drag & Drop 5 955 • Доска для игры Реверси 97 496 • Графические эффекты 7 290 • Рисование по маске 6 584 • Перетаскивание изображений 5 457 • Canvas Drawing 5 826 • Рисование Луны 5 537 • Поворот изображения 5 058 • Рисование стержней 3 623 • Paint on Shape 2 864 • Генератор кроссвордов 3 750 • Головоломка Paletto 3 019 • Теорема Монжа об окружностях 3 828 • Пазл Numbrix 2 519 • Заборы и коммивояжеры 3 219 • Игра HIP 2 186 • Игра Go (Го) 2 117 • Симулятор лифта 2 499 • Программа укладки плитки 2 149 • Генератор лабиринта 2 633 • Проверка числового ввода 2 303 • HEX View 2 635 • Физический маятник 2 255