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

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