DragDrop.pas 77 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051
  1. unit DragDrop;
  2. {
  3. Description
  4. ===========
  5. TDragDrop is a component for OLE drag-and-drop operations. The component
  6. is able to make successor components of TWinControl to the source AND
  7. target of drag-and-drop operations.
  8. Disclaimer
  9. ==========
  10. The author disclaims all warranties, expressed or implied, including,
  11. without limitation, the warranties of merchantability and of fitness
  12. for any purpose. The author assumes no liability for damages, direct or
  13. consequential, which may result from the use of this component/unit.
  14. Restrictions on Using the Unit / Component
  15. ==========================================
  16. This unit/component is copyright 1998 by Dieter Steinwedel. ALL RIGHTS
  17. ARE RESERVED BY DIETER STEINWEDEL. You are allowed to use it freely
  18. subject to the following restrictions:
  19. • You are not allowed delete or alter the author's name and
  20. copyright in any manner
  21. • You are not allowed to publish a copy, modified version or
  22. compilation neither for payment in any kind nor freely
  23. • You are allowed to create a link to the download in the WWW
  24. • These restrictions and terms apply to you as long as until
  25. I alter them. Changes can found on my homepage
  26. Contact
  27. =======
  28. homepage: http://godard.oec.uni-osnabrueck.de/student_home/dsteinwe/delphi/DietersDelphiSite.htm
  29. }
  30. {$ALIGN ON}
  31. {$ASSERTIONS OFF}
  32. {$BOOLEVAL OFF}
  33. {$DENYPACKAGEUNIT OFF}
  34. {$EXTENDEDSYNTAX ON}
  35. {$HINTS ON}
  36. {$IMPORTEDDATA ON}
  37. {$LONGSTRINGS ON}
  38. {$OPTIMIZATION ON}
  39. {$TYPEDADDRESS OFF}
  40. {$TYPEINFO OFF}
  41. {$WARNINGS ON}
  42. {$WARN SYMBOL_DEPRECATED OFF}
  43. interface
  44. uses
  45. SysUtils, Windows, Classes, Controls, Forms, ShellApi,
  46. Menus, Messages, Graphics, ActiveX, ExtCtrls, Grids;
  47. {MP}(*$HPPEMIT '#include <oleidl.h>'*)
  48. // Available drop effects by the system:
  49. // (redefined, so need not to type "ActiveX" in the uses clause of your units )
  50. const DROPEFFECT_None=ActiveX.DROPEFFECT_None;
  51. DROPEFFECT_Copy=ActiveX.DROPEFFECT_Copy;
  52. DROPEFFECT_Move=ActiveX.DROPEFFECT_Move;
  53. DROPEFFECT_Link=ActiveX.DROPEFFECT_Link;
  54. DROPEFFECT_Scroll=ActiveX.DROPEFFECT_Scroll;
  55. TYMED_HGLOBAL=ActiveX.TYMED_HGLOBAL;
  56. TYMED_FILE=ActiveX.TYMED_FILE;
  57. TYMED_ISTREAM=ActiveX.TYMED_ISTREAM;
  58. TYMED_ISTORAGE=ActiveX.TYMED_ISTORAGE;
  59. TYMED_GDI=ActiveX.TYMED_GDI;
  60. TYMED_MFPICT=ActiveX.TYMED_MFPICT;
  61. TYMED_ENHMF=ActiveX.TYMED_ENHMF;
  62. TYMED_NULL=ActiveX.TYMED_NULL;
  63. DefaultCursor=0;
  64. type
  65. IEnumFormatEtc = ActiveX.IEnumFormatEtc;
  66. IDataObject = ActiveX.IDataObject;
  67. TFormatEtc = ActiveX.TFormatEtc;
  68. TStgMedium = ActiveX.TStgMedium;
  69. TDropEffect=(deCopy, deMove, deLink);
  70. TDragResult=(drInvalid, drCancelled, drCopy, drMove, drLink);
  71. TDropEffectSet = set of TDropEffect;
  72. TDragDetectStatus = (ddsNone, ddsLeft, ddsRight, ddsCancelled, ddsDrag);
  73. TRenderDataOn = (rdoEnter, rdoEnterAndDropSync, rdoEnterAndDropAsync, rdoDropSync, rdoDropAsync, rdoNever);
  74. TSrcCompatibilityCheck = (CheckLindex, CheckdwAspect);
  75. TSrcCompatibilityCheckSet = set of TSrcCompatibilityCheck;
  76. TScrollInterval=1..10000;
  77. TScrollDirection=(sdUp, sdDown, sdLeft, sdRight);
  78. // event handlers ...
  79. TOnDragEnter = procedure(DataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  80. var dwEffect: longint; var Accept:boolean) of object;
  81. TOnDragLeave = procedure of object;
  82. TOnDragOver = procedure(grfKeyState: Longint; pt: TPoint;
  83. var dwEffect: longint) of object;
  84. TOnDrop = procedure(DataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  85. var dwEffect: longint) of object;
  86. TOnQueryContinueDrag = procedure(fEscapePressed: BOOL; grfKeyState: Longint; var Result: HResult) of object;
  87. TOnGiveFeedback = procedure(dwEffect: Longint; var Result: HResult) of object;
  88. TOnDragDetect = procedure(grfKeyState: Longint; DetectStart, pt: TPoint; DragDetectStatus:TDragDetectStatus) of object;
  89. TOnProcessDropped = procedure(Sender: TObject; grfKeyState: Longint; pt: TPoint; dwEffect: Longint) of object;
  90. TOnBeforeScrolling = procedure(Sender: TObject; pt: TPoint; var Interval: TScrollInterval;
  91. ScrollDirection: TScrollDirection; var ScrollPage:boolean) of object;
  92. TOnMenuPopup = procedure(Sender: TObject; AMenu: HMenu; DataObj:IDataObject;
  93. AMinCustCmd:integer; grfKeyState: Longint; pt: TPoint) of object;
  94. TOnMenuExecCmd = procedure(Sender: TObject; AMenu: HMenu; DataObj:IDataObject;
  95. Command:integer; var dwEffect: longint; var Succeeded:boolean) of object;
  96. TOnMenuDestroy = procedure(Sender: TObject; AMenu: HMenu) of object;
  97. TFormatEtcArray = array of TFormatEtc;
  98. TDetectRec = record
  99. end;
  100. // list classes ...
  101. TFormatEtcList = class
  102. private
  103. FCount:integer;
  104. FList:TFormatEtcArray;
  105. function Get(Index: Integer): TFormatEtc;
  106. procedure Put(Index: Integer; Item: TFormatEtc);
  107. public
  108. constructor Create;
  109. destructor Destroy; override;
  110. function Add(Item: TFormatEtc):integer;
  111. procedure Clear;
  112. procedure Delete(Index: Integer);
  113. function Clone:TFormatEtcList;
  114. property Count:integer read FCount;
  115. property Items[Index:integer]:TFormatEtc read get write put;
  116. end;
  117. // inherited classes ...
  118. TDDInterfacedObject = class(TInterfacedObject)
  119. public
  120. function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  121. function _AddRef: Integer; stdcall;
  122. function _Release: Integer; stdcall;
  123. end;
  124. TEnumFormatEtc = class(TDDInterfacedObject, IEnumFormatEtc)
  125. protected
  126. FFormatEtcList:TFormatEtcList;
  127. FIndex: integer;
  128. public
  129. constructor Create(FormatEtcList:TFormatEtcList);
  130. destructor Destroy; override;
  131. function Next(celt: Longint; out elt;
  132. pceltFetched: PLongint): HResult; stdcall;
  133. function Skip(celt: Longint): HResult; stdcall;
  134. function Reset: HResult; stdcall;
  135. function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
  136. end;
  137. TDataObject = class(TDDInterfacedObject, IDataObject)
  138. protected
  139. FFormatEtcList:TFormatEtcList;
  140. FCheckLindex:boolean;
  141. FCheckdwAspect:boolean;
  142. public
  143. constructor Create;
  144. destructor Destroy; override;
  145. function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
  146. HResult; stdcall;
  147. function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
  148. HResult; stdcall;
  149. function QueryGetData(const formatetc: TFormatEtc): HResult;
  150. stdcall;
  151. function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
  152. out formatetcOut: TFormatEtc): HResult; stdcall;
  153. function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
  154. fRelease: BOOL): HResult; stdcall;
  155. function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
  156. IEnumFormatEtc): HResult; stdcall;
  157. function DAdvise(const formatetc: TFormatEtc; advf: Longint;
  158. const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
  159. function DUnadvise(dwConnection: Longint): HResult; stdcall;
  160. function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
  161. stdcall;
  162. function RenderData(FormatEtc:TFormatEtc;
  163. var StgMedium: TStgMedium): HResult; virtual; abstract;
  164. protected
  165. function AllowData(FormatEtc: TFormatEtc): Boolean; virtual;
  166. end;
  167. // forward declaration, because TDropSource and TDropTarget uses this class ...
  168. TDragDrop = class;
  169. TDropSource = class(TDDInterfacedObject, IDropSource)
  170. private
  171. FOwner: TDragDrop;
  172. public
  173. constructor Create(AOwner: TDragDrop);
  174. destructor Destroy; override;
  175. function QueryContinueDrag(fEscapePressed: BOOL;
  176. grfKeyState: Longint): HResult; stdcall;
  177. function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  178. end;
  179. TDropTarget = class(TDDInterfacedObject, IDropTarget)
  180. private
  181. FAccept:boolean;
  182. HorzStartTimer:TTimer;
  183. HorzScrollTimer:TTimer;
  184. VertStartTimer:TTimer;
  185. VertScrollTimer:TTimer;
  186. FVScrollCode:integer;
  187. FHScrollCode:integer;
  188. procedure InitScroll(VerticalScroll:boolean; ScrollCode:integer);
  189. procedure TermScroll(VerticalScroll:boolean);
  190. procedure DetermineScrollDir(VertScrolling:boolean; var ScrollCode:integer);
  191. procedure OnStartTimer(Sender: TObject);
  192. procedure OnScrollTimer(Sender: TObject);
  193. protected
  194. FOwner: TDragDrop;
  195. procedure SuggestDropEffect(grfKeyState: Longint; var dwEffect: longint); virtual;
  196. procedure AcceptDataObject(DataObj: IDataObject; var Accept:boolean); virtual;
  197. procedure RenderDropped(DataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  198. var dwEffect: longint); virtual;
  199. public
  200. constructor Create(AOwner: TDragDrop);
  201. destructor Destroy; override;
  202. function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
  203. pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  204. function DragOver(grfKeyState: Longint; pt: TPoint;
  205. var dwEffect: Longint): HResult; stdcall;
  206. function DragLeave: HResult; stdcall;
  207. function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  208. var dwEffect: Longint): HResult; stdcall;
  209. end;
  210. // custom properties
  211. TScrollDetectArea = class(TPersistent)
  212. private
  213. FControl: TPersistent;
  214. FMargin: word;
  215. FRange: word;
  216. FOnChange: TNotifyEvent;
  217. procedure SetValue(Index: Integer; Value: word);
  218. protected
  219. procedure Change; dynamic;
  220. procedure AssignTo(Dest: TPersistent); override;
  221. property Control: TPersistent read FControl;
  222. public
  223. constructor Create(Control: TPersistent);
  224. property OnChange: TNotifyEvent read FOnChange write FOnChange;
  225. published
  226. property Margin: word index 0 read FMargin write SetValue default 0;
  227. property Range: word index 1 read FRange write SetValue default 10;
  228. end;
  229. TScrollDetectOptions = class(TPersistent)
  230. private
  231. FControl: TDragDrop;
  232. FScrollDelay: TScrollInterval;
  233. FStartDelay: TScrollInterval;
  234. FLeft: TScrollDetectArea;
  235. FTop: TScrollDetectArea;
  236. FRight: TScrollDetectArea;
  237. FBottom: TScrollDetectArea;
  238. FOnChange: TNotifyEvent;
  239. FHorzScrolling:boolean;
  240. FVertScrolling:boolean;
  241. FHorzPageScroll:boolean;
  242. FVertPageScroll:boolean;
  243. procedure SetValue(index:integer; Value: TScrollInterval);
  244. protected
  245. procedure Change; dynamic;
  246. procedure AssignTo(Dest: TPersistent); override;
  247. property Control: TDragDrop read FControl;
  248. public
  249. constructor Create(Control: TDragDrop);
  250. destructor Destroy; override;
  251. property OnChange: TNotifyEvent read FOnChange write FOnChange;
  252. published
  253. property ScrollDelay: TScrollInterval index 0 read FScrollDelay write SetValue default 100;
  254. property StartDelay: TScrollInterval index 1 read FStartDelay write SetValue default 750;
  255. property AreaLeft: TScrollDetectArea read FLeft write FLeft;
  256. property AreaTop: TScrollDetectArea read FTop write FTop;
  257. property AreaRight: TScrollDetectArea read FRight write FRight;
  258. property AreaBottom: TScrollDetectArea read FBottom write FBottom;
  259. property HorzScrolling:boolean read FHorzScrolling write FHorzScrolling default false;
  260. property VertScrolling:boolean read FVertScrolling write FVertScrolling default false;
  261. property HorzPageScroll:boolean read FHorzPageScroll write FHorzPageScroll default false;
  262. property VertPageScroll:boolean read FVertPageScroll write FVertPageScroll default false;
  263. end;
  264. // *THE* pseudo-visual Component
  265. TDragDrop = class(TComponent)
  266. private
  267. FAutoDetectDnD:boolean;
  268. FDragDetectDelta:byte;
  269. FAcceptOwnDnD:boolean;
  270. FBTF:Boolean;
  271. FContextMenu: boolean;
  272. FDragDropControl: TWinControl;
  273. FRegistered: Boolean;
  274. FOwnerIsSource:boolean;
  275. FShowPopUpMenu: boolean;
  276. FTargetEffectsSet: TDropEffectSet;
  277. FTargetEffects: longint;
  278. FOnQueryContinueDrag: TOnQueryContinueDrag;
  279. FOnGiveFeedback: TOnGiveFeedback;
  280. FOnDragEnter: TOnDragEnter;
  281. FOnDragLeave: TOnDragLeave;
  282. FOnDragOver: TOnDragOver;
  283. FOnDrop: TOnDrop;
  284. FSourceEffectsSet: TDropEffectSet;
  285. FSourceEffects: longint;
  286. FOnProcessDropped: TOnProcessDropped;
  287. OldWndProc:Pointer;
  288. WndProcPtr:Pointer;
  289. FOnDragDetect:TOnDragDetect;
  290. FDragDetectStatus:TDragDetectStatus;
  291. FDragDetectStart:TPoint;
  292. FRenderDataOn: TRenderDataOn;
  293. FDataObj:IDataObject;
  294. FgrfKeyState: Longint;
  295. Fpt: TPoint;
  296. FdwEffect: Longint;
  297. FCHCopy: HCursor;
  298. FCHMove: HCursor;
  299. FCHLink: HCursor;
  300. FCHScrollCopy: HCursor;
  301. FCHScrollMove: HCursor;
  302. FCHScrollLink: HCursor;
  303. FMessageHooked:boolean;
  304. FAvailableDropEffects:Longint;
  305. FTargetScrolling:integer;
  306. FSrcCompatibilityCheck:TSrcCompatibilityCheckSet;
  307. FScrollDetectOptions: TScrollDetectOptions;
  308. FOnBeforeScrolling: TOnBeforeScrolling;
  309. FOnAfterScrolling: TNotifyEvent;
  310. FPressedButton:integer;
  311. FInternalSource:TDragDrop;
  312. FOnMenuPopup:TOnMenuPopup;
  313. FOnMenuExecCmd:TOnMenuExecCmd;
  314. FOnMenuDestroy:TOnMenuDestroy;
  315. FOnMenuSucceeded:TOnProcessDropped;
  316. FOnDropHandlerSucceeded:TOnProcessDropped;
  317. procedure WndMethod(var Msg: TMessage);
  318. procedure SetDragDropControl(WinControl: TWinControl);
  319. procedure SetSourceEffects(Values:TDropEffectSet);
  320. procedure SetTargetEffects(Values:TDropEffectSet);
  321. protected
  322. FDropTarget: TDropTarget;
  323. procedure Loaded; override;
  324. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  325. function CreateDataObject:TDataObject; virtual; abstract;
  326. procedure DoMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  327. AMinCustCmd:integer; grfKeyState: Longint; pt: TPoint); virtual;
  328. function DoMenuExecCmd(Sender: TObject; AMenu: HMenu; DataObj:IDataObject;
  329. Command:integer; var dwEffect: longint):boolean; virtual;
  330. procedure DoMenuDestroy(Sender:TObject; AMenu: HMenu); virtual;
  331. function DropHandler(const dataObj: IDataObject; grfKeyState: Longint;
  332. pt: TPoint; var dwEffect: Longint): boolean; virtual;
  333. property OnDropHandlerSucceeded:TOnProcessDropped read FOnDropHandlerSucceeded
  334. write FOnDropHandlerSucceeded;
  335. public
  336. constructor Create(AOwner: TComponent); override;
  337. destructor Destroy; override;
  338. function RegisterTarget: Boolean;
  339. function UnRegisterTarget: Boolean;
  340. procedure HookMessageHandler;
  341. procedure UnhookMessageHandler(ForceUnhook:boolean);
  342. function ExecuteOperation(DataObject:TDataObject): TDragResult;
  343. function Execute: TDragResult;
  344. function CopyToClipboard:boolean; virtual;
  345. function GetFromClipboard:boolean; virtual;
  346. procedure StartDnDDetection(Button: TMouseButton); virtual;
  347. property OwnerIsSource:boolean read FOwnerIsSource;
  348. property Registered: Boolean read FRegistered default False;
  349. property CHCopy: HCursor read FCHCopy write FCHCopy default DefaultCursor;
  350. property CHMove: HCursor read FCHMove write FCHMove default DefaultCursor;
  351. property CHLink: HCursor read FCHLink write FCHLink default DefaultCursor;
  352. property CHScrollCopy: HCursor read FCHScrollCopy write FCHScrollCopy default DefaultCursor;
  353. property CHScrollMove: HCursor read FCHScrollMove write FCHScrollMove default DefaultCursor;
  354. property CHScrollLink: HCursor read FCHScrollLink write FCHScrollLink default DefaultCursor;
  355. property DragDetectStatus: TDragDetectStatus read FDragDetectStatus;
  356. property AvailableDropEffects: Longint read FAvailableDropEffects;
  357. property InternalSource:TDragDrop read FInternalSource;
  358. published
  359. property AcceptOwnDnD:boolean read FAcceptOwnDnD write FAcceptOwnDnD;
  360. property AutoDetectDnD:boolean read FAutoDetectDnD write FAutoDetectDnD;
  361. property BringToFront:Boolean read FBTF write FBTF;
  362. property DragDetectDelta:byte read FDragDetectDelta write FDragDetectDelta default 10;
  363. property DragDropControl: TWinControl read FDragDropControl write SetDragDropControl;
  364. property RenderDataOn: TRenderDataOn read FRenderDataOn write FRenderDataOn default rdoDropSync;
  365. property ScrollDetectOptions: TScrollDetectOptions read FScrollDetectOptions
  366. write FScrollDetectOptions;
  367. property SourceCompatibility:TSrcCompatibilityCheckSet read FSrcCompatibilityCheck
  368. write FSrcCompatibilityCheck;
  369. property SourceEffects: TDropEffectSet read FSourceEffectsSet write SetSourceEffects;
  370. property TargetPopupMenu: boolean read FShowPopUpMenu write FShowPopUpMenu;
  371. property TargetEffects: TDropEffectSet read FTargetEffectsSet write SetTargetEffects;
  372. property OnAfterScrolling: TNotifyEvent read FOnAfterScrolling write FOnAfterScrolling;
  373. property OnBeforeScrolling: TOnBeforeScrolling read FOnBeforeScrolling write FOnBeforeScrolling;
  374. property OnDragDetect: TOnDragDetect read FOnDragDetect write FOnDragDetect;
  375. property OnDragEnter: TOnDragEnter read FOnDragEnter write FOnDragEnter;
  376. property OnDragLeave: TOnDragLeave read FOnDragLeave write FOnDragLeave;
  377. property OnDragOver: TOnDragOver read FOnDragOver write FOnDragOver;
  378. property OnDrop: TOnDrop read FOnDrop write FOnDrop;
  379. property OnQueryContinueDrag: TOnQueryContinueDrag read FOnQueryContinueDrag
  380. write FOnQueryContinueDrag;
  381. property OnGiveFeedback: TOnGiveFeedback read FOnGiveFeedback
  382. write FOnGiveFeedback;
  383. property OnProcessDropped: TOnProcessDropped read FOnProcessDropped write FOnProcessDropped;
  384. property OnMenuPopup:TOnMenuPopup read FOnMenuPopup write FOnMenuPopup;
  385. property OnMenuExecCmd:TOnMenuExecCmd read FOnMenuExecCmd write FOnMenuExecCmd;
  386. property OnMenuDestroy:TOnMenuDestroy read FOnMenuDestroy write FOnMenuDestroy;
  387. property OnMenuSucceeded:TOnProcessDropped read FOnMenuSucceeded write FOnMenuSucceeded;
  388. end;
  389. procedure Register;
  390. resourcestring
  391. MICopyStr = '&Copy Here';
  392. MIMoveStr = '&Move Here';
  393. MILinkStr = '&Shortcut(s) Create Here';
  394. MIAbortStr = '&Abort';
  395. implementation
  396. const CmdAbort = 0;
  397. CmdMove = 1;
  398. CmdCopy = 2;
  399. CmdLink = 3;
  400. CmdSeparator = 4;
  401. MinCustCmd = 10;
  402. var DDM_ProcessDropped:DWord; // Never change its value
  403. MouseHookHandle:HHook;
  404. MouseHookDragDrop:TDragDrop;
  405. GInternalSource:TDragDrop;
  406. function MouseHookProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
  407. var MouseHookStruct:TMouseHookStruct;
  408. grfKeyState:Longint;
  409. begin
  410. Result:=CallNextHookEx(MouseHookHandle,Code,wParam,lParam);
  411. if assigned(MouseHookDragDrop)=false then
  412. begin
  413. UnHookWindowsHookEx(MouseHookHandle);
  414. MouseHookHandle:=0;
  415. exit;
  416. end;
  417. with MouseHookDragDrop do
  418. begin
  419. MouseHookStruct:=TMouseHookStruct(pointer(lparam)^);
  420. if ((FDragDetectStatus=ddsRight) and (wParam=WM_LBUTTONDOWN)) or
  421. ((FDragDetectStatus=ddsLeft) and (wParam=WM_RBUTTONDOWN)) then
  422. begin
  423. FPressedButton:=2;
  424. FDragDetectStatus:=ddsCancelled;
  425. if assigned(FOnDragDetect) then
  426. begin
  427. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then
  428. grfKeyState:=MK_SHIFT
  429. else grfKeyState:=0;
  430. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  431. grfKeyState:=grfKeyState or MK_CONTROL;
  432. FOnDragDetect(grfKeyState,
  433. FDragDropControl.ScreenToClient(FDragDetectStart),
  434. FDragDropControl.ScreenToClient(MouseHookStruct.pt),
  435. FDragDetectStatus);
  436. end;
  437. exit;
  438. end;
  439. if ((wParam=WM_LBUTTONDOWN) or (wParam=WM_RBUTTONDOWN)) and
  440. (FDragDetectStatus=ddsCancelled) then
  441. begin
  442. FPressedButton:=2;
  443. exit;
  444. end;
  445. if (FDragDetectStatus=ddsCancelled) and
  446. ((wParam=WM_LBUTTONUP) or (wParam=WM_RBUTTONUP)) then
  447. begin
  448. dec(FPressedButton);
  449. if FPressedButton<=0 then
  450. begin
  451. UnHookWindowsHookEx(MouseHookHandle);
  452. MouseHookHandle:=0;
  453. FDragDetectStatus:=ddsNone;
  454. if assigned(FOnDragDetect) then
  455. begin
  456. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then
  457. grfKeyState:=MK_SHIFT
  458. else grfKeyState:=0;
  459. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  460. grfKeyState:=grfKeyState or MK_CONTROL;
  461. FOnDragDetect(grfKeyState,
  462. FDragDropControl.ScreenToClient(FDragDetectStart),
  463. FDragDropControl.ScreenToClient(MouseHookStruct.pt),
  464. FDragDetectStatus);
  465. end;
  466. end;
  467. exit;
  468. end;
  469. if ((FDragDetectStatus=ddsRight) and (wParam=WM_RBUTTONUP)) or
  470. ((FDragDetectStatus=ddsLeft) and (wParam=WM_LBUTTONUP)) then
  471. begin
  472. UnHookWindowsHookEx(MouseHookHandle);
  473. MouseHookHandle:=0;
  474. FDragDetectStatus:=ddsNone;
  475. if assigned(FOnDragDetect) then
  476. begin
  477. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then
  478. grfKeyState:=MK_SHIFT
  479. else grfKeyState:=0;
  480. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  481. grfKeyState:=grfKeyState or MK_CONTROL;
  482. FOnDragDetect(grfKeyState,
  483. FDragDropControl.ScreenToClient(FDragDetectStart),
  484. FDragDropControl.ScreenToClient(MouseHookStruct.pt),
  485. FDragDetectStatus);
  486. end;
  487. exit;
  488. end;
  489. if ((abs(FDragDetectStart.X-MouseHookStruct.pt.x)>DragDetectDelta) or
  490. (abs(FDragDetectStart.Y-MouseHookStruct.pt.y)>DragDetectDelta)) and
  491. ((FDragDetectStatus=ddsRight) or (FDragDetectStatus=ddsLeft)) then
  492. begin
  493. FDragDetectStatus:=ddsDrag;
  494. UnHookWindowsHookEx(MouseHookHandle);
  495. MouseHookHandle:=0;
  496. if assigned(FOnDragDetect) then
  497. begin
  498. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then
  499. grfKeyState:=MK_SHIFT
  500. else grfKeyState:=0;
  501. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  502. grfKeyState:=grfKeyState or MK_CONTROL;
  503. FOnDragDetect(grfKeyState,
  504. FDragDropControl.ScreenToClient(FDragDetectStart),
  505. FDragDropControl.ScreenToClient(MouseHookStruct.pt),
  506. FDragDetectStatus);
  507. end;
  508. if (FDragDetectStatus<>ddsNone) then
  509. begin
  510. FDragDetectStatus:=ddsNone;
  511. if assigned(FOnDragDetect) then
  512. begin
  513. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then
  514. grfKeyState:=MK_SHIFT
  515. else grfKeyState:=0;
  516. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  517. grfKeyState:=grfKeyState or MK_CONTROL;
  518. FOnDragDetect(grfKeyState,
  519. FDragDropControl.ScreenToClient(FDragDetectStart),
  520. FDragDropControl.ScreenToClient(MouseHookStruct.pt),
  521. FDragDetectStatus);
  522. end;
  523. end;
  524. end;
  525. end;
  526. end;
  527. // TFormatEtcList --------------------------------------------------------------
  528. constructor TFormatEtcList.Create;
  529. begin
  530. inherited Create;
  531. FCount:=0;
  532. SetLength(FList, 0);
  533. end;
  534. destructor TFormatEtcList.Destroy;
  535. begin
  536. if (FCount>0) and (FList<>nil) then SetLength(FList, 0);
  537. inherited Destroy;
  538. end;
  539. function TFormatEtcList.Get(Index: Integer): TFormatEtc;
  540. begin
  541. if (Index>=FCount) or (FList=nil) then
  542. raise EListError.Create('Invalid item index')
  543. else Result:=FList[Index];
  544. end;
  545. procedure TFormatEtcList.Put(Index: Integer; Item: TFormatEtc);
  546. begin
  547. if (Index>=FCount) or (FList=nil) then
  548. raise EListError.Create('Invalid item index')
  549. else FList[Index]:=Item;
  550. end;
  551. function TFormatEtcList.Add(Item: TFormatEtc):integer;
  552. begin
  553. SetLength(FList, Succ(FCount));
  554. FList[FCount]:=Item;
  555. Result:=FCount;
  556. inc(FCount);
  557. end;
  558. procedure TFormatEtcList.Clear;
  559. begin
  560. SetLength(Flist, 0);
  561. FCount:=0;
  562. end;
  563. function TFormatEtcList.Clone:TFormatEtcList;
  564. var FEL:TFormatEtcList;
  565. begin
  566. FEL:=TFormatEtcList.Create;
  567. if FList<>nil then
  568. begin
  569. SetLength(FEL.FList, FCount);
  570. CopyMemory(FEL.FList,FList,FCount*SizeOf(TFormatEtc));
  571. FEL.FCount:=FCount;
  572. end;
  573. Result:=FEL;
  574. end;
  575. procedure TFormatEtcList.Delete(Index: Integer);
  576. var movecount:integer;
  577. begin
  578. if (Index>=FCount) or (FList=nil) then
  579. raise EListError.Create('Invalid item index')
  580. else
  581. begin
  582. movecount:=FCount-Index-1;
  583. System.move(FList[Index+1],FList[Index],movecount*sizeof(TFormatEtc));
  584. dec(FCount);
  585. SetLength(FList, FCount);
  586. end;
  587. end;
  588. // TDDInterfacedObject ---------------------------------------------------------
  589. function TDDInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
  590. begin
  591. Result:=inherited QueryInterface(IID,Obj);
  592. end;
  593. function TDDInterfacedObject._AddRef: Integer;
  594. begin
  595. Result:=inherited _AddRef;
  596. end;
  597. function TDDInterfacedObject._Release: Integer;
  598. begin
  599. Result:=inherited _Release;
  600. end;
  601. // TEnumFormatEtc --------------------------------------------------------------
  602. constructor TEnumFormatEtc.Create(FormatEtcList:TFormatEtcList);
  603. begin
  604. inherited Create;
  605. _AddRef;
  606. FFormatEtcList:=FormatEtcList;
  607. end;
  608. destructor TEnumFormatEtc.Destroy;
  609. begin
  610. if Assigned(FFormatEtcList) then FFormatEtcList.Free;
  611. inherited Destroy;
  612. end;
  613. function TEnumFormatEtc.Next(celt: Longint; out elt;
  614. pceltFetched: PLongint): HResult;
  615. var copycount:integer;
  616. begin
  617. Result:=S_False;
  618. if pceltFetched<>nil then pceltFetched^:=0;
  619. if (celt<=0) or (FFormatEtcList.Count=0) or (FIndex>=FFormatEtcList.Count) or
  620. ((pceltFetched=nil) and (celt<>1)) then exit;
  621. copycount:=FFormatEtcList.Count-FIndex;
  622. if celt<copycount then copycount:=celt;
  623. if pceltFetched<>nil then pceltFetched^:=copycount;
  624. CopyMemory(@TFormatEtc(elt),@TFormatEtc(FFormatEtcList.FList[FIndex]),
  625. copycount*sizeof(TFormatEtc));
  626. inc(FIndex,copycount);
  627. Result:=S_OK;
  628. end;
  629. function TEnumFormatEtc.Skip(celt: Longint): HResult;
  630. begin
  631. if (FIndex+celt<=FFormatEtcList.Count) then
  632. begin
  633. inc(FIndex,celt);
  634. Result:=S_Ok;
  635. end
  636. else Result:=S_False;
  637. end;
  638. function TEnumFormatEtc.Reset: HResult;
  639. begin
  640. FIndex:=0;
  641. Result:=S_OK;
  642. end;
  643. function TEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HResult;
  644. begin
  645. Result:=S_OK;
  646. try
  647. Enum:=TEnumFormatEtc.Create(FFormatEtcList);
  648. TEnumFormatEtc(Enum).FIndex := FIndex;
  649. except
  650. Result:=E_Fail;
  651. end;
  652. end;
  653. // TDataObject -----------------------------------------------------------------
  654. constructor TDataObject.Create;
  655. begin
  656. inherited Create;
  657. _AddRef;
  658. FFormatEtcList:=TFormatEtcList.Create;
  659. end;
  660. destructor TDataObject.Destroy;
  661. begin
  662. FFormatEtcList.Free;
  663. inherited Destroy;
  664. end;
  665. function TDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
  666. HResult;
  667. var i:integer;
  668. Cursor:TCursor;
  669. begin
  670. try
  671. if FFormatEtcList.Count>0 then
  672. for i:=0 to FFormatEtcList.Count-1 do
  673. if (formatetcIn.tymed and FFormatEtcList.Items[i].tymed<>0) and
  674. ((FCheckLindex=false) or (FCheckLindex and
  675. (formatetcIn.lindex=FFormatEtcList.Items[i].lindex))) and
  676. ((FCheckdwAspect=false) or (FCheckdwAspect and
  677. (formatetcIn.dwAspect=FFormatEtcList.Items[i].dwAspect))) and
  678. (formatetcIn.cfFormat=FFormatEtcList.Items[i].cfFormat) then
  679. begin
  680. Cursor:=Screen.Cursor;
  681. try
  682. Screen.Cursor:=crHourglass;
  683. Result:=RenderData(formatetcIn,medium);
  684. finally
  685. Screen.Cursor:=Cursor;
  686. end;
  687. exit;
  688. end;
  689. Result:=DV_E_FormatEtc;
  690. except
  691. medium.HGlobal:=0;
  692. Result:=E_Fail;
  693. end;
  694. end;
  695. function TDataObject.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
  696. HResult;
  697. begin
  698. Result:=E_NOTIMPL;
  699. end;
  700. function TDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc;
  701. out formatetcOut: TFormatEtc): HResult;
  702. begin
  703. Result:=E_NOTIMPL;
  704. end;
  705. function TDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
  706. const DVError:array[0..3] of HResult=(DV_E_FORMATETC,DV_E_TYMED,DV_E_DVASPECT,DV_E_LINDEX);
  707. var i,j:integer;
  708. begin
  709. j:=0;
  710. if (FFormatEtcList.Count>0) and AllowData(FormatEtc) then
  711. for i:=0 to FFormatEtcList.Count-1 do
  712. if FormatEtc.cfFormat=FFormatEtcList.Items[i].cfFormat then
  713. begin
  714. if FormatEtc.tymed and FFormatEtcList.Items[i].tymed<>0 then
  715. begin
  716. if FormatEtc.dwAspect=FFormatEtcList.Items[i].dwAspect then
  717. begin
  718. if FormatEtc.lindex=FFormatEtcList.Items[i].lindex then
  719. begin
  720. Result:=S_OK;
  721. exit;
  722. end
  723. else if j<3 then j:=3;
  724. end
  725. else if j<2 then j:=2;
  726. end
  727. else if j<1 then j:=1;
  728. end;
  729. Result:=DVError[j];
  730. end;
  731. function TDataObject.AllowData(FormatEtc: TFormatEtc): Boolean;
  732. begin
  733. Result := True;
  734. end;
  735. function TDataObject.EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
  736. IEnumFormatEtc): HResult;
  737. begin
  738. Result:=E_Fail;
  739. if dwDirection=DATADIR_GET then
  740. begin
  741. EnumFormatEtc:=TEnumFormatEtc.Create(FFormatEtcList.Clone);
  742. Result:=S_OK;
  743. end
  744. else EnumFormatEtc:=nil;
  745. if EnumFormatEtc=nil then Result:=OLE_S_USEREG;
  746. end;
  747. function TDataObject.SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
  748. fRelease: BOOL): HResult;
  749. var i:integer;
  750. AddData:boolean;
  751. begin
  752. Result:=E_Fail;
  753. if FRelease then exit;
  754. AddData:=true;
  755. if FFormatEtcList.Count>0 then
  756. for i:=0 to FFormatEtcList.Count-1 do
  757. if FFormatEtcList.Items[i].cfFormat=FormatEtc.cfFormat then
  758. begin
  759. AddData:=false;
  760. FFormatEtcList.Items[i]:=FormatEtc;
  761. end;
  762. if AddData then
  763. FFormatEtcList.Add(FormatEtc);
  764. end;
  765. function TDataObject.DAdvise(const formatetc: TFormatEtc; advf: Longint;
  766. const advSink: IAdviseSink; out dwConnection: Longint): HResult;
  767. begin
  768. Result:=E_NOTIMPL;
  769. end;
  770. function TDataObject.DUnadvise(dwConnection: longint): HResult; stdcall;
  771. begin
  772. Result:=E_NOTIMPL;
  773. end;
  774. function TDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
  775. begin
  776. Result:=OLE_E_AdviseNotSupported;
  777. end;
  778. // TDropSource methods ---------------------------------------------------------
  779. constructor TDropSource.Create(AOwner: TDragDrop);
  780. begin
  781. inherited Create;
  782. _AddRef;
  783. FOwner:=AOwner;
  784. end;
  785. destructor TDropSource.Destroy;
  786. begin
  787. inherited Destroy;
  788. end;
  789. function TDropSource.QueryContinueDrag(fEscapePressed: BOOL;
  790. grfKeyState: Longint): HResult; stdcall;
  791. // Determines whether a drag-and-drop operation should be continued, cancelled,
  792. // or completed. You do not call this method directly. The OLE DoDragDrop function
  793. // calls this method during a drag-and-drop operation.
  794. begin
  795. // Abort drag-and-drop?
  796. if (((grfKeyState and MK_LBUTTON)<>0) and
  797. ((grfKeyState and MK_RBUTTON)<>0)) or fEscapePressed then
  798. begin
  799. Result:=DRAGDROP_S_CANCEL;
  800. FOwner.FOwnerIsSource:=false;
  801. end
  802. // Finish drag-and-drop?
  803. else if (((grfKeyState and MK_LBUTTON)=0) and
  804. ((grfKeyState and MK_RBUTTON)=0)) then Result:=DRAGDROP_S_DROP
  805. else Result:=S_OK;
  806. if assigned(FOwner.FOnQueryContinueDrag) then
  807. FOwner.FOnQueryContinueDrag(fEscapePressed,grfKeyState,Result);
  808. end;
  809. function TDropSource.GiveFeedback(dwEffect: Longint): HResult; stdcall;
  810. // Enables a source application to give visual feedback to its end user
  811. // during a drag-and-drop operation by providing the DoDragDrop function
  812. // with an enumeration value specifying the visual effect.
  813. var HC: HCursor;
  814. begin
  815. if Assigned(FOwner.FOnGiveFeedback) then FOwner.FOnGiveFeedback(dwEffect,Result);
  816. if dwEffect and DROPEFFECT_SCROLL<>0 then
  817. begin
  818. if dwEffect and DROPEFFECT_LINK<>0 then HC:=FOwner.FCHScrollLink
  819. else if dwEffect and DROPEFFECT_Move<>0 then HC:=FOwner.FCHScrollMove
  820. else if dwEffect and DROPEFFECT_COPY<>0 then HC:=FOwner.FCHScrollCopy
  821. else HC:=DefaultCursor;
  822. end
  823. else if dwEffect and DROPEFFECT_LINK<>0 then HC:=FOwner.FCHLink
  824. else if dwEffect and DROPEFFECT_Move<>0 then HC:=FOwner.FCHMove
  825. else if dwEffect and DROPEFFECT_COPY<>0 then HC:=FOwner.FCHCopy
  826. else HC:=DefaultCursor;
  827. if HC=DefaultCursor then Result:=DRAGDROP_S_USEDEFAULTCURSORS
  828. else
  829. begin
  830. Result:=S_Ok;
  831. Windows.SetCursor(HC);
  832. end;
  833. end;
  834. // TDropTarget interface -------------------------------------------------------
  835. constructor TDropTarget.Create(AOwner: TDragDrop);
  836. begin
  837. inherited Create;
  838. FOwner:=AOwner;
  839. _AddRef;
  840. HorzStartTimer:=TTimer.Create(FOwner);
  841. HorzStartTimer.Enabled:=false;
  842. HorzStartTimer.OnTimer:=OnStartTimer;
  843. HorzScrollTimer:=TTimer.Create(FOwner);
  844. HorzScrollTimer.Enabled:=false;
  845. HorzScrollTimer.OnTimer:=OnScrollTimer;
  846. VertStartTimer:=TTimer.Create(FOwner);
  847. VertStartTimer.Enabled:=false;
  848. VertStartTimer.OnTimer:=OnStartTimer;
  849. VertScrollTimer:=TTimer.Create(FOwner);
  850. VertScrollTimer.Enabled:=false;
  851. VertScrollTimer.OnTimer:=OnScrollTimer;
  852. FVScrollCode:=0;
  853. FHScrollCode:=0;
  854. end;
  855. destructor TDropTarget.Destroy;
  856. begin
  857. HorzStartTimer.Free;
  858. HorzScrollTimer.Free;
  859. VertStartTimer.Free;
  860. VertScrollTimer.Free;
  861. inherited Destroy;
  862. end;
  863. procedure TDropTarget.InitScroll(VerticalScroll:boolean; ScrollCode:integer);
  864. begin
  865. TermScroll(VerticalScroll);
  866. if VerticalScroll then
  867. begin
  868. VertStartTimer.Interval:=FOwner.FScrollDetectOptions.FStartDelay;
  869. VertStartTimer.Enabled:=true;
  870. FVScrollCode:=ScrollCode;
  871. end
  872. else
  873. begin
  874. HorzStartTimer.Interval:=FOwner.FScrollDetectOptions.FStartDelay;
  875. HorzStartTimer.Enabled:=true;
  876. FHScrollCode:=ScrollCode;
  877. end;
  878. end;
  879. procedure TDropTarget.TermScroll(VerticalScroll:boolean);
  880. begin
  881. if VerticalScroll then
  882. begin
  883. VertStartTimer.Enabled:=false;
  884. if VertScrollTimer.Enabled then
  885. sendmessage(FOwner.DragDropControl.handle,WM_VScroll,SB_ENDSCROLL,0);
  886. VertScrollTimer.Enabled:=false;
  887. FVScrollCode:=0;
  888. end
  889. else
  890. begin
  891. HorzStartTimer.Enabled:=false;
  892. if HorzScrollTimer.Enabled then
  893. sendmessage(FOwner.DragDropControl.handle,WM_HScroll,SB_ENDSCROLL,0);
  894. HorzScrollTimer.Enabled:=false;
  895. FHScrollCode:=0;
  896. end;
  897. end;
  898. procedure TDropTarget.DetermineScrollDir(VertScrolling:boolean;
  899. var ScrollCode:integer);
  900. var p1m,p1r,p2m,p2r:integer;
  901. ptmc:TPoint;
  902. SCROLLINFO:TSCROLLINFO;
  903. begin
  904. GetCursorPos(ptmc);
  905. ptmc:=FOwner.DragDropControl.ScreenToClient(ptmc);
  906. if VertScrolling then
  907. begin
  908. // Checking vertical scroll areas ...
  909. // If the vertical scroll areas intersect, we don't allow scrolling
  910. p1m:=FOwner.FScrollDetectOptions.AreaTop.Margin;
  911. p1r:=p1m+FOwner.ScrollDetectOptions.AreaTop.Range;
  912. p2m:=FOwner.DragDropControl.ClientHeight-1-
  913. FOwner.ScrollDetectOptions.AreaBottom.Margin;
  914. p2r:=p2m-FOwner.ScrollDetectOptions.AreaBottom.Range;
  915. if (p1r<p2r) then
  916. begin
  917. if (p1m<=ptmc.y) and (p1r>=ptmc.y) then ScrollCode:=1
  918. else if (p2m>=ptmc.y) and (p2r<=ptmc.y) then ScrollCode:=2
  919. else ScrollCode:=0;
  920. if ScrollCode>0 then
  921. begin
  922. ScrollInfo.cbSize := Sizeof(ScrollInfo);
  923. ScrollInfo.FMask:=SIF_PAGE or SIF_POS or SIF_RANGE;
  924. if GetScrollInfo(FOwner.DragDropControl.Handle,SB_VERT,
  925. ScrollInfo) then
  926. begin
  927. if ScrollInfo.nPage>0 then dec(ScrollInfo.nPage);
  928. if ((ScrollCode=1) and (ScrollInfo.nPos<=ScrollInfo.nMin)) or
  929. ((ScrollCode=2) and
  930. (ScrollInfo.nPos>=ScrollInfo.nMax-integer(ScrollInfo.nPage))) then
  931. ScrollCode:=0;
  932. end
  933. else ScrollCode:=0;
  934. end;
  935. end
  936. else ScrollCode:=0;
  937. end
  938. else
  939. begin
  940. // Checking horizontal scroll areas ...
  941. // If the horizontal scroll areas intersect, we don't allow scrolling
  942. p1m:=FOwner.FScrollDetectOptions.AreaLeft.Margin;
  943. p1r:=p1m+FOwner.ScrollDetectOptions.AreaLeft.Range;
  944. p2m:=FOwner.DragDropControl.ClientWidth-1-
  945. FOwner.ScrollDetectOptions.AreaRight.Margin;
  946. p2r:=p2m-FOwner.ScrollDetectOptions.AreaRight.Range;
  947. if (p1r<p2r) then
  948. begin
  949. if (p1m<=ptmc.x) and (p1r>=ptmc.x) then ScrollCode:=1
  950. else if (p2m>=ptmc.x) and (p2r<=ptmc.x) then ScrollCode:=2
  951. else ScrollCode:=0;
  952. if ScrollCode>0 then
  953. begin
  954. ScrollInfo.cbSize := Sizeof(ScrollInfo);
  955. ScrollInfo.FMask:=SIF_PAGE or SIF_POS or SIF_RANGE;
  956. if GetScrollInfo(FOwner.DragDropControl.Handle,SB_Horz,
  957. ScrollInfo) then
  958. begin
  959. if ScrollInfo.nPage>0 then dec(ScrollInfo.nPage);
  960. if ((ScrollCode=1) and (ScrollInfo.nPos<=ScrollInfo.nMin)) or
  961. ((ScrollCode=2) and
  962. (ScrollInfo.nPos>=ScrollInfo.nMax-integer(ScrollInfo.nPage))) then
  963. ScrollCode:=0;
  964. end
  965. else ScrollCode:=0;
  966. end;
  967. end
  968. else ScrollCode:=0;
  969. end;
  970. end;
  971. procedure TDropTarget.OnStartTimer(Sender: TObject);
  972. begin
  973. if Sender=HorzStartTimer then
  974. begin
  975. HorzStartTimer.Enabled:=false;
  976. HorzScrollTimer.Interval:=FOwner.FScrollDetectOptions.FScrollDelay;
  977. OnScrollTimer(HorzScrollTimer);
  978. HorzScrollTimer.Enabled:=true;
  979. end
  980. else
  981. begin
  982. VertStartTimer.Enabled:=false;
  983. VertScrollTimer.Interval:=FOwner.FScrollDetectOptions.FScrollDelay;
  984. OnScrollTimer(VertScrollTimer);
  985. VertScrollTimer.Enabled:=true;
  986. end;
  987. end;
  988. procedure TDropTarget.OnScrollTimer(Sender: TObject);
  989. var ScrollPage:boolean;
  990. pt:TPoint;
  991. Interval:TScrollInterval;
  992. ScrollCode,SCWParam:integer;
  993. begin
  994. Interval:=FOwner.FScrollDetectOptions.FScrollDelay;
  995. if Sender=VertScrollTimer then
  996. begin
  997. if FOwner.FScrollDetectOptions.FVertScrolling then
  998. begin
  999. DetermineScrollDir(true,ScrollCode);
  1000. if ScrollCode>0 then
  1001. begin
  1002. if ((VertStartTimer.Enabled=false) and (VertScrollTimer.Enabled=false)) or
  1003. (FVScrollCode<>ScrollCode) then InitScroll(true,ScrollCode)
  1004. else
  1005. begin
  1006. ScrollPage:=FOwner.FScrollDetectOptions.FVertPageScroll;
  1007. if assigned(FOwner.FOnBeforeScrolling) then
  1008. begin
  1009. GetCursorPos(pt);
  1010. pt:=FOwner.DragDropControl.ScreenToClient(pt);
  1011. if FVScrollCode=1 then FOwner.FOnBeforeScrolling(FOwner, pt,
  1012. Interval, sdUp, ScrollPage)
  1013. else FOwner.FOnBeforeScrolling(FOwner, pt, Interval, sdDown,
  1014. ScrollPage);
  1015. end;
  1016. if ScrollPage then
  1017. begin
  1018. if FVScrollCode=1 then SCWParam:=SB_PAGEUP
  1019. else SCWParam:=SB_PAGEDOWN;
  1020. end
  1021. else
  1022. begin
  1023. if FVScrollCode=1 then SCWParam:=SB_LINEUP
  1024. else SCWParam:=SB_LINEDOWN;
  1025. end;
  1026. sendmessage(FOwner.DragDropControl.handle,WM_VScroll,SCWParam,0);
  1027. if assigned(FOwner.FOnAfterScrolling) then
  1028. FOwner.FOnAfterScrolling(FOwner);
  1029. VertScrollTimer.Interval:=Interval;
  1030. end;
  1031. end
  1032. else if FVScrollCode<>0 then TermScroll(true);
  1033. end
  1034. else if FVScrollCode<>0 then TermScroll(true);
  1035. end
  1036. else
  1037. begin
  1038. if FOwner.FScrollDetectOptions.FHorzScrolling then
  1039. begin
  1040. DetermineScrollDir(false,ScrollCode);
  1041. if ScrollCode>0 then
  1042. begin
  1043. if ((HorzStartTimer.Enabled=false) and (HorzScrollTimer.Enabled=false)) or
  1044. (FHScrollCode<>ScrollCode) then InitScroll(false,ScrollCode)
  1045. else
  1046. begin
  1047. ScrollPage:=FOwner.FScrollDetectOptions.FHorzPageScroll;
  1048. if assigned(FOwner.FOnBeforeScrolling) then
  1049. begin
  1050. GetCursorPos(pt);
  1051. pt:=FOwner.DragDropControl.ScreenToClient(pt);
  1052. if FHScrollCode=1 then FOwner.FOnBeforeScrolling(FOwner, pt,
  1053. Interval, sdLeft, ScrollPage)
  1054. else FOwner.FOnBeforeScrolling(FOwner, pt, Interval, sdRight,
  1055. ScrollPage);
  1056. end;
  1057. if ScrollPage then
  1058. begin
  1059. if FHScrollCode=1 then SCWParam:=SB_PAGELEFT
  1060. else SCWParam:=SB_PAGERIGHT;
  1061. end
  1062. else
  1063. begin
  1064. if FHScrollCode=1 then SCWParam:=SB_LINELEFT
  1065. else SCWParam:=SB_LINERIGHT;
  1066. end;
  1067. sendmessage(FOwner.DragDropControl.handle,WM_HScroll,SCWParam,0);
  1068. HorzScrollTimer.Interval:=Interval;
  1069. end;
  1070. end
  1071. else if FHScrollCode<>0 then TermScroll(false);
  1072. end
  1073. else if FHScrollCode<>0 then TermScroll(false);
  1074. end;
  1075. end;
  1076. procedure TDropTarget.SuggestDropEffect(grfKeyState: Longint; var dwEffect: longint);
  1077. begin
  1078. if (FOwner.FAcceptOwnDnD=false) and
  1079. (FOwner.FOwnerIsSource) then dwEffect:=DropEffect_None
  1080. else if (grfKeyState and MK_CONTROL=0) and (grfKeyState and MK_SHIFT<>0) and
  1081. (FOwner.FTargetEffects and DropEffect_Move<>0) then
  1082. dwEffect:=DropEffect_Move
  1083. else if (grfKeyState and MK_CONTROL<>0) and
  1084. (grfKeyState and MK_SHIFT<>0) and
  1085. (FOwner.FTargetEffects and DropEffect_Link<>0) then
  1086. dwEffect:=DropEffect_Link
  1087. else if (deCopy in FOwner.FTargetEffectsSet) and
  1088. (dwEffect and DropEffect_Copy<>0) then
  1089. dwEffect:=DropEffect_Copy
  1090. else if (deMove in FOwner.FTargetEffectsSet) and
  1091. (dwEffect and DropEffect_Move<>0) then
  1092. dwEffect:=DropEffect_Move
  1093. else if (deLink in FOwner.FTargetEffectsSet) and
  1094. (dwEffect and DropEffect_Link<>0) then
  1095. dwEffect:=DropEffect_Link
  1096. else dwEffect:=DropEffect_None;
  1097. if FOwner.FTargetScrolling<>0 then dwEffect:=dwEffect or integer(DropEffect_Scroll);
  1098. end;
  1099. procedure TDropTarget.AcceptDataObject(DataObj: IDataObject; var Accept:boolean);
  1100. begin
  1101. Accept:=true;
  1102. end;
  1103. function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
  1104. pt: TPoint; var dwEffect: Longint): HResult;
  1105. // Is called if the d&d-mouse cursor moves ON (one call only) the TargeTWinControl. Here,
  1106. // you influence if a drop can be accepted and the drop's effect if accepted.
  1107. begin
  1108. TDragDrop(FOwner).FInternalSource:=GInternalSource;
  1109. FOwner.FAvailableDropEffects:=dwEffect;
  1110. FOwner.FContextMenu:=grfKeyState and mk_rbutton<>0;
  1111. if (FOwner.RenderDataOn=rdoEnter) or (FOwner.RenderDataOn=rdoEnterAndDropSync) or
  1112. (FOwner.RenderDataOn=rdoEnterAndDropAsync) then
  1113. RenderDropped(DataObj, grfKeyState, pt, dwEffect);
  1114. SuggestDropEffect(grfKeyState,dwEffect);
  1115. AcceptDataObject(DataObj, FAccept);
  1116. if Assigned(FOwner.OnDragEnter) then
  1117. FOwner.OnDragEnter(DataObj, grfKeyState,
  1118. FOwner.FDragDropControl.ScreenToClient(pt), dwEffect, FAccept);
  1119. if ((FOwner.FAcceptOwnDnD=false) and (FOwner.FOwnerIsSource)) or
  1120. (FAccept=false) then dwEffect:=DropEffect_None;
  1121. Result:= NOERROR;
  1122. end;
  1123. function TDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
  1124. var dwEffect: Longint): HResult;
  1125. // Is called if the mouse cursor moves OVER (called on every mouse move) the
  1126. // TargeTWinControl. Even here may you influence if a drop can be accepted and the
  1127. // drop's effect if accepted. Because this function is very often called YOUR
  1128. // function should be very efficient programmed.
  1129. var ScrollCode:integer;
  1130. begin
  1131. if FOwner.FScrollDetectOptions.FVertScrolling then
  1132. begin
  1133. DetermineScrollDir(true,ScrollCode);
  1134. if ScrollCode>0 then
  1135. begin
  1136. if ((VertStartTimer.Enabled=false) and (VertScrollTimer.Enabled=false)) or
  1137. (FVScrollCode<>ScrollCode) then InitScroll(true,ScrollCode);
  1138. end
  1139. else if FVScrollCode<>0 then TermScroll(true);
  1140. end
  1141. else if FVScrollCode<>0 then TermScroll(true);
  1142. if FOwner.FScrollDetectOptions.FHorzScrolling then
  1143. begin
  1144. DetermineScrollDir(false,ScrollCode);
  1145. if ScrollCode>0 then
  1146. begin
  1147. if ((HorzStartTimer.Enabled=false) and (HorzScrollTimer.Enabled=false)) or
  1148. (FHScrollCode<>ScrollCode) then InitScroll(false,ScrollCode);
  1149. end
  1150. else if FHScrollCode<>0 then TermScroll(false);
  1151. end
  1152. else if FHScrollCode<>0 then TermScroll(false);
  1153. if FAccept=false then dwEffect:=DropEffect_None;
  1154. SuggestDropEffect(grfKeyState,dwEffect);
  1155. if Assigned(FOwner.OnDragOver) then
  1156. FOwner.OnDragOver(grfKeyState, FOwner.FDragDropControl.ScreenToClient(pt),
  1157. dwEffect);
  1158. if ((FOwner.FAcceptOwnDnD=false) and (FOwner.FOwnerIsSource)) or
  1159. (FAccept=false) then dwEffect:=DropEffect_None;
  1160. Result:=NOERROR;
  1161. end;
  1162. function TDropTarget.DragLeave: HResult;
  1163. // Removes target feedback and releases the data object.
  1164. begin
  1165. TDragDrop(FOwner).FInternalSource:=nil;
  1166. if Assigned(FOwner.OnDragLeave) then FOwner.OnDragLeave;
  1167. FOwner.FAvailableDropEffects:=0;
  1168. Result:=NOERROR;
  1169. TermScroll(true);
  1170. TermScroll(false);
  1171. end;
  1172. function TDropTarget.Drop(const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  1173. var dwEffect: Longint): HResult;
  1174. // Instructs drop target to handle the datas which are dropped on it.
  1175. var Menu:HMenu;
  1176. Cmd:Cardinal;
  1177. mcursor:TCursor;
  1178. KeyState:integer;
  1179. function BuildMenuItemInfo(ACaption:string; ShowDefault:boolean;
  1180. ACommand:UInt; ASeparator:boolean):TMenuItemInfo;
  1181. begin
  1182. with Result do
  1183. begin
  1184. // cbSize:=SizeOf(MenuItemInfo);
  1185. cbSize:=44; //Required for Windows95
  1186. fMask:=MIIM_ID or MIIM_STATE or MIIM_TYPE;
  1187. if ASeparator then fType:=MFT_SEPARATOR
  1188. else fType:=MFT_STRING;
  1189. if ShowDefault then fState:=MFS_ENABLED or MFS_Default
  1190. else fState:=MFS_ENABLED;
  1191. wID:=ACommand;
  1192. hSubMenu:=0;
  1193. hbmpChecked:=0;
  1194. hbmpUnchecked:=0;
  1195. dwTypeData:=PChar(ACaption);
  1196. end;
  1197. end;
  1198. begin
  1199. Result:=E_Fail;
  1200. if FOwner.FContextMenu then KeyState:=grfKeyState or MK_RButton
  1201. else KeyState:=grfKeyState or MK_LButton;
  1202. if FAccept then SuggestDropEffect(KeyState,dwEffect)
  1203. else dwEffect:=DropEffect_None;
  1204. if assigned(FOwner.OnDragOver) then
  1205. FOwner.OnDragOver(KeyState, FOwner.FDragDropControl.ScreenToClient(pt),
  1206. dwEffect);
  1207. if ((FOwner.FAcceptOwnDnD=false) and (FOwner.FOwnerIsSource)) or
  1208. (FAccept=false) then dwEffect:=DropEffect_None;
  1209. TermScroll(true);
  1210. TermScroll(false);
  1211. if (FOwner.DropHandler(DataObj, KeyState, pt, dwEffect)=false) then
  1212. begin
  1213. // Show popup menu?
  1214. if FOwner.FContextMenu and FOwner.FShowPopupMenu and (dwEffect<>DropEffect_None) then
  1215. begin
  1216. Menu:=CreatePopupMenu;
  1217. if (deMove in FOwner.FTargetEffectsSet) and
  1218. (FOwner.FAvailableDropEffects and DropEffect_Move<>0) then
  1219. InsertMenuItem(Menu, DWORD(-1), true,
  1220. BuildMenuItemInfo(MIMoveStr, dwEffect and DropEffect_Move<>0,
  1221. CmdMove, false));
  1222. if (deCopy in FOwner.FTargetEffectsSet) and
  1223. (FOwner.FAvailableDropEffects and DropEffect_Copy<>0) then
  1224. InsertMenuItem(Menu, DWORD(-1), true,
  1225. BuildMenuItemInfo(MICopyStr, dwEffect and DropEffect_Copy<>0,
  1226. CmdCopy, false));
  1227. if (deLink in FOwner.FTargetEffectsSet) and
  1228. (FOwner.FAvailableDropEffects and DropEffect_Link<>0) then
  1229. InsertMenuItem(Menu, DWORD(-1), true,
  1230. BuildMenuItemInfo(MILinkStr, dwEffect and DropEffect_Link<>0,
  1231. CmdLink, false));
  1232. InsertMenuItem(Menu, DWORD(-1), true,
  1233. BuildMenuItemInfo('-', false, CmdSeparator, true));
  1234. InsertMenuItem(Menu, DWORD(-1), true,
  1235. BuildMenuItemInfo(MIAbortStr, false, CmdAbort, false));
  1236. // Add custom-menuitems ...
  1237. FOwner.DoMenuPopup(self, Menu, DataObj, MinCustCmd, KeyState, pt);
  1238. try
  1239. dwEffect:=DROPEFFECT_None;
  1240. Cmd:=Cardinal(TrackPopupMenuEx(Menu, TPM_LEFTALIGN or TPM_RIGHTBUTTON or TPM_RETURNCMD,
  1241. pt.x, pt.y, FOwner.DragDropControl.Handle, nil));
  1242. case Cmd of
  1243. CmdMove: dwEffect:=DROPEFFECT_Move;
  1244. CmdCopy: dwEffect:=DROPEFFECT_Copy;
  1245. CmdLink: dwEffect:=DROPEFFECT_Link;
  1246. CmdSeparator, CmdAbort:
  1247. dwEffect:=DROPEFFECT_None;
  1248. else // custom-menuitem was selected ...
  1249. begin
  1250. dwEffect:=DROPEFFECT_None;
  1251. if FOwner.DoMenuExecCmd(self, Menu, DataObj, Cmd, dwEffect) and
  1252. assigned(FOwner.FOnMenuSucceeded) then
  1253. FOwner.FOnMenuSucceeded(self, KeyState,
  1254. FOwner.FDragDropControl.ScreenToClient(pt), dwEffect);
  1255. end;
  1256. end;
  1257. finally
  1258. FOwner.DoMenuDestroy(Self, Menu);
  1259. DestroyMenu(Menu);
  1260. end;
  1261. end;
  1262. if assigned(FOwner.OnDrop) then
  1263. FOwner.OnDrop(DataObj, KeyState,
  1264. FOwner.FDragDropControl.ScreenToClient(pt), dwEffect);
  1265. if dwEffect<>DROPEFFECT_None then
  1266. begin
  1267. if FOwner.FBTF Then
  1268. SetForegroundWindow((FOwner.Owner As TWinControl).Handle);
  1269. TDragDrop(FOwner).FdwEffect:=dwEffect;
  1270. TDragDrop(FOwner).FgrfKeyState:=KeyState;
  1271. TDragDrop(FOwner).Fpt:=pt;
  1272. if (FOwner.RenderDataOn=rdoDropAsync) or
  1273. (FOwner.RenderDataOn=rdoEnterAndDropAsync) then
  1274. begin
  1275. TDragDrop(FOwner).FDataObj:=DataObj;
  1276. DataObj._AddRef;
  1277. end
  1278. else if (FOwner.RenderDataOn=rdoDropSync) or
  1279. (FOwner.RenderDataOn=rdoEnterAndDropSync) then
  1280. begin
  1281. // Set hourglass-cursor
  1282. mcursor:=Screen.Cursor;
  1283. Screen.Cursor:=crHourGlass;
  1284. try
  1285. RenderDropped(DataObj, KeyState, pt, dwEffect);
  1286. finally
  1287. // Set old cursor
  1288. Screen.Cursor:=mcursor;
  1289. end;
  1290. end;
  1291. PostMessage(FOwner.DragDropControl.Handle,DDM_ProcessDropped,0,0);
  1292. Result:=NOERROR;
  1293. end
  1294. else TDragDrop(FOwner).FInternalSource:=nil;
  1295. end
  1296. else
  1297. begin
  1298. TDragDrop(FOwner).FInternalSource:=nil;
  1299. if assigned(FOwner.FOnDropHandlerSucceeded) then
  1300. FOwner.FOnDropHandlerSucceeded(self, KeyState,
  1301. FOwner.FDragDropControl.ScreenToClient(pt), dwEffect);
  1302. end;
  1303. end;
  1304. procedure TDropTarget.RenderDropped(DataObj: IDataObject; grfKeyState: Longint;
  1305. pt: TPoint; var dwEffect: longint);
  1306. begin
  1307. // override, if you need ...
  1308. end;
  1309. // TScrollDetectArea methods ---------------------------------------------------
  1310. constructor TScrollDetectArea.Create(Control: TPersistent);
  1311. begin
  1312. inherited Create;
  1313. FControl:=Control;
  1314. end;
  1315. procedure TScrollDetectArea.AssignTo(Dest: TPersistent);
  1316. begin
  1317. if Dest is TScrollDetectArea then
  1318. with TScrollDetectArea(Dest) do
  1319. begin
  1320. FMargin:=Self.FMargin;
  1321. FRange:=Self.FRange;
  1322. Change;
  1323. end
  1324. else inherited AssignTo(Dest);
  1325. end;
  1326. procedure TScrollDetectArea.SetValue(Index: Integer;
  1327. Value: word);
  1328. begin
  1329. case Index of
  1330. 0: if Value<>FMargin then
  1331. begin
  1332. FMargin:=Value;
  1333. Change;
  1334. end;
  1335. 1: if Value<>FRange then
  1336. begin
  1337. FRange:=Value;
  1338. Change;
  1339. end;
  1340. end;
  1341. end;
  1342. procedure TScrollDetectArea.Change;
  1343. begin
  1344. if Assigned(FOnChange) then FOnChange(Self);
  1345. end;
  1346. // TScrollDetectOptions methods -------------------------------------------------
  1347. constructor TScrollDetectOptions.Create(Control: TDragDrop);
  1348. begin
  1349. inherited Create;
  1350. FControl:=Control;
  1351. FScrollDelay:=100;
  1352. FStartDelay:=750;
  1353. FLeft:=TScrollDetectArea.Create(self);
  1354. FLeft.Margin:=0;
  1355. FLeft.Range:=10;
  1356. FLeft.OnChange:=FOnChange;
  1357. FTop:=TScrollDetectArea.Create(self);
  1358. FTop.Margin:=0;
  1359. FTop.Range:=10;
  1360. FTop.OnChange:=FOnChange;
  1361. FRight:=TScrollDetectArea.Create(self);
  1362. FRight.Margin:=0;
  1363. FRight.Range:=10;
  1364. FRight.OnChange:=FOnChange;
  1365. FBottom:=TScrollDetectArea.Create(self);
  1366. FBottom.Margin:=0;
  1367. FBottom.Range:=10;
  1368. FBottom.OnChange:=FOnChange;
  1369. FHorzScrolling:=false;
  1370. FVertScrolling:=false;
  1371. FHorzPageScroll:=false;
  1372. FVertPageScroll:=false;
  1373. end;
  1374. destructor TScrollDetectOptions.Destroy;
  1375. begin
  1376. FLeft.Free;
  1377. FTop.Free;
  1378. FRight.Free;
  1379. FBottom.Free;
  1380. inherited Destroy;
  1381. end;
  1382. procedure TScrollDetectOptions.AssignTo(Dest: TPersistent);
  1383. begin
  1384. if Dest is TScrollDetectOptions then
  1385. with TScrollDetectOptions(Dest) do
  1386. begin
  1387. FScrollDelay:=Self.FScrollDelay;
  1388. FStartDelay:=Self.FStartDelay;
  1389. FLeft.AssignTo(Self.FLeft);
  1390. FTop.AssignTo(Self.FTop);
  1391. FRight.AssignTo(Self.FRight);
  1392. FBottom.AssignTo(Self.FBottom);
  1393. Change;
  1394. end
  1395. else inherited AssignTo(Dest);
  1396. end;
  1397. procedure TScrollDetectOptions.SetValue(index:integer; Value: TScrollInterval);
  1398. begin
  1399. if (Index=0) and (Value<>FScrollDelay) then
  1400. begin
  1401. FScrollDelay:=Value;
  1402. Change;
  1403. end;
  1404. if (Index=1) and (Value<>FStartDelay) then
  1405. begin
  1406. FStartDelay:=Value;
  1407. Change;
  1408. end;
  1409. end;
  1410. procedure TScrollDetectOptions.Change;
  1411. begin
  1412. if Assigned(FOnChange) then FOnChange(Self);
  1413. end;
  1414. // TDragDrop control ------------------------------------------------------
  1415. constructor TDragDrop.Create(AOwner: TComponent);
  1416. begin
  1417. inherited Create(AOwner);
  1418. FDropTarget:=TDropTarget.Create(Self);
  1419. FRegistered:=False;
  1420. FDragDropControl:=nil;
  1421. FBTF:=False;
  1422. FAcceptOwnDnD:=false;
  1423. FShowPopupMenu:=true;
  1424. FDragDetectDelta:=10;
  1425. FDragDetectStatus:=ddsNone;
  1426. FRenderDataOn:=rdoDropSync;
  1427. FCHCopy:=DefaultCursor;
  1428. FCHMove:=DefaultCursor;
  1429. FCHLink:=DefaultCursor;
  1430. FCHScrollCopy:=DefaultCursor;
  1431. FCHScrollMove:=DefaultCursor;
  1432. FCHScrollLink:=DefaultCursor;
  1433. FMessageHooked:=false;
  1434. FAvailableDropEffects:=0;
  1435. FTargetScrolling:=0;
  1436. FSrcCompatibilityCheck:=[CheckLindex, CheckdwAspect];
  1437. FScrollDetectOptions:=TScrollDetectOptions.Create(Self);
  1438. FInternalSource:=nil;
  1439. end;
  1440. destructor TDragDrop.Destroy;
  1441. begin
  1442. UnregisterTarget;
  1443. UnhookMessageHandler(true);
  1444. FDropTarget._Release;
  1445. FDropTarget:=nil;
  1446. FDragDropControl:=nil;
  1447. FScrollDetectOptions.Free;
  1448. inherited Destroy;
  1449. end;
  1450. procedure TDragDrop.WndMethod(var Msg: TMessage); // message-hook to receive DDM_ProcessDropped
  1451. var mcursor:TCursor;
  1452. begin
  1453. with Msg do
  1454. begin
  1455. Result:=CallWindowProc(OldWndProc, DragDropControl.Handle, Msg, wParam, LParam);
  1456. if (Msg=DDM_ProcessDropped) then
  1457. begin
  1458. if (RenderDataOn=rdoDropAsync) or (RenderDataOn=rdoEnterAndDropAsync) then
  1459. begin
  1460. // Set hourglass-cursor
  1461. mcursor:=Screen.Cursor;
  1462. Screen.Cursor:=crHourGlass;
  1463. try
  1464. FDropTarget.RenderDropped(FDataObj, FgrfKeyState, Fpt, FdwEffect);
  1465. FDataObj._Release;
  1466. finally
  1467. // Set old cursor
  1468. Screen.Cursor:=mcursor;
  1469. end;
  1470. end;
  1471. if assigned(FOnProcessDropped) then
  1472. FOnProcessDropped(self, FgrfKeyState,
  1473. FDragDropControl.ScreenToClient(Fpt), FdwEffect);
  1474. FAvailableDropEffects:=0;
  1475. FInternalSource:=nil;
  1476. end;
  1477. case Msg of
  1478. WM_Destroy:
  1479. begin
  1480. if FRegistered then
  1481. begin
  1482. CoLockObjectExternal(FDropTarget, false, false);
  1483. if (FDragDropControl.HandleAllocated=false) or
  1484. (FDragDropControl.HandleAllocated and
  1485. (RevokeDragDrop(FDragDropControl.Handle)=S_OK)) then
  1486. FRegistered:=false;
  1487. end;
  1488. FMessageHooked:=false;
  1489. end;
  1490. WM_LBUTTONDOWN, WM_RBUTTONDOWN:
  1491. begin
  1492. if FAutoDetectDnD and (FDragDetectStatus=ddsNone) and
  1493. (FSourceEffects<>0) then
  1494. begin
  1495. if Msg=WM_LBUTTONDOWN then FDragDetectStatus:=ddsLeft
  1496. else FDragDetectStatus:=ddsRight;
  1497. GetCursorPos(FDragDetectStart);
  1498. if assigned(FOnDragDetect) then
  1499. FOnDragDetect(wparam,
  1500. FDragDropControl.ScreenToClient(FDragDetectStart),
  1501. FDragDropControl.ScreenToClient(FDragDetectStart),
  1502. FDragDetectStatus);
  1503. if (MouseHookHandle<>0) then
  1504. begin // MouseHookProc is used by another component ...
  1505. UnHookWindowsHookEx(MouseHookHandle);
  1506. MouseHookHandle:=0;
  1507. if assigned(MouseHookDragDrop) then
  1508. begin
  1509. MouseHookDragDrop.FDragDetectStatus:=ddsNone;
  1510. if assigned(MouseHookDragDrop.FOnDragDetect) then
  1511. MouseHookDragDrop.FOnDragDetect(wparam,
  1512. MouseHookDragDrop.FDragDropControl.ScreenToClient(
  1513. MouseHookDragDrop.FDragDetectStart),
  1514. MouseHookDragDrop.FDragDropControl.ScreenToClient(
  1515. FDragDetectStart),
  1516. MouseHookDragDrop.FDragDetectStatus);
  1517. end;
  1518. end;
  1519. MouseHookDragDrop:=self;
  1520. MouseHookHandle:=SetWindowsHookEx(WH_MOUSE,MouseHookProc,LongWord(HInstance),0);
  1521. end;
  1522. end;
  1523. WM_HSCROLL:
  1524. if LOWORD(wParam)<>SB_ENDSCROLL then FTargetScrolling:=FTargetScrolling or 1
  1525. else FTargetScrolling:=FTargetScrolling and not 1;
  1526. WM_VSCROLL:
  1527. if LOWORD(wParam)<>SB_ENDSCROLL then FTargetScrolling:=FTargetScrolling or 2
  1528. else FTargetScrolling:=FTargetScrolling and not 2;
  1529. WM_MOUSEMOVE:
  1530. if (MouseHookHandle<>0) and (wParam and (MK_LBUTTON or MK_RBUTTON)=0) then
  1531. begin
  1532. UnHookWindowsHookEx(MouseHookHandle);
  1533. MouseHookHandle:=0;
  1534. if assigned(MouseHookDragDrop) then
  1535. begin
  1536. MouseHookDragDrop.FDragDetectStatus:=ddsNone;
  1537. if assigned(MouseHookDragDrop.FOnDragDetect) then
  1538. MouseHookDragDrop.FOnDragDetect(wparam,
  1539. MouseHookDragDrop.FDragDropControl.ScreenToClient(
  1540. MouseHookDragDrop.FDragDetectStart),
  1541. MouseHookDragDrop.FDragDropControl.ScreenToClient(
  1542. FDragDetectStart),
  1543. MouseHookDragDrop.FDragDetectStatus);
  1544. end;
  1545. MouseHookDragDrop:=nil;
  1546. end;
  1547. end;
  1548. end;
  1549. end;
  1550. procedure TDragDrop.StartDnDDetection(Button: TMouseButton);
  1551. var grfKeyState: Longint;
  1552. begin
  1553. if Button=mbLeft then FDragDetectStatus:=ddsLeft
  1554. else if Button=mbRight then FDragDetectStatus:=ddsRight
  1555. else
  1556. begin
  1557. FDragDetectStatus:=ddsNone;
  1558. exit;
  1559. end;
  1560. GetCursorPos(FDragDetectStart);
  1561. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then grfKeyState:=MK_SHIFT
  1562. else grfKeyState:=0;
  1563. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  1564. grfKeyState:=grfKeyState or MK_CONTROL;
  1565. if (MouseHookHandle<>0) then
  1566. begin // MouseHookProc is used by another component ...
  1567. UnHookWindowsHookEx(MouseHookHandle);
  1568. MouseHookHandle:=0;
  1569. if assigned(MouseHookDragDrop) then
  1570. begin
  1571. MouseHookDragDrop.FDragDetectStatus:=ddsNone;
  1572. if assigned(MouseHookDragDrop.FOnDragDetect) then
  1573. MouseHookDragDrop.FOnDragDetect(grfKeyState,
  1574. MouseHookDragDrop.FDragDropControl.ScreenToClient(
  1575. MouseHookDragDrop.FDragDetectStart),
  1576. MouseHookDragDrop.FDragDropControl.ScreenToClient(FDragDetectStart),
  1577. MouseHookDragDrop.FDragDetectStatus);
  1578. end;
  1579. end;
  1580. MouseHookDragDrop:=self;
  1581. MouseHookHandle:=SetWindowsHookEx(WH_MOUSE,MouseHookProc,LongWord(HInstance),0);
  1582. if assigned(FOnDragDetect) then
  1583. FOnDragDetect(grfKeyState,
  1584. FDragDropControl.ScreenToClient(FDragDetectStart),
  1585. FDragDropControl.ScreenToClient(FDragDetectStart),
  1586. FDragDetectStatus);
  1587. end;
  1588. procedure TDragDrop.Loaded;
  1589. // Methode which is called if all components are created - now, we can register
  1590. // the target control for drag-and-drop operations
  1591. begin
  1592. inherited Loaded;
  1593. if (FDragDropControl<>nil) and (csDesigning in ComponentState=false) then RegisterTarget;
  1594. end;
  1595. procedure TDragDrop.Notification(AComponent: TComponent; Operation: TOperation);
  1596. begin
  1597. inherited Notification(AComponent,Operation);
  1598. if (AComponent=FDragDropControl) and (Operation=opRemove) then
  1599. begin
  1600. UnregisterTarget;
  1601. UnhookMessageHandler(true);
  1602. FDragDropControl:=nil;
  1603. end;
  1604. end;
  1605. function TDragDrop.RegisterTarget: Boolean;
  1606. // Methode for registering the DragDropControl for drag-and-drop oprations
  1607. begin
  1608. Result:=false;
  1609. try
  1610. HookMessageHandler;
  1611. finally
  1612. // nothing to do
  1613. end;
  1614. if FRegistered or (FTargetEffects=0) or (FDragDropControl=nil) then exit;
  1615. try
  1616. // CoLockObjectExternal crashes debugging intermittently in C++ Builder 2010
  1617. {$IFNDEF IDE}
  1618. // Ensure that drag-and-drop interface stays in memory
  1619. CoLockObjectExternal(FDropTarget, True, False);
  1620. {$ENDIF}
  1621. if RegisterDragDrop(FDragDropControl.Handle, IDropTarget(FDropTarget))=S_OK then
  1622. begin
  1623. Result:=True;
  1624. FRegistered:=True;
  1625. end;
  1626. except
  1627. Result:=false;
  1628. FRegistered:=false;
  1629. end;
  1630. end;
  1631. function TDragDrop.UnRegisterTarget: Boolean;
  1632. begin
  1633. Result:=false;
  1634. if (FRegistered=false) or (FDragDropControl=nil) then exit;
  1635. try
  1636. UnHookMessageHandler(false);
  1637. CoLockObjectExternal(FDropTarget, false, False);
  1638. if (FDragDropControl.HandleAllocated=false) or
  1639. (FDragDropControl.HandleAllocated and
  1640. (RevokeDragDrop(FDragDropControl.Handle)=S_OK)) then
  1641. begin
  1642. FRegistered:=false;
  1643. Result:=true;
  1644. end;
  1645. except
  1646. end;
  1647. end;
  1648. procedure TDragDrop.HookMessageHandler;
  1649. begin
  1650. if (FDragDropControl=nil) or (FDragDropControl.Handle=0) then exit;
  1651. if (FMessageHooked=false) and ((FSourceEffects<>0) or (FTargetEffects<>0)) then
  1652. begin
  1653. WndProcPtr:=MakeObjectInstance(WndMethod);
  1654. OldWndProc:=Pointer(SetWindowLong(FDragDropControl.Handle, GWL_WNDPROC,
  1655. longint(WndProcPtr)));
  1656. FMessageHooked:=true;
  1657. end;
  1658. end;
  1659. procedure TDragDrop.UnhookMessageHandler(ForceUnhook:boolean);
  1660. begin
  1661. if FMessageHooked and (ForceUnhook or ((FSourceEffects=0) and (FTargetEffects=0))) then
  1662. begin
  1663. begin
  1664. SetWindowLong(FDragDropControl.Handle, GWL_WNDPROC, longint(OldWndProc));
  1665. FreeObjectInstance(WndProcPtr);
  1666. WndProcPtr:=nil;
  1667. OldWndProc:=nil;
  1668. end;
  1669. FMessageHooked:=false;
  1670. end;
  1671. end;
  1672. procedure TDragDrop.DoMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject; AMinCustCmd:integer;
  1673. grfKeyState: Longint; pt: TPoint);
  1674. begin
  1675. if assigned(FOnMenuPopup) then
  1676. FOnMenuPopup(Sender, AMenu, DataObj, AMinCustCmd, grfKeyState,
  1677. FDragDropControl.ScreenToClient(pt));
  1678. end;
  1679. function TDragDrop.DoMenuExecCmd(Sender: TObject; AMenu: HMenu; DataObj:IDataObject;
  1680. Command:integer; var dwEffect: longint):boolean;
  1681. begin
  1682. Result:=false;
  1683. if assigned(FOnMenuExecCmd) then
  1684. FOnMenuExecCmd(Sender, AMenu, DataObj, Command, dwEffect, Result);
  1685. end;
  1686. procedure TDragDrop.DoMenuDestroy(Sender:TObject; AMenu: HMenu);
  1687. begin
  1688. if assigned(FOnMenuDestroy) then FOnMenuDestroy(Sender, AMenu);
  1689. end;
  1690. procedure TDragDrop.SetDragDropControl(WinControl: TWinControl);
  1691. begin
  1692. if WinControl<>FDragDropControl then
  1693. begin
  1694. if FRegistered and (csDesigning in ComponentState=false) then
  1695. begin
  1696. UnhookMessageHandler(true);
  1697. UnregisterTarget;
  1698. end;
  1699. FDragDropControl:=WinControl;
  1700. if (csDesigning in ComponentState=false) then RegisterTarget;
  1701. end;
  1702. end;
  1703. function TDragDrop.ExecuteOperation(DataObject:TDataObject): TDragResult;
  1704. var dwEffect: Longint;
  1705. DropSource: TDropSource;
  1706. pt: tpoint;
  1707. grfKeyState:longint;
  1708. begin
  1709. Result:=drInvalid;
  1710. if (DataObject=nil) or (GInternalSource<>nil) then exit;
  1711. GInternalSource:=self;
  1712. if (FSourceEffects<>0) then
  1713. begin
  1714. if MouseHookHandle<>0 then
  1715. begin
  1716. UnHookWindowsHookEx(MouseHookHandle);
  1717. MouseHookHandle:=0;
  1718. end;
  1719. FDragDetectStatus:=ddsDrag;
  1720. DataObject.FCheckLindex:=CheckLindex in FSrcCompatibilityCheck;
  1721. DataObject.FCheckdwAspect:=CheckdwAspect in FSrcCompatibilityCheck;
  1722. try
  1723. FOwnerIsSource:=true;
  1724. try
  1725. DropSource:=TDropSource.Create(self);
  1726. try
  1727. if (DataObject<>nil) and (DragDropControl<>nil) and
  1728. (DoDragDrop(IDataObject(DataObject), DropSource,
  1729. FSourceEffects, dwEffect)=DRAGDROP_S_DROP) then
  1730. begin
  1731. case dwEffect and ((DropEffect_Copy or
  1732. DropEffect_Move or DropEffect_Link)) of
  1733. DropEffect_Copy: Result:=drCopy;
  1734. DropEffect_Move: Result:=drMove;
  1735. DropEffect_Link: Result:=drLink;
  1736. else
  1737. begin
  1738. {MP dropped on no-drop location or }
  1739. {cancelled by ddext after drop with move-effect}
  1740. Result:=drInvalid;
  1741. end;
  1742. end;
  1743. end
  1744. else
  1745. begin
  1746. {MP cancelled by user }
  1747. Result:=drCancelled;
  1748. end;
  1749. finally
  1750. DropSource._Release;
  1751. end;
  1752. except
  1753. Result:=drInvalid;
  1754. raise;
  1755. end;
  1756. finally
  1757. FOwnerIsSource:=false;
  1758. DataObject._Release;
  1759. end;
  1760. FDragDetectStatus:=ddsNone;
  1761. if assigned(FOnDragDetect) then
  1762. begin
  1763. GetCursorPos(pt);
  1764. if HiWord(DWord(GetKeyState(VK_SHIFT)))<>0 then grfKeyState:=MK_SHIFT
  1765. else grfKeyState:=0;
  1766. if HiWord(DWord(GetKeyState(VK_CONTROL)))<>0 then
  1767. grfKeyState:=grfKeyState or MK_CONTROL;
  1768. FOnDragDetect(grfKeyState,
  1769. FDragDropControl.ScreenToClient(FDragDetectStart),
  1770. FDragDropControl.ScreenToClient(pt), FDragDetectStatus);
  1771. end;
  1772. end
  1773. else
  1774. begin
  1775. FDragDetectStatus:=ddsNone;
  1776. Result:=drCancelled;
  1777. end;
  1778. GInternalSource:=nil;
  1779. end;
  1780. function TDragDrop.Execute: TDragResult;
  1781. begin
  1782. Result:=ExecuteOperation(CreateDataObject);
  1783. end;
  1784. procedure TDragDrop.SetSourceEffects(Values:TDropEffectSet);
  1785. begin
  1786. FSourceEffectsSet:=Values;
  1787. FSourceEffects:=0;
  1788. if deCopy in Values then inc(FSourceEffects,DROPEFFECT_COPY);
  1789. if deMove in Values then inc(FSourceEffects,DROPEFFECT_MOVE);
  1790. if deLink in Values then inc(FSourceEffects,DROPEFFECT_LINK);
  1791. if (csDesigning in ComponentState=false) and (csLoading in ComponentState=false) then
  1792. begin
  1793. if (csDesigning in ComponentState=false) and (FMessageHooked=false) and
  1794. (FSourceEffects<>0) then HookMessageHandler;
  1795. if (csDesigning in ComponentState=false) and (FMessageHooked=true) and
  1796. (FSourceEffects=0) then UnhookMessageHandler(false);
  1797. end;
  1798. end;
  1799. procedure TDragDrop.SetTargetEffects(Values:TDropEffectSet);
  1800. begin
  1801. FTargetEffectsSet:=Values;
  1802. FTargetEffects:=0;
  1803. if deCopy in Values then inc(FTargetEffects,DROPEFFECT_COPY);
  1804. if deMove in Values then inc(FTargetEffects,DROPEFFECT_MOVE);
  1805. if deLink in Values then inc(FTargetEffects,DROPEFFECT_LINK);
  1806. if (csDesigning in ComponentState=false) and (FRegistered=false) and
  1807. (FTargetEffects<>0) then RegisterTarget;
  1808. if (FRegistered=true) and (FTargetEffects=0) then
  1809. UnRegisterTarget;
  1810. end;
  1811. procedure SetMenuItemsStrings;
  1812. begin
  1813. {MP}{ case SysLocale.PriLangID of
  1814. LANG_GERMAN:
  1815. begin
  1816. MICopyStr:='Hierher &kopieren';
  1817. MIMoveStr:='Hierher &verschieben';
  1818. MILinkStr:='Verknüpfung(en) hier &erstellen';
  1819. MIAbortStr:='&Abbrechen';
  1820. end;
  1821. LANG_FRENCH:
  1822. begin // French
  1823. MICopyStr:='&Copier ici';
  1824. MIMoveStr:='&Transférer ici';
  1825. MILinkStr:='&Créer un ou des raccourci(s) ici';
  1826. MIAbortStr:='&Arrêt';
  1827. end;
  1828. LANG_ITALIAN:
  1829. begin // Italian
  1830. MICopyStr:='&Copiare qui';
  1831. MIMoveStr:='&Muoversi qui';
  1832. MILinkStr:='&Scorciatoia(e) crea qui';
  1833. MIAbortStr:='&Terminazione';
  1834. end;
  1835. LANG_POLISH:
  1836. begin // Polish
  1837. MICopyStr:='&Kopiuj tutaj';
  1838. MIMoveStr:='&Przenieœ tutaj';
  1839. MILinkStr:='Utwórz &skrót(y) tutaj';
  1840. MIAbortStr:='&Anuluj';
  1841. end;
  1842. LANG_PORTUGUESE:
  1843. begin // Portuguese
  1844. MICopyStr:='&Copíe aqui';
  1845. MIMoveStr:='&Mova aqui';
  1846. MILinkStr:='&Atalho(s) cría aqui';
  1847. MIAbortStr:='&Aborto';
  1848. end;
  1849. LANG_SPANISH:
  1850. begin // Spanish
  1851. MICopyStr:='&Copie aquí';
  1852. MIMoveStr:='&Muévase aquí';
  1853. MILinkStr:='&Atajo(s) crea aquí ';
  1854. MIAbortStr:='&Aborto';
  1855. end;
  1856. else
  1857. begin // English
  1858. MICopyStr:=SCopyStr;'&Copy Here';
  1859. MIMoveStr:=SMoveStr;'&Move Here';
  1860. MILinkStr:=SLinkStr;'&Shortcut(s) Create Here';
  1861. MIAbortStr:=SAbortStr;'&Abort';
  1862. end;
  1863. end;}{/MP}
  1864. end;
  1865. function TDragDrop.CopyToClipboard:boolean;
  1866. var DataObject:IDataObject;
  1867. begin
  1868. Result:=false;
  1869. DataObject:=CreateDataObject;
  1870. if DataObject=nil then exit;
  1871. try
  1872. Result:=OLESetClipBoard(DataObject)=S_Ok;
  1873. finally
  1874. DataObject._Release;
  1875. end;
  1876. end;
  1877. function TDragDrop.GetFromClipboard:boolean;
  1878. var DataObject:IDataObject;
  1879. pt:TPoint;
  1880. dwEffect:longint;
  1881. begin
  1882. Result:=OLEGetClipBoard(DataObject)=S_Ok;
  1883. if Result then
  1884. begin
  1885. pt.x:=-1;
  1886. pt.y:=-1;
  1887. dwEffect:=DropEffect_Copy;
  1888. FDropTarget.RenderDropped(DataObject, 0, pt, dwEffect);
  1889. end;
  1890. end;
  1891. function TDragDrop.DropHandler(const dataObj: IDataObject; grfKeyState: Longint;
  1892. pt: TPoint; var dwEffect: Longint): boolean;
  1893. begin
  1894. Result:=false;
  1895. end;
  1896. // Register method -------------------------------------------------------------
  1897. procedure Register;
  1898. begin
  1899. {MP}RegisterComponents({'Shell32'}'DragDrop', [TDragDrop]);
  1900. end;
  1901. // initialize/de-initialize the ole libary -------------------------------------
  1902. initialization
  1903. begin
  1904. OleInitialize(nil);
  1905. MouseHookHandle:=0;
  1906. GInternalSource:=nil;
  1907. SetMenuItemsStrings;
  1908. // to avoid mix ups
  1909. DDM_ProcessDropped:=RegisterWindowMessage('DDM_ProcessDropped');
  1910. end;
  1911. finalization
  1912. begin
  1913. if MouseHookHandle<>0 then UnHookWindowsHookEx(MouseHookHandle);
  1914. OleUninitialize;
  1915. end;
  1916. end.