1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:

unit Unit1_;

{ ****************************************************************
  Source File Name :  TMemoDragDropFrm.pas
  Typ              :  Hauptformular
  Autor            :  Andreas Kosch
  Compiler         :  Delphi 4.02 CSS
  Betriebssystem   :  Windows 98
  Beschreibung     :  Text via OLE Drag&Drop übernehmen aus einer
                      anderen Anwendung (wie zum Beispiel WordPad)
                      übernehmen.
  16.01.2003: Test mit Delphi 7 und Microsoft Word XP unter Windowx XP
 **************************************************************** }
 { Comments by Thomas Stutz }

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ActiveX, ShlObj, ComObj, StdCtrls;

type
  // TForm1's declaration indicates that it's a TForm and that
  // it supports the IDropTarget interface:

 {

  IDropTarget

  Any application wanting to accept drop operations must
  implement the IDropTarget interface.

  Methods of the IDropTarget interface:

  DragEnter
    Dragged item has just been moved into the application's window,
    return the relevant icon.

  DragOver
    Dragged item is being moved over the application's window,
    return the relevant icon.

  DragLeave
    Dragged item has just moved out of the application's window.

  Drop
    The dragged item has been dropped on this application.

  }

  TForm1 = class(TForm, IDropTarget)
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    // IDropTarget
    function DragEnter(const dataObj: IDataObject;
                       grfKeyState: Longint;
                       pt: TPoint;
                       var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint;
                      pt: TPoint;
                      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject;
                  grfKeyState: Longint; pt: TPoint;
                  var dwEffect: Longint): HResult; stdcall;
   // IUnknown
   // Ignore referance counting
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  ShellAPI;


// In the OnCreate event handler, two important methods are called.
// First, OleInitalize is called. This initializes the OLE libraries and should always be
// called before your application uses any OLE functions.
// RegisterDragDrop registers the window as a valid drop target.
// If this isn't called, the window will never receive any drop events.


procedure TForm1.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);
  {Allow window to accept drop events}
  OleCheck(RegisterDragDrop(Handle, Self));
  { Execute Wordpad for testing }
//  ShellExecute(Handle, 'open', 'wordpad', 'c:\Test.doc', nil, SW_SHOW);
end;

// OnDestroy does the exact opposite. It calls RevokeDropTarget to indicate that
// drop events are no longer accepted.
// It then calls OleUninitialize, since the application is finished using all OLE functions.

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {Finished accepting drops}
  RevokeDragDrop(Handle);
  OleUninitialize;
end;

{-----------------------------------------------------------------}
{ IDropTarget-Implementierung                                     }
{-----------------------------------------------------------------}
function TForm1.DragEnter(const dataObj: IDataObject;
  grfKeyState: Longint;
  pt: TPoint;
  var dwEffect: Longint): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result  := S_OK;
end;

function TForm1.DragOver(grfKeyState: Longint;
  pt: TPoint;
  var dwEffect: Longint): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TForm1.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TForm1._AddRef: Integer;
begin
   Result := 1;
end;

function TForm1._Release: Integer;
begin
   Result := 1;
end;

function TForm1.Drop(const dataObj: IDataObject;
  grfKeyState: Longint;
  pt: TPoint;
  var dwEffect: Longint): HResult;
var
  aFmtEtc: TFORMATETC;
  aStgMed: TSTGMEDIUM;
  pData: PChar;
begin
  {Make certain the data rendering is available}
  if (dataObj = nil) then
    raise Exception.Create('IDataObject-Pointer is not valid!');
  with aFmtEtc do
  begin
    cfFormat := CF_TEXT;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  {Get the data}
  OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
  try
    {Lock the global memory handle to get a pointer to the data}
    pData := GlobalLock(aStgMed.hGlobal);
    { Replace Text }
    RichEdit1.Text := pData;
  finally
    {Finished with the pointer}
    GlobalUnlock(aStgMed.hGlobal);
    {Free the memory}
    ReleaseStgMedium(aStgMed);
  end;
  Result := S_OK;
end;

end.