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

  1. unit ListBoxImpl1;
  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.   TListBoxX = class(TActiveXControl, IListBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TListBox;
  14.     FEvents: IListBoxXEvents;
  15.     procedure ClickEvent(Sender: TObject);
  16.     procedure DblClickEvent(Sender: TObject);
  17.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  18.     procedure MeasureItemEvent(Control: TWinControl; Index: Integer;
  19.       var Height: Integer);
  20.   protected
  21.     { Protected declarations }
  22.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  23.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  24.     procedure InitializeControl; override;
  25.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  26.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  27.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  28.     function Get_BiDiMode: TxBiDiMode; safecall;
  29.     function Get_BorderStyle: TxBorderStyle; safecall;
  30.     function Get_Color: OLE_COLOR; safecall;
  31.     function Get_Columns: Integer; safecall;
  32.     function Get_Ctl3D: WordBool; safecall;
  33.     function Get_Cursor: Smallint; safecall;
  34.     function Get_DoubleBuffered: WordBool; safecall;
  35.     function Get_DragCursor: Smallint; safecall;
  36.     function Get_DragMode: TxDragMode; safecall;
  37.     function Get_Enabled: WordBool; safecall;
  38.     function Get_ExtendedSelect: WordBool; safecall;
  39.     function Get_Font: IFontDisp; safecall;
  40.     function Get_ImeMode: TxImeMode; safecall;
  41.     function Get_ImeName: WideString; safecall;
  42.     function Get_IntegralHeight: WordBool; safecall;
  43.     function Get_ItemHeight: Integer; safecall;
  44.     function Get_ItemIndex: Integer; safecall;
  45.     function Get_Items: IStrings; safecall;
  46.     function Get_MultiSelect: WordBool; safecall;
  47.     function Get_ParentColor: WordBool; safecall;
  48.     function Get_ParentCtl3D: WordBool; safecall;
  49.     function Get_ParentFont: WordBool; safecall;
  50.     function Get_SelCount: Integer; safecall;
  51.     function Get_Sorted: WordBool; safecall;
  52.     function Get_Style: TxListBoxStyle; safecall;
  53.     function Get_TabWidth: Integer; safecall;
  54.     function Get_TopIndex: Integer; safecall;
  55.     function Get_Visible: WordBool; safecall;
  56.     function GetControlsAlignment: TxAlignment; safecall;
  57.     function IsRightToLeft: WordBool; safecall;
  58.     function UseRightToLeftAlignment: WordBool; safecall;
  59.     function UseRightToLeftReading: WordBool; safecall;
  60.     function UseRightToLeftScrollBar: WordBool; safecall;
  61.     procedure _Set_Font(const Value: IFontDisp); safecall;
  62.     procedure AboutBox; safecall;
  63.     procedure Clear; safecall;
  64.     procedure FlipChildren(AllLevels: WordBool); safecall;
  65.     procedure InitiateAction; safecall;
  66.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  67.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  68.     procedure Set_Color(Value: OLE_COLOR); safecall;
  69.     procedure Set_Columns(Value: Integer); safecall;
  70.     procedure Set_Ctl3D(Value: WordBool); safecall;
  71.     procedure Set_Cursor(Value: Smallint); safecall;
  72.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  73.     procedure Set_DragCursor(Value: Smallint); safecall;
  74.     procedure Set_DragMode(Value: TxDragMode); safecall;
  75.     procedure Set_Enabled(Value: WordBool); safecall;
  76.     procedure Set_ExtendedSelect(Value: WordBool); safecall;
  77.     procedure Set_Font(const Value: IFontDisp); safecall;
  78.     procedure Set_ImeMode(Value: TxImeMode); safecall;
  79.     procedure Set_ImeName(const Value: WideString); safecall;
  80.     procedure Set_IntegralHeight(Value: WordBool); safecall;
  81.     procedure Set_ItemHeight(Value: Integer); safecall;
  82.     procedure Set_ItemIndex(Value: Integer); safecall;
  83.     procedure Set_Items(const Value: IStrings); safecall;
  84.     procedure Set_MultiSelect(Value: WordBool); safecall;
  85.     procedure Set_ParentColor(Value: WordBool); safecall;
  86.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  87.     procedure Set_ParentFont(Value: WordBool); safecall;
  88.     procedure Set_Sorted(Value: WordBool); safecall;
  89.     procedure Set_Style(Value: TxListBoxStyle); safecall;
  90.     procedure Set_TabWidth(Value: Integer); safecall;
  91.     procedure Set_TopIndex(Value: Integer); safecall;
  92.     procedure Set_Visible(Value: WordBool); safecall;
  93.   end;
  94.  
  95. implementation
  96.  
  97. uses ComObj, About14;
  98.  
  99. { TListBoxX }
  100.  
  101. procedure TListBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  102. begin
  103.   { Define property pages here.  Property pages are defined by calling
  104.     DefinePropertyPage with the class id of the page.  For example,
  105.       DefinePropertyPage(Class_ListBoxXPage); }
  106. end;
  107.  
  108. procedure TListBoxX.EventSinkChanged(const EventSink: IUnknown);
  109. begin
  110.   FEvents := EventSink as IListBoxXEvents;
  111. end;
  112.  
  113. procedure TListBoxX.InitializeControl;
  114. begin
  115.   FDelphiControl := Control as TListBox;
  116.   FDelphiControl.OnClick := ClickEvent;
  117.   FDelphiControl.OnDblClick := DblClickEvent;
  118.   FDelphiControl.OnKeyPress := KeyPressEvent;
  119.   FDelphiControl.OnMeasureItem := MeasureItemEvent;
  120. end;
  121.  
  122. function TListBoxX.ClassNameIs(const Name: WideString): WordBool;
  123. begin
  124.   Result := FDelphiControl.ClassNameIs(Name);
  125. end;
  126.  
  127. function TListBoxX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  128. begin
  129.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  130. end;
  131.  
  132. function TListBoxX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  133. begin
  134.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  135. end;
  136.  
  137. function TListBoxX.Get_BiDiMode: TxBiDiMode;
  138. begin
  139.   Result := Ord(FDelphiControl.BiDiMode);
  140. end;
  141.  
  142. function TListBoxX.Get_BorderStyle: TxBorderStyle;
  143. begin
  144.   Result := Ord(FDelphiControl.BorderStyle);
  145. end;
  146.  
  147. function TListBoxX.Get_Color: OLE_COLOR;
  148. begin
  149.   Result := OLE_COLOR(FDelphiControl.Color);
  150. end;
  151.  
  152. function TListBoxX.Get_Columns: Integer;
  153. begin
  154.   Result := FDelphiControl.Columns;
  155. end;
  156.  
  157. function TListBoxX.Get_Ctl3D: WordBool;
  158. begin
  159.   Result := FDelphiControl.Ctl3D;
  160. end;
  161.  
  162. function TListBoxX.Get_Cursor: Smallint;
  163. begin
  164.   Result := Smallint(FDelphiControl.Cursor);
  165. end;
  166.  
  167. function TListBoxX.Get_DoubleBuffered: WordBool;
  168. begin
  169.   Result := FDelphiControl.DoubleBuffered;
  170. end;
  171.  
  172. function TListBoxX.Get_DragCursor: Smallint;
  173. begin
  174.   Result := Smallint(FDelphiControl.DragCursor);
  175. end;
  176.  
  177. function TListBoxX.Get_DragMode: TxDragMode;
  178. begin
  179.   Result := Ord(FDelphiControl.DragMode);
  180. end;
  181.  
  182. function TListBoxX.Get_Enabled: WordBool;
  183. begin
  184.   Result := FDelphiControl.Enabled;
  185. end;
  186.  
  187. function TListBoxX.Get_ExtendedSelect: WordBool;
  188. begin
  189.   Result := FDelphiControl.ExtendedSelect;
  190. end;
  191.  
  192. function TListBoxX.Get_Font: IFontDisp;
  193. begin
  194.   GetOleFont(FDelphiControl.Font, Result);
  195. end;
  196.  
  197. function TListBoxX.Get_ImeMode: TxImeMode;
  198. begin
  199.   Result := Ord(FDelphiControl.ImeMode);
  200. end;
  201.  
  202. function TListBoxX.Get_ImeName: WideString;
  203. begin
  204.   Result := WideString(FDelphiControl.ImeName);
  205. end;
  206.  
  207. function TListBoxX.Get_IntegralHeight: WordBool;
  208. begin
  209.   Result := FDelphiControl.IntegralHeight;
  210. end;
  211.  
  212. function TListBoxX.Get_ItemHeight: Integer;
  213. begin
  214.   Result := FDelphiControl.ItemHeight;
  215. end;
  216.  
  217. function TListBoxX.Get_ItemIndex: Integer;
  218. begin
  219.   Result := FDelphiControl.ItemIndex;
  220. end;
  221.  
  222. function TListBoxX.Get_Items: IStrings;
  223. begin
  224.   GetOleStrings(FDelphiControl.Items, Result);
  225. end;
  226.  
  227. function TListBoxX.Get_MultiSelect: WordBool;
  228. begin
  229.   Result := FDelphiControl.MultiSelect;
  230. end;
  231.  
  232. function TListBoxX.Get_ParentColor: WordBool;
  233. begin
  234.   Result := FDelphiControl.ParentColor;
  235. end;
  236.  
  237. function TListBoxX.Get_ParentCtl3D: WordBool;
  238. begin
  239.   Result := FDelphiControl.ParentCtl3D;
  240. end;
  241.  
  242. function TListBoxX.Get_ParentFont: WordBool;
  243. begin
  244.   Result := FDelphiControl.ParentFont;
  245. end;
  246.  
  247. function TListBoxX.Get_SelCount: Integer;
  248. begin
  249.   Result := FDelphiControl.SelCount;
  250. end;
  251.  
  252. function TListBoxX.Get_Sorted: WordBool;
  253. begin
  254.   Result := FDelphiControl.Sorted;
  255. end;
  256.  
  257. function TListBoxX.Get_Style: TxListBoxStyle;
  258. begin
  259.   Result := Ord(FDelphiControl.Style);
  260. end;
  261.  
  262. function TListBoxX.Get_TabWidth: Integer;
  263. begin
  264.   Result := FDelphiControl.TabWidth;
  265. end;
  266.  
  267. function TListBoxX.Get_TopIndex: Integer;
  268. begin
  269.   Result := FDelphiControl.TopIndex;
  270. end;
  271.  
  272. function TListBoxX.Get_Visible: WordBool;
  273. begin
  274.   Result := FDelphiControl.Visible;
  275. end;
  276.  
  277. function TListBoxX.GetControlsAlignment: TxAlignment;
  278. begin
  279.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  280. end;
  281.  
  282. function TListBoxX.IsRightToLeft: WordBool;
  283. begin
  284.   Result := FDelphiControl.IsRightToLeft;
  285. end;
  286.  
  287. function TListBoxX.UseRightToLeftAlignment: WordBool;
  288. begin
  289.   Result := FDelphiControl.UseRightToLeftAlignment;
  290. end;
  291.  
  292. function TListBoxX.UseRightToLeftReading: WordBool;
  293. begin
  294.   Result := FDelphiControl.UseRightToLeftReading;
  295. end;
  296.  
  297. function TListBoxX.UseRightToLeftScrollBar: WordBool;
  298. begin
  299.   Result := FDelphiControl.UseRightToLeftScrollBar;
  300. end;
  301.  
  302. procedure TListBoxX._Set_Font(const Value: IFontDisp);
  303. begin
  304.   SetOleFont(FDelphiControl.Font, Value);
  305. end;
  306.  
  307. procedure TListBoxX.AboutBox;
  308. begin
  309.   ShowListBoxXAbout;
  310. end;
  311.  
  312. procedure TListBoxX.Clear;
  313. begin
  314.   FDelphiControl.Clear;
  315. end;
  316.  
  317. procedure TListBoxX.FlipChildren(AllLevels: WordBool);
  318. begin
  319.   FDelphiControl.FlipChildren(AllLevels);
  320. end;
  321.  
  322. procedure TListBoxX.InitiateAction;
  323. begin
  324.   FDelphiControl.InitiateAction;
  325. end;
  326.  
  327. procedure TListBoxX.Set_BiDiMode(Value: TxBiDiMode);
  328. begin
  329.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  330. end;
  331.  
  332. procedure TListBoxX.Set_BorderStyle(Value: TxBorderStyle);
  333. begin
  334.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  335. end;
  336.  
  337. procedure TListBoxX.Set_Color(Value: OLE_COLOR);
  338. begin
  339.   FDelphiControl.Color := TColor(Value);
  340. end;
  341.  
  342. procedure TListBoxX.Set_Columns(Value: Integer);
  343. begin
  344.   FDelphiControl.Columns := Value;
  345. end;
  346.  
  347. procedure TListBoxX.Set_Ctl3D(Value: WordBool);
  348. begin
  349.   FDelphiControl.Ctl3D := Value;
  350. end;
  351.  
  352. procedure TListBoxX.Set_Cursor(Value: Smallint);
  353. begin
  354.   FDelphiControl.Cursor := TCursor(Value);
  355. end;
  356.  
  357. procedure TListBoxX.Set_DoubleBuffered(Value: WordBool);
  358. begin
  359.   FDelphiControl.DoubleBuffered := Value;
  360. end;
  361.  
  362. procedure TListBoxX.Set_DragCursor(Value: Smallint);
  363. begin
  364.   FDelphiControl.DragCursor := TCursor(Value);
  365. end;
  366.  
  367. procedure TListBoxX.Set_DragMode(Value: TxDragMode);
  368. begin
  369.   FDelphiControl.DragMode := TDragMode(Value);
  370. end;
  371.  
  372. procedure TListBoxX.Set_Enabled(Value: WordBool);
  373. begin
  374.   FDelphiControl.Enabled := Value;
  375. end;
  376.  
  377. procedure TListBoxX.Set_ExtendedSelect(Value: WordBool);
  378. begin
  379.   FDelphiControl.ExtendedSelect := Value;
  380. end;
  381.  
  382. procedure TListBoxX.Set_Font(const Value: IFontDisp);
  383. begin
  384.   SetOleFont(FDelphiControl.Font, Value);
  385. end;
  386.  
  387. procedure TListBoxX.Set_ImeMode(Value: TxImeMode);
  388. begin
  389.   FDelphiControl.ImeMode := TImeMode(Value);
  390. end;
  391.  
  392. procedure TListBoxX.Set_ImeName(const Value: WideString);
  393. begin
  394.   FDelphiControl.ImeName := TImeName(Value);
  395. end;
  396.  
  397. procedure TListBoxX.Set_IntegralHeight(Value: WordBool);
  398. begin
  399.   FDelphiControl.IntegralHeight := Value;
  400. end;
  401.  
  402. procedure TListBoxX.Set_ItemHeight(Value: Integer);
  403. begin
  404.   FDelphiControl.ItemHeight := Value;
  405. end;
  406.  
  407. procedure TListBoxX.Set_ItemIndex(Value: Integer);
  408. begin
  409.   FDelphiControl.ItemIndex := Value;
  410. end;
  411.  
  412. procedure TListBoxX.Set_Items(const Value: IStrings);
  413. begin
  414.   SetOleStrings(FDelphiControl.Items, Value);
  415. end;
  416.  
  417. procedure TListBoxX.Set_MultiSelect(Value: WordBool);
  418. begin
  419.   FDelphiControl.MultiSelect := Value;
  420. end;
  421.  
  422. procedure TListBoxX.Set_ParentColor(Value: WordBool);
  423. begin
  424.   FDelphiControl.ParentColor := Value;
  425. end;
  426.  
  427. procedure TListBoxX.Set_ParentCtl3D(Value: WordBool);
  428. begin
  429.   FDelphiControl.ParentCtl3D := Value;
  430. end;
  431.  
  432. procedure TListBoxX.Set_ParentFont(Value: WordBool);
  433. begin
  434.   FDelphiControl.ParentFont := Value;
  435. end;
  436.  
  437. procedure TListBoxX.Set_Sorted(Value: WordBool);
  438. begin
  439.   FDelphiControl.Sorted := Value;
  440. end;
  441.  
  442. procedure TListBoxX.Set_Style(Value: TxListBoxStyle);
  443. begin
  444.   FDelphiControl.Style := TListBoxStyle(Value);
  445. end;
  446.  
  447. procedure TListBoxX.Set_TabWidth(Value: Integer);
  448. begin
  449.   FDelphiControl.TabWidth := Value;
  450. end;
  451.  
  452. procedure TListBoxX.Set_TopIndex(Value: Integer);
  453. begin
  454.   FDelphiControl.TopIndex := Value;
  455. end;
  456.  
  457. procedure TListBoxX.Set_Visible(Value: WordBool);
  458. begin
  459.   FDelphiControl.Visible := Value;
  460. end;
  461.  
  462. procedure TListBoxX.ClickEvent(Sender: TObject);
  463. begin
  464.   if FEvents <> nil then FEvents.OnClick;
  465. end;
  466.  
  467. procedure TListBoxX.DblClickEvent(Sender: TObject);
  468. begin
  469.   if FEvents <> nil then FEvents.OnDblClick;
  470. end;
  471.  
  472. procedure TListBoxX.KeyPressEvent(Sender: TObject; var Key: Char);
  473. var
  474.   TempKey: Smallint;
  475. begin
  476.   TempKey := Smallint(Key);
  477.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  478.   Key := Char(TempKey);
  479. end;
  480.  
  481. procedure TListBoxX.MeasureItemEvent(Control: TWinControl; Index: Integer;
  482.   var Height: Integer);
  483. var
  484.   TempHeight: Integer;
  485. begin
  486.   TempHeight := Integer(Height);
  487.   if FEvents <> nil then FEvents.OnMeasureItem(Index, TempHeight);
  488.   Height := Integer(TempHeight);
  489. end;
  490.  
  491. initialization
  492.   TActiveXControlFactory.Create(
  493.     ComServer,
  494.     TListBoxX,
  495.     TListBox,
  496.     Class_ListBoxX,
  497.     14,
  498.     '{695CDB3F-02E5-11D2-B20D-00C04FA368D4}',
  499.     0,
  500.     tmApartment);
  501. end.
  502.