home *** CD-ROM | disk | FTP | other *** search
/ PC Expert 29 / Pce29cd.iso / RUNIMAGE / DELPHI40 / DEMOS / ACTIVEX / DELCTRLS / tabcontrolimpl1.pas < prev    next >
Pascal/Delphi Source File  |  1998-06-16  |  12KB  |  431 lines

  1. unit TabControlImpl1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelCtrls_TLB, ComCtrls;
  8.  
  9. type
  10.   TTabControlX = class(TActiveXControl, ITabControlX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TTabControl;
  14.     FEvents: ITabControlXEvents;
  15.     procedure ChangeEvent(Sender: TObject);
  16.     procedure ChangingEvent(Sender: TObject; var AllowChange: Boolean);
  17.     procedure GetImageIndexEvent(Sender: TObject; TabIndex: Integer;
  18.       var ImageIndex: Integer);
  19.     procedure ResizeEvent(Sender: TObject);
  20.   protected
  21.     { Protected declarations }
  22.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  23.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  24.     procedure InitializeControl; override;
  25.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  26.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  27.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  28.     function Get_BiDiMode: TxBiDiMode; safecall;
  29.     function Get_Cursor: Smallint; safecall;
  30.     function Get_DockSite: WordBool; safecall;
  31.     function Get_DoubleBuffered: WordBool; safecall;
  32.     function Get_DragCursor: Smallint; safecall;
  33.     function Get_DragMode: TxDragMode; safecall;
  34.     function Get_Enabled: WordBool; safecall;
  35.     function Get_Font: IFontDisp; safecall;
  36.     function Get_HotTrack: WordBool; safecall;
  37.     function Get_MultiLine: WordBool; safecall;
  38.     function Get_MultiSelect: WordBool; safecall;
  39.     function Get_OwnerDraw: WordBool; safecall;
  40.     function Get_ParentFont: WordBool; safecall;
  41.     function Get_RaggedRight: WordBool; safecall;
  42.     function Get_ScrollOpposite: WordBool; safecall;
  43.     function Get_Style: TxTabStyle; safecall;
  44.     function Get_TabHeight: Smallint; safecall;
  45.     function Get_TabIndex: Integer; safecall;
  46.     function Get_TabPosition: TxTabPosition; safecall;
  47.     function Get_Tabs: IStrings; safecall;
  48.     function Get_TabWidth: Smallint; safecall;
  49.     function Get_Visible: WordBool; safecall;
  50.     function GetControlsAlignment: TxAlignment; safecall;
  51.     function IsRightToLeft: WordBool; safecall;
  52.     function UseRightToLeftAlignment: WordBool; safecall;
  53.     function UseRightToLeftReading: WordBool; safecall;
  54.     function UseRightToLeftScrollBar: WordBool; safecall;
  55.     procedure _Set_Font(const Value: IFontDisp); safecall;
  56.     procedure AboutBox; safecall;
  57.     procedure FlipChildren(AllLevels: WordBool); safecall;
  58.     procedure InitiateAction; safecall;
  59.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  60.     procedure Set_Cursor(Value: Smallint); safecall;
  61.     procedure Set_DockSite(Value: WordBool); safecall;
  62.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  63.     procedure Set_DragCursor(Value: Smallint); safecall;
  64.     procedure Set_DragMode(Value: TxDragMode); safecall;
  65.     procedure Set_Enabled(Value: WordBool); safecall;
  66.     procedure Set_Font(const Value: IFontDisp); safecall;
  67.     procedure Set_HotTrack(Value: WordBool); safecall;
  68.     procedure Set_MultiLine(Value: WordBool); safecall;
  69.     procedure Set_MultiSelect(Value: WordBool); safecall;
  70.     procedure Set_OwnerDraw(Value: WordBool); safecall;
  71.     procedure Set_ParentFont(Value: WordBool); safecall;
  72.     procedure Set_RaggedRight(Value: WordBool); safecall;
  73.     procedure Set_ScrollOpposite(Value: WordBool); safecall;
  74.     procedure Set_Style(Value: TxTabStyle); safecall;
  75.     procedure Set_TabHeight(Value: Smallint); safecall;
  76.     procedure Set_TabIndex(Value: Integer); safecall;
  77.     procedure Set_TabPosition(Value: TxTabPosition); safecall;
  78.     procedure Set_Tabs(const Value: IStrings); safecall;
  79.     procedure Set_TabWidth(Value: Smallint); safecall;
  80.     procedure Set_Visible(Value: WordBool); safecall;
  81.   end;
  82.  
  83. implementation
  84.  
  85. uses ComObj, About34;
  86.  
  87. { TTabControlX }
  88.  
  89. procedure TTabControlX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  90. begin
  91.   { Define property pages here.  Property pages are defined by calling
  92.     DefinePropertyPage with the class id of the page.  For example,
  93.       DefinePropertyPage(Class_TabControlXPage); }
  94. end;
  95.  
  96. procedure TTabControlX.EventSinkChanged(const EventSink: IUnknown);
  97. begin
  98.   FEvents := EventSink as ITabControlXEvents;
  99. end;
  100.  
  101. procedure TTabControlX.InitializeControl;
  102. begin
  103.   FDelphiControl := Control as TTabControl;
  104.   FDelphiControl.OnChange := ChangeEvent;
  105.   FDelphiControl.OnChanging := ChangingEvent;
  106.   FDelphiControl.OnGetImageIndex := GetImageIndexEvent;
  107.   FDelphiControl.OnResize := ResizeEvent;
  108. end;
  109.  
  110. function TTabControlX.ClassNameIs(const Name: WideString): WordBool;
  111. begin
  112.   Result := FDelphiControl.ClassNameIs(Name);
  113. end;
  114.  
  115. function TTabControlX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  116. begin
  117.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  118. end;
  119.  
  120. function TTabControlX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  121. begin
  122.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  123. end;
  124.  
  125. function TTabControlX.Get_BiDiMode: TxBiDiMode;
  126. begin
  127.   Result := Ord(FDelphiControl.BiDiMode);
  128. end;
  129.  
  130. function TTabControlX.Get_Cursor: Smallint;
  131. begin
  132.   Result := Smallint(FDelphiControl.Cursor);
  133. end;
  134.  
  135. function TTabControlX.Get_DockSite: WordBool;
  136. begin
  137.   Result := FDelphiControl.DockSite;
  138. end;
  139.  
  140. function TTabControlX.Get_DoubleBuffered: WordBool;
  141. begin
  142.   Result := FDelphiControl.DoubleBuffered;
  143. end;
  144.  
  145. function TTabControlX.Get_DragCursor: Smallint;
  146. begin
  147.   Result := Smallint(FDelphiControl.DragCursor);
  148. end;
  149.  
  150. function TTabControlX.Get_DragMode: TxDragMode;
  151. begin
  152.   Result := Ord(FDelphiControl.DragMode);
  153. end;
  154.  
  155. function TTabControlX.Get_Enabled: WordBool;
  156. begin
  157.   Result := FDelphiControl.Enabled;
  158. end;
  159.  
  160. function TTabControlX.Get_Font: IFontDisp;
  161. begin
  162.   GetOleFont(FDelphiControl.Font, Result);
  163. end;
  164.  
  165. function TTabControlX.Get_HotTrack: WordBool;
  166. begin
  167.   Result := FDelphiControl.HotTrack;
  168. end;
  169.  
  170. function TTabControlX.Get_MultiLine: WordBool;
  171. begin
  172.   Result := FDelphiControl.MultiLine;
  173. end;
  174.  
  175. function TTabControlX.Get_MultiSelect: WordBool;
  176. begin
  177.   Result := FDelphiControl.MultiSelect;
  178. end;
  179.  
  180. function TTabControlX.Get_OwnerDraw: WordBool;
  181. begin
  182.   Result := FDelphiControl.OwnerDraw;
  183. end;
  184.  
  185. function TTabControlX.Get_ParentFont: WordBool;
  186. begin
  187.   Result := FDelphiControl.ParentFont;
  188. end;
  189.  
  190. function TTabControlX.Get_RaggedRight: WordBool;
  191. begin
  192.   Result := FDelphiControl.RaggedRight;
  193. end;
  194.  
  195. function TTabControlX.Get_ScrollOpposite: WordBool;
  196. begin
  197.   Result := FDelphiControl.ScrollOpposite;
  198. end;
  199.  
  200. function TTabControlX.Get_Style: TxTabStyle;
  201. begin
  202.   Result := Ord(FDelphiControl.Style);
  203. end;
  204.  
  205. function TTabControlX.Get_TabHeight: Smallint;
  206. begin
  207.   Result := FDelphiControl.TabHeight;
  208. end;
  209.  
  210. function TTabControlX.Get_TabIndex: Integer;
  211. begin
  212.   Result := FDelphiControl.TabIndex;
  213. end;
  214.  
  215. function TTabControlX.Get_TabPosition: TxTabPosition;
  216. begin
  217.   Result := Ord(FDelphiControl.TabPosition);
  218. end;
  219.  
  220. function TTabControlX.Get_Tabs: IStrings;
  221. begin
  222.   GetOleStrings(FDelphiControl.Tabs, Result);
  223. end;
  224.  
  225. function TTabControlX.Get_TabWidth: Smallint;
  226. begin
  227.   Result := FDelphiControl.TabWidth;
  228. end;
  229.  
  230. function TTabControlX.Get_Visible: WordBool;
  231. begin
  232.   Result := FDelphiControl.Visible;
  233. end;
  234.  
  235. function TTabControlX.GetControlsAlignment: TxAlignment;
  236. begin
  237.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  238. end;
  239.  
  240. function TTabControlX.IsRightToLeft: WordBool;
  241. begin
  242.   Result := FDelphiControl.IsRightToLeft;
  243. end;
  244.  
  245. function TTabControlX.UseRightToLeftAlignment: WordBool;
  246. begin
  247.   Result := FDelphiControl.UseRightToLeftAlignment;
  248. end;
  249.  
  250. function TTabControlX.UseRightToLeftReading: WordBool;
  251. begin
  252.   Result := FDelphiControl.UseRightToLeftReading;
  253. end;
  254.  
  255. function TTabControlX.UseRightToLeftScrollBar: WordBool;
  256. begin
  257.   Result := FDelphiControl.UseRightToLeftScrollBar;
  258. end;
  259.  
  260. procedure TTabControlX._Set_Font(const Value: IFontDisp);
  261. begin
  262.   SetOleFont(FDelphiControl.Font, Value);
  263. end;
  264.  
  265. procedure TTabControlX.AboutBox;
  266. begin
  267.   ShowTabControlXAbout;
  268. end;
  269.  
  270. procedure TTabControlX.FlipChildren(AllLevels: WordBool);
  271. begin
  272.   FDelphiControl.FlipChildren(AllLevels);
  273. end;
  274.  
  275. procedure TTabControlX.InitiateAction;
  276. begin
  277.   FDelphiControl.InitiateAction;
  278. end;
  279.  
  280. procedure TTabControlX.Set_BiDiMode(Value: TxBiDiMode);
  281. begin
  282.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  283. end;
  284.  
  285. procedure TTabControlX.Set_Cursor(Value: Smallint);
  286. begin
  287.   FDelphiControl.Cursor := TCursor(Value);
  288. end;
  289.  
  290. procedure TTabControlX.Set_DockSite(Value: WordBool);
  291. begin
  292.   FDelphiControl.DockSite := Value;
  293. end;
  294.  
  295. procedure TTabControlX.Set_DoubleBuffered(Value: WordBool);
  296. begin
  297.   FDelphiControl.DoubleBuffered := Value;
  298. end;
  299.  
  300. procedure TTabControlX.Set_DragCursor(Value: Smallint);
  301. begin
  302.   FDelphiControl.DragCursor := TCursor(Value);
  303. end;
  304.  
  305. procedure TTabControlX.Set_DragMode(Value: TxDragMode);
  306. begin
  307.   FDelphiControl.DragMode := TDragMode(Value);
  308. end;
  309.  
  310. procedure TTabControlX.Set_Enabled(Value: WordBool);
  311. begin
  312.   FDelphiControl.Enabled := Value;
  313. end;
  314.  
  315. procedure TTabControlX.Set_Font(const Value: IFontDisp);
  316. begin
  317.   SetOleFont(FDelphiControl.Font, Value);
  318. end;
  319.  
  320. procedure TTabControlX.Set_HotTrack(Value: WordBool);
  321. begin
  322.   FDelphiControl.HotTrack := Value;
  323. end;
  324.  
  325. procedure TTabControlX.Set_MultiLine(Value: WordBool);
  326. begin
  327.   FDelphiControl.MultiLine := Value;
  328. end;
  329.  
  330. procedure TTabControlX.Set_MultiSelect(Value: WordBool);
  331. begin
  332.   FDelphiControl.MultiSelect := Value;
  333. end;
  334.  
  335. procedure TTabControlX.Set_OwnerDraw(Value: WordBool);
  336. begin
  337.   FDelphiControl.OwnerDraw := Value;
  338. end;
  339.  
  340. procedure TTabControlX.Set_ParentFont(Value: WordBool);
  341. begin
  342.   FDelphiControl.ParentFont := Value;
  343. end;
  344.  
  345. procedure TTabControlX.Set_RaggedRight(Value: WordBool);
  346. begin
  347.   FDelphiControl.RaggedRight := Value;
  348. end;
  349.  
  350. procedure TTabControlX.Set_ScrollOpposite(Value: WordBool);
  351. begin
  352.   FDelphiControl.ScrollOpposite := Value;
  353. end;
  354.  
  355. procedure TTabControlX.Set_Style(Value: TxTabStyle);
  356. begin
  357.   FDelphiControl.Style := TTabStyle(Value);
  358. end;
  359.  
  360. procedure TTabControlX.Set_TabHeight(Value: Smallint);
  361. begin
  362.   FDelphiControl.TabHeight := Value;
  363. end;
  364.  
  365. procedure TTabControlX.Set_TabIndex(Value: Integer);
  366. begin
  367.   FDelphiControl.TabIndex := Value;
  368. end;
  369.  
  370. procedure TTabControlX.Set_TabPosition(Value: TxTabPosition);
  371. begin
  372.   FDelphiControl.TabPosition := TTabPosition(Value);
  373. end;
  374.  
  375. procedure TTabControlX.Set_Tabs(const Value: IStrings);
  376. begin
  377.   SetOleStrings(FDelphiControl.Tabs, Value);
  378. end;
  379.  
  380. procedure TTabControlX.Set_TabWidth(Value: Smallint);
  381. begin
  382.   FDelphiControl.TabWidth := Value;
  383. end;
  384.  
  385. procedure TTabControlX.Set_Visible(Value: WordBool);
  386. begin
  387.   FDelphiControl.Visible := Value;
  388. end;
  389.  
  390. procedure TTabControlX.ChangeEvent(Sender: TObject);
  391. begin
  392.   if FEvents <> nil then FEvents.OnChange;
  393. end;
  394.  
  395. procedure TTabControlX.ChangingEvent(Sender: TObject;
  396.   var AllowChange: Boolean);
  397. var
  398.   TempAllowChange: WordBool;
  399. begin
  400.   TempAllowChange := WordBool(AllowChange);
  401.   if FEvents <> nil then FEvents.OnChanging(TempAllowChange);
  402.   AllowChange := Boolean(TempAllowChange);
  403. end;
  404.  
  405. procedure TTabControlX.GetImageIndexEvent(Sender: TObject;
  406.   TabIndex: Integer; var ImageIndex: Integer);
  407. var
  408.   TempImageIndex: Integer;
  409. begin
  410.   TempImageIndex := Integer(ImageIndex);
  411.   if FEvents <> nil then FEvents.OnGetImageIndex(TabIndex, TempImageIndex);
  412.   ImageIndex := Integer(TempImageIndex);
  413. end;
  414.  
  415. procedure TTabControlX.ResizeEvent(Sender: TObject);
  416. begin
  417.   if FEvents <> nil then FEvents.OnResize;
  418. end;
  419.  
  420. initialization
  421.   TActiveXControlFactory.Create(
  422.     ComServer,
  423.     TTabControlX,
  424.     TTabControl,
  425.     Class_TabControlX,
  426.     34,
  427.     '{695CDBDC-02E5-11D2-B20D-00C04FA368D4}',
  428.     OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
  429.     tmApartment);
  430. end.
  431.