unit Unit1;

{$WARNINGS OFF}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DragDropHelper, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    DragDropHelper1: TDragDropHelper;
    ListBox1: TListBox;
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Memo1StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure DragDropHelper1GetDragImage(Sender: TObject;
      AControl: TControl; ABitmap: TBitmap);
    procedure Memo2DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Memo1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure DragDropHelper1GetDragCursor(Sender: TObject;
      Accepted: Boolean; X, Y: Integer; var ACursor: TCursor);
  private
    { Private declarations }
    FLastSelStart  : Integer;
    FLastSelLength : Integer;
    ST : string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Ch : Integer;
begin
  if FLastSelLength > 0 then
  begin
    Ch := LoWord(Memo1.Perform(EM_CHARFROMPOS,0, MakeLParam(X, Y)));
    if (Ch >= FLastSelStart) and (Ch <= FLastSelStart+FLastSelLength-1) then
     begin
       Memo1.SelStart := FLastSelStart;
       Memo1.SelLength := FLastSelLength;
       St := memo1.SelText;
       St := StringReplace(St, #13#10, '', [rfReplaceAll]);
       Memo1.BeginDrag(True);
     end;
  end;
end;


procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FLastSelStart := Memo1.SelStart;
  FLastSelLength := Memo1.SelLength;
end;

procedure TForm1.Memo1StartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  DragObject := DragDropHelper1.GetDragObject(Memo1);
end;

procedure TForm1.DragDropHelper1GetDragImage(Sender: TObject;
  AControl: TControl; ABitmap: TBitmap);
var
  W : integer;
  H : Integer;
  TextH : integer;
  R : TRect;
  Flags : integer;
  ch : char;
begin
  //First step is to select the font you want to use draw the text during drag operation
  //We will draw selected text using the font of memo,
  //but you can use another font for it
  ABitmap.Canvas.Font.Assign(Memo1.Font);
  //Here you can change font style, size, color, etc...
  ABitmap.Canvas.Font.Color := clNavy;

  //Width of the bitmap can be equal memo1.Width or
  //can be smaller, if the memo is too big
  W := Memo1.Width;
  //Calculate text height according to the size of the font
  TextH := ABitmap.Canvas.TextHeight('Wg');
  H := TextH;

  //Calculate the real rectangle we need to draw selected text
  //on the bitmap
  Flags := DT_CALCRECT or DT_LEFT or DT_EXPANDTABS;
  R := Rect(0,0,W, H);
 //It will not draw text, but calculate rectange and returns R with correct size to fit selected text
  DrawText(Canvas.Handle, PChar(St), Length(St), R, Flags);

  //If the last symbol of text string is CR or LF then we have do decrease the
  //size of bitmap for one empty line of text
  ch := St[Length(st)];
  if (ch = #13) or (ch = #10) then
   R.Bottom := R.Bottom - TextH;  //decrease for one line

  //You can leave calculated bitmap as is or make it smaller if it's too big.
  //In this case you will see only part of the text, but if you drag 10000 lines
  //of the text maybe it will be good idea do not draw huge image :)

  if R.Left > 500 then
   R.Left := 500;  //or whatever you want

  if R.Bottom > 500 then
   R.Bottom := 500; //You can use your own limit


  //set size of the drag image
  ABitmap.Width := R.Right;
  ABitmap.Height := R.Bottom;

  //If you want, you can change bitmap background color
  ABitmap.Canvas.Brush.Color := clYellow;  //for example Yellow, but you can leave it White or what you like
  ABitmap.Canvas.FillRect(ABitmap.Canvas.ClipRect);

  //Draw the text on the bitmap
  Flags :=  DT_LEFT or DT_EXPANDTABS;
  DrawText(ABitmap.Canvas.Handle, PChar(St), Length(St), R, Flags);

end;

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

procedure TForm1.Memo1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  TMemo(Target).Text := TMemo(Target).Text + st;
end;

procedure TForm1.DragDropHelper1GetDragCursor(Sender: TObject;
  Accepted: Boolean; X, Y: Integer; var ACursor: TCursor);
begin
  Caption := Format('X:%d,Y:%d', [X, Y]);
end;

end.