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

  1. unit ScrollBoxImpl1;
  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.   TScrollBoxX = class(TActiveXControl, IScrollBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TScrollBox;
  14.     FEvents: IScrollBoxXEvents;
  15.     procedure CanResizeEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
  16.       var Resize: Boolean);
  17.     procedure ClickEvent(Sender: TObject);
  18.     procedure ConstrainedResizeEvent(Sender: TObject; var MinWidth, MinHeight,
  19.       MaxWidth, MaxHeight: Integer);
  20.     procedure DblClickEvent(Sender: TObject);
  21.     procedure ResizeEvent(Sender: TObject);
  22.   protected
  23.     { Protected declarations }
  24.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  25.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  26.     procedure InitializeControl; override;
  27.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  28.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  29.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  30.     function Get_AutoScroll: WordBool; safecall;
  31.     function Get_AutoSize: WordBool; safecall;
  32.     function Get_BiDiMode: TxBiDiMode; safecall;
  33.     function Get_BorderStyle: TxBorderStyle; safecall;
  34.     function Get_Color: OLE_COLOR; safecall;
  35.     function Get_Ctl3D: WordBool; safecall;
  36.     function Get_Cursor: Smallint; safecall;
  37.     function Get_DockSite: WordBool; safecall;
  38.     function Get_DoubleBuffered: WordBool; safecall;
  39.     function Get_DragCursor: Smallint; safecall;
  40.     function Get_DragMode: TxDragMode; safecall;
  41.     function Get_Enabled: WordBool; safecall;
  42.     function Get_Font: IFontDisp; safecall;
  43.     function Get_ParentColor: WordBool; safecall;
  44.     function Get_ParentCtl3D: WordBool; safecall;
  45.     function Get_ParentFont: WordBool; 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 _Set_Font(const Value: IFontDisp); safecall;
  53.     procedure AboutBox; safecall;
  54.     procedure DisableAutoRange; safecall;
  55.     procedure EnableAutoRange; safecall;
  56.     procedure FlipChildren(AllLevels: WordBool); safecall;
  57.     procedure InitiateAction; safecall;
  58.     procedure Set_AutoScroll(Value: WordBool); safecall;
  59.     procedure Set_AutoSize(Value: WordBool); safecall;
  60.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  61.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  62.     procedure Set_Color(Value: OLE_COLOR); safecall;
  63.     procedure Set_Ctl3D(Value: WordBool); safecall;
  64.     procedure Set_Cursor(Value: Smallint); safecall;
  65.     procedure Set_DockSite(Value: WordBool); safecall;
  66.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  67.     procedure Set_DragCursor(Value: Smallint); safecall;
  68.     procedure Set_DragMode(Value: TxDragMode); safecall;
  69.     procedure Set_Enabled(Value: WordBool); safecall;
  70.     procedure Set_Font(const Value: IFontDisp); safecall;
  71.     procedure Set_ParentColor(Value: WordBool); safecall;
  72.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  73.     procedure Set_ParentFont(Value: WordBool); safecall;
  74.     procedure Set_Visible(Value: WordBool); safecall;
  75.   end;
  76.  
  77. implementation
  78.  
  79. uses ComObj, About28;
  80.  
  81. { TScrollBoxX }
  82.  
  83. procedure TScrollBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  84. begin
  85.   { Define property pages here.  Property pages are defined by calling
  86.     DefinePropertyPage with the class id of the page.  For example,
  87.       DefinePropertyPage(Class_ScrollBoxXPage); }
  88. end;
  89.  
  90. procedure TScrollBoxX.EventSinkChanged(const EventSink: IUnknown);
  91. begin
  92.   FEvents := EventSink as IScrollBoxXEvents;
  93. end;
  94.  
  95. procedure TScrollBoxX.InitializeControl;
  96. begin
  97.   FDelphiControl := Control as TScrollBox;
  98.   FDelphiControl.OnCanResize := CanResizeEvent;
  99.   FDelphiControl.OnClick := ClickEvent;
  100.   FDelphiControl.OnConstrainedResize := ConstrainedResizeEvent;
  101.   FDelphiControl.OnDblClick := DblClickEvent;
  102.   FDelphiControl.OnResize := ResizeEvent;
  103. end;
  104.  
  105. function TScrollBoxX.ClassNameIs(const Name: WideString): WordBool;
  106. begin
  107.   Result := FDelphiControl.ClassNameIs(Name);
  108. end;
  109.  
  110. function TScrollBoxX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  111. begin
  112.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  113. end;
  114.  
  115. function TScrollBoxX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  116. begin
  117.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  118. end;
  119.  
  120. function TScrollBoxX.Get_AutoScroll: WordBool;
  121. begin
  122.   Result := FDelphiControl.AutoScroll;
  123. end;
  124.  
  125. function TScrollBoxX.Get_AutoSize: WordBool;
  126. begin
  127.   Result := FDelphiControl.AutoSize;
  128. end;
  129.  
  130. function TScrollBoxX.Get_BiDiMode: TxBiDiMode;
  131. begin
  132.   Result := Ord(FDelphiControl.BiDiMode);
  133. end;
  134.  
  135. function TScrollBoxX.Get_BorderStyle: TxBorderStyle;
  136. begin
  137.   Result := Ord(FDelphiControl.BorderStyle);
  138. end;
  139.  
  140. function TScrollBoxX.Get_Color: OLE_COLOR;
  141. begin
  142.   Result := OLE_COLOR(FDelphiControl.Color);
  143. end;
  144.  
  145. function TScrollBoxX.Get_Ctl3D: WordBool;
  146. begin
  147.   Result := FDelphiControl.Ctl3D;
  148. end;
  149.  
  150. function TScrollBoxX.Get_Cursor: Smallint;
  151. begin
  152.   Result := Smallint(FDelphiControl.Cursor);
  153. end;
  154.  
  155. function TScrollBoxX.Get_DockSite: WordBool;
  156. begin
  157.   Result := FDelphiControl.DockSite;
  158. end;
  159.  
  160. function TScrollBoxX.Get_DoubleBuffered: WordBool;
  161. begin
  162.   Result := FDelphiControl.DoubleBuffered;
  163. end;
  164.  
  165. function TScrollBoxX.Get_DragCursor: Smallint;
  166. begin
  167.   Result := Smallint(FDelphiControl.DragCursor);
  168. end;
  169.  
  170. function TScrollBoxX.Get_DragMode: TxDragMode;
  171. begin
  172.   Result := Ord(FDelphiControl.DragMode);
  173. end;
  174.  
  175. function TScrollBoxX.Get_Enabled: WordBool;
  176. begin
  177.   Result := FDelphiControl.Enabled;
  178. end;
  179.  
  180. function TScrollBoxX.Get_Font: IFontDisp;
  181. begin
  182.   GetOleFont(FDelphiControl.Font, Result);
  183. end;
  184.  
  185. function TScrollBoxX.Get_ParentColor: WordBool;
  186. begin
  187.   Result := FDelphiControl.ParentColor;
  188. end;
  189.  
  190. function TScrollBoxX.Get_ParentCtl3D: WordBool;
  191. begin
  192.   Result := FDelphiControl.ParentCtl3D;
  193. end;
  194.  
  195. function TScrollBoxX.Get_ParentFont: WordBool;
  196. begin
  197.   Result := FDelphiControl.ParentFont;
  198. end;
  199.  
  200. function TScrollBoxX.Get_Visible: WordBool;
  201. begin
  202.   Result := FDelphiControl.Visible;
  203. end;
  204.  
  205. function TScrollBoxX.GetControlsAlignment: TxAlignment;
  206. begin
  207.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  208. end;
  209.  
  210. function TScrollBoxX.IsRightToLeft: WordBool;
  211. begin
  212.   Result := FDelphiControl.IsRightToLeft;
  213. end;
  214.  
  215. function TScrollBoxX.UseRightToLeftAlignment: WordBool;
  216. begin
  217.   Result := FDelphiControl.UseRightToLeftAlignment;
  218. end;
  219.  
  220. function TScrollBoxX.UseRightToLeftReading: WordBool;
  221. begin
  222.   Result := FDelphiControl.UseRightToLeftReading;
  223. end;
  224.  
  225. function TScrollBoxX.UseRightToLeftScrollBar: WordBool;
  226. begin
  227.   Result := FDelphiControl.UseRightToLeftScrollBar;
  228. end;
  229.  
  230. procedure TScrollBoxX._Set_Font(const Value: IFontDisp);
  231. begin
  232.   SetOleFont(FDelphiControl.Font, Value);
  233. end;
  234.  
  235. procedure TScrollBoxX.AboutBox;
  236. begin
  237.   ShowScrollBoxXAbout;
  238. end;
  239.  
  240. procedure TScrollBoxX.DisableAutoRange;
  241. begin
  242.   FDelphiControl.DisableAutoRange;
  243. end;
  244.  
  245. procedure TScrollBoxX.EnableAutoRange;
  246. begin
  247.   FDelphiControl.EnableAutoRange;
  248. end;
  249.  
  250. procedure TScrollBoxX.FlipChildren(AllLevels: WordBool);
  251. begin
  252.   FDelphiControl.FlipChildren(AllLevels);
  253. end;
  254.  
  255. procedure TScrollBoxX.InitiateAction;
  256. begin
  257.   FDelphiControl.InitiateAction;
  258. end;
  259.  
  260. procedure TScrollBoxX.Set_AutoScroll(Value: WordBool);
  261. begin
  262.   FDelphiControl.AutoScroll := Value;
  263. end;
  264.  
  265. procedure TScrollBoxX.Set_AutoSize(Value: WordBool);
  266. begin
  267.   FDelphiControl.AutoSize := Value;
  268. end;
  269.  
  270. procedure TScrollBoxX.Set_BiDiMode(Value: TxBiDiMode);
  271. begin
  272.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  273. end;
  274.  
  275. procedure TScrollBoxX.Set_BorderStyle(Value: TxBorderStyle);
  276. begin
  277.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  278. end;
  279.  
  280. procedure TScrollBoxX.Set_Color(Value: OLE_COLOR);
  281. begin
  282.   FDelphiControl.Color := TColor(Value);
  283. end;
  284.  
  285. procedure TScrollBoxX.Set_Ctl3D(Value: WordBool);
  286. begin
  287.   FDelphiControl.Ctl3D := Value;
  288. end;
  289.  
  290. procedure TScrollBoxX.Set_Cursor(Value: Smallint);
  291. begin
  292.   FDelphiControl.Cursor := TCursor(Value);
  293. end;
  294.  
  295. procedure TScrollBoxX.Set_DockSite(Value: WordBool);
  296. begin
  297.   FDelphiControl.DockSite := Value;
  298. end;
  299.  
  300. procedure TScrollBoxX.Set_DoubleBuffered(Value: WordBool);
  301. begin
  302.   FDelphiControl.DoubleBuffered := Value;
  303. end;
  304.  
  305. procedure TScrollBoxX.Set_DragCursor(Value: Smallint);
  306. begin
  307.   FDelphiControl.DragCursor := TCursor(Value);
  308. end;
  309.  
  310. procedure TScrollBoxX.Set_DragMode(Value: TxDragMode);
  311. begin
  312.   FDelphiControl.DragMode := TDragMode(Value);
  313. end;
  314.  
  315. procedure TScrollBoxX.Set_Enabled(Value: WordBool);
  316. begin
  317.   FDelphiControl.Enabled := Value;
  318. end;
  319.  
  320. procedure TScrollBoxX.Set_Font(const Value: IFontDisp);
  321. begin
  322.   SetOleFont(FDelphiControl.Font, Value);
  323. end;
  324.  
  325. procedure TScrollBoxX.Set_ParentColor(Value: WordBool);
  326. begin
  327.   FDelphiControl.ParentColor := Value;
  328. end;
  329.  
  330. procedure TScrollBoxX.Set_ParentCtl3D(Value: WordBool);
  331. begin
  332.   FDelphiControl.ParentCtl3D := Value;
  333. end;
  334.  
  335. procedure TScrollBoxX.Set_ParentFont(Value: WordBool);
  336. begin
  337.   FDelphiControl.ParentFont := Value;
  338. end;
  339.  
  340. procedure TScrollBoxX.Set_Visible(Value: WordBool);
  341. begin
  342.   FDelphiControl.Visible := Value;
  343. end;
  344.  
  345. procedure TScrollBoxX.CanResizeEvent(Sender: TObject; var NewWidth,
  346.   NewHeight: Integer; var Resize: Boolean);
  347. var
  348.   TempNewWidth: Integer;
  349.   TempNewHeight: Integer;
  350.   TempResize: WordBool;
  351. begin
  352.   TempNewWidth := Integer(NewWidth);
  353.   TempNewHeight := Integer(NewHeight);
  354.   TempResize := WordBool(Resize);
  355.   if FEvents <> nil then FEvents.OnCanResize(TempNewWidth, TempNewHeight, TempResize);
  356.   NewWidth := Integer(TempNewWidth);
  357.   NewHeight := Integer(TempNewHeight);
  358.   Resize := Boolean(TempResize);
  359. end;
  360.  
  361. procedure TScrollBoxX.ClickEvent(Sender: TObject);
  362. begin
  363.   if FEvents <> nil then FEvents.OnClick;
  364. end;
  365.  
  366. procedure TScrollBoxX.ConstrainedResizeEvent(Sender: TObject; var MinWidth,
  367.   MinHeight, MaxWidth, MaxHeight: Integer);
  368. var
  369.   TempMinWidth: Integer;
  370.   TempMinHeight: Integer;
  371.   TempMaxWidth: Integer;
  372.   TempMaxHeight: Integer;
  373. begin
  374.   TempMinWidth := Integer(MinWidth);
  375.   TempMinHeight := Integer(MinHeight);
  376.   TempMaxWidth := Integer(MaxWidth);
  377.   TempMaxHeight := Integer(MaxHeight);
  378.   if FEvents <> nil then FEvents.OnConstrainedResize(TempMinWidth, TempMinHeight, TempMaxWidth, TempMaxHeight);
  379.   MinWidth := Integer(TempMinWidth);
  380.   MinHeight := Integer(TempMinHeight);
  381.   MaxWidth := Integer(TempMaxWidth);
  382.   MaxHeight := Integer(TempMaxHeight);
  383. end;
  384.  
  385. procedure TScrollBoxX.DblClickEvent(Sender: TObject);
  386. begin
  387.   if FEvents <> nil then FEvents.OnDblClick;
  388. end;
  389.  
  390. procedure TScrollBoxX.ResizeEvent(Sender: TObject);
  391. begin
  392.   if FEvents <> nil then FEvents.OnResize;
  393. end;
  394.  
  395. initialization
  396.   TActiveXControlFactory.Create(
  397.     ComServer,
  398.     TScrollBoxX,
  399.     TScrollBox,
  400.     Class_ScrollBoxX,
  401.     28,
  402.     '{695CDBAF-02E5-11D2-B20D-00C04FA368D4}',
  403.     OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
  404.     tmApartment);
  405. end.
  406.