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

  1. unit GroupBoxImpl1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelCtrls_TLB;
  8.  
  9. type
  10.   TGroupBoxX = class(TActiveXControl, IGroupBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TGroupBox;
  14.     FEvents: IGroupBoxXEvents;
  15.     procedure ClickEvent(Sender: TObject);
  16.     procedure DblClickEvent(Sender: TObject);
  17.   protected
  18.     { Protected declarations }
  19.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  20.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  21.     procedure InitializeControl; override;
  22.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  23.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  24.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  25.     function Get_BiDiMode: TxBiDiMode; safecall;
  26.     function Get_Caption: WideString; safecall;
  27.     function Get_Color: OLE_COLOR; safecall;
  28.     function Get_Ctl3D: WordBool; 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_ParentColor: WordBool; safecall;
  37.     function Get_ParentCtl3D: WordBool; safecall;
  38.     function Get_ParentFont: WordBool; safecall;
  39.     function Get_Visible: WordBool; safecall;
  40.     function GetControlsAlignment: TxAlignment; safecall;
  41.     function IsRightToLeft: WordBool; safecall;
  42.     function UseRightToLeftAlignment: WordBool; safecall;
  43.     function UseRightToLeftReading: WordBool; safecall;
  44.     function UseRightToLeftScrollBar: WordBool; safecall;
  45.     procedure _Set_Font(const Value: IFontDisp); safecall;
  46.     procedure AboutBox; safecall;
  47.     procedure FlipChildren(AllLevels: WordBool); safecall;
  48.     procedure InitiateAction; safecall;
  49.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  50.     procedure Set_Caption(const Value: WideString); safecall;
  51.     procedure Set_Color(Value: OLE_COLOR); safecall;
  52.     procedure Set_Ctl3D(Value: WordBool); safecall;
  53.     procedure Set_Cursor(Value: Smallint); safecall;
  54.     procedure Set_DockSite(Value: WordBool); safecall;
  55.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  56.     procedure Set_DragCursor(Value: Smallint); safecall;
  57.     procedure Set_DragMode(Value: TxDragMode); safecall;
  58.     procedure Set_Enabled(Value: WordBool); safecall;
  59.     procedure Set_Font(const Value: IFontDisp); safecall;
  60.     procedure Set_ParentColor(Value: WordBool); safecall;
  61.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  62.     procedure Set_ParentFont(Value: WordBool); safecall;
  63.     procedure Set_Visible(Value: WordBool); safecall;
  64.   end;
  65.  
  66. implementation
  67.  
  68. uses ComObj, About12;
  69.  
  70. { TGroupBoxX }
  71.  
  72. procedure TGroupBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  73. begin
  74.   { Define property pages here.  Property pages are defined by calling
  75.     DefinePropertyPage with the class id of the page.  For example,
  76.       DefinePropertyPage(Class_GroupBoxXPage); }
  77. end;
  78.  
  79. procedure TGroupBoxX.EventSinkChanged(const EventSink: IUnknown);
  80. begin
  81.   FEvents := EventSink as IGroupBoxXEvents;
  82. end;
  83.  
  84. procedure TGroupBoxX.InitializeControl;
  85. begin
  86.   FDelphiControl := Control as TGroupBox;
  87.   FDelphiControl.OnClick := ClickEvent;
  88.   FDelphiControl.OnDblClick := DblClickEvent;
  89. end;
  90.  
  91. function TGroupBoxX.ClassNameIs(const Name: WideString): WordBool;
  92. begin
  93.   Result := FDelphiControl.ClassNameIs(Name);
  94. end;
  95.  
  96. function TGroupBoxX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  97. begin
  98.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  99. end;
  100.  
  101. function TGroupBoxX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  102. begin
  103.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  104. end;
  105.  
  106. function TGroupBoxX.Get_BiDiMode: TxBiDiMode;
  107. begin
  108.   Result := Ord(FDelphiControl.BiDiMode);
  109. end;
  110.  
  111. function TGroupBoxX.Get_Caption: WideString;
  112. begin
  113.   Result := WideString(FDelphiControl.Caption);
  114. end;
  115.  
  116. function TGroupBoxX.Get_Color: OLE_COLOR;
  117. begin
  118.   Result := OLE_COLOR(FDelphiControl.Color);
  119. end;
  120.  
  121. function TGroupBoxX.Get_Ctl3D: WordBool;
  122. begin
  123.   Result := FDelphiControl.Ctl3D;
  124. end;
  125.  
  126. function TGroupBoxX.Get_Cursor: Smallint;
  127. begin
  128.   Result := Smallint(FDelphiControl.Cursor);
  129. end;
  130.  
  131. function TGroupBoxX.Get_DockSite: WordBool;
  132. begin
  133.   Result := FDelphiControl.DockSite;
  134. end;
  135.  
  136. function TGroupBoxX.Get_DoubleBuffered: WordBool;
  137. begin
  138.   Result := FDelphiControl.DoubleBuffered;
  139. end;
  140.  
  141. function TGroupBoxX.Get_DragCursor: Smallint;
  142. begin
  143.   Result := Smallint(FDelphiControl.DragCursor);
  144. end;
  145.  
  146. function TGroupBoxX.Get_DragMode: TxDragMode;
  147. begin
  148.   Result := Ord(FDelphiControl.DragMode);
  149. end;
  150.  
  151. function TGroupBoxX.Get_Enabled: WordBool;
  152. begin
  153.   Result := FDelphiControl.Enabled;
  154. end;
  155.  
  156. function TGroupBoxX.Get_Font: IFontDisp;
  157. begin
  158.   GetOleFont(FDelphiControl.Font, Result);
  159. end;
  160.  
  161. function TGroupBoxX.Get_ParentColor: WordBool;
  162. begin
  163.   Result := FDelphiControl.ParentColor;
  164. end;
  165.  
  166. function TGroupBoxX.Get_ParentCtl3D: WordBool;
  167. begin
  168.   Result := FDelphiControl.ParentCtl3D;
  169. end;
  170.  
  171. function TGroupBoxX.Get_ParentFont: WordBool;
  172. begin
  173.   Result := FDelphiControl.ParentFont;
  174. end;
  175.  
  176. function TGroupBoxX.Get_Visible: WordBool;
  177. begin
  178.   Result := FDelphiControl.Visible;
  179. end;
  180.  
  181. function TGroupBoxX.GetControlsAlignment: TxAlignment;
  182. begin
  183.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  184. end;
  185.  
  186. function TGroupBoxX.IsRightToLeft: WordBool;
  187. begin
  188.   Result := FDelphiControl.IsRightToLeft;
  189. end;
  190.  
  191. function TGroupBoxX.UseRightToLeftAlignment: WordBool;
  192. begin
  193.   Result := FDelphiControl.UseRightToLeftAlignment;
  194. end;
  195.  
  196. function TGroupBoxX.UseRightToLeftReading: WordBool;
  197. begin
  198.   Result := FDelphiControl.UseRightToLeftReading;
  199. end;
  200.  
  201. function TGroupBoxX.UseRightToLeftScrollBar: WordBool;
  202. begin
  203.   Result := FDelphiControl.UseRightToLeftScrollBar;
  204. end;
  205.  
  206. procedure TGroupBoxX._Set_Font(const Value: IFontDisp);
  207. begin
  208.   SetOleFont(FDelphiControl.Font, Value);
  209. end;
  210.  
  211. procedure TGroupBoxX.AboutBox;
  212. begin
  213.   ShowGroupBoxXAbout;
  214. end;
  215.  
  216. procedure TGroupBoxX.FlipChildren(AllLevels: WordBool);
  217. begin
  218.   FDelphiControl.FlipChildren(AllLevels);
  219. end;
  220.  
  221. procedure TGroupBoxX.InitiateAction;
  222. begin
  223.   FDelphiControl.InitiateAction;
  224. end;
  225.  
  226. procedure TGroupBoxX.Set_BiDiMode(Value: TxBiDiMode);
  227. begin
  228.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  229. end;
  230.  
  231. procedure TGroupBoxX.Set_Caption(const Value: WideString);
  232. begin
  233.   FDelphiControl.Caption := TCaption(Value);
  234. end;
  235.  
  236. procedure TGroupBoxX.Set_Color(Value: OLE_COLOR);
  237. begin
  238.   FDelphiControl.Color := TColor(Value);
  239. end;
  240.  
  241. procedure TGroupBoxX.Set_Ctl3D(Value: WordBool);
  242. begin
  243.   FDelphiControl.Ctl3D := Value;
  244. end;
  245.  
  246. procedure TGroupBoxX.Set_Cursor(Value: Smallint);
  247. begin
  248.   FDelphiControl.Cursor := TCursor(Value);
  249. end;
  250.  
  251. procedure TGroupBoxX.Set_DockSite(Value: WordBool);
  252. begin
  253.   FDelphiControl.DockSite := Value;
  254. end;
  255.  
  256. procedure TGroupBoxX.Set_DoubleBuffered(Value: WordBool);
  257. begin
  258.   FDelphiControl.DoubleBuffered := Value;
  259. end;
  260.  
  261. procedure TGroupBoxX.Set_DragCursor(Value: Smallint);
  262. begin
  263.   FDelphiControl.DragCursor := TCursor(Value);
  264. end;
  265.  
  266. procedure TGroupBoxX.Set_DragMode(Value: TxDragMode);
  267. begin
  268.   FDelphiControl.DragMode := TDragMode(Value);
  269. end;
  270.  
  271. procedure TGroupBoxX.Set_Enabled(Value: WordBool);
  272. begin
  273.   FDelphiControl.Enabled := Value;
  274. end;
  275.  
  276. procedure TGroupBoxX.Set_Font(const Value: IFontDisp);
  277. begin
  278.   SetOleFont(FDelphiControl.Font, Value);
  279. end;
  280.  
  281. procedure TGroupBoxX.Set_ParentColor(Value: WordBool);
  282. begin
  283.   FDelphiControl.ParentColor := Value;
  284. end;
  285.  
  286. procedure TGroupBoxX.Set_ParentCtl3D(Value: WordBool);
  287. begin
  288.   FDelphiControl.ParentCtl3D := Value;
  289. end;
  290.  
  291. procedure TGroupBoxX.Set_ParentFont(Value: WordBool);
  292. begin
  293.   FDelphiControl.ParentFont := Value;
  294. end;
  295.  
  296. procedure TGroupBoxX.Set_Visible(Value: WordBool);
  297. begin
  298.   FDelphiControl.Visible := Value;
  299. end;
  300.  
  301. procedure TGroupBoxX.ClickEvent(Sender: TObject);
  302. begin
  303.   if FEvents <> nil then FEvents.OnClick;
  304. end;
  305.  
  306. procedure TGroupBoxX.DblClickEvent(Sender: TObject);
  307. begin
  308.   if FEvents <> nil then FEvents.OnDblClick;
  309. end;
  310.  
  311. initialization
  312.   TActiveXControlFactory.Create(
  313.     ComServer,
  314.     TGroupBoxX,
  315.     TGroupBox,
  316.     Class_GroupBoxX,
  317.     12,
  318.     '{695CDB31-02E5-11D2-B20D-00C04FA368D4}',
  319.     OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
  320.     tmApartment);
  321. end.
  322.