RealICQImageOleImpl1.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446
  1. unit RealICQImageOleImpl1;
  2. {$WARN SYMBOL_PLATFORM OFF}
  3. interface
  4. uses
  5. jpeg,
  6. Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7. ComServ, StdVCL, AXCtrls, ImageX_TLB,
  8. ImagePanelForActiveX, ExtCtrls;
  9. type
  10. TRealICQImageOleX = class(TActiveXControl, IRealICQImageOleX)
  11. private
  12. { Private declarations }
  13. FDelphiControl: TImagePanelForActiveX;
  14. FEvents: IRealICQImageOleXEvents;
  15. procedure CanResizeEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
  16. var Resize: Boolean);
  17. procedure ClickEvent(Sender: TObject);
  18. procedure ConstrainedResizeEvent(Sender: TObject; var MinWidth, MinHeight,
  19. MaxWidth, MaxHeight: Integer);
  20. procedure DblClickEvent(Sender: TObject);
  21. procedure ResizeEvent(Sender: TObject);
  22. protected
  23. { Protected declarations }
  24. procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  25. procedure EventSinkChanged(const EventSink: IUnknown); override;
  26. procedure InitializeControl; override;
  27. function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  28. function Get_AlignDisabled: WordBool; safecall;
  29. function Get_Alignment: TxAlignment; safecall;
  30. function Get_AutoSize: WordBool; safecall;
  31. function Get_BevelInner: TxBevelCut; safecall;
  32. function Get_BevelOuter: TxBevelCut; safecall;
  33. function Get_BorderStyle: TxBorderStyle; safecall;
  34. function Get_Caption: WideString; safecall;
  35. function Get_Color: OLE_COLOR; safecall;
  36. function Get_Ctl3D: WordBool; safecall;
  37. function Get_DockSite: WordBool; safecall;
  38. function Get_DoubleBuffered: WordBool; safecall;
  39. function Get_DragCursor: Smallint; safecall;
  40. function Get_DragMode: TxDragMode; safecall;
  41. function Get_Enabled: WordBool; safecall;
  42. function Get_Font: IFontDisp; safecall;
  43. function Get_FullRepaint: WordBool; safecall;
  44. function Get_Locked: WordBool; safecall;
  45. function Get_ParentBackground: WordBool; safecall;
  46. function Get_ParentColor: WordBool; safecall;
  47. function Get_ParentCtl3D: WordBool; safecall;
  48. function Get_Picture: IPictureDisp; safecall;
  49. function Get_UseDockManager: WordBool; safecall;
  50. function Get_Visible: WordBool; safecall;
  51. function Get_VisibleDockClientCount: Integer; safecall;
  52. function IsRightToLeft: WordBool; safecall;
  53. function UseRightToLeftReading: WordBool; safecall;
  54. function UseRightToLeftScrollBar: WordBool; safecall;
  55. procedure _Set_Font(var Value: IFontDisp); safecall;
  56. procedure InitiateAction; safecall;
  57. procedure LoadFromFile(const AFileName: WideString); safecall;
  58. procedure Set_Alignment(Value: TxAlignment); safecall;
  59. procedure Set_AutoSize(Value: WordBool); safecall;
  60. procedure Set_BevelInner(Value: TxBevelCut); safecall;
  61. procedure Set_BevelOuter(Value: TxBevelCut); safecall;
  62. procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  63. procedure Set_Caption(const Value: WideString); safecall;
  64. procedure Set_Color(Value: OLE_COLOR); safecall;
  65. procedure Set_Ctl3D(Value: WordBool); safecall;
  66. procedure Set_DockSite(Value: WordBool); safecall;
  67. procedure Set_DoubleBuffered(Value: WordBool); safecall;
  68. procedure Set_DragCursor(Value: Smallint); safecall;
  69. procedure Set_DragMode(Value: TxDragMode); safecall;
  70. procedure Set_Enabled(Value: WordBool); safecall;
  71. procedure Set_Font(const Value: IFontDisp); safecall;
  72. procedure Set_FullRepaint(Value: WordBool); safecall;
  73. procedure Set_Locked(Value: WordBool); safecall;
  74. procedure Set_ParentBackground(Value: WordBool); safecall;
  75. procedure Set_ParentColor(Value: WordBool); safecall;
  76. procedure Set_ParentCtl3D(Value: WordBool); safecall;
  77. procedure Set_Picture(const Value: IPictureDisp); safecall;
  78. procedure Set_UseDockManager(Value: WordBool); safecall;
  79. procedure Set_Visible(Value: WordBool); safecall;
  80. procedure SetSubComponent(IsSubComponent: WordBool); safecall;
  81. end;
  82. implementation
  83. uses ComObj;
  84. { TRealICQImageOleX }
  85. procedure TRealICQImageOleX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  86. begin
  87. {TODO: Define property pages here. Property pages are defined by calling
  88. DefinePropertyPage with the class id of the page. For example,
  89. DefinePropertyPage(Class_RealICQImageOleXPage); }
  90. end;
  91. procedure TRealICQImageOleX.EventSinkChanged(const EventSink: IUnknown);
  92. begin
  93. FEvents := EventSink as IRealICQImageOleXEvents;
  94. end;
  95. procedure TRealICQImageOleX.InitializeControl;
  96. begin
  97. FDelphiControl := Control as TImagePanelForActiveX;
  98. FDelphiControl.OnCanResize := CanResizeEvent;
  99. FDelphiControl.OnClick := ClickEvent;
  100. FDelphiControl.OnConstrainedResize := ConstrainedResizeEvent;
  101. FDelphiControl.OnDblClick := DblClickEvent;
  102. FDelphiControl.OnResize := ResizeEvent;
  103. end;
  104. function TRealICQImageOleX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  105. begin
  106. Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  107. end;
  108. function TRealICQImageOleX.Get_AlignDisabled: WordBool;
  109. begin
  110. Result := FDelphiControl.AlignDisabled;
  111. end;
  112. function TRealICQImageOleX.Get_Alignment: TxAlignment;
  113. begin
  114. Result := Ord(FDelphiControl.Alignment);
  115. end;
  116. function TRealICQImageOleX.Get_AutoSize: WordBool;
  117. begin
  118. Result := FDelphiControl.AutoSize;
  119. end;
  120. function TRealICQImageOleX.Get_BevelInner: TxBevelCut;
  121. begin
  122. Result := Ord(FDelphiControl.BevelInner);
  123. end;
  124. function TRealICQImageOleX.Get_BevelOuter: TxBevelCut;
  125. begin
  126. Result := Ord(FDelphiControl.BevelOuter);
  127. end;
  128. function TRealICQImageOleX.Get_BorderStyle: TxBorderStyle;
  129. begin
  130. Result := Ord(FDelphiControl.BorderStyle);
  131. end;
  132. function TRealICQImageOleX.Get_Caption: WideString;
  133. begin
  134. Result := WideString(FDelphiControl.Caption);
  135. end;
  136. function TRealICQImageOleX.Get_Color: OLE_COLOR;
  137. begin
  138. Result := OLE_COLOR(FDelphiControl.Color);
  139. end;
  140. function TRealICQImageOleX.Get_Ctl3D: WordBool;
  141. begin
  142. Result := FDelphiControl.Ctl3D;
  143. end;
  144. function TRealICQImageOleX.Get_DockSite: WordBool;
  145. begin
  146. Result := FDelphiControl.DockSite;
  147. end;
  148. function TRealICQImageOleX.Get_DoubleBuffered: WordBool;
  149. begin
  150. Result := FDelphiControl.DoubleBuffered;
  151. end;
  152. function TRealICQImageOleX.Get_DragCursor: Smallint;
  153. begin
  154. Result := Smallint(FDelphiControl.DragCursor);
  155. end;
  156. function TRealICQImageOleX.Get_DragMode: TxDragMode;
  157. begin
  158. Result := Ord(FDelphiControl.DragMode);
  159. end;
  160. function TRealICQImageOleX.Get_Enabled: WordBool;
  161. begin
  162. Result := FDelphiControl.Enabled;
  163. end;
  164. function TRealICQImageOleX.Get_Font: IFontDisp;
  165. begin
  166. GetOleFont(FDelphiControl.Font, Result);
  167. end;
  168. function TRealICQImageOleX.Get_FullRepaint: WordBool;
  169. begin
  170. Result := FDelphiControl.FullRepaint;
  171. end;
  172. function TRealICQImageOleX.Get_Locked: WordBool;
  173. begin
  174. Result := FDelphiControl.Locked;
  175. end;
  176. function TRealICQImageOleX.Get_ParentBackground: WordBool;
  177. begin
  178. Result := FDelphiControl.ParentBackground;
  179. end;
  180. function TRealICQImageOleX.Get_ParentColor: WordBool;
  181. begin
  182. Result := FDelphiControl.ParentColor;
  183. end;
  184. function TRealICQImageOleX.Get_ParentCtl3D: WordBool;
  185. begin
  186. Result := FDelphiControl.ParentCtl3D;
  187. end;
  188. function TRealICQImageOleX.Get_Picture: IPictureDisp;
  189. begin
  190. GetOlePicture(FDelphiControl.Picture, Result);
  191. end;
  192. function TRealICQImageOleX.Get_UseDockManager: WordBool;
  193. begin
  194. Result := FDelphiControl.UseDockManager;
  195. end;
  196. function TRealICQImageOleX.Get_Visible: WordBool;
  197. begin
  198. Result := FDelphiControl.Visible;
  199. end;
  200. function TRealICQImageOleX.Get_VisibleDockClientCount: Integer;
  201. begin
  202. Result := FDelphiControl.VisibleDockClientCount;
  203. end;
  204. function TRealICQImageOleX.IsRightToLeft: WordBool;
  205. begin
  206. Result := FDelphiControl.IsRightToLeft;
  207. end;
  208. function TRealICQImageOleX.UseRightToLeftReading: WordBool;
  209. begin
  210. Result := FDelphiControl.UseRightToLeftReading;
  211. end;
  212. function TRealICQImageOleX.UseRightToLeftScrollBar: WordBool;
  213. begin
  214. Result := FDelphiControl.UseRightToLeftScrollBar;
  215. end;
  216. procedure TRealICQImageOleX._Set_Font(var Value: IFontDisp);
  217. begin
  218. SetOleFont(FDelphiControl.Font, Value);
  219. end;
  220. procedure TRealICQImageOleX.CanResizeEvent(Sender: TObject; var NewWidth,
  221. NewHeight: Integer; var Resize: Boolean);
  222. var
  223. TempNewWidth: Integer;
  224. TempNewHeight: Integer;
  225. TempResize: WordBool;
  226. begin
  227. TempNewWidth := Integer(NewWidth);
  228. TempNewHeight := Integer(NewHeight);
  229. TempResize := WordBool(Resize);
  230. if FEvents <> nil then FEvents.OnCanResize(TempNewWidth, TempNewHeight, TempResize);
  231. NewWidth := Integer(TempNewWidth);
  232. NewHeight := Integer(TempNewHeight);
  233. Resize := Boolean(TempResize);
  234. end;
  235. procedure TRealICQImageOleX.ClickEvent(Sender: TObject);
  236. begin
  237. if FEvents <> nil then FEvents.OnClick;
  238. end;
  239. procedure TRealICQImageOleX.ConstrainedResizeEvent(Sender: TObject;
  240. var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
  241. var
  242. TempMinWidth: Integer;
  243. TempMinHeight: Integer;
  244. TempMaxWidth: Integer;
  245. TempMaxHeight: Integer;
  246. begin
  247. TempMinWidth := Integer(MinWidth);
  248. TempMinHeight := Integer(MinHeight);
  249. TempMaxWidth := Integer(MaxWidth);
  250. TempMaxHeight := Integer(MaxHeight);
  251. if FEvents <> nil then FEvents.OnConstrainedResize(TempMinWidth, TempMinHeight, TempMaxWidth, TempMaxHeight);
  252. MinWidth := Integer(TempMinWidth);
  253. MinHeight := Integer(TempMinHeight);
  254. MaxWidth := Integer(TempMaxWidth);
  255. MaxHeight := Integer(TempMaxHeight);
  256. end;
  257. procedure TRealICQImageOleX.DblClickEvent(Sender: TObject);
  258. begin
  259. if FEvents <> nil then FEvents.OnDblClick;
  260. end;
  261. procedure TRealICQImageOleX.InitiateAction;
  262. begin
  263. FDelphiControl.InitiateAction;
  264. end;
  265. procedure TRealICQImageOleX.LoadFromFile(const AFileName: WideString);
  266. begin
  267. FDelphiControl.LoadFromFile(AFileName);
  268. end;
  269. procedure TRealICQImageOleX.ResizeEvent(Sender: TObject);
  270. begin
  271. if FEvents <> nil then FEvents.OnResize;
  272. end;
  273. procedure TRealICQImageOleX.Set_Alignment(Value: TxAlignment);
  274. begin
  275. FDelphiControl.Alignment := TAlignment(Value);
  276. end;
  277. procedure TRealICQImageOleX.Set_AutoSize(Value: WordBool);
  278. begin
  279. FDelphiControl.AutoSize := Value;
  280. end;
  281. procedure TRealICQImageOleX.Set_BevelInner(Value: TxBevelCut);
  282. begin
  283. FDelphiControl.BevelInner := TBevelCut(Value);
  284. end;
  285. procedure TRealICQImageOleX.Set_BevelOuter(Value: TxBevelCut);
  286. begin
  287. FDelphiControl.BevelOuter := TBevelCut(Value);
  288. end;
  289. procedure TRealICQImageOleX.Set_BorderStyle(Value: TxBorderStyle);
  290. begin
  291. FDelphiControl.BorderStyle := TBorderStyle(Value);
  292. end;
  293. procedure TRealICQImageOleX.Set_Caption(const Value: WideString);
  294. begin
  295. FDelphiControl.Caption := TCaption(Value);
  296. end;
  297. procedure TRealICQImageOleX.Set_Color(Value: OLE_COLOR);
  298. begin
  299. FDelphiControl.Color := TColor(Value);
  300. end;
  301. procedure TRealICQImageOleX.Set_Ctl3D(Value: WordBool);
  302. begin
  303. FDelphiControl.Ctl3D := Value;
  304. end;
  305. procedure TRealICQImageOleX.Set_DockSite(Value: WordBool);
  306. begin
  307. FDelphiControl.DockSite := Value;
  308. end;
  309. procedure TRealICQImageOleX.Set_DoubleBuffered(Value: WordBool);
  310. begin
  311. FDelphiControl.DoubleBuffered := Value;
  312. end;
  313. procedure TRealICQImageOleX.Set_DragCursor(Value: Smallint);
  314. begin
  315. FDelphiControl.DragCursor := TCursor(Value);
  316. end;
  317. procedure TRealICQImageOleX.Set_DragMode(Value: TxDragMode);
  318. begin
  319. FDelphiControl.DragMode := TDragMode(Value);
  320. end;
  321. procedure TRealICQImageOleX.Set_Enabled(Value: WordBool);
  322. begin
  323. FDelphiControl.Enabled := Value;
  324. end;
  325. procedure TRealICQImageOleX.Set_Font(const Value: IFontDisp);
  326. begin
  327. SetOleFont(FDelphiControl.Font, Value);
  328. end;
  329. procedure TRealICQImageOleX.Set_FullRepaint(Value: WordBool);
  330. begin
  331. FDelphiControl.FullRepaint := Value;
  332. end;
  333. procedure TRealICQImageOleX.Set_Locked(Value: WordBool);
  334. begin
  335. FDelphiControl.Locked := Value;
  336. end;
  337. procedure TRealICQImageOleX.Set_ParentBackground(Value: WordBool);
  338. begin
  339. FDelphiControl.ParentBackground := Value;
  340. end;
  341. procedure TRealICQImageOleX.Set_ParentColor(Value: WordBool);
  342. begin
  343. FDelphiControl.ParentColor := Value;
  344. end;
  345. procedure TRealICQImageOleX.Set_ParentCtl3D(Value: WordBool);
  346. begin
  347. FDelphiControl.ParentCtl3D := Value;
  348. end;
  349. procedure TRealICQImageOleX.Set_Picture(const Value: IPictureDisp);
  350. begin
  351. SetOlePicture(FDelphiControl.Picture, Value);
  352. end;
  353. procedure TRealICQImageOleX.Set_UseDockManager(Value: WordBool);
  354. begin
  355. FDelphiControl.UseDockManager := Value;
  356. end;
  357. procedure TRealICQImageOleX.Set_Visible(Value: WordBool);
  358. begin
  359. FDelphiControl.Visible := Value;
  360. end;
  361. procedure TRealICQImageOleX.SetSubComponent(IsSubComponent: WordBool);
  362. begin
  363. FDelphiControl.SetSubComponent(IsSubComponent);
  364. end;
  365. initialization
  366. TActiveXControlFactory.Create(
  367. ComServer,
  368. TRealICQImageOleX,
  369. TImagePanelForActiveX,
  370. Class_RealICQImageOleX,
  371. 1,
  372. '{4CA28EC4-830F-4D3C-9A27-D76E515AFF3C}',
  373. OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
  374. tmApartment);
  375. end.