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

  1. unit CheckBoxImpl1;
  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.   TCheckBoxX = class(TActiveXControl, ICheckBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TCheckBox;
  14.     FEvents: ICheckBoxXEvents;
  15.     procedure ClickEvent(Sender: TObject);
  16.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  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_Alignment: TxLeftRight; safecall;
  26.     function Get_AllowGrayed: WordBool; safecall;
  27.     function Get_BiDiMode: TxBiDiMode; safecall;
  28.     function Get_Caption: WideString; safecall;
  29.     function Get_Checked: WordBool; safecall;
  30.     function Get_Color: OLE_COLOR; safecall;
  31.     function Get_Ctl3D: WordBool; safecall;
  32.     function Get_Cursor: Smallint; safecall;
  33.     function Get_DoubleBuffered: WordBool; safecall;
  34.     function Get_DragCursor: Smallint; safecall;
  35.     function Get_DragMode: TxDragMode; safecall;
  36.     function Get_Enabled: WordBool; safecall;
  37.     function Get_Font: IFontDisp; safecall;
  38.     function Get_ParentColor: WordBool; safecall;
  39.     function Get_ParentCtl3D: WordBool; safecall;
  40.     function Get_ParentFont: WordBool; safecall;
  41.     function Get_State: TxCheckBoxState; safecall;
  42.     function Get_Visible: WordBool; safecall;
  43.     function GetControlsAlignment: TxAlignment; safecall;
  44.     function IsRightToLeft: WordBool; safecall;
  45.     function UseRightToLeftAlignment: WordBool; safecall;
  46.     function UseRightToLeftReading: WordBool; safecall;
  47.     function UseRightToLeftScrollBar: WordBool; safecall;
  48.     procedure _Set_Font(const Value: IFontDisp); safecall;
  49.     procedure AboutBox; safecall;
  50.     procedure FlipChildren(AllLevels: WordBool); safecall;
  51.     procedure InitiateAction; safecall;
  52.     procedure Set_Alignment(Value: TxLeftRight); safecall;
  53.     procedure Set_AllowGrayed(Value: WordBool); safecall;
  54.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  55.     procedure Set_Caption(const Value: WideString); safecall;
  56.     procedure Set_Checked(Value: WordBool); safecall;
  57.     procedure Set_Color(Value: OLE_COLOR); safecall;
  58.     procedure Set_Ctl3D(Value: WordBool); safecall;
  59.     procedure Set_Cursor(Value: Smallint); safecall;
  60.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  61.     procedure Set_DragCursor(Value: Smallint); safecall;
  62.     procedure Set_DragMode(Value: TxDragMode); safecall;
  63.     procedure Set_Enabled(Value: WordBool); safecall;
  64.     procedure Set_Font(const Value: IFontDisp); safecall;
  65.     procedure Set_ParentColor(Value: WordBool); safecall;
  66.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  67.     procedure Set_ParentFont(Value: WordBool); safecall;
  68.     procedure Set_State(Value: TxCheckBoxState); safecall;
  69.     procedure Set_Visible(Value: WordBool); safecall;
  70.   end;
  71.  
  72. implementation
  73.  
  74. uses ComObj, About4;
  75.  
  76. { TCheckBoxX }
  77.  
  78. procedure TCheckBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  79. begin
  80.   { Define property pages here.  Property pages are defined by calling
  81.     DefinePropertyPage with the class id of the page.  For example,
  82.       DefinePropertyPage(Class_CheckBoxXPage); }
  83. end;
  84.  
  85. procedure TCheckBoxX.EventSinkChanged(const EventSink: IUnknown);
  86. begin
  87.   FEvents := EventSink as ICheckBoxXEvents;
  88. end;
  89.  
  90. procedure TCheckBoxX.InitializeControl;
  91. begin
  92.   FDelphiControl := Control as TCheckBox;
  93.   FDelphiControl.OnClick := ClickEvent;
  94.   FDelphiControl.OnKeyPress := KeyPressEvent;
  95. end;
  96.  
  97. function TCheckBoxX.ClassNameIs(const Name: WideString): WordBool;
  98. begin
  99.   Result := FDelphiControl.ClassNameIs(Name);
  100. end;
  101.  
  102. function TCheckBoxX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  103. begin
  104.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  105. end;
  106.  
  107. function TCheckBoxX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  108. begin
  109.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  110. end;
  111.  
  112. function TCheckBoxX.Get_Alignment: TxLeftRight;
  113. begin
  114.   Result := Ord(FDelphiControl.Alignment);
  115. end;
  116.  
  117. function TCheckBoxX.Get_AllowGrayed: WordBool;
  118. begin
  119.   Result := FDelphiControl.AllowGrayed;
  120. end;
  121.  
  122. function TCheckBoxX.Get_BiDiMode: TxBiDiMode;
  123. begin
  124.   Result := Ord(FDelphiControl.BiDiMode);
  125. end;
  126.  
  127. function TCheckBoxX.Get_Caption: WideString;
  128. begin
  129.   Result := WideString(FDelphiControl.Caption);
  130. end;
  131.  
  132. function TCheckBoxX.Get_Checked: WordBool;
  133. begin
  134.   Result := FDelphiControl.Checked;
  135. end;
  136.  
  137. function TCheckBoxX.Get_Color: OLE_COLOR;
  138. begin
  139.   Result := OLE_COLOR(FDelphiControl.Color);
  140. end;
  141.  
  142. function TCheckBoxX.Get_Ctl3D: WordBool;
  143. begin
  144.   Result := FDelphiControl.Ctl3D;
  145. end;
  146.  
  147. function TCheckBoxX.Get_Cursor: Smallint;
  148. begin
  149.   Result := Smallint(FDelphiControl.Cursor);
  150. end;
  151.  
  152. function TCheckBoxX.Get_DoubleBuffered: WordBool;
  153. begin
  154.   Result := FDelphiControl.DoubleBuffered;
  155. end;
  156.  
  157. function TCheckBoxX.Get_DragCursor: Smallint;
  158. begin
  159.   Result := Smallint(FDelphiControl.DragCursor);
  160. end;
  161.  
  162. function TCheckBoxX.Get_DragMode: TxDragMode;
  163. begin
  164.   Result := Ord(FDelphiControl.DragMode);
  165. end;
  166.  
  167. function TCheckBoxX.Get_Enabled: WordBool;
  168. begin
  169.   Result := FDelphiControl.Enabled;
  170. end;
  171.  
  172. function TCheckBoxX.Get_Font: IFontDisp;
  173. begin
  174.   GetOleFont(FDelphiControl.Font, Result);
  175. end;
  176.  
  177. function TCheckBoxX.Get_ParentColor: WordBool;
  178. begin
  179.   Result := FDelphiControl.ParentColor;
  180. end;
  181.  
  182. function TCheckBoxX.Get_ParentCtl3D: WordBool;
  183. begin
  184.   Result := FDelphiControl.ParentCtl3D;
  185. end;
  186.  
  187. function TCheckBoxX.Get_ParentFont: WordBool;
  188. begin
  189.   Result := FDelphiControl.ParentFont;
  190. end;
  191.  
  192. function TCheckBoxX.Get_State: TxCheckBoxState;
  193. begin
  194.   Result := Ord(FDelphiControl.State);
  195. end;
  196.  
  197. function TCheckBoxX.Get_Visible: WordBool;
  198. begin
  199.   Result := FDelphiControl.Visible;
  200. end;
  201.  
  202. function TCheckBoxX.GetControlsAlignment: TxAlignment;
  203. begin
  204.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  205. end;
  206.  
  207. function TCheckBoxX.IsRightToLeft: WordBool;
  208. begin
  209.   Result := FDelphiControl.IsRightToLeft;
  210. end;
  211.  
  212. function TCheckBoxX.UseRightToLeftAlignment: WordBool;
  213. begin
  214.   Result := FDelphiControl.UseRightToLeftAlignment;
  215. end;
  216.  
  217. function TCheckBoxX.UseRightToLeftReading: WordBool;
  218. begin
  219.   Result := FDelphiControl.UseRightToLeftReading;
  220. end;
  221.  
  222. function TCheckBoxX.UseRightToLeftScrollBar: WordBool;
  223. begin
  224.   Result := FDelphiControl.UseRightToLeftScrollBar;
  225. end;
  226.  
  227. procedure TCheckBoxX._Set_Font(const Value: IFontDisp);
  228. begin
  229.   SetOleFont(FDelphiControl.Font, Value);
  230. end;
  231.  
  232. procedure TCheckBoxX.AboutBox;
  233. begin
  234.   ShowCheckBoxXAbout;
  235. end;
  236.  
  237. procedure TCheckBoxX.FlipChildren(AllLevels: WordBool);
  238. begin
  239.   FDelphiControl.FlipChildren(AllLevels);
  240. end;
  241.  
  242. procedure TCheckBoxX.InitiateAction;
  243. begin
  244.   FDelphiControl.InitiateAction;
  245. end;
  246.  
  247. procedure TCheckBoxX.Set_Alignment(Value: TxLeftRight);
  248. begin
  249.   FDelphiControl.Alignment := TLeftRight(Value);
  250. end;
  251.  
  252. procedure TCheckBoxX.Set_AllowGrayed(Value: WordBool);
  253. begin
  254.   FDelphiControl.AllowGrayed := Value;
  255. end;
  256.  
  257. procedure TCheckBoxX.Set_BiDiMode(Value: TxBiDiMode);
  258. begin
  259.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  260. end;
  261.  
  262. procedure TCheckBoxX.Set_Caption(const Value: WideString);
  263. begin
  264.   FDelphiControl.Caption := TCaption(Value);
  265. end;
  266.  
  267. procedure TCheckBoxX.Set_Checked(Value: WordBool);
  268. begin
  269.   FDelphiControl.Checked := Value;
  270. end;
  271.  
  272. procedure TCheckBoxX.Set_Color(Value: OLE_COLOR);
  273. begin
  274.   FDelphiControl.Color := TColor(Value);
  275. end;
  276.  
  277. procedure TCheckBoxX.Set_Ctl3D(Value: WordBool);
  278. begin
  279.   FDelphiControl.Ctl3D := Value;
  280. end;
  281.  
  282. procedure TCheckBoxX.Set_Cursor(Value: Smallint);
  283. begin
  284.   FDelphiControl.Cursor := TCursor(Value);
  285. end;
  286.  
  287. procedure TCheckBoxX.Set_DoubleBuffered(Value: WordBool);
  288. begin
  289.   FDelphiControl.DoubleBuffered := Value;
  290. end;
  291.  
  292. procedure TCheckBoxX.Set_DragCursor(Value: Smallint);
  293. begin
  294.   FDelphiControl.DragCursor := TCursor(Value);
  295. end;
  296.  
  297. procedure TCheckBoxX.Set_DragMode(Value: TxDragMode);
  298. begin
  299.   FDelphiControl.DragMode := TDragMode(Value);
  300. end;
  301.  
  302. procedure TCheckBoxX.Set_Enabled(Value: WordBool);
  303. begin
  304.   FDelphiControl.Enabled := Value;
  305. end;
  306.  
  307. procedure TCheckBoxX.Set_Font(const Value: IFontDisp);
  308. begin
  309.   SetOleFont(FDelphiControl.Font, Value);
  310. end;
  311.  
  312. procedure TCheckBoxX.Set_ParentColor(Value: WordBool);
  313. begin
  314.   FDelphiControl.ParentColor := Value;
  315. end;
  316.  
  317. procedure TCheckBoxX.Set_ParentCtl3D(Value: WordBool);
  318. begin
  319.   FDelphiControl.ParentCtl3D := Value;
  320. end;
  321.  
  322. procedure TCheckBoxX.Set_ParentFont(Value: WordBool);
  323. begin
  324.   FDelphiControl.ParentFont := Value;
  325. end;
  326.  
  327. procedure TCheckBoxX.Set_State(Value: TxCheckBoxState);
  328. begin
  329.   FDelphiControl.State := TCheckBoxState(Value);
  330. end;
  331.  
  332. procedure TCheckBoxX.Set_Visible(Value: WordBool);
  333. begin
  334.   FDelphiControl.Visible := Value;
  335. end;
  336.  
  337. procedure TCheckBoxX.ClickEvent(Sender: TObject);
  338. begin
  339.   if FEvents <> nil then FEvents.OnClick;
  340. end;
  341.  
  342. procedure TCheckBoxX.KeyPressEvent(Sender: TObject; var Key: Char);
  343. var
  344.   TempKey: Smallint;
  345. begin
  346.   TempKey := Smallint(Key);
  347.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  348.   Key := Char(TempKey);
  349. end;
  350.  
  351. initialization
  352.   TActiveXControlFactory.Create(
  353.     ComServer,
  354.     TCheckBoxX,
  355.     TCheckBox,
  356.     Class_CheckBoxX,
  357.     4,
  358.     '{695CDAED-02E5-11D2-B20D-00C04FA368D4}',
  359.     0,
  360.     tmApartment);
  361. end.
  362.