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

  1. unit OutlineImpl1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelCtrls_TLB, Outline, Grids;
  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 DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  23.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  24.     procedure InitializeControl; override;
  25.     function Add(Index: Integer; const Text: WideString): Integer; safecall;
  26.     function AddChild(Index: Integer; const Text: WideString): Integer;
  27.       safecall;
  28.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  29.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  30.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  31.     function Get_BiDiMode: TxBiDiMode; safecall;
  32.     function Get_BorderStyle: TxBorderStyle; safecall;
  33.     function Get_Color: OLE_COLOR; safecall;
  34.     function Get_Ctl3D: WordBool; safecall;
  35.     function Get_Cursor: Smallint; safecall;
  36.     function Get_DoubleBuffered: WordBool; safecall;
  37.     function Get_DragCursor: Smallint; safecall;
  38.     function Get_DragMode: TxDragMode; safecall;
  39.     function Get_Enabled: WordBool; safecall;
  40.     function Get_Font: IFontDisp; safecall;
  41.     function Get_ItemCount: Integer; safecall;
  42.     function Get_ItemHeight: Integer; safecall;
  43.     function Get_ItemSeparator: WideString; safecall;
  44.     function Get_Lines: IStrings; safecall;
  45.     function Get_OutlineStyle: TxOutlineStyle; safecall;
  46.     function Get_ParentColor: WordBool; safecall;
  47.     function Get_ParentCtl3D: WordBool; safecall;
  48.     function Get_ParentFont: WordBool; safecall;
  49.     function Get_Row: Integer; safecall;
  50.     function Get_ScrollBars: TxScrollStyle; safecall;
  51.     function Get_SelectedItem: Integer; safecall;
  52.     function Get_Style: TxOutlineType; safecall;
  53.     function Get_Visible: WordBool; safecall;
  54.     function GetControlsAlignment: TxAlignment; safecall;
  55.     function GetItem(X, Y: Integer): Integer; safecall;
  56.     function GetTextItem(const Param1: WideString): Integer; safecall;
  57.     function Insert(Index: Integer; const Text: WideString): Integer; safecall;
  58.     function IsRightToLeft: WordBool; safecall;
  59.     function UseRightToLeftAlignment: WordBool; safecall;
  60.     function UseRightToLeftReading: WordBool; safecall;
  61.     function UseRightToLeftScrollBar: WordBool; safecall;
  62.     procedure _Set_Font(const Value: IFontDisp); safecall;
  63.     procedure AboutBox; safecall;
  64.     procedure BeginUpdate; safecall;
  65.     procedure Clear; safecall;
  66.     procedure Delete(Index: Integer); safecall;
  67.     procedure EndUpdate; safecall;
  68.     procedure FlipChildren(AllLevels: WordBool); safecall;
  69.     procedure FullCollapse; safecall;
  70.     procedure FullExpand; safecall;
  71.     procedure InitiateAction; safecall;
  72.     procedure LoadFromFile(const FileName: WideString); safecall;
  73.     procedure SaveToFile(const FileName: WideString); safecall;
  74.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  75.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  76.     procedure Set_Color(Value: OLE_COLOR); safecall;
  77.     procedure Set_Ctl3D(Value: WordBool); safecall;
  78.     procedure Set_Cursor(Value: Smallint); safecall;
  79.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  80.     procedure Set_DragCursor(Value: Smallint); safecall;
  81.     procedure Set_DragMode(Value: TxDragMode); safecall;
  82.     procedure Set_Enabled(Value: WordBool); safecall;
  83.     procedure Set_Font(const Value: IFontDisp); safecall;
  84.     procedure Set_ItemHeight(Value: Integer); safecall;
  85.     procedure Set_ItemSeparator(const Value: WideString); safecall;
  86.     procedure Set_Lines(const Value: IStrings); safecall;
  87.     procedure Set_OutlineStyle(Value: TxOutlineStyle); safecall;
  88.     procedure Set_ParentColor(Value: WordBool); safecall;
  89.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  90.     procedure Set_ParentFont(Value: WordBool); safecall;
  91.     procedure Set_Row(Value: Integer); safecall;
  92.     procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
  93.     procedure Set_SelectedItem(Value: Integer); safecall;
  94.     procedure Set_Style(Value: TxOutlineType); safecall;
  95.     procedure Set_Visible(Value: WordBool); safecall;
  96.     procedure SetUpdateState(Value: WordBool); safecall;
  97.   end;
  98.  
  99. implementation
  100.  
  101. uses ComObj, About20;
  102.  
  103. { TOutlineX }
  104.  
  105. procedure TOutlineX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  106. begin
  107.   { Define property pages here.  Property pages are defined by calling
  108.     DefinePropertyPage with the class id of the page.  For example,
  109.       DefinePropertyPage(Class_OutlineXPage); }
  110. end;
  111.  
  112. procedure TOutlineX.EventSinkChanged(const EventSink: IUnknown);
  113. begin
  114.   FEvents := EventSink as IOutlineXEvents;
  115. end;
  116.  
  117. procedure TOutlineX.InitializeControl;
  118. begin
  119.   FDelphiControl := Control as TOutline;
  120.   FDelphiControl.OnClick := ClickEvent;
  121.   FDelphiControl.OnCollapse := CollapseEvent;
  122.   FDelphiControl.OnDblClick := DblClickEvent;
  123.   FDelphiControl.OnExpand := ExpandEvent;
  124.   FDelphiControl.OnKeyPress := KeyPressEvent;
  125. end;
  126.  
  127. function TOutlineX.Add(Index: Integer; const Text: WideString): Integer;
  128. begin
  129.   Result := FDelphiControl.Add(Index, Text);
  130. end;
  131.  
  132. function TOutlineX.AddChild(Index: Integer;
  133.   const Text: WideString): Integer;
  134. begin
  135.   Result := FDelphiControl.AddChild(Index, Text);
  136. end;
  137.  
  138. function TOutlineX.ClassNameIs(const Name: WideString): WordBool;
  139. begin
  140.   Result := FDelphiControl.ClassNameIs(Name);
  141. end;
  142.  
  143. function TOutlineX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  144. begin
  145.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  146. end;
  147.  
  148. function TOutlineX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  149. begin
  150.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  151. end;
  152.  
  153. function TOutlineX.Get_BiDiMode: TxBiDiMode;
  154. begin
  155.   Result := Ord(FDelphiControl.BiDiMode);
  156. end;
  157.  
  158. function TOutlineX.Get_BorderStyle: TxBorderStyle;
  159. begin
  160.   Result := Ord(FDelphiControl.BorderStyle);
  161. end;
  162.  
  163. function TOutlineX.Get_Color: OLE_COLOR;
  164. begin
  165.   Result := OLE_COLOR(FDelphiControl.Color);
  166. end;
  167.  
  168. function TOutlineX.Get_Ctl3D: WordBool;
  169. begin
  170.   Result := FDelphiControl.Ctl3D;
  171. end;
  172.  
  173. function TOutlineX.Get_Cursor: Smallint;
  174. begin
  175.   Result := Smallint(FDelphiControl.Cursor);
  176. end;
  177.  
  178. function TOutlineX.Get_DoubleBuffered: WordBool;
  179. begin
  180.   Result := FDelphiControl.DoubleBuffered;
  181. end;
  182.  
  183. function TOutlineX.Get_DragCursor: Smallint;
  184. begin
  185.   Result := Smallint(FDelphiControl.DragCursor);
  186. end;
  187.  
  188. function TOutlineX.Get_DragMode: TxDragMode;
  189. begin
  190.   Result := Ord(FDelphiControl.DragMode);
  191. end;
  192.  
  193. function TOutlineX.Get_Enabled: WordBool;
  194. begin
  195.   Result := FDelphiControl.Enabled;
  196. end;
  197.  
  198. function TOutlineX.Get_Font: IFontDisp;
  199. begin
  200.   GetOleFont(FDelphiControl.Font, Result);
  201. end;
  202.  
  203. function TOutlineX.Get_ItemCount: Integer;
  204. begin
  205.   Result := FDelphiControl.ItemCount;
  206. end;
  207.  
  208. function TOutlineX.Get_ItemHeight: Integer;
  209. begin
  210.   Result := FDelphiControl.ItemHeight;
  211. end;
  212.  
  213. function TOutlineX.Get_ItemSeparator: WideString;
  214. begin
  215.   Result := WideString(FDelphiControl.ItemSeparator);
  216. end;
  217.  
  218. function TOutlineX.Get_Lines: IStrings;
  219. begin
  220.   GetOleStrings(FDelphiControl.Lines, Result);
  221. end;
  222.  
  223. function TOutlineX.Get_OutlineStyle: TxOutlineStyle;
  224. begin
  225.   Result := Ord(FDelphiControl.OutlineStyle);
  226. end;
  227.  
  228. function TOutlineX.Get_ParentColor: WordBool;
  229. begin
  230.   Result := FDelphiControl.ParentColor;
  231. end;
  232.  
  233. function TOutlineX.Get_ParentCtl3D: WordBool;
  234. begin
  235.   Result := FDelphiControl.ParentCtl3D;
  236. end;
  237.  
  238. function TOutlineX.Get_ParentFont: WordBool;
  239. begin
  240.   Result := FDelphiControl.ParentFont;
  241. end;
  242.  
  243. function TOutlineX.Get_Row: Integer;
  244. begin
  245.   Result := FDelphiControl.Row;
  246. end;
  247.  
  248. function TOutlineX.Get_ScrollBars: TxScrollStyle;
  249. begin
  250.   Result := Ord(FDelphiControl.ScrollBars);
  251. end;
  252.  
  253. function TOutlineX.Get_SelectedItem: Integer;
  254. begin
  255.   Result := FDelphiControl.SelectedItem;
  256. end;
  257.  
  258. function TOutlineX.Get_Style: TxOutlineType;
  259. begin
  260.   Result := Ord(FDelphiControl.Style);
  261. end;
  262.  
  263. function TOutlineX.Get_Visible: WordBool;
  264. begin
  265.   Result := FDelphiControl.Visible;
  266. end;
  267.  
  268. function TOutlineX.GetControlsAlignment: TxAlignment;
  269. begin
  270.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  271. end;
  272.  
  273. function TOutlineX.GetItem(X, Y: Integer): Integer;
  274. begin
  275.   Result := FDelphiControl.GetItem(X, Y);
  276. end;
  277.  
  278. function TOutlineX.GetTextItem(const Param1: WideString): Integer;
  279. begin
  280.   Result := FDelphiControl.GetTextItem(Param1);
  281. end;
  282.  
  283. function TOutlineX.Insert(Index: Integer; const Text: WideString): Integer;
  284. begin
  285.   Result := FDelphiControl.Insert(Index, Text);
  286. end;
  287.  
  288. function TOutlineX.IsRightToLeft: WordBool;
  289. begin
  290.   Result := FDelphiControl.IsRightToLeft;
  291. end;
  292.  
  293. function TOutlineX.UseRightToLeftAlignment: WordBool;
  294. begin
  295.   Result := FDelphiControl.UseRightToLeftAlignment;
  296. end;
  297.  
  298. function TOutlineX.UseRightToLeftReading: WordBool;
  299. begin
  300.   Result := FDelphiControl.UseRightToLeftReading;
  301. end;
  302.  
  303. function TOutlineX.UseRightToLeftScrollBar: WordBool;
  304. begin
  305.   Result := FDelphiControl.UseRightToLeftScrollBar;
  306. end;
  307.  
  308. procedure TOutlineX._Set_Font(const Value: IFontDisp);
  309. begin
  310.   SetOleFont(FDelphiControl.Font, Value);
  311. end;
  312.  
  313. procedure TOutlineX.AboutBox;
  314. begin
  315.   ShowOutlineXAbout;
  316. end;
  317.  
  318. procedure TOutlineX.BeginUpdate;
  319. begin
  320.   FDelphiControl.BeginUpdate;
  321. end;
  322.  
  323. procedure TOutlineX.Clear;
  324. begin
  325.   FDelphiControl.Clear;
  326. end;
  327.  
  328. procedure TOutlineX.Delete(Index: Integer);
  329. begin
  330.   FDelphiControl.Delete(Index);
  331. end;
  332.  
  333. procedure TOutlineX.EndUpdate;
  334. begin
  335.   FDelphiControl.EndUpdate;
  336. end;
  337.  
  338. procedure TOutlineX.FlipChildren(AllLevels: WordBool);
  339. begin
  340.   FDelphiControl.FlipChildren(AllLevels);
  341. end;
  342.  
  343. procedure TOutlineX.FullCollapse;
  344. begin
  345.   FDelphiControl.FullCollapse;
  346. end;
  347.  
  348. procedure TOutlineX.FullExpand;
  349. begin
  350.   FDelphiControl.FullExpand;
  351. end;
  352.  
  353. procedure TOutlineX.InitiateAction;
  354. begin
  355.   FDelphiControl.InitiateAction;
  356. end;
  357.  
  358. procedure TOutlineX.LoadFromFile(const FileName: WideString);
  359. begin
  360.   FDelphiControl.LoadFromFile(FileName);
  361. end;
  362.  
  363. procedure TOutlineX.SaveToFile(const FileName: WideString);
  364. begin
  365.   FDelphiControl.SaveToFile(FileName);
  366. end;
  367.  
  368. procedure TOutlineX.Set_BiDiMode(Value: TxBiDiMode);
  369. begin
  370.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  371. end;
  372.  
  373. procedure TOutlineX.Set_BorderStyle(Value: TxBorderStyle);
  374. begin
  375.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  376. end;
  377.  
  378. procedure TOutlineX.Set_Color(Value: OLE_COLOR);
  379. begin
  380.   FDelphiControl.Color := TColor(Value);
  381. end;
  382.  
  383. procedure TOutlineX.Set_Ctl3D(Value: WordBool);
  384. begin
  385.   FDelphiControl.Ctl3D := Value;
  386. end;
  387.  
  388. procedure TOutlineX.Set_Cursor(Value: Smallint);
  389. begin
  390.   FDelphiControl.Cursor := TCursor(Value);
  391. end;
  392.  
  393. procedure TOutlineX.Set_DoubleBuffered(Value: WordBool);
  394. begin
  395.   FDelphiControl.DoubleBuffered := Value;
  396. end;
  397.  
  398. procedure TOutlineX.Set_DragCursor(Value: Smallint);
  399. begin
  400.   FDelphiControl.DragCursor := TCursor(Value);
  401. end;
  402.  
  403. procedure TOutlineX.Set_DragMode(Value: TxDragMode);
  404. begin
  405.   FDelphiControl.DragMode := TDragMode(Value);
  406. end;
  407.  
  408. procedure TOutlineX.Set_Enabled(Value: WordBool);
  409. begin
  410.   FDelphiControl.Enabled := Value;
  411. end;
  412.  
  413. procedure TOutlineX.Set_Font(const Value: IFontDisp);
  414. begin
  415.   SetOleFont(FDelphiControl.Font, Value);
  416. end;
  417.  
  418. procedure TOutlineX.Set_ItemHeight(Value: Integer);
  419. begin
  420.   FDelphiControl.ItemHeight := Value;
  421. end;
  422.  
  423. procedure TOutlineX.Set_ItemSeparator(const Value: WideString);
  424. begin
  425.   FDelphiControl.ItemSeparator := String(Value);
  426. end;
  427.  
  428. procedure TOutlineX.Set_Lines(const Value: IStrings);
  429. begin
  430.   SetOleStrings(FDelphiControl.Lines, Value);
  431. end;
  432.  
  433. procedure TOutlineX.Set_OutlineStyle(Value: TxOutlineStyle);
  434. begin
  435.   FDelphiControl.OutlineStyle := TOutlineStyle(Value);
  436. end;
  437.  
  438. procedure TOutlineX.Set_ParentColor(Value: WordBool);
  439. begin
  440.   FDelphiControl.ParentColor := Value;
  441. end;
  442.  
  443. procedure TOutlineX.Set_ParentCtl3D(Value: WordBool);
  444. begin
  445.   FDelphiControl.ParentCtl3D := Value;
  446. end;
  447.  
  448. procedure TOutlineX.Set_ParentFont(Value: WordBool);
  449. begin
  450.   FDelphiControl.ParentFont := Value;
  451. end;
  452.  
  453. procedure TOutlineX.Set_Row(Value: Integer);
  454. begin
  455.   FDelphiControl.Row := Value;
  456. end;
  457.  
  458. procedure TOutlineX.Set_ScrollBars(Value: TxScrollStyle);
  459. begin
  460.   FDelphiControl.ScrollBars := TScrollStyle(Value);
  461. end;
  462.  
  463. procedure TOutlineX.Set_SelectedItem(Value: Integer);
  464. begin
  465.   FDelphiControl.SelectedItem := Value;
  466. end;
  467.  
  468. procedure TOutlineX.Set_Style(Value: TxOutlineType);
  469. begin
  470.   FDelphiControl.Style := TOutlineType(Value);
  471. end;
  472.  
  473. procedure TOutlineX.Set_Visible(Value: WordBool);
  474. begin
  475.   FDelphiControl.Visible := Value;
  476. end;
  477.  
  478. procedure TOutlineX.SetUpdateState(Value: WordBool);
  479. begin
  480.   FDelphiControl.SetUpdateState(Value);
  481. end;
  482.  
  483. procedure TOutlineX.ClickEvent(Sender: TObject);
  484. begin
  485.   if FEvents <> nil then FEvents.OnClick;
  486. end;
  487.  
  488. procedure TOutlineX.CollapseEvent(Sender: TObject; Index: Integer);
  489. begin
  490.   if FEvents <> nil then FEvents.OnCollapse(Index);
  491. end;
  492.  
  493. procedure TOutlineX.DblClickEvent(Sender: TObject);
  494. begin
  495.   if FEvents <> nil then FEvents.OnDblClick;
  496. end;
  497.  
  498. procedure TOutlineX.ExpandEvent(Sender: TObject; Index: Integer);
  499. begin
  500.   if FEvents <> nil then FEvents.OnExpand(Index);
  501. end;
  502.  
  503. procedure TOutlineX.KeyPressEvent(Sender: TObject; var Key: Char);
  504. var
  505.   TempKey: Smallint;
  506. begin
  507.   TempKey := Smallint(Key);
  508.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  509.   Key := Char(TempKey);
  510. end;
  511.  
  512. initialization
  513.   TActiveXControlFactory.Create(
  514.     ComServer,
  515.     TOutlineX,
  516.     TOutline,
  517.     Class_OutlineX,
  518.     20,
  519.     '{695CDB71-02E5-11D2-B20D-00C04FA368D4}',
  520.     0,
  521.     tmApartment);
  522. end.
  523.