home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / DEMOS / ACTIVEX / DELCTRLS / OUTLIMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-04  |  10.4 KB  |  420 lines

  1. unit OutlImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelC_TLB, Grids, Outline;
  8.  
  9. type
  10.   TOutlineX = class(TActiveXControl, IOutlineX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TOutline;
  14.     FEvents: IOutlineXEvents;
  15.     procedure ClickEvent(Sender: TObject);
  16.     procedure CollapseEvent(Sender: TObject; Index: Integer);
  17.     procedure DblClickEvent(Sender: TObject);
  18.     procedure ExpandEvent(Sender: TObject; Index: Integer);
  19.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  20.   protected
  21.     { Protected declarations }
  22.     procedure InitializeControl; override;
  23.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  24.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  25.     function Add(Index: Integer; const Text: WideString): Integer; safecall;
  26.     function AddChild(Index: Integer; const Text: WideString): Integer;
  27.       safecall;
  28.     function Get_BorderStyle: TxBorderStyle; safecall;
  29.     function Get_Color: TColor; safecall;
  30.     function Get_Ctl3D: WordBool; safecall;
  31.     function Get_Cursor: Smallint; safecall;
  32.     function Get_DragCursor: Smallint; safecall;
  33.     function Get_DragMode: TxDragMode; safecall;
  34.     function Get_Enabled: WordBool; safecall;
  35.     function Get_Font: Font; safecall;
  36.     function Get_ItemCount: Integer; safecall;
  37.     function Get_ItemHeight: Integer; safecall;
  38.     function Get_ItemSeparator: WideString; safecall;
  39.     function Get_Lines: IStrings; safecall;
  40.     function Get_OutlineStyle: TxOutlineStyle; safecall;
  41.     function Get_ParentColor: WordBool; safecall;
  42.     function Get_ParentCtl3D: WordBool; safecall;
  43.     function Get_Row: Integer; safecall;
  44.     function Get_ScrollBars: TxScrollStyle; safecall;
  45.     function Get_SelectedItem: Integer; safecall;
  46.     function Get_Style: TxOutlineType; safecall;
  47.     function Get_Visible: WordBool; safecall;
  48.     function GetItem(X, Y: Integer): Integer; safecall;
  49.     function GetTextItem(const Value: WideString): Integer; safecall;
  50.     function Insert(Index: Integer; const Text: WideString): Integer; safecall;
  51.     procedure AboutBox; safecall;
  52.     procedure BeginUpdate; safecall;
  53.     procedure Clear; safecall;
  54.     procedure Delete(Index: Integer); safecall;
  55.     procedure EndUpdate; safecall;
  56.     procedure FullCollapse; safecall;
  57.     procedure FullExpand; safecall;
  58.     procedure LoadFromFile(const FileName: WideString); safecall;
  59.     procedure SaveToFile(const FileName: WideString); safecall;
  60.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  61.     procedure Set_Color(Value: TColor); safecall;
  62.     procedure Set_Ctl3D(Value: WordBool); safecall;
  63.     procedure Set_Cursor(Value: Smallint); safecall;
  64.     procedure Set_DragCursor(Value: Smallint); safecall;
  65.     procedure Set_DragMode(Value: TxDragMode); safecall;
  66.     procedure Set_Enabled(Value: WordBool); safecall;
  67.     procedure Set_Font(const Value: Font); safecall;
  68.     procedure Set_ItemHeight(Value: Integer); safecall;
  69.     procedure Set_ItemSeparator(const Value: WideString); safecall;
  70.     procedure Set_Lines(const Value: IStrings); safecall;
  71.     procedure Set_OutlineStyle(Value: TxOutlineStyle); safecall;
  72.     procedure Set_ParentColor(Value: WordBool); safecall;
  73.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  74.     procedure Set_Row(Value: Integer); safecall;
  75.     procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
  76.     procedure Set_SelectedItem(Value: Integer); safecall;
  77.     procedure Set_Style(Value: TxOutlineType); safecall;
  78.     procedure Set_Visible(Value: WordBool); safecall;
  79.     procedure SetUpdateState(Value: WordBool); safecall;
  80.   end;
  81.  
  82. implementation
  83.  
  84. uses About18;
  85.  
  86. { TOutlineX }
  87.  
  88. procedure TOutlineX.InitializeControl;
  89. begin
  90.   FDelphiControl := Control as TOutline;
  91.   FDelphiControl.OnClick := ClickEvent;
  92.   FDelphiControl.OnCollapse := CollapseEvent;
  93.   FDelphiControl.OnDblClick := DblClickEvent;
  94.   FDelphiControl.OnExpand := ExpandEvent;
  95.   FDelphiControl.OnKeyPress := KeyPressEvent;
  96. end;
  97.  
  98. procedure TOutlineX.EventSinkChanged(const EventSink: IUnknown);
  99. begin
  100.   FEvents := EventSink as IOutlineXEvents;
  101. end;
  102.  
  103. procedure TOutlineX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  104. begin
  105.   { Define property pages here.  Property pages are defined by calling
  106.     DefinePropertyPage with the class id of the page.  For example,
  107.       DefinePropertyPage(Class_OutlineXPage); }
  108. end;
  109.  
  110. function TOutlineX.Add(Index: Integer; const Text: WideString): Integer;
  111. begin
  112.  
  113. end;
  114.  
  115. function TOutlineX.AddChild(Index: Integer;
  116.   const Text: WideString): Integer;
  117. begin
  118.  
  119. end;
  120.  
  121. function TOutlineX.Get_BorderStyle: TxBorderStyle;
  122. begin
  123.   Result := Ord(FDelphiControl.BorderStyle);
  124. end;
  125.  
  126. function TOutlineX.Get_Color: TColor;
  127. begin
  128.   Result := FDelphiControl.Color;
  129. end;
  130.  
  131. function TOutlineX.Get_Ctl3D: WordBool;
  132. begin
  133.   Result := FDelphiControl.Ctl3D;
  134. end;
  135.  
  136. function TOutlineX.Get_Cursor: Smallint;
  137. begin
  138.   Result := Smallint(FDelphiControl.Cursor);
  139. end;
  140.  
  141. function TOutlineX.Get_DragCursor: Smallint;
  142. begin
  143.   Result := Smallint(FDelphiControl.DragCursor);
  144. end;
  145.  
  146. function TOutlineX.Get_DragMode: TxDragMode;
  147. begin
  148.   Result := Ord(FDelphiControl.DragMode);
  149. end;
  150.  
  151. function TOutlineX.Get_Enabled: WordBool;
  152. begin
  153.   Result := FDelphiControl.Enabled;
  154. end;
  155.  
  156. function TOutlineX.Get_Font: Font;
  157. begin
  158.   GetOleFont(FDelphiControl.Font, Result);
  159. end;
  160.  
  161. function TOutlineX.Get_ItemCount: Integer;
  162. begin
  163.   Result := FDelphiControl.ItemCount;
  164. end;
  165.  
  166. function TOutlineX.Get_ItemHeight: Integer;
  167. begin
  168.   Result := FDelphiControl.ItemHeight;
  169. end;
  170.  
  171. function TOutlineX.Get_ItemSeparator: WideString;
  172. begin
  173.   Result := WideString(FDelphiControl.ItemSeparator);
  174. end;
  175.  
  176. function TOutlineX.Get_Lines: IStrings;
  177. begin
  178.   GetOleStrings(FDelphiControl.Lines, Result);
  179. end;
  180.  
  181. function TOutlineX.Get_OutlineStyle: TxOutlineStyle;
  182. begin
  183.   Result := Ord(FDelphiControl.OutlineStyle);
  184. end;
  185.  
  186. function TOutlineX.Get_ParentColor: WordBool;
  187. begin
  188.   Result := FDelphiControl.ParentColor;
  189. end;
  190.  
  191. function TOutlineX.Get_ParentCtl3D: WordBool;
  192. begin
  193.   Result := FDelphiControl.ParentCtl3D;
  194. end;
  195.  
  196. function TOutlineX.Get_Row: Integer;
  197. begin
  198.   Result := FDelphiControl.Row;
  199. end;
  200.  
  201. function TOutlineX.Get_ScrollBars: TxScrollStyle;
  202. begin
  203.   Result := Ord(FDelphiControl.ScrollBars);
  204. end;
  205.  
  206. function TOutlineX.Get_SelectedItem: Integer;
  207. begin
  208.   Result := FDelphiControl.SelectedItem;
  209. end;
  210.  
  211. function TOutlineX.Get_Style: TxOutlineType;
  212. begin
  213.   Result := Ord(FDelphiControl.Style);
  214. end;
  215.  
  216. function TOutlineX.Get_Visible: WordBool;
  217. begin
  218.   Result := FDelphiControl.Visible;
  219. end;
  220.  
  221. function TOutlineX.GetItem(X, Y: Integer): Integer;
  222. begin
  223.  
  224. end;
  225.  
  226. function TOutlineX.GetTextItem(const Value: WideString): Integer;
  227. begin
  228.  
  229. end;
  230.  
  231. function TOutlineX.Insert(Index: Integer; const Text: WideString): Integer;
  232. begin
  233.  
  234. end;
  235.  
  236. procedure TOutlineX.AboutBox;
  237. begin
  238.   ShowOutlineXAbout;
  239. end;
  240.  
  241. procedure TOutlineX.BeginUpdate;
  242. begin
  243.  
  244. end;
  245.  
  246. procedure TOutlineX.Clear;
  247. begin
  248.  
  249. end;
  250.  
  251. procedure TOutlineX.Delete(Index: Integer);
  252. begin
  253.  
  254. end;
  255.  
  256. procedure TOutlineX.EndUpdate;
  257. begin
  258.  
  259. end;
  260.  
  261. procedure TOutlineX.FullCollapse;
  262. begin
  263.  
  264. end;
  265.  
  266. procedure TOutlineX.FullExpand;
  267. begin
  268.  
  269. end;
  270.  
  271. procedure TOutlineX.LoadFromFile(const FileName: WideString);
  272. begin
  273.  
  274. end;
  275.  
  276. procedure TOutlineX.SaveToFile(const FileName: WideString);
  277. begin
  278.  
  279. end;
  280.  
  281. procedure TOutlineX.Set_BorderStyle(Value: TxBorderStyle);
  282. begin
  283.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  284. end;
  285.  
  286. procedure TOutlineX.Set_Color(Value: TColor);
  287. begin
  288.   FDelphiControl.Color := Value;
  289. end;
  290.  
  291. procedure TOutlineX.Set_Ctl3D(Value: WordBool);
  292. begin
  293.   FDelphiControl.Ctl3D := Value;
  294. end;
  295.  
  296. procedure TOutlineX.Set_Cursor(Value: Smallint);
  297. begin
  298.   FDelphiControl.Cursor := TCursor(Value);
  299. end;
  300.  
  301. procedure TOutlineX.Set_DragCursor(Value: Smallint);
  302. begin
  303.   FDelphiControl.DragCursor := TCursor(Value);
  304. end;
  305.  
  306. procedure TOutlineX.Set_DragMode(Value: TxDragMode);
  307. begin
  308.   FDelphiControl.DragMode := TDragMode(Value);
  309. end;
  310.  
  311. procedure TOutlineX.Set_Enabled(Value: WordBool);
  312. begin
  313.   FDelphiControl.Enabled := Value;
  314. end;
  315.  
  316. procedure TOutlineX.Set_Font(const Value: Font);
  317. begin
  318.   SetOleFont(FDelphiControl.Font, Value);
  319. end;
  320.  
  321. procedure TOutlineX.Set_ItemHeight(Value: Integer);
  322. begin
  323.   FDelphiControl.ItemHeight := Value;
  324. end;
  325.  
  326. procedure TOutlineX.Set_ItemSeparator(const Value: WideString);
  327. begin
  328.   FDelphiControl.ItemSeparator := String(Value);
  329. end;
  330.  
  331. procedure TOutlineX.Set_Lines(const Value: IStrings);
  332. begin
  333.   SetOleStrings(FDelphiControl.Lines, Value);
  334. end;
  335.  
  336. procedure TOutlineX.Set_OutlineStyle(Value: TxOutlineStyle);
  337. begin
  338.   FDelphiControl.OutlineStyle := TOutlineStyle(Value);
  339. end;
  340.  
  341. procedure TOutlineX.Set_ParentColor(Value: WordBool);
  342. begin
  343.   FDelphiControl.ParentColor := Value;
  344. end;
  345.  
  346. procedure TOutlineX.Set_ParentCtl3D(Value: WordBool);
  347. begin
  348.   FDelphiControl.ParentCtl3D := Value;
  349. end;
  350.  
  351. procedure TOutlineX.Set_Row(Value: Integer);
  352. begin
  353.   FDelphiControl.Row := Value;
  354. end;
  355.  
  356. procedure TOutlineX.Set_ScrollBars(Value: TxScrollStyle);
  357. begin
  358.   FDelphiControl.ScrollBars := TScrollStyle(Value);
  359. end;
  360.  
  361. procedure TOutlineX.Set_SelectedItem(Value: Integer);
  362. begin
  363.   FDelphiControl.SelectedItem := Value;
  364. end;
  365.  
  366. procedure TOutlineX.Set_Style(Value: TxOutlineType);
  367. begin
  368.   FDelphiControl.Style := TOutlineType(Value);
  369. end;
  370.  
  371. procedure TOutlineX.Set_Visible(Value: WordBool);
  372. begin
  373.   FDelphiControl.Visible := Value;
  374. end;
  375.  
  376. procedure TOutlineX.SetUpdateState(Value: WordBool);
  377. begin
  378.  
  379. end;
  380.  
  381. procedure TOutlineX.ClickEvent(Sender: TObject);
  382. begin
  383.   if FEvents <> nil then FEvents.OnClick;
  384. end;
  385.  
  386. procedure TOutlineX.CollapseEvent(Sender: TObject; Index: Integer);
  387. begin
  388.   if FEvents <> nil then FEvents.OnCollapse(Index);
  389. end;
  390.  
  391. procedure TOutlineX.DblClickEvent(Sender: TObject);
  392. begin
  393.   if FEvents <> nil then FEvents.OnDblClick;
  394. end;
  395.  
  396. procedure TOutlineX.ExpandEvent(Sender: TObject; Index: Integer);
  397. begin
  398.   if FEvents <> nil then FEvents.OnExpand(Index);
  399. end;
  400.  
  401. procedure TOutlineX.KeyPressEvent(Sender: TObject; var Key: Char);
  402. var
  403.   TempKey: Smallint;
  404. begin
  405.   TempKey := Smallint(Key);
  406.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  407.   Key := Char(TempKey);
  408. end;
  409.  
  410. initialization
  411.   TActiveXControlFactory.Create(
  412.     ComServer,
  413.     TOutlineX,
  414.     TOutline,
  415.     Class_OutlineX,
  416.     18,
  417.     '{FA7B847C-9ED7-11D0-AA40-444553540000}',
  418.     0);
  419. end.
  420.