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

  1. unit TrackBarImpl1;
  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.   TTrackBarX = class(TActiveXControl, ITrackBarX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TTrackBar;
  14.     FEvents: ITrackBarXEvents;
  15.     procedure ChangeEvent(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_BiDiMode: TxBiDiMode; safecall;
  26.     function Get_Ctl3D: WordBool; safecall;
  27.     function Get_Cursor: Smallint; safecall;
  28.     function Get_DoubleBuffered: WordBool; safecall;
  29.     function Get_DragCursor: Smallint; safecall;
  30.     function Get_DragMode: TxDragMode; safecall;
  31.     function Get_Enabled: WordBool; safecall;
  32.     function Get_Frequency: Integer; safecall;
  33.     function Get_LineSize: Integer; safecall;
  34.     function Get_Max: Integer; safecall;
  35.     function Get_Min: Integer; safecall;
  36.     function Get_Orientation: TxTrackBarOrientation; safecall;
  37.     function Get_PageSize: Integer; safecall;
  38.     function Get_ParentCtl3D: WordBool; safecall;
  39.     function Get_Position: Integer; safecall;
  40.     function Get_SelEnd: Integer; safecall;
  41.     function Get_SelStart: Integer; safecall;
  42.     function Get_SliderVisible: WordBool; safecall;
  43.     function Get_ThumbLength: Integer; safecall;
  44.     function Get_TickMarks: TxTickMark; safecall;
  45.     function Get_TickStyle: TxTickStyle; safecall;
  46.     function Get_Visible: WordBool; safecall;
  47.     function GetControlsAlignment: TxAlignment; safecall;
  48.     function IsRightToLeft: WordBool; safecall;
  49.     function UseRightToLeftAlignment: WordBool; safecall;
  50.     function UseRightToLeftReading: WordBool; safecall;
  51.     function UseRightToLeftScrollBar: WordBool; safecall;
  52.     procedure AboutBox; safecall;
  53.     procedure FlipChildren(AllLevels: WordBool); safecall;
  54.     procedure InitiateAction; safecall;
  55.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  56.     procedure Set_Ctl3D(Value: WordBool); safecall;
  57.     procedure Set_Cursor(Value: Smallint); safecall;
  58.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  59.     procedure Set_DragCursor(Value: Smallint); safecall;
  60.     procedure Set_DragMode(Value: TxDragMode); safecall;
  61.     procedure Set_Enabled(Value: WordBool); safecall;
  62.     procedure Set_Frequency(Value: Integer); safecall;
  63.     procedure Set_LineSize(Value: Integer); safecall;
  64.     procedure Set_Max(Value: Integer); safecall;
  65.     procedure Set_Min(Value: Integer); safecall;
  66.     procedure Set_Orientation(Value: TxTrackBarOrientation); safecall;
  67.     procedure Set_PageSize(Value: Integer); safecall;
  68.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  69.     procedure Set_Position(Value: Integer); safecall;
  70.     procedure Set_SelEnd(Value: Integer); safecall;
  71.     procedure Set_SelStart(Value: Integer); safecall;
  72.     procedure Set_SliderVisible(Value: WordBool); safecall;
  73.     procedure Set_ThumbLength(Value: Integer); safecall;
  74.     procedure Set_TickMarks(Value: TxTickMark); safecall;
  75.     procedure Set_TickStyle(Value: TxTickStyle); safecall;
  76.     procedure Set_Visible(Value: WordBool); safecall;
  77.     procedure SetTick(Value: Integer); safecall;
  78.   end;
  79.  
  80. implementation
  81.  
  82. uses ComObj, About36;
  83.  
  84. { TTrackBarX }
  85.  
  86. procedure TTrackBarX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  87. begin
  88.   { Define property pages here.  Property pages are defined by calling
  89.     DefinePropertyPage with the class id of the page.  For example,
  90.       DefinePropertyPage(Class_TrackBarXPage); }
  91. end;
  92.  
  93. procedure TTrackBarX.EventSinkChanged(const EventSink: IUnknown);
  94. begin
  95.   FEvents := EventSink as ITrackBarXEvents;
  96. end;
  97.  
  98. procedure TTrackBarX.InitializeControl;
  99. begin
  100.   FDelphiControl := Control as TTrackBar;
  101.   FDelphiControl.OnChange := ChangeEvent;
  102.   FDelphiControl.OnKeyPress := KeyPressEvent;
  103. end;
  104.  
  105. function TTrackBarX.ClassNameIs(const Name: WideString): WordBool;
  106. begin
  107.   Result := FDelphiControl.ClassNameIs(Name);
  108. end;
  109.  
  110. function TTrackBarX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  111. begin
  112.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  113. end;
  114.  
  115. function TTrackBarX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  116. begin
  117.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  118. end;
  119.  
  120. function TTrackBarX.Get_BiDiMode: TxBiDiMode;
  121. begin
  122.   Result := Ord(FDelphiControl.BiDiMode);
  123. end;
  124.  
  125. function TTrackBarX.Get_Ctl3D: WordBool;
  126. begin
  127.   Result := FDelphiControl.Ctl3D;
  128. end;
  129.  
  130. function TTrackBarX.Get_Cursor: Smallint;
  131. begin
  132.   Result := Smallint(FDelphiControl.Cursor);
  133. end;
  134.  
  135. function TTrackBarX.Get_DoubleBuffered: WordBool;
  136. begin
  137.   Result := FDelphiControl.DoubleBuffered;
  138. end;
  139.  
  140. function TTrackBarX.Get_DragCursor: Smallint;
  141. begin
  142.   Result := Smallint(FDelphiControl.DragCursor);
  143. end;
  144.  
  145. function TTrackBarX.Get_DragMode: TxDragMode;
  146. begin
  147.   Result := Ord(FDelphiControl.DragMode);
  148. end;
  149.  
  150. function TTrackBarX.Get_Enabled: WordBool;
  151. begin
  152.   Result := FDelphiControl.Enabled;
  153. end;
  154.  
  155. function TTrackBarX.Get_Frequency: Integer;
  156. begin
  157.   Result := FDelphiControl.Frequency;
  158. end;
  159.  
  160. function TTrackBarX.Get_LineSize: Integer;
  161. begin
  162.   Result := FDelphiControl.LineSize;
  163. end;
  164.  
  165. function TTrackBarX.Get_Max: Integer;
  166. begin
  167.   Result := FDelphiControl.Max;
  168. end;
  169.  
  170. function TTrackBarX.Get_Min: Integer;
  171. begin
  172.   Result := FDelphiControl.Min;
  173. end;
  174.  
  175. function TTrackBarX.Get_Orientation: TxTrackBarOrientation;
  176. begin
  177.   Result := Ord(FDelphiControl.Orientation);
  178. end;
  179.  
  180. function TTrackBarX.Get_PageSize: Integer;
  181. begin
  182.   Result := FDelphiControl.PageSize;
  183. end;
  184.  
  185. function TTrackBarX.Get_ParentCtl3D: WordBool;
  186. begin
  187.   Result := FDelphiControl.ParentCtl3D;
  188. end;
  189.  
  190. function TTrackBarX.Get_Position: Integer;
  191. begin
  192.   Result := FDelphiControl.Position;
  193. end;
  194.  
  195. function TTrackBarX.Get_SelEnd: Integer;
  196. begin
  197.   Result := FDelphiControl.SelEnd;
  198. end;
  199.  
  200. function TTrackBarX.Get_SelStart: Integer;
  201. begin
  202.   Result := FDelphiControl.SelStart;
  203. end;
  204.  
  205. function TTrackBarX.Get_SliderVisible: WordBool;
  206. begin
  207.   Result := FDelphiControl.SliderVisible;
  208. end;
  209.  
  210. function TTrackBarX.Get_ThumbLength: Integer;
  211. begin
  212.   Result := FDelphiControl.ThumbLength;
  213. end;
  214.  
  215. function TTrackBarX.Get_TickMarks: TxTickMark;
  216. begin
  217.   Result := Ord(FDelphiControl.TickMarks);
  218. end;
  219.  
  220. function TTrackBarX.Get_TickStyle: TxTickStyle;
  221. begin
  222.   Result := Ord(FDelphiControl.TickStyle);
  223. end;
  224.  
  225. function TTrackBarX.Get_Visible: WordBool;
  226. begin
  227.   Result := FDelphiControl.Visible;
  228. end;
  229.  
  230. function TTrackBarX.GetControlsAlignment: TxAlignment;
  231. begin
  232.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  233. end;
  234.  
  235. function TTrackBarX.IsRightToLeft: WordBool;
  236. begin
  237.   Result := FDelphiControl.IsRightToLeft;
  238. end;
  239.  
  240. function TTrackBarX.UseRightToLeftAlignment: WordBool;
  241. begin
  242.   Result := FDelphiControl.UseRightToLeftAlignment;
  243. end;
  244.  
  245. function TTrackBarX.UseRightToLeftReading: WordBool;
  246. begin
  247.   Result := FDelphiControl.UseRightToLeftReading;
  248. end;
  249.  
  250. function TTrackBarX.UseRightToLeftScrollBar: WordBool;
  251. begin
  252.   Result := FDelphiControl.UseRightToLeftScrollBar;
  253. end;
  254.  
  255. procedure TTrackBarX.AboutBox;
  256. begin
  257.   ShowTrackBarXAbout;
  258. end;
  259.  
  260. procedure TTrackBarX.FlipChildren(AllLevels: WordBool);
  261. begin
  262.   FDelphiControl.FlipChildren(AllLevels);
  263. end;
  264.  
  265. procedure TTrackBarX.InitiateAction;
  266. begin
  267.   FDelphiControl.InitiateAction;
  268. end;
  269.  
  270. procedure TTrackBarX.Set_BiDiMode(Value: TxBiDiMode);
  271. begin
  272.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  273. end;
  274.  
  275. procedure TTrackBarX.Set_Ctl3D(Value: WordBool);
  276. begin
  277.   FDelphiControl.Ctl3D := Value;
  278. end;
  279.  
  280. procedure TTrackBarX.Set_Cursor(Value: Smallint);
  281. begin
  282.   FDelphiControl.Cursor := TCursor(Value);
  283. end;
  284.  
  285. procedure TTrackBarX.Set_DoubleBuffered(Value: WordBool);
  286. begin
  287.   FDelphiControl.DoubleBuffered := Value;
  288. end;
  289.  
  290. procedure TTrackBarX.Set_DragCursor(Value: Smallint);
  291. begin
  292.   FDelphiControl.DragCursor := TCursor(Value);
  293. end;
  294.  
  295. procedure TTrackBarX.Set_DragMode(Value: TxDragMode);
  296. begin
  297.   FDelphiControl.DragMode := TDragMode(Value);
  298. end;
  299.  
  300. procedure TTrackBarX.Set_Enabled(Value: WordBool);
  301. begin
  302.   FDelphiControl.Enabled := Value;
  303. end;
  304.  
  305. procedure TTrackBarX.Set_Frequency(Value: Integer);
  306. begin
  307.   FDelphiControl.Frequency := Value;
  308. end;
  309.  
  310. procedure TTrackBarX.Set_LineSize(Value: Integer);
  311. begin
  312.   FDelphiControl.LineSize := Value;
  313. end;
  314.  
  315. procedure TTrackBarX.Set_Max(Value: Integer);
  316. begin
  317.   FDelphiControl.Max := Value;
  318. end;
  319.  
  320. procedure TTrackBarX.Set_Min(Value: Integer);
  321. begin
  322.   FDelphiControl.Min := Value;
  323. end;
  324.  
  325. procedure TTrackBarX.Set_Orientation(Value: TxTrackBarOrientation);
  326. begin
  327.   FDelphiControl.Orientation := TTrackBarOrientation(Value);
  328. end;
  329.  
  330. procedure TTrackBarX.Set_PageSize(Value: Integer);
  331. begin
  332.   FDelphiControl.PageSize := Value;
  333. end;
  334.  
  335. procedure TTrackBarX.Set_ParentCtl3D(Value: WordBool);
  336. begin
  337.   FDelphiControl.ParentCtl3D := Value;
  338. end;
  339.  
  340. procedure TTrackBarX.Set_Position(Value: Integer);
  341. begin
  342.   FDelphiControl.Position := Value;
  343. end;
  344.  
  345. procedure TTrackBarX.Set_SelEnd(Value: Integer);
  346. begin
  347.   FDelphiControl.SelEnd := Value;
  348. end;
  349.  
  350. procedure TTrackBarX.Set_SelStart(Value: Integer);
  351. begin
  352.   FDelphiControl.SelStart := Value;
  353. end;
  354.  
  355. procedure TTrackBarX.Set_SliderVisible(Value: WordBool);
  356. begin
  357.   FDelphiControl.SliderVisible := Value;
  358. end;
  359.  
  360. procedure TTrackBarX.Set_ThumbLength(Value: Integer);
  361. begin
  362.   FDelphiControl.ThumbLength := Value;
  363. end;
  364.  
  365. procedure TTrackBarX.Set_TickMarks(Value: TxTickMark);
  366. begin
  367.   FDelphiControl.TickMarks := TTickMark(Value);
  368. end;
  369.  
  370. procedure TTrackBarX.Set_TickStyle(Value: TxTickStyle);
  371. begin
  372.   FDelphiControl.TickStyle := TTickStyle(Value);
  373. end;
  374.  
  375. procedure TTrackBarX.Set_Visible(Value: WordBool);
  376. begin
  377.   FDelphiControl.Visible := Value;
  378. end;
  379.  
  380. procedure TTrackBarX.SetTick(Value: Integer);
  381. begin
  382.   FDelphiControl.SetTick(Value);
  383. end;
  384.  
  385. procedure TTrackBarX.ChangeEvent(Sender: TObject);
  386. begin
  387.   if FEvents <> nil then FEvents.OnChange;
  388. end;
  389.  
  390. procedure TTrackBarX.KeyPressEvent(Sender: TObject; var Key: Char);
  391. var
  392.   TempKey: Smallint;
  393. begin
  394.   TempKey := Smallint(Key);
  395.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  396.   Key := Char(TempKey);
  397. end;
  398.  
  399. initialization
  400.   TActiveXControlFactory.Create(
  401.     ComServer,
  402.     TTrackBarX,
  403.     TTrackBar,
  404.     Class_TrackBarX,
  405.     36,
  406.     '{695CDBED-02E5-11D2-B20D-00C04FA368D4}',
  407.     0,
  408.     tmApartment);
  409. end.
  410.