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

  1. unit CBoxImpl;
  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.   TComboBoxX = class(TActiveXControl, IComboBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TComboBox;
  14.     FEvents: IComboBoxXEvents;
  15.     procedure ChangeEvent(Sender: TObject);
  16.     procedure ClickEvent(Sender: TObject);
  17.     procedure DblClickEvent(Sender: TObject);
  18.     procedure DropDownEvent(Sender: TObject);
  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 Get_Color: TColor; 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_DropDownCount: Integer; safecall;
  31.     function Get_DroppedDown: WordBool; safecall;
  32.     function Get_Enabled: WordBool; safecall;
  33.     function Get_Font: Font; safecall;
  34.     function Get_ImeMode: TxImeMode; safecall;
  35.     function Get_ImeName: WideString; safecall;
  36.     function Get_ItemHeight: Integer; safecall;
  37.     function Get_ItemIndex: Integer; safecall;
  38.     function Get_Items: IStrings; safecall;
  39.     function Get_MaxLength: Integer; safecall;
  40.     function Get_ParentColor: WordBool; safecall;
  41.     function Get_ParentCtl3D: WordBool; safecall;
  42.     function Get_SelLength: Integer; safecall;
  43.     function Get_SelStart: Integer; safecall;
  44.     function Get_SelText: WideString; safecall;
  45.     function Get_Sorted: WordBool; safecall;
  46.     function Get_Style: TxComboBoxStyle; safecall;
  47.     function Get_Text: WideString; safecall;
  48.     function Get_Visible: WordBool; safecall;
  49.     procedure AboutBox; safecall;
  50.     procedure Clear; safecall;
  51.     procedure SelectAll; safecall;
  52.     procedure Set_Color(Value: TColor); 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_DropDownCount(Value: Integer); safecall;
  58.     procedure Set_DroppedDown(Value: WordBool); safecall;
  59.     procedure Set_Enabled(Value: WordBool); safecall;
  60.     procedure Set_Font(const Value: Font); safecall;
  61.     procedure Set_ImeMode(Value: TxImeMode); safecall;
  62.     procedure Set_ImeName(const Value: WideString); 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_MaxLength(Value: Integer); safecall;
  67.     procedure Set_ParentColor(Value: WordBool); safecall;
  68.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  69.     procedure Set_SelLength(Value: Integer); safecall;
  70.     procedure Set_SelStart(Value: Integer); safecall;
  71.     procedure Set_SelText(const Value: WideString); safecall;
  72.     procedure Set_Sorted(Value: WordBool); safecall;
  73.     procedure Set_Style(Value: TxComboBoxStyle); safecall;
  74.     procedure Set_Text(const Value: WideString); safecall;
  75.     procedure Set_Visible(Value: WordBool); safecall;
  76.   end;
  77.  
  78. implementation
  79.  
  80. uses About7;
  81.  
  82. { TComboBoxX }
  83.  
  84. procedure TComboBoxX.InitializeControl;
  85. begin
  86.   FDelphiControl := Control as TComboBox;
  87.   FDelphiControl.OnChange := ChangeEvent;
  88.   FDelphiControl.OnClick := ClickEvent;
  89.   FDelphiControl.OnDblClick := DblClickEvent;
  90.   FDelphiControl.OnDropDown := DropDownEvent;
  91.   FDelphiControl.OnKeyPress := KeyPressEvent;
  92. end;
  93.  
  94. procedure TComboBoxX.EventSinkChanged(const EventSink: IUnknown);
  95. begin
  96.   FEvents := EventSink as IComboBoxXEvents;
  97. end;
  98.  
  99. procedure TComboBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  100. begin
  101.   { Define property pages here.  Property pages are defined by calling
  102.     DefinePropertyPage with the class id of the page.  For example,
  103.       DefinePropertyPage(Class_ComboBoxXPage); }
  104. end;
  105.  
  106. function TComboBoxX.Get_Color: TColor;
  107. begin
  108.   Result := FDelphiControl.Color;
  109. end;
  110.  
  111. function TComboBoxX.Get_Ctl3D: WordBool;
  112. begin
  113.   Result := FDelphiControl.Ctl3D;
  114. end;
  115.  
  116. function TComboBoxX.Get_Cursor: Smallint;
  117. begin
  118.   Result := Smallint(FDelphiControl.Cursor);
  119. end;
  120.  
  121. function TComboBoxX.Get_DragCursor: Smallint;
  122. begin
  123.   Result := Smallint(FDelphiControl.DragCursor);
  124. end;
  125.  
  126. function TComboBoxX.Get_DragMode: TxDragMode;
  127. begin
  128.   Result := Ord(FDelphiControl.DragMode);
  129. end;
  130.  
  131. function TComboBoxX.Get_DropDownCount: Integer;
  132. begin
  133.   Result := FDelphiControl.DropDownCount;
  134. end;
  135.  
  136. function TComboBoxX.Get_DroppedDown: WordBool;
  137. begin
  138.   Result := FDelphiControl.DroppedDown;
  139. end;
  140.  
  141. function TComboBoxX.Get_Enabled: WordBool;
  142. begin
  143.   Result := FDelphiControl.Enabled;
  144. end;
  145.  
  146. function TComboBoxX.Get_Font: Font;
  147. begin
  148.   GetOleFont(FDelphiControl.Font, Result);
  149. end;
  150.  
  151. function TComboBoxX.Get_ImeMode: TxImeMode;
  152. begin
  153.   Result := Ord(FDelphiControl.ImeMode);
  154. end;
  155.  
  156. function TComboBoxX.Get_ImeName: WideString;
  157. begin
  158.   Result := WideString(FDelphiControl.ImeName);
  159. end;
  160.  
  161. function TComboBoxX.Get_ItemHeight: Integer;
  162. begin
  163.   Result := FDelphiControl.ItemHeight;
  164. end;
  165.  
  166. function TComboBoxX.Get_ItemIndex: Integer;
  167. begin
  168.   Result := FDelphiControl.ItemIndex;
  169. end;
  170.  
  171. function TComboBoxX.Get_Items: IStrings;
  172. begin
  173.   GetOleStrings(FDelphiControl.Items, Result);
  174. end;
  175.  
  176. function TComboBoxX.Get_MaxLength: Integer;
  177. begin
  178.   Result := FDelphiControl.MaxLength;
  179. end;
  180.  
  181. function TComboBoxX.Get_ParentColor: WordBool;
  182. begin
  183.   Result := FDelphiControl.ParentColor;
  184. end;
  185.  
  186. function TComboBoxX.Get_ParentCtl3D: WordBool;
  187. begin
  188.   Result := FDelphiControl.ParentCtl3D;
  189. end;
  190.  
  191. function TComboBoxX.Get_SelLength: Integer;
  192. begin
  193.   Result := FDelphiControl.SelLength;
  194. end;
  195.  
  196. function TComboBoxX.Get_SelStart: Integer;
  197. begin
  198.   Result := FDelphiControl.SelStart;
  199. end;
  200.  
  201. function TComboBoxX.Get_SelText: WideString;
  202. begin
  203.   Result := WideString(FDelphiControl.SelText);
  204. end;
  205.  
  206. function TComboBoxX.Get_Sorted: WordBool;
  207. begin
  208.   Result := FDelphiControl.Sorted;
  209. end;
  210.  
  211. function TComboBoxX.Get_Style: TxComboBoxStyle;
  212. begin
  213.   Result := Ord(FDelphiControl.Style);
  214. end;
  215.  
  216. function TComboBoxX.Get_Text: WideString;
  217. begin
  218.   Result := WideString(FDelphiControl.Text);
  219. end;
  220.  
  221. function TComboBoxX.Get_Visible: WordBool;
  222. begin
  223.   Result := FDelphiControl.Visible;
  224. end;
  225.  
  226. procedure TComboBoxX.AboutBox;
  227. begin
  228.   ShowComboBoxXAbout;
  229. end;
  230.  
  231. procedure TComboBoxX.Clear;
  232. begin
  233.  
  234. end;
  235.  
  236. procedure TComboBoxX.SelectAll;
  237. begin
  238.  
  239. end;
  240.  
  241. procedure TComboBoxX.Set_Color(Value: TColor);
  242. begin
  243.   FDelphiControl.Color := Value;
  244. end;
  245.  
  246. procedure TComboBoxX.Set_Ctl3D(Value: WordBool);
  247. begin
  248.   FDelphiControl.Ctl3D := Value;
  249. end;
  250.  
  251. procedure TComboBoxX.Set_Cursor(Value: Smallint);
  252. begin
  253.   FDelphiControl.Cursor := TCursor(Value);
  254. end;
  255.  
  256. procedure TComboBoxX.Set_DragCursor(Value: Smallint);
  257. begin
  258.   FDelphiControl.DragCursor := TCursor(Value);
  259. end;
  260.  
  261. procedure TComboBoxX.Set_DragMode(Value: TxDragMode);
  262. begin
  263.   FDelphiControl.DragMode := TDragMode(Value);
  264. end;
  265.  
  266. procedure TComboBoxX.Set_DropDownCount(Value: Integer);
  267. begin
  268.   FDelphiControl.DropDownCount := Value;
  269. end;
  270.  
  271. procedure TComboBoxX.Set_DroppedDown(Value: WordBool);
  272. begin
  273.   FDelphiControl.DroppedDown := Value;
  274. end;
  275.  
  276. procedure TComboBoxX.Set_Enabled(Value: WordBool);
  277. begin
  278.   FDelphiControl.Enabled := Value;
  279. end;
  280.  
  281. procedure TComboBoxX.Set_Font(const Value: Font);
  282. begin
  283.   SetOleFont(FDelphiControl.Font, Value);
  284. end;
  285.  
  286. procedure TComboBoxX.Set_ImeMode(Value: TxImeMode);
  287. begin
  288.   FDelphiControl.ImeMode := TImeMode(Value);
  289. end;
  290.  
  291. procedure TComboBoxX.Set_ImeName(const Value: WideString);
  292. begin
  293.   FDelphiControl.ImeName := TImeName(Value);
  294. end;
  295.  
  296. procedure TComboBoxX.Set_ItemHeight(Value: Integer);
  297. begin
  298.   FDelphiControl.ItemHeight := Value;
  299. end;
  300.  
  301. procedure TComboBoxX.Set_ItemIndex(Value: Integer);
  302. begin
  303.   FDelphiControl.ItemIndex := Value;
  304. end;
  305.  
  306. procedure TComboBoxX.Set_Items(const Value: IStrings);
  307. begin
  308.   SetOleStrings(FDelphiControl.Items, Value);
  309. end;
  310.  
  311. procedure TComboBoxX.Set_MaxLength(Value: Integer);
  312. begin
  313.   FDelphiControl.MaxLength := Value;
  314. end;
  315.  
  316. procedure TComboBoxX.Set_ParentColor(Value: WordBool);
  317. begin
  318.   FDelphiControl.ParentColor := Value;
  319. end;
  320.  
  321. procedure TComboBoxX.Set_ParentCtl3D(Value: WordBool);
  322. begin
  323.   FDelphiControl.ParentCtl3D := Value;
  324. end;
  325.  
  326. procedure TComboBoxX.Set_SelLength(Value: Integer);
  327. begin
  328.   FDelphiControl.SelLength := Value;
  329. end;
  330.  
  331. procedure TComboBoxX.Set_SelStart(Value: Integer);
  332. begin
  333.   FDelphiControl.SelStart := Value;
  334. end;
  335.  
  336. procedure TComboBoxX.Set_SelText(const Value: WideString);
  337. begin
  338.   FDelphiControl.SelText := String(Value);
  339. end;
  340.  
  341. procedure TComboBoxX.Set_Sorted(Value: WordBool);
  342. begin
  343.   FDelphiControl.Sorted := Value;
  344. end;
  345.  
  346. procedure TComboBoxX.Set_Style(Value: TxComboBoxStyle);
  347. begin
  348.   FDelphiControl.Style := TComboBoxStyle(Value);
  349. end;
  350.  
  351. procedure TComboBoxX.Set_Text(const Value: WideString);
  352. begin
  353.   FDelphiControl.Text := TCaption(Value);
  354. end;
  355.  
  356. procedure TComboBoxX.Set_Visible(Value: WordBool);
  357. begin
  358.   FDelphiControl.Visible := Value;
  359. end;
  360.  
  361. procedure TComboBoxX.ChangeEvent(Sender: TObject);
  362. begin
  363.   if FEvents <> nil then FEvents.OnChange;
  364. end;
  365.  
  366. procedure TComboBoxX.ClickEvent(Sender: TObject);
  367. begin
  368.   if FEvents <> nil then FEvents.OnClick;
  369. end;
  370.  
  371. procedure TComboBoxX.DblClickEvent(Sender: TObject);
  372. begin
  373.   if FEvents <> nil then FEvents.OnDblClick;
  374. end;
  375.  
  376. procedure TComboBoxX.DropDownEvent(Sender: TObject);
  377. begin
  378.   if FEvents <> nil then FEvents.OnDropDown;
  379. end;
  380.  
  381. procedure TComboBoxX.KeyPressEvent(Sender: TObject; var Key: Char);
  382. var
  383.   TempKey: Smallint;
  384. begin
  385.   TempKey := Smallint(Key);
  386.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  387.   Key := Char(TempKey);
  388. end;
  389.  
  390. initialization
  391.   TActiveXControlFactory.Create(
  392.     ComServer,
  393.     TComboBoxX,
  394.     TComboBox,
  395.     Class_ComboBoxX,
  396.     7,
  397.     '{FA7B832F-9ED7-11D0-AA40-444553540000}',
  398.     0);
  399. end.
  400.