CnDockSupportClass.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
  1. {******************************************************************************}
  2. { CnPack For Delphi/C++Builder }
  3. { 中国人自己的开放源码第三方开发包 }
  4. { (C)Copyright 2001-2018 CnPack 开发组 }
  5. { ------------------------------------ }
  6. { }
  7. { 本开发包是开源的自由软件,您可以遵照 CnPack 的发布协议来修 }
  8. { 改和重新发布这一程序。 }
  9. { }
  10. { 发布这一开发包的目的是希望它有用,但没有任何担保。甚至没有 }
  11. { 适合特定目的而隐含的担保。更详细的情况请参阅 CnPack 发布协议。 }
  12. { }
  13. { 您应该已经和开发包一起收到一份 CnPack 发布协议的副本。如果 }
  14. { 还没有,可访问我们的网站: }
  15. { }
  16. { 网站地址:http://www.cnpack.org }
  17. { 电子邮件:master@cnpack.org }
  18. { }
  19. {******************************************************************************}
  20. {*******************************************************}
  21. { }
  22. { 一些通用的类 }
  23. { SupportClass 单元 }
  24. { }
  25. { 版权 (C) 2002,2003 鲁小班 }
  26. { }
  27. {*******************************************************}
  28. unit CnDockSupportClass;
  29. {* |<PRE>
  30. ================================================================================
  31. * 软件名称:不可视工具组件包停靠单元
  32. * 单元名称:停靠组件中的一些通用的类单元
  33. * 单元作者:CnPack开发组 周益波(鲁小班)
  34. * 备 注:本单元由原作者授权CnPack开发组移植,已保留原作者版权信息
  35. * 开发平台:
  36. * 兼容测试:PWin9X/2000/XP + Delphi 5/6/7
  37. * 本 地 化:该单元中的字符串均符合本地化处理方式
  38. * 单元标识:$Id$
  39. * 修改记录:2007.07.13 V1.0
  40. * 移植单元
  41. ================================================================================
  42. |</PRE>}
  43. interface
  44. {$I CnPack.inc}
  45. uses
  46. Classes, Windows, SysUtils, Messages, Controls, Forms, CnNativeDecl;
  47. type
  48. TCnBaseTree = class;
  49. {树的节点的基础类}
  50. TCnBaseZone = class
  51. private
  52. FBaseTree: TCnBaseTree; //属于哪棵树
  53. FChildZone: TCnBaseZone; //左子女
  54. FNextSibling: TCnBaseZone; //右兄弟
  55. FPrevSibling: TCnBaseZone; //上一个兄弟
  56. FParentZone: TCnBaseZone; //父亲
  57. protected
  58. function GetNextSibingCount: Integer; //获得右兄弟的个数
  59. function GetPrevSibingCount: Integer; //获得前兄弟的个数
  60. public
  61. constructor Create(BaseTree: TCnBaseTree); virtual;
  62. function CreateChildZone: TCnBaseZone;
  63. function GetParentZone: TCnBaseZone; virtual;
  64. function GetChildCount: Integer; //获得子孙的个数
  65. function GetChildZone(Index: Word): TCnBaseZone;
  66. //获得索引为Index的子孙
  67. property ChildZone: TCnBaseZone read FChildZone write FChildZone;
  68. property NextSibling: TCnBaseZone read FNextSibling write FNextSibling;
  69. property PrevSibling: TCnBaseZone read FPrevSibling write FPrevSibling;
  70. property ParentZone: TCnBaseZone read FParentZone write FParentZone;
  71. property BaseTree: TCnBaseTree read FBaseTree write FBaseTree;
  72. end;
  73. TScanZoneNotification = (snNone, snAdded, snExtracted, snDeleted);
  74. TCnTreeZoneClass = class of TCnBaseZone;
  75. TScanTreeZoneProc = procedure(TreeZone: TCnBaseZone);
  76. {树的基础类}
  77. TCnBaseTree = class
  78. private
  79. FScanAction: TScanZoneNotification;
  80. FTreeZoneClass: TCnTreeZoneClass;
  81. FTopTreeZone: TCnBaseZone; //树的根节点
  82. FCurrTreeZone: TCnBaseZone; //当前的树节点
  83. FScanZoneProc: TScanTreeZoneProc; //TScanTreeZoneProc;
  84. protected
  85. procedure ForwardScanTree(TreeZone: TCnBaseZone); virtual; //前序遍历
  86. procedure BackwardScanTree(TreeZone: TCnBaseZone); virtual;//后序遍历
  87. procedure MiddleScanTree(TreeZone: TCnBaseZone); virtual; //中序遍历
  88. procedure ScanTreeZone(TreeZone: TCnBaseZone); virtual;//当扫描到一个节点时,调用这个函数
  89. public
  90. constructor Create(TreeZone: TCnTreeZoneClass); virtual;
  91. destructor Destroy; override;
  92. function AddChildZone(TreeZone, NewZone: TCnBaseZone): TCnBaseZone; virtual;
  93. function AddNextSibling(TreeZone, NewZone: TCnBaseZone): TCnBaseZone; virtual;
  94. function AddPrevSibling(TreeZone, NewZone: TCnBaseZone): TCnBaseZone; virtual;
  95. function AddParentZone(TreeZone, NewZone: TCnBaseZone): TCnBaseZone; virtual;
  96. procedure RemoveChildZone(TreeZone: TCnBaseZone); virtual;
  97. procedure RemoveNextSibling(TreeZone: TCnBaseZone); virtual;
  98. procedure RemovePrevSibling(TreeZone: TCnBaseZone); virtual;
  99. procedure RemoveParentZone(TreeZone: TCnBaseZone); virtual;
  100. property TreeZoneClass: TCnTreeZoneClass read FTreeZoneClass write FTreeZoneClass;
  101. property TopTreeZone: TCnBaseZone read FTopTreeZone write FTopTreeZone;
  102. property CurrTreeZone: TCnBaseZone read FCurrTreeZone write FCurrTreeZone;
  103. property ScanZoneProc: TScanTreeZoneProc read FScanZoneProc write FScanZoneProc;
  104. end;
  105. TCnBaseGetFormEventComponent = class(TComponent)
  106. private
  107. { 继承自TCustomForm }
  108. FOldOnActivate: TNotifyEvent;
  109. FOldOnClose: TCloseEvent;
  110. FOldOnCloseQuery: TCloseQueryEvent;
  111. FOldOnCreate: TNotifyEvent;
  112. FOldOnDeactivate: TNotifyEvent;
  113. FOldOnDestroy: TNotifyEvent;
  114. FOldOnHelp: THelpEvent;
  115. FOldOnHide: TNotifyEvent;
  116. FOldOnPaint: TNotifyEvent;
  117. FOldOnShortCut: TShortCutEvent;
  118. FOldOnShow: TNotifyEvent;
  119. { 继承自TWinControl }
  120. FOldOnDockDrop: TDockDropEvent;
  121. FOldOnDockOver: TDockOverEvent;
  122. FOldOnExit: TNotifyEvent;
  123. FOldOnGetSiteInfo: TGetSiteInfoEvent;
  124. FOldOnKeyDown: TKeyEvent;
  125. FOldOnKeyPress: TKeyPressEvent;
  126. FOldOnKeyUp: TKeyEvent;
  127. FOldOnMouseWheel: TMouseWheelEvent;
  128. FOldOnMouseWheelDown: TMouseWheelUpDownEvent;
  129. FOldOnMouseWheelUp: TMouseWheelUpDownEvent;
  130. FOldOnUndock: TUnDockEvent;
  131. { 继承自TControl }
  132. FOldOnCanResize: TCanResizeEvent;
  133. FOldOnClick: TNotifyEvent;
  134. FOldOnConstrainedResize: TConstrainedResizeEvent;
  135. FOldOnContextPopup: TContextPopupEvent;
  136. FOldOnDblClick: TNotifyEvent;
  137. FOldOnDragDrop: TDragDropEvent;
  138. FOldOnDragOver: TDragOverEvent;
  139. FOldOnEndDock: TEndDragEvent;
  140. FOldOnEndDrag: TEndDragEvent;
  141. FOldOnMouseDown: TMouseEvent;
  142. FOldOnMouseMove: TMouseMoveEvent;
  143. FOldOnMouseUp: TMouseEvent;
  144. FOldOnResize: TNotifyEvent;
  145. FOldOnStartDock: TStartDockEvent;
  146. FParentForm: TForm;
  147. FOldWindowProc: TWndMethod;
  148. protected
  149. { 继承自TCustomForm }
  150. procedure DoFormOnActivate(Sender: TObject); virtual;
  151. procedure DoFormOnClose(Sender: TObject; var Action: TCloseAction); virtual;
  152. procedure DoFormOnCloseQuery(Sender: TObject;
  153. var CanClose: Boolean); virtual;
  154. procedure DoFormOnCreate(Sender: TObject); virtual;
  155. procedure DoFormOnDeactivate(Sender: TObject); virtual;
  156. procedure DoFormOnDestroy(Sender: TObject); virtual;
  157. function DoFormOnHelp(Command: Word; Data: TCnNativeInt;
  158. var CallHelp: Boolean): Boolean;
  159. procedure DoFormOnHide(Sender: TObject); virtual;
  160. procedure DoFormOnPaint(Sender: TObject); virtual;
  161. procedure DoFormOnShortCut(var Msg: TWMKey; var Handled: Boolean); virtual;
  162. procedure DoFormOnShow(Sender: TObject); virtual;
  163. procedure DoFormOnDockDrop(Sender: TObject; Source: TDragDockObject;
  164. X, Y: Integer); virtual;
  165. { 继承自TWinControl }
  166. procedure DoFormOnDockOver(Sender: TObject; Source: TDragDockObject;
  167. X, Y: Integer; State: TDragState; var Accept: Boolean); virtual;
  168. procedure DoFormOnExit(Sender: TObject); virtual;
  169. procedure DoFormOnGetSiteInfo(Sender: TObject; DockClient: TControl;
  170. var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); virtual;
  171. procedure DoFormOnKeyDown(Sender: TObject; var Key: Word;
  172. Shift: TShiftState); virtual;
  173. procedure DoFormOnKeyPress(Sender: TObject; var Key: Char); virtual;
  174. procedure DoFormOnKeyUp(Sender: TObject; var Key: Word;
  175. Shift: TShiftState); virtual;
  176. procedure DoFormOnMouseWheel(Sender: TObject; Shift: TShiftState;
  177. WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); virtual;
  178. procedure DoFormOnMouseWheelDown(Sender: TObject; Shift: TShiftState;
  179. MousePos: TPoint; var Handled: Boolean); virtual;
  180. procedure DoFormOnMouseWheelUp(Sender: TObject; Shift: TShiftState;
  181. MousePos: TPoint; var Handled: Boolean); virtual;
  182. procedure DoFormOnUndock(Sender: TObject; Client: TControl;
  183. NewTarget: TWinControl; var Allow: Boolean); virtual;
  184. { 继承自TControl }
  185. procedure DoFormOnCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
  186. var Resize: Boolean); virtual;
  187. procedure DoFormOnClick(Sender: TObject); virtual;
  188. procedure DoFormOnConstrainedResize(Sender: TObject; var MinWidth, MinHeight,
  189. MaxWidth, MaxHeight: Integer); virtual;
  190. procedure DoFormOnContextPopup(Sender: TObject; MousePos: TPoint;
  191. var Handled: Boolean); virtual;
  192. procedure DoFormOnDblClick(Sender: TObject); virtual;
  193. procedure DoFormOnDragDrop(Sender, Source: TObject;
  194. X, Y: Integer); virtual;
  195. procedure DoFormOnDragOver(Sender, Source: TObject; X, Y: Integer;
  196. State: TDragState; var Accept: Boolean); virtual;
  197. procedure DoFormOnEndDock(Sender, Target: TObject;
  198. X, Y: Integer); virtual;
  199. procedure DoFormOnEndDrag(Sender, Target: TObject;
  200. X, Y: Integer); virtual;
  201. procedure DoFormOnMouseDown(Sender: TObject; Button: TMouseButton;
  202. Shift: TShiftState; X, Y: Integer); virtual;
  203. procedure DoFormOnMouseMove(Sender: TObject; Shift: TShiftState;
  204. X, Y: Integer); virtual;
  205. procedure DoFormOnMouseUp(Sender: TObject; Button: TMouseButton;
  206. Shift: TShiftState; X, Y: Integer); virtual;
  207. procedure DoFormOnResize(Sender: TObject); virtual;
  208. procedure DoFormOnStartDock(Sender: TObject;
  209. var DragObject: TDragDockObject); virtual;
  210. { 被捕获的父控件的WindowProc消息,虚函数 }
  211. procedure WindowProc(var Message: TMessage); virtual;
  212. public
  213. constructor Create(AOwner: TComponent); override;
  214. destructor Destroy; override;
  215. property ParentForm: TForm read FParentForm;
  216. end;
  217. implementation
  218. { TCnBaseZone }
  219. constructor TCnBaseZone.Create(BaseTree: TCnBaseTree);
  220. begin
  221. FBaseTree := BaseTree;
  222. ChildZone := nil;
  223. NextSibling := nil;
  224. PrevSibling := nil;
  225. ParentZone := nil;
  226. end;
  227. function TCnBaseZone.CreateChildZone: TCnBaseZone;
  228. begin
  229. Result := nil;
  230. end;
  231. function TCnBaseZone.GetChildCount: Integer;
  232. var AZone: TCnBaseZone;
  233. begin
  234. Result := 0;
  235. if FChildZone <> nil then
  236. begin
  237. Inc(Result);
  238. AZone := FChildZone;
  239. while AZone.NextSibling <> nil do
  240. begin
  241. AZone := AZone.NextSibling;
  242. Inc(Result);
  243. end;
  244. end;
  245. end;
  246. function TCnBaseZone.GetChildZone(Index: Word): TCnBaseZone;
  247. begin
  248. Result := ChildZone;
  249. while Index > 0 do
  250. begin
  251. Result := Result.NextSibling;
  252. Dec(Index);
  253. end;
  254. end;
  255. function TCnBaseZone.GetNextSibingCount: Integer;
  256. var AZone: TCnBaseZone;
  257. begin
  258. Result := 0;
  259. AZone := Self;
  260. while AZone.NextSibling <> nil do
  261. begin
  262. AZone := AZone.NextSibling;
  263. Inc(Result);
  264. end;
  265. end;
  266. function TCnBaseZone.GetParentZone: TCnBaseZone;
  267. var TreeZone: TCnBaseZone;
  268. begin
  269. TreeZone := Self;
  270. while (TreeZone <> nil) and (TreeZone.ParentZone = nil)
  271. and (TreeZone.PrevSibling <> nil) do
  272. TreeZone := TreeZone.PrevSibling;
  273. if TreeZone <> nil then Result := TreeZone.ParentZone
  274. else Result := nil;
  275. end;
  276. function TCnBaseZone.GetPrevSibingCount: Integer;
  277. var AZone: TCnBaseZone;
  278. begin
  279. Result := 0;
  280. AZone := Self;
  281. while AZone.PrevSibling <> nil do
  282. begin
  283. AZone := AZone.PrevSibling;
  284. Inc(Result);
  285. end;
  286. end;
  287. { TCnBaseTree }
  288. function TCnBaseTree.AddChildZone(TreeZone, NewZone: TCnBaseZone): TCnBaseZone;
  289. begin
  290. if TreeZone.ChildZone <> nil then
  291. begin
  292. Result := AddNextSibling(TreeZone.ChildZone, NewZone);
  293. end else
  294. begin
  295. if NewZone = nil then
  296. Result := FTreeZoneClass.Create(Self)
  297. else Result := NewZone;
  298. TreeZone.ChildZone := Result;
  299. Result.ParentZone := TreeZone;
  300. end;
  301. end;
  302. function TCnBaseTree.AddNextSibling(TreeZone, NewZone: TCnBaseZone): TCnBaseZone;
  303. begin
  304. while TreeZone.NextSibling <> nil do
  305. TreeZone := TreeZone.NextSibling;
  306. if NewZone = nil then
  307. Result := FTreeZoneClass.Create(Self)
  308. else Result := NewZone;
  309. TreeZone.NextSibling := Result;
  310. Result.PrevSibling := TreeZone;
  311. Result.ParentZone := TreeZone.ParentZone;
  312. end;
  313. function TCnBaseTree.AddParentZone(TreeZone, NewZone: TCnBaseZone): TCnBaseZone;
  314. begin
  315. if NewZone = nil then
  316. Result := FTreeZoneClass.Create(Self)
  317. else Result := NewZone;
  318. while TreeZone.PrevSibling <> nil do
  319. TreeZone := TreeZone.PrevSibling;
  320. if TreeZone.ParentZone <> nil then
  321. begin
  322. TreeZone.ParentZone.ChildZone := Result;
  323. end else
  324. begin
  325. TopTreeZone := Result;
  326. end;
  327. Result.ParentZone := TreeZone.ParentZone;
  328. TreeZone.ParentZone := Result;
  329. end;
  330. function TCnBaseTree.AddPrevSibling(TreeZone, NewZone: TCnBaseZone): TCnBaseZone;
  331. begin
  332. if NewZone = nil then
  333. Result := FTreeZoneClass.Create(Self)
  334. else Result := NewZone;
  335. if TreeZone.PrevSibling <> nil then
  336. begin
  337. TreeZone.PrevSibling.NextSibling := Result;
  338. Result.PrevSibling := TreeZone.PrevSibling;
  339. TreeZone.PrevSibling := Result;
  340. Result.NextSibling := TreeZone;
  341. Result.ParentZone := TreeZone.ParentZone;
  342. end else
  343. begin
  344. if TreeZone.ParentZone <> nil then
  345. begin
  346. TreeZone.ParentZone.ChildZone := Result;
  347. end else
  348. begin
  349. TopTreeZone := Result;
  350. end;
  351. Result.ParentZone := TreeZone.ParentZone;
  352. Result.NextSibling := TreeZone;
  353. TreeZone.PrevSibling := Result;
  354. // TreeZone.ParentZone := nil;
  355. end;
  356. end;
  357. constructor TCnBaseTree.Create(TreeZone: TCnTreeZoneClass);
  358. begin
  359. FTreeZoneClass := TreeZone;
  360. FTopTreeZone := FTreeZoneClass.Create(Self);
  361. FCurrTreeZone := FTopTreeZone;
  362. FScanZoneProc := nil;
  363. FScanAction := snNone;
  364. end;
  365. destructor TCnBaseTree.Destroy;
  366. begin
  367. FScanAction := snDeleted;
  368. BackwardScanTree(TopTreeZone);
  369. FScanAction := snNone;
  370. inherited Destroy;
  371. end;
  372. procedure TCnBaseTree.ForwardScanTree(TreeZone: TCnBaseZone);
  373. begin
  374. if TreeZone <> nil then
  375. begin
  376. ScanTreeZone(TreeZone);
  377. ForwardScanTree(TreeZone.ChildZone);
  378. ForwardScanTree(TreeZone.NextSibling);
  379. end;
  380. end;
  381. procedure TCnBaseTree.MiddleScanTree(TreeZone: TCnBaseZone);
  382. begin
  383. if TreeZone <> nil then
  384. begin
  385. MiddleScanTree(TreeZone.ChildZone);
  386. ScanTreeZone(TreeZone);
  387. MiddleScanTree(TreeZone.NextSibling);
  388. end;
  389. end;
  390. procedure TCnBaseTree.BackwardScanTree(TreeZone: TCnBaseZone);
  391. begin
  392. if TreeZone <> nil then
  393. begin
  394. BackwardScanTree(TreeZone.ChildZone);
  395. BackwardScanTree(TreeZone.NextSibling);
  396. ScanTreeZone(TreeZone);
  397. end;
  398. end;
  399. procedure TCnBaseTree.ScanTreeZone(TreeZone: TCnBaseZone);
  400. begin
  401. if Assigned(FScanZoneProc) then
  402. FScanZoneProc(TreeZone);
  403. if FScanAction = snDeleted then
  404. TreeZone.Free;
  405. end;
  406. procedure TCnBaseTree.RemoveChildZone(TreeZone: TCnBaseZone);
  407. begin
  408. if TreeZone.ChildZone <> nil then
  409. begin
  410. FScanAction := snDeleted;
  411. BackwardScanTree(TreeZone.ChildZone);
  412. FScanAction := snNone;
  413. end;
  414. end;
  415. procedure TCnBaseTree.RemoveNextSibling(TreeZone: TCnBaseZone);
  416. begin
  417. if TreeZone.NextSibling <> nil then
  418. begin
  419. FScanAction := snDeleted;
  420. BackwardScanTree(TreeZone.NextSibling);
  421. FScanAction := snNone;
  422. end;
  423. end;
  424. procedure TCnBaseTree.RemoveParentZone(TreeZone: TCnBaseZone);
  425. begin
  426. end;
  427. procedure TCnBaseTree.RemovePrevSibling(TreeZone: TCnBaseZone);
  428. begin
  429. if TreeZone.PrevSibling <> nil then
  430. begin
  431. FScanAction := snDeleted;
  432. BackwardScanTree(TreeZone.PrevSibling);
  433. FScanAction := snNone;
  434. end;
  435. end;
  436. { TCnBaseGetFormEventComponent }
  437. constructor TCnBaseGetFormEventComponent.Create(AOwner: TComponent);
  438. begin
  439. inherited Create(AOwner);
  440. FParentForm := TForm(AOwner);
  441. if not (csDesigning in ComponentState) then
  442. begin
  443. { 继承自TCustomForm }
  444. FOldOnActivate := FParentForm.OnActivate;
  445. FParentForm.OnActivate := DoFormOnActivate;
  446. FOldOnClose := FParentForm.OnClose;
  447. FParentForm.OnClose := DoFormOnClose;
  448. FOldOnCloseQuery := FParentForm.OnCloseQuery;
  449. FParentForm.OnCloseQuery := DoFormOnCloseQuery;
  450. FOldOnCreate := FParentForm.OnCreate;
  451. FParentForm.OnCreate := DoFormOnCreate;
  452. FOldOnDeactivate := FParentForm.OnDeactivate;
  453. FParentForm.OnDeactivate := DoFormOnDeactivate;
  454. FOldOnDestroy := FParentForm.OnDestroy;
  455. FParentForm.OnDestroy := DoFormOnDestroy;
  456. FOldOnHelp := FParentForm.OnHelp;
  457. FParentForm.OnHelp := DoFormOnHelp;
  458. FOldOnHide := FParentForm.OnHide;
  459. FParentForm.OnHide := DoFormOnHide;
  460. FOldOnPaint := FParentForm.OnPaint;
  461. FParentForm.OnPaint := DoFormOnPaint;
  462. FOldOnShortCut := FParentForm.OnShortCut;
  463. FParentForm.OnShortCut := DoFormOnShortCut;
  464. FOldOnShow := FParentForm.OnShow;
  465. FParentForm.OnShow := DoFormOnShow;
  466. { 继承自TWinControl }
  467. FOldOnDockDrop := FParentForm.OnDockDrop;
  468. FParentForm.OnDockDrop := DoFormOnDockDrop;
  469. FOldOnDockOver := FParentForm.OnDockOver;
  470. FParentForm.OnDockOver := DoFormOnDockOver;
  471. // FOldOnExit := FParentForm.OnExit;
  472. FOldOnGetSiteInfo := FParentForm.OnGetSiteInfo;
  473. FParentForm.OnGetSiteInfo := DoFormOnGetSiteInfo;
  474. FOldOnKeyDown := FParentForm.OnKeyDown;
  475. FParentForm.OnKeyDown := DoFormOnKeyDown;
  476. FOldOnKeyPress := FParentForm.OnKeyPress;
  477. FParentForm.OnKeyPress := DoFormOnKeyPress;
  478. FOldOnKeyUp := FParentForm.OnKeyUp;
  479. FParentForm.OnKeyUp := DoFormOnKeyUp;
  480. FOldOnMouseWheel := FParentForm.OnMouseWheel;
  481. FParentForm.OnMouseWheel := DoFormOnMouseWheel;
  482. FOldOnMouseWheelDown := FParentForm.OnMouseWheelDown;
  483. FParentForm.OnMouseWheelDown := DoFormOnMouseWheelDown;
  484. FOldOnMouseWheelUp := FParentForm.OnMouseWheelUp;
  485. FParentForm.OnMouseWheelUp := DoFormOnMouseWheelUp;
  486. FOldOnUndock := FParentForm.OnUnDock;
  487. FParentForm.OnUnDock := DoFormOnUnDock;
  488. { 继承自TControl }
  489. FOldOnCanResize := FParentForm.OnCanResize;
  490. FParentForm.OnCanResize := DoFormOnCanResize;
  491. FOldOnClick := FParentForm.OnClick;
  492. FParentForm.OnClick := DoFormOnClick;
  493. FOldOnConstrainedResize := FParentForm.OnConstrainedResize;
  494. FParentForm.OnConstrainedResize := DoFormOnConstrainedResize;
  495. FOldOnContextPopup := FParentForm.OnContextPopup;
  496. FParentForm.OnContextPopup := DoFormOnContextPopup;
  497. FOldOnDblClick := FParentForm.OnDblClick;
  498. FParentForm.OnDblClick := DoFormOnDblClick;
  499. FOldOnDragDrop := FParentForm.OnDragDrop;
  500. FParentForm.OnDragDrop := DoFormOnDragDrop;
  501. FOldOnDragOver := FParentForm.OnDragOver;
  502. FParentForm.OnDragOver := DoFormOnDragOver;
  503. FOldOnEndDock := FParentForm.OnEndDock;
  504. FParentForm.OnEndDock := DoFormOnEndDock;
  505. // FOldOnEndDrag := FParentForm.OnEndDrag;
  506. FOldOnMouseDown := FParentForm.OnMouseDown;
  507. FParentForm.OnMouseDown := DoFormOnMouseDown;
  508. FOldOnMouseMove := FParentForm.OnMouseMove;
  509. FParentForm.OnMouseMove := DoFormOnMouseMove;
  510. FOldOnMouseUp := FParentForm.OnMouseUp;
  511. FParentForm.OnMouseUp := DoFormOnMouseUp;
  512. FOldOnResize := FParentForm.OnResize;
  513. FParentForm.OnResize := DoFormOnResize;
  514. FOldOnStartDock := FParentForm.OnStartDock;
  515. FParentForm.OnStartDock := DoFormOnStartDock;
  516. { 保存老的窗口过程 }
  517. FOldWindowProc := FParentForm.WindowProc;
  518. { 重载窗口过程 }
  519. FParentForm.WindowProc := WindowProc;
  520. end;
  521. end;
  522. destructor TCnBaseGetFormEventComponent.Destroy;
  523. begin
  524. if not (csDesigning in ComponentState) then
  525. begin
  526. if @FOldWindowProc <> nil then
  527. FParentForm.WindowProc := FOldWindowProc;
  528. FOldWindowProc := nil;
  529. { 继承自TCustomForm }
  530. FParentForm.OnActivate := FOldOnActivate;
  531. FOldOnActivate := nil;
  532. FParentForm.OnClose := FOldOnClose;
  533. FOldOnClose := nil;
  534. FParentForm.OnCloseQuery := FOldOnCloseQuery;
  535. FOldOnCloseQuery := nil;
  536. FParentForm.OnCreate := FOldOnCreate;
  537. FOldOnCreate := nil;
  538. FParentForm.OnDeactivate := FOldOnDeactivate;
  539. FOldOnDeactivate := nil;
  540. FParentForm.OnDestroy := FOldOnDestroy;
  541. FOldOnDestroy := nil;
  542. FParentForm.OnHelp := FOldOnHelp;
  543. FOldOnHelp := nil;
  544. FParentForm.OnHide := FOldOnHide;
  545. FOldOnHide := nil;
  546. FParentForm.OnPaint := FOldOnPaint;
  547. FOldOnPaint := nil;
  548. FParentForm.OnShortCut := FOldOnShortCut;
  549. FOldOnShortCut := nil;
  550. FParentForm.OnShow := FOldOnShow;
  551. FOldOnShow := nil;
  552. { 继承自TWinControl }
  553. FParentForm.OnDockDrop := FOldOnDockDrop;
  554. FOldOnDockDrop := nil;
  555. FParentForm.OnDockOver := FOldOnDockOver;
  556. FOldOnDockOver := nil;
  557. // FParentForm.OnExit := FOldOnExit;
  558. // FOldOnExit := nil;
  559. FParentForm.OnGetSiteInfo := FOldOnGetSiteInfo;
  560. FOldOnGetSiteInfo := nil;
  561. FParentForm.OnKeyDown := FOldOnKeyDown;
  562. FOldOnKeyDown := nil;
  563. FParentForm.OnKeyPress := FOldOnKeyPress;
  564. FOldOnKeyPress := nil;
  565. FParentForm.OnKeyUp := FOldOnKeyUp;
  566. FOldOnKeyUp := nil;
  567. FParentForm.OnMouseWheel := FOldOnMouseWheel;
  568. FOldOnMouseWheel := nil;
  569. FParentForm.OnMouseWheelDown := FOldOnMouseWheelDown;
  570. FOldOnMouseWheelDown := nil;
  571. FParentForm.OnMouseWheelUp := FOldOnMouseWheelUp;
  572. FOldOnMouseWheelUp := nil;
  573. FParentForm.OnUndock := FOldOnUndock;
  574. FOldOnUndock := nil;
  575. { 继承自TControl }
  576. FParentForm.OnCanResize := FOldOnCanResize;
  577. FOldOnCanResize := nil;
  578. FParentForm.OnClick := FOldOnClick;
  579. FOldOnClick := nil;
  580. FParentForm.OnConstrainedResize := FOldOnConstrainedResize;
  581. FOldOnConstrainedResize := nil;
  582. FParentForm.OnContextPopup := FOldOnContextPopup;
  583. FOldOnContextPopup := nil;
  584. FParentForm.OnDblClick := FOldOnDblClick;
  585. FOldOnDblClick := nil;
  586. FParentForm.OnDragDrop := FOldOnDragDrop;
  587. FOldOnDragDrop := nil;
  588. FParentForm.OnDragOver := FOldOnDragOver;
  589. FOldOnDragOver := nil;
  590. FParentForm.OnEndDock := FOldOnEndDock;
  591. FOldOnEndDock := nil;
  592. // FParentForm.OnEndDrag := FOldOnEndDrag;
  593. // FOldOnEndDrag := nil;
  594. FParentForm.OnMouseDown := FOldOnMouseDown;
  595. FOldOnMouseDown := nil;
  596. FParentForm.OnMouseMove := FOldOnMouseMove;
  597. FOldOnMouseMove := nil;
  598. FParentForm.OnMouseUp := FOldOnMouseUp;
  599. FOldOnMouseUp := nil;
  600. FParentForm.OnResize := FOldOnResize;
  601. FOldOnResize := nil;
  602. FParentForm.OnStartDock := FOldOnStartDock;
  603. FOldOnStartDock := nil;
  604. FParentForm := nil;
  605. end;
  606. inherited;
  607. end;
  608. procedure TCnBaseGetFormEventComponent.DoFormOnActivate(Sender: TObject);
  609. begin
  610. if Assigned(FOldOnActivate) then
  611. FOldOnActivate(Sender);
  612. end;
  613. procedure TCnBaseGetFormEventComponent.DoFormOnCanResize(Sender: TObject;
  614. var NewWidth, NewHeight: Integer; var Resize: Boolean);
  615. begin
  616. if Assigned(FOldOnCanResize) then
  617. FOldOnCanResize(Sender, NewWidth, NewHeight, Resize);
  618. end;
  619. procedure TCnBaseGetFormEventComponent.DoFormOnClick(Sender: TObject);
  620. begin
  621. if Assigned(FOldOnClick) then
  622. FOldOnClick(Sender);
  623. end;
  624. procedure TCnBaseGetFormEventComponent.DoFormOnClose(Sender: TObject;
  625. var Action: TCloseAction);
  626. begin
  627. if Assigned(FOldOnClose) then
  628. FOldOnClose(Sender, Action);
  629. end;
  630. procedure TCnBaseGetFormEventComponent.DoFormOnCloseQuery(Sender: TObject;
  631. var CanClose: Boolean);
  632. begin
  633. if Assigned(FOldOnCloseQuery) then
  634. FOldOnCloseQuery(Sender, CanClose);
  635. end;
  636. procedure TCnBaseGetFormEventComponent.DoFormOnConstrainedResize(
  637. Sender: TObject; var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
  638. begin
  639. if Assigned(FOldOnConstrainedResize) then
  640. FOldOnConstrainedResize(Sender, MinWidth, MinHeight, MaxWidth, MaxHeight);
  641. end;
  642. procedure TCnBaseGetFormEventComponent.DoFormOnContextPopup(
  643. Sender: TObject; MousePos: TPoint; var Handled: Boolean);
  644. begin
  645. if Assigned(FOldOnContextPopup) then
  646. FOldOnContextPopup(Sender, MousePos, Handled);
  647. end;
  648. procedure TCnBaseGetFormEventComponent.DoFormOnCreate(Sender: TObject);
  649. begin
  650. if Assigned(FOldOnCreate) then
  651. FOldOnCreate(Sender);
  652. end;
  653. procedure TCnBaseGetFormEventComponent.DoFormOnDblClick(Sender: TObject);
  654. begin
  655. if Assigned(FOldOnDblClick) then
  656. FOldOnDblClick(Sender);
  657. end;
  658. procedure TCnBaseGetFormEventComponent.DoFormOnDeactivate(Sender: TObject);
  659. begin
  660. if Assigned(FOldOnDeactivate) then
  661. FOldOnDeactivate(Sender);
  662. end;
  663. procedure TCnBaseGetFormEventComponent.DoFormOnDestroy(Sender: TObject);
  664. begin
  665. if Assigned(FOldOnDestroy) then
  666. FOldOnDestroy(Sender);
  667. end;
  668. procedure TCnBaseGetFormEventComponent.DoFormOnDockDrop(Sender: TObject;
  669. Source: TDragDockObject; X, Y: Integer);
  670. begin
  671. if Assigned(FOldOnDockDrop) then
  672. FOldOnDockDrop(Sender, Source, X, Y);
  673. end;
  674. procedure TCnBaseGetFormEventComponent.DoFormOnDockOver(Sender: TObject;
  675. Source: TDragDockObject; X, Y: Integer; State: TDragState;
  676. var Accept: Boolean);
  677. begin
  678. if Assigned(FOldOnDockOver) then
  679. FOldOnDockOver(Sender, Source, X, Y, State, Accept);
  680. end;
  681. procedure TCnBaseGetFormEventComponent.DoFormOnDragDrop(Sender,
  682. Source: TObject; X, Y: Integer);
  683. begin
  684. if Assigned(FOldOnDragDrop) then
  685. FOldOnDragDrop(Sender, Source, X, Y);
  686. end;
  687. procedure TCnBaseGetFormEventComponent.DoFormOnDragOver(Sender,
  688. Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  689. begin
  690. if Assigned(FOldOnDragOver) then
  691. FOldOnDragOver(Sender, Source, X, Y, State, Accept);
  692. end;
  693. procedure TCnBaseGetFormEventComponent.DoFormOnEndDock(Sender,
  694. Target: TObject; X, Y: Integer);
  695. begin
  696. if Assigned(FOldOnEndDock) then
  697. FOldOnEndDock(Sender, Target, X, Y);
  698. end;
  699. procedure TCnBaseGetFormEventComponent.DoFormOnEndDrag(Sender,
  700. Target: TObject; X, Y: Integer);
  701. begin
  702. if Assigned(FOldOnEndDrag) then
  703. FOldOnEndDrag(Sender, Target, X, Y);
  704. end;
  705. procedure TCnBaseGetFormEventComponent.DoFormOnExit(Sender: TObject);
  706. begin
  707. if Assigned(FOldOnExit) then
  708. FOldOnExit(Sender);
  709. end;
  710. procedure TCnBaseGetFormEventComponent.DoFormOnGetSiteInfo(Sender: TObject;
  711. DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  712. var CanDock: Boolean);
  713. begin
  714. if Assigned(FOldOnGetSiteInfo) then
  715. FOldOnGetSiteInfo(Sender, DockClient, InfluenceRect, MousePos, CanDock);
  716. end;
  717. function TCnBaseGetFormEventComponent.DoFormOnHelp(Command: Word;
  718. Data: TCnNativeInt; var CallHelp: Boolean): Boolean;
  719. begin
  720. Result := False;
  721. if Assigned(FOldOnHelp) then
  722. Result := FOldOnHelp(Command, Data, CallHelp);
  723. end;
  724. procedure TCnBaseGetFormEventComponent.DoFormOnHide(Sender: TObject);
  725. begin
  726. if Assigned(FOldOnHide) then
  727. FOldOnHide(Sender);
  728. end;
  729. procedure TCnBaseGetFormEventComponent.DoFormOnKeyDown(Sender: TObject;
  730. var Key: Word; Shift: TShiftState);
  731. begin
  732. if Assigned(FOldOnKeyDown) then
  733. FOldOnKeyDown(Sender, Key, Shift);
  734. end;
  735. procedure TCnBaseGetFormEventComponent.DoFormOnKeyPress(Sender: TObject;
  736. var Key: Char);
  737. begin
  738. if Assigned(FOldOnKeyPress) then
  739. FOldOnKeyPress(Sender, Key);
  740. end;
  741. procedure TCnBaseGetFormEventComponent.DoFormOnKeyUp(Sender: TObject;
  742. var Key: Word; Shift: TShiftState);
  743. begin
  744. if Assigned(FOldOnKeyUp) then
  745. FOldOnKeyUp(Sender, Key, Shift);
  746. end;
  747. procedure TCnBaseGetFormEventComponent.DoFormOnMouseDown(Sender: TObject;
  748. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  749. begin
  750. if Assigned(FOldOnMouseDown) then
  751. FOldOnMouseDown(Sender, Button, Shift, X, Y);
  752. end;
  753. procedure TCnBaseGetFormEventComponent.DoFormOnMouseMove(Sender: TObject;
  754. Shift: TShiftState; X, Y: Integer);
  755. begin
  756. if Assigned(FOldOnMouseMove) then
  757. FOldOnMouseMove(Sender, Shift, X, Y);
  758. end;
  759. procedure TCnBaseGetFormEventComponent.DoFormOnMouseUp(Sender: TObject;
  760. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  761. begin
  762. if Assigned(FOldOnMouseUp) then
  763. FOldOnMouseUp(Sender, Button, Shift, X, Y);
  764. end;
  765. procedure TCnBaseGetFormEventComponent.DoFormOnMouseWheel(Sender: TObject;
  766. Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  767. var Handled: Boolean);
  768. begin
  769. if Assigned(FOldOnMouseWheel) then
  770. FOldOnMouseWheel(Sender, Shift, WheelDelta, MousePos, Handled);
  771. end;
  772. procedure TCnBaseGetFormEventComponent.DoFormOnMouseWheelDown(
  773. Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  774. var Handled: Boolean);
  775. begin
  776. if Assigned(FOldOnMouseWheelDown) then
  777. FOldOnMouseWheelDown(Sender, Shift, MousePos, Handled);
  778. end;
  779. procedure TCnBaseGetFormEventComponent.DoFormOnMouseWheelUp(Sender: TObject;
  780. Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  781. begin
  782. if Assigned(FOldOnMouseWheelUp) then
  783. FOldOnMouseWheelUp(Sender, Shift, MousePos, Handled);
  784. end;
  785. procedure TCnBaseGetFormEventComponent.DoFormOnPaint(Sender: TObject);
  786. begin
  787. if Assigned(FOldOnPaint) then
  788. FOldOnPaint(Sender);
  789. end;
  790. procedure TCnBaseGetFormEventComponent.DoFormOnResize(Sender: TObject);
  791. begin
  792. if Assigned(FOldOnResize) then
  793. FOldOnResize(Sender);
  794. end;
  795. procedure TCnBaseGetFormEventComponent.DoFormOnShortCut(var Msg: TWMKey;
  796. var Handled: Boolean);
  797. begin
  798. if Assigned(FOldOnShortCut) then
  799. FOldOnShortCut(Msg, Handled);
  800. end;
  801. procedure TCnBaseGetFormEventComponent.DoFormOnShow(Sender: TObject);
  802. begin
  803. if Assigned(FOldOnShow) then
  804. FOldOnShow(Sender);
  805. end;
  806. procedure TCnBaseGetFormEventComponent.DoFormOnStartDock(Sender: TObject;
  807. var DragObject: TDragDockObject);
  808. begin
  809. if Assigned(FOldOnStartDock) then
  810. FOldOnStartDock(Sender, DragObject);
  811. end;
  812. procedure TCnBaseGetFormEventComponent.DoFormOnUndock(Sender: TObject;
  813. Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
  814. begin
  815. if Assigned(FOldOnUndock) then
  816. FOldOnUndock(Sender, Client, NewTarget, Allow);
  817. end;
  818. procedure TCnBaseGetFormEventComponent.WindowProc(var Message: TMessage);
  819. begin
  820. if Assigned(FOldWindowProc) then
  821. FOldWindowProc(Message);
  822. end;
  823. end.