home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / INSTALL / data.z / LBOXIMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-05  |  9.7 KB  |  386 lines

  1. unit LBoxImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelC_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.   protected
  19.     { Protected declarations }
  20.     procedure InitializeControl; override;
  21.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  22.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  23.     function Get_BorderStyle: TxBorderStyle; safecall;
  24.     function Get_Color: TColor; safecall;
  25.     function Get_Columns: Integer; safecall;
  26.     function Get_Ctl3D: WordBool; safecall;
  27.     function Get_Cursor: Smallint; safecall;
  28.     function Get_DragCursor: Smallint; safecall;
  29.     function Get_DragMode: TxDragMode; safecall;
  30.     function Get_Enabled: WordBool; safecall;
  31.     function Get_ExtendedSelect: WordBool; safecall;
  32.     function Get_Font: Font; safecall;
  33.     function Get_ImeMode: TxImeMode; safecall;
  34.     function Get_ImeName: WideString; safecall;
  35.     function Get_IntegralHeight: WordBool; safecall;
  36.     function Get_ItemHeight: Integer; safecall;
  37.     function Get_ItemIndex: Integer; safecall;
  38.     function Get_Items: IStrings; safecall;
  39.     function Get_MultiSelect: WordBool; safecall;
  40.     function Get_ParentColor: WordBool; safecall;
  41.     function Get_ParentCtl3D: WordBool; safecall;
  42.     function Get_SelCount: Integer; safecall;
  43.     function Get_Sorted: WordBool; safecall;
  44.     function Get_Style: TxListBoxStyle; safecall;
  45.     function Get_TabWidth: Integer; safecall;
  46.     function Get_TopIndex: Integer; safecall;
  47.     function Get_Visible: WordBool; safecall;
  48.     procedure AboutBox; safecall;
  49.     procedure Clear; safecall;
  50.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  51.     procedure Set_Color(Value: TColor); safecall;
  52.     procedure Set_Columns(Value: Integer); safecall;
  53.     procedure Set_Ctl3D(Value: WordBool); safecall;
  54.     procedure Set_Cursor(Value: Smallint); safecall;
  55.     procedure Set_DragCursor(Value: Smallint); safecall;
  56.     procedure Set_DragMode(Value: TxDragMode); safecall;
  57.     procedure Set_Enabled(Value: WordBool); safecall;
  58.     procedure Set_ExtendedSelect(Value: WordBool); safecall;
  59.     procedure Set_Font(const Value: Font); safecall;
  60.     procedure Set_ImeMode(Value: TxImeMode); safecall;
  61.     procedure Set_ImeName(const Value: WideString); safecall;
  62.     procedure Set_IntegralHeight(Value: WordBool); safecall;
  63.     procedure Set_ItemHeight(Value: Integer); safecall;
  64.     procedure Set_ItemIndex(Value: Integer); safecall;
  65.     procedure Set_Items(const Value: IStrings); safecall;
  66.     procedure Set_MultiSelect(Value: WordBool); safecall;
  67.     procedure Set_ParentColor(Value: WordBool); safecall;
  68.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  69.     procedure Set_Sorted(Value: WordBool); safecall;
  70.     procedure Set_Style(Value: TxListBoxStyle); safecall;
  71.     procedure Set_TabWidth(Value: Integer); safecall;
  72.     procedure Set_TopIndex(Value: Integer); safecall;
  73.     procedure Set_Visible(Value: WordBool); safecall;
  74.   end;
  75.  
  76. implementation
  77.  
  78. uses About13;
  79.  
  80. { TListBoxX }
  81.  
  82. procedure TListBoxX.InitializeControl;
  83. begin
  84.   FDelphiControl := Control as TListBox;
  85.   FDelphiControl.OnClick := ClickEvent;
  86.   FDelphiControl.OnDblClick := DblClickEvent;
  87.   FDelphiControl.OnKeyPress := KeyPressEvent;
  88. end;
  89.  
  90. procedure TListBoxX.EventSinkChanged(const EventSink: IUnknown);
  91. begin
  92.   FEvents := EventSink as IListBoxXEvents;
  93. end;
  94.  
  95. procedure TListBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  96. begin
  97.   { Define property pages here.  Property pages are defined by calling
  98.     DefinePropertyPage with the class id of the page.  For example,
  99.       DefinePropertyPage(Class_ListBoxXPage); }
  100. end;
  101.  
  102. function TListBoxX.Get_BorderStyle: TxBorderStyle;
  103. begin
  104.   Result := Ord(FDelphiControl.BorderStyle);
  105. end;
  106.  
  107. function TListBoxX.Get_Color: TColor;
  108. begin
  109.   Result := FDelphiControl.Color;
  110. end;
  111.  
  112. function TListBoxX.Get_Columns: Integer;
  113. begin
  114.   Result := FDelphiControl.Columns;
  115. end;
  116.  
  117. function TListBoxX.Get_Ctl3D: WordBool;
  118. begin
  119.   Result := FDelphiControl.Ctl3D;
  120. end;
  121.  
  122. function TListBoxX.Get_Cursor: Smallint;
  123. begin
  124.   Result := Smallint(FDelphiControl.Cursor);
  125. end;
  126.  
  127. function TListBoxX.Get_DragCursor: Smallint;
  128. begin
  129.   Result := Smallint(FDelphiControl.DragCursor);
  130. end;
  131.  
  132. function TListBoxX.Get_DragMode: TxDragMode;
  133. begin
  134.   Result := Ord(FDelphiControl.DragMode);
  135. end;
  136.  
  137. function TListBoxX.Get_Enabled: WordBool;
  138. begin
  139.   Result := FDelphiControl.Enabled;
  140. end;
  141.  
  142. function TListBoxX.Get_ExtendedSelect: WordBool;
  143. begin
  144.   Result := FDelphiControl.ExtendedSelect;
  145. end;
  146.  
  147. function TListBoxX.Get_Font: Font;
  148. begin
  149.   GetOleFont(FDelphiControl.Font, Result);
  150. end;
  151.  
  152. function TListBoxX.Get_ImeMode: TxImeMode;
  153. begin
  154.   Result := Ord(FDelphiControl.ImeMode);
  155. end;
  156.  
  157. function TListBoxX.Get_ImeName: WideString;
  158. begin
  159.   Result := WideString(FDelphiControl.ImeName);
  160. end;
  161.  
  162. function TListBoxX.Get_IntegralHeight: WordBool;
  163. begin
  164.   Result := FDelphiControl.IntegralHeight;
  165. end;
  166.  
  167. function TListBoxX.Get_ItemHeight: Integer;
  168. begin
  169.   Result := FDelphiControl.ItemHeight;
  170. end;
  171.  
  172. function TListBoxX.Get_ItemIndex: Integer;
  173. begin
  174.   Result := FDelphiControl.ItemIndex;
  175. end;
  176.  
  177. function TListBoxX.Get_Items: IStrings;
  178. begin
  179.   GetOleStrings(FDelphiControl.Items, Result);
  180. end;
  181.  
  182. function TListBoxX.Get_MultiSelect: WordBool;
  183. begin
  184.   Result := FDelphiControl.MultiSelect;
  185. end;
  186.  
  187. function TListBoxX.Get_ParentColor: WordBool;
  188. begin
  189.   Result := FDelphiControl.ParentColor;
  190. end;
  191.  
  192. function TListBoxX.Get_ParentCtl3D: WordBool;
  193. begin
  194.   Result := FDelphiControl.ParentCtl3D;
  195. end;
  196.  
  197. function TListBoxX.Get_SelCount: Integer;
  198. begin
  199.   Result := FDelphiControl.SelCount;
  200. end;
  201.  
  202. function TListBoxX.Get_Sorted: WordBool;
  203. begin
  204.   Result := FDelphiControl.Sorted;
  205. end;
  206.  
  207. function TListBoxX.Get_Style: TxListBoxStyle;
  208. begin
  209.   Result := Ord(FDelphiControl.Style);
  210. end;
  211.  
  212. function TListBoxX.Get_TabWidth: Integer;
  213. begin
  214.   Result := FDelphiControl.TabWidth;
  215. end;
  216.  
  217. function TListBoxX.Get_TopIndex: Integer;
  218. begin
  219.   Result := FDelphiControl.TopIndex;
  220. end;
  221.  
  222. function TListBoxX.Get_Visible: WordBool;
  223. begin
  224.   Result := FDelphiControl.Visible;
  225. end;
  226.  
  227. procedure TListBoxX.AboutBox;
  228. begin
  229.   ShowListBoxXAbout;
  230. end;
  231.  
  232. procedure TListBoxX.Clear;
  233. begin
  234.  
  235. end;
  236.  
  237. procedure TListBoxX.Set_BorderStyle(Value: TxBorderStyle);
  238. begin
  239.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  240. end;
  241.  
  242. procedure TListBoxX.Set_Color(Value: TColor);
  243. begin
  244.   FDelphiControl.Color := Value;
  245. end;
  246.  
  247. procedure TListBoxX.Set_Columns(Value: Integer);
  248. begin
  249.   FDelphiControl.Columns := Value;
  250. end;
  251.  
  252. procedure TListBoxX.Set_Ctl3D(Value: WordBool);
  253. begin
  254.   FDelphiControl.Ctl3D := Value;
  255. end;
  256.  
  257. procedure TListBoxX.Set_Cursor(Value: Smallint);
  258. begin
  259.   FDelphiControl.Cursor := TCursor(Value);
  260. end;
  261.  
  262. procedure TListBoxX.Set_DragCursor(Value: Smallint);
  263. begin
  264.   FDelphiControl.DragCursor := TCursor(Value);
  265. end;
  266.  
  267. procedure TListBoxX.Set_DragMode(Value: TxDragMode);
  268. begin
  269.   FDelphiControl.DragMode := TDragMode(Value);
  270. end;
  271.  
  272. procedure TListBoxX.Set_Enabled(Value: WordBool);
  273. begin
  274.   FDelphiControl.Enabled := Value;
  275. end;
  276.  
  277. procedure TListBoxX.Set_ExtendedSelect(Value: WordBool);
  278. begin
  279.   FDelphiControl.ExtendedSelect := Value;
  280. end;
  281.  
  282. procedure TListBoxX.Set_Font(const Value: Font);
  283. begin
  284.   SetOleFont(FDelphiControl.Font, Value);
  285. end;
  286.  
  287. procedure TListBoxX.Set_ImeMode(Value: TxImeMode);
  288. begin
  289.   FDelphiControl.ImeMode := TImeMode(Value);
  290. end;
  291.  
  292. procedure TListBoxX.Set_ImeName(const Value: WideString);
  293. begin
  294.   FDelphiControl.ImeName := TImeName(Value);
  295. end;
  296.  
  297. procedure TListBoxX.Set_IntegralHeight(Value: WordBool);
  298. begin
  299.   FDelphiControl.IntegralHeight := Value;
  300. end;
  301.  
  302. procedure TListBoxX.Set_ItemHeight(Value: Integer);
  303. begin
  304.   FDelphiControl.ItemHeight := Value;
  305. end;
  306.  
  307. procedure TListBoxX.Set_ItemIndex(Value: Integer);
  308. begin
  309.   FDelphiControl.ItemIndex := Value;
  310. end;
  311.  
  312. procedure TListBoxX.Set_Items(const Value: IStrings);
  313. begin
  314.   SetOleStrings(FDelphiControl.Items, Value);
  315. end;
  316.  
  317. procedure TListBoxX.Set_MultiSelect(Value: WordBool);
  318. begin
  319.   FDelphiControl.MultiSelect := Value;
  320. end;
  321.  
  322. procedure TListBoxX.Set_ParentColor(Value: WordBool);
  323. begin
  324.   FDelphiControl.ParentColor := Value;
  325. end;
  326.  
  327. procedure TListBoxX.Set_ParentCtl3D(Value: WordBool);
  328. begin
  329.   FDelphiControl.ParentCtl3D := Value;
  330. end;
  331.  
  332. procedure TListBoxX.Set_Sorted(Value: WordBool);
  333. begin
  334.   FDelphiControl.Sorted := Value;
  335. end;
  336.  
  337. procedure TListBoxX.Set_Style(Value: TxListBoxStyle);
  338. begin
  339.   FDelphiControl.Style := TListBoxStyle(Value);
  340. end;
  341.  
  342. procedure TListBoxX.Set_TabWidth(Value: Integer);
  343. begin
  344.   FDelphiControl.TabWidth := Value;
  345. end;
  346.  
  347. procedure TListBoxX.Set_TopIndex(Value: Integer);
  348. begin
  349.   FDelphiControl.TopIndex := Value;
  350. end;
  351.  
  352. procedure TListBoxX.Set_Visible(Value: WordBool);
  353. begin
  354.   FDelphiControl.Visible := Value;
  355. end;
  356.  
  357. procedure TListBoxX.ClickEvent(Sender: TObject);
  358. begin
  359.   if FEvents <> nil then FEvents.OnClick;
  360. end;
  361.  
  362. procedure TListBoxX.DblClickEvent(Sender: TObject);
  363. begin
  364.   if FEvents <> nil then FEvents.OnDblClick;
  365. end;
  366.  
  367. procedure TListBoxX.KeyPressEvent(Sender: TObject; var Key: Char);
  368. var
  369.   TempKey: Smallint;
  370. begin
  371.   TempKey := Smallint(Key);
  372.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  373.   Key := Char(TempKey);
  374. end;
  375.  
  376. initialization
  377.   TActiveXControlFactory.Create(
  378.     ComServer,
  379.     TListBoxX,
  380.     TListBox,
  381.     Class_ListBoxX,
  382.     13,
  383.     '{FA7B83C5-9ED7-11D0-AA40-444553540000}',
  384.     0);
  385. end.
  386.