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

  1. unit UpDownImpl1;
  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.   TUpDownX = class(TActiveXControl, IUpDownX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TUpDown;
  14.     FEvents: IUpDownXEvents;
  15.     procedure ChangingEvent(Sender: TObject; var AllowChange: Boolean);
  16.     procedure ClickEvent(Sender: TObject; Button: TUDBtnType);
  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_AlignButton: TxUDAlignButton; safecall;
  26.     function Get_ArrowKeys: WordBool; safecall;
  27.     function Get_BiDiMode: TxBiDiMode; safecall;
  28.     function Get_Cursor: Smallint; safecall;
  29.     function Get_DoubleBuffered: WordBool; safecall;
  30.     function Get_Enabled: WordBool; safecall;
  31.     function Get_Increment: Integer; safecall;
  32.     function Get_Max: Smallint; safecall;
  33.     function Get_Min: Smallint; safecall;
  34.     function Get_Orientation: TxUDOrientation; safecall;
  35.     function Get_Position: Smallint; safecall;
  36.     function Get_Thousands: WordBool; safecall;
  37.     function Get_Visible: WordBool; safecall;
  38.     function Get_Wrap: WordBool; safecall;
  39.     function GetControlsAlignment: TxAlignment; safecall;
  40.     function IsRightToLeft: WordBool; safecall;
  41.     function UseRightToLeftAlignment: WordBool; safecall;
  42.     function UseRightToLeftReading: WordBool; safecall;
  43.     function UseRightToLeftScrollBar: WordBool; safecall;
  44.     procedure AboutBox; safecall;
  45.     procedure FlipChildren(AllLevels: WordBool); safecall;
  46.     procedure InitiateAction; safecall;
  47.     procedure Set_AlignButton(Value: TxUDAlignButton); safecall;
  48.     procedure Set_ArrowKeys(Value: WordBool); safecall;
  49.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  50.     procedure Set_Cursor(Value: Smallint); safecall;
  51.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  52.     procedure Set_Enabled(Value: WordBool); safecall;
  53.     procedure Set_Increment(Value: Integer); safecall;
  54.     procedure Set_Max(Value: Smallint); safecall;
  55.     procedure Set_Min(Value: Smallint); safecall;
  56.     procedure Set_Orientation(Value: TxUDOrientation); safecall;
  57.     procedure Set_Position(Value: Smallint); safecall;
  58.     procedure Set_Thousands(Value: WordBool); safecall;
  59.     procedure Set_Visible(Value: WordBool); safecall;
  60.     procedure Set_Wrap(Value: WordBool); safecall;
  61.   end;
  62.  
  63. implementation
  64.  
  65. uses ComObj, About37;
  66.  
  67. { TUpDownX }
  68.  
  69. procedure TUpDownX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  70. begin
  71.   { Define property pages here.  Property pages are defined by calling
  72.     DefinePropertyPage with the class id of the page.  For example,
  73.       DefinePropertyPage(Class_UpDownXPage); }
  74. end;
  75.  
  76. procedure TUpDownX.EventSinkChanged(const EventSink: IUnknown);
  77. begin
  78.   FEvents := EventSink as IUpDownXEvents;
  79. end;
  80.  
  81. procedure TUpDownX.InitializeControl;
  82. begin
  83.   FDelphiControl := Control as TUpDown;
  84.   FDelphiControl.OnChanging := ChangingEvent;
  85.   FDelphiControl.OnClick := ClickEvent;
  86. end;
  87.  
  88. function TUpDownX.ClassNameIs(const Name: WideString): WordBool;
  89. begin
  90.   Result := FDelphiControl.ClassNameIs(Name);
  91. end;
  92.  
  93. function TUpDownX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  94. begin
  95.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  96. end;
  97.  
  98. function TUpDownX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  99. begin
  100.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  101. end;
  102.  
  103. function TUpDownX.Get_AlignButton: TxUDAlignButton;
  104. begin
  105.   Result := Ord(FDelphiControl.AlignButton);
  106. end;
  107.  
  108. function TUpDownX.Get_ArrowKeys: WordBool;
  109. begin
  110.   Result := FDelphiControl.ArrowKeys;
  111. end;
  112.  
  113. function TUpDownX.Get_BiDiMode: TxBiDiMode;
  114. begin
  115.   Result := Ord(FDelphiControl.BiDiMode);
  116. end;
  117.  
  118. function TUpDownX.Get_Cursor: Smallint;
  119. begin
  120.   Result := Smallint(FDelphiControl.Cursor);
  121. end;
  122.  
  123. function TUpDownX.Get_DoubleBuffered: WordBool;
  124. begin
  125.   Result := FDelphiControl.DoubleBuffered;
  126. end;
  127.  
  128. function TUpDownX.Get_Enabled: WordBool;
  129. begin
  130.   Result := FDelphiControl.Enabled;
  131. end;
  132.  
  133. function TUpDownX.Get_Increment: Integer;
  134. begin
  135.   Result := FDelphiControl.Increment;
  136. end;
  137.  
  138. function TUpDownX.Get_Max: Smallint;
  139. begin
  140.   Result := FDelphiControl.Max;
  141. end;
  142.  
  143. function TUpDownX.Get_Min: Smallint;
  144. begin
  145.   Result := FDelphiControl.Min;
  146. end;
  147.  
  148. function TUpDownX.Get_Orientation: TxUDOrientation;
  149. begin
  150.   Result := Ord(FDelphiControl.Orientation);
  151. end;
  152.  
  153. function TUpDownX.Get_Position: Smallint;
  154. begin
  155.   Result := FDelphiControl.Position;
  156. end;
  157.  
  158. function TUpDownX.Get_Thousands: WordBool;
  159. begin
  160.   Result := FDelphiControl.Thousands;
  161. end;
  162.  
  163. function TUpDownX.Get_Visible: WordBool;
  164. begin
  165.   Result := FDelphiControl.Visible;
  166. end;
  167.  
  168. function TUpDownX.Get_Wrap: WordBool;
  169. begin
  170.   Result := FDelphiControl.Wrap;
  171. end;
  172.  
  173. function TUpDownX.GetControlsAlignment: TxAlignment;
  174. begin
  175.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  176. end;
  177.  
  178. function TUpDownX.IsRightToLeft: WordBool;
  179. begin
  180.   Result := FDelphiControl.IsRightToLeft;
  181. end;
  182.  
  183. function TUpDownX.UseRightToLeftAlignment: WordBool;
  184. begin
  185.   Result := FDelphiControl.UseRightToLeftAlignment;
  186. end;
  187.  
  188. function TUpDownX.UseRightToLeftReading: WordBool;
  189. begin
  190.   Result := FDelphiControl.UseRightToLeftReading;
  191. end;
  192.  
  193. function TUpDownX.UseRightToLeftScrollBar: WordBool;
  194. begin
  195.   Result := FDelphiControl.UseRightToLeftScrollBar;
  196. end;
  197.  
  198. procedure TUpDownX.AboutBox;
  199. begin
  200.   ShowUpDownXAbout;
  201. end;
  202.  
  203. procedure TUpDownX.FlipChildren(AllLevels: WordBool);
  204. begin
  205.   FDelphiControl.FlipChildren(AllLevels);
  206. end;
  207.  
  208. procedure TUpDownX.InitiateAction;
  209. begin
  210.   FDelphiControl.InitiateAction;
  211. end;
  212.  
  213. procedure TUpDownX.Set_AlignButton(Value: TxUDAlignButton);
  214. begin
  215.   FDelphiControl.AlignButton := TUDAlignButton(Value);
  216. end;
  217.  
  218. procedure TUpDownX.Set_ArrowKeys(Value: WordBool);
  219. begin
  220.   FDelphiControl.ArrowKeys := Value;
  221. end;
  222.  
  223. procedure TUpDownX.Set_BiDiMode(Value: TxBiDiMode);
  224. begin
  225.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  226. end;
  227.  
  228. procedure TUpDownX.Set_Cursor(Value: Smallint);
  229. begin
  230.   FDelphiControl.Cursor := TCursor(Value);
  231. end;
  232.  
  233. procedure TUpDownX.Set_DoubleBuffered(Value: WordBool);
  234. begin
  235.   FDelphiControl.DoubleBuffered := Value;
  236. end;
  237.  
  238. procedure TUpDownX.Set_Enabled(Value: WordBool);
  239. begin
  240.   FDelphiControl.Enabled := Value;
  241. end;
  242.  
  243. procedure TUpDownX.Set_Increment(Value: Integer);
  244. begin
  245.   FDelphiControl.Increment := Value;
  246. end;
  247.  
  248. procedure TUpDownX.Set_Max(Value: Smallint);
  249. begin
  250.   FDelphiControl.Max := Value;
  251. end;
  252.  
  253. procedure TUpDownX.Set_Min(Value: Smallint);
  254. begin
  255.   FDelphiControl.Min := Value;
  256. end;
  257.  
  258. procedure TUpDownX.Set_Orientation(Value: TxUDOrientation);
  259. begin
  260.   FDelphiControl.Orientation := TUDOrientation(Value);
  261. end;
  262.  
  263. procedure TUpDownX.Set_Position(Value: Smallint);
  264. begin
  265.   FDelphiControl.Position := Value;
  266. end;
  267.  
  268. procedure TUpDownX.Set_Thousands(Value: WordBool);
  269. begin
  270.   FDelphiControl.Thousands := Value;
  271. end;
  272.  
  273. procedure TUpDownX.Set_Visible(Value: WordBool);
  274. begin
  275.   FDelphiControl.Visible := Value;
  276. end;
  277.  
  278. procedure TUpDownX.Set_Wrap(Value: WordBool);
  279. begin
  280.   FDelphiControl.Wrap := Value;
  281. end;
  282.  
  283. procedure TUpDownX.ChangingEvent(Sender: TObject;
  284.   var AllowChange: Boolean);
  285. var
  286.   TempAllowChange: WordBool;
  287. begin
  288.   TempAllowChange := WordBool(AllowChange);
  289.   if FEvents <> nil then FEvents.OnChanging(TempAllowChange);
  290.   AllowChange := Boolean(TempAllowChange);
  291. end;
  292.  
  293. procedure TUpDownX.ClickEvent(Sender: TObject; Button: TUDBtnType);
  294. begin
  295.   if FEvents <> nil then FEvents.OnClick(TxUDBtnType(Button));
  296. end;
  297.  
  298. initialization
  299.   TActiveXControlFactory.Create(
  300.     ComServer,
  301.     TUpDownX,
  302.     TUpDown,
  303.     Class_UpDownX,
  304.     37,
  305.     '{695CDBF7-02E5-11D2-B20D-00C04FA368D4}',
  306.     0,
  307.     tmApartment);
  308. end.
  309.