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

  1. unit MemoImpl1;
  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.   TMemoX = class(TActiveXControl, IMemoX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TMemo;
  14.     FEvents: IMemoXEvents;
  15.     procedure ChangeEvent(Sender: TObject);
  16.     procedure ClickEvent(Sender: TObject);
  17.     procedure DblClickEvent(Sender: TObject);
  18.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  19.   protected
  20.     { Protected declarations }
  21.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  22.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  23.     procedure InitializeControl; override;
  24.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  25.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  26.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  27.     function Get_Alignment: TxAlignment; safecall;
  28.     function Get_BiDiMode: TxBiDiMode; safecall;
  29.     function Get_BorderStyle: TxBorderStyle; safecall;
  30.     function Get_CanUndo: WordBool; safecall;
  31.     function Get_Color: OLE_COLOR; 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_Font: IFontDisp; safecall;
  39.     function Get_HideSelection: WordBool; safecall;
  40.     function Get_ImeMode: TxImeMode; safecall;
  41.     function Get_ImeName: WideString; safecall;
  42.     function Get_Lines: IStrings; safecall;
  43.     function Get_MaxLength: Integer; safecall;
  44.     function Get_Modified: WordBool; safecall;
  45.     function Get_OEMConvert: WordBool; safecall;
  46.     function Get_ParentColor: WordBool; safecall;
  47.     function Get_ParentCtl3D: WordBool; safecall;
  48.     function Get_ParentFont: WordBool; safecall;
  49.     function Get_ReadOnly: WordBool; safecall;
  50.     function Get_ScrollBars: TxScrollStyle; safecall;
  51.     function Get_SelLength: Integer; safecall;
  52.     function Get_SelStart: Integer; safecall;
  53.     function Get_SelText: WideString; safecall;
  54.     function Get_Text: WideString; safecall;
  55.     function Get_Visible: WordBool; safecall;
  56.     function Get_WantReturns: WordBool; safecall;
  57.     function Get_WantTabs: WordBool; safecall;
  58.     function Get_WordWrap: WordBool; safecall;
  59.     function GetControlsAlignment: TxAlignment; safecall;
  60.     function IsRightToLeft: WordBool; safecall;
  61.     function UseRightToLeftAlignment: WordBool; safecall;
  62.     function UseRightToLeftReading: WordBool; safecall;
  63.     function UseRightToLeftScrollBar: WordBool; safecall;
  64.     procedure _Set_Font(const Value: IFontDisp); safecall;
  65.     procedure AboutBox; safecall;
  66.     procedure Clear; safecall;
  67.     procedure ClearSelection; safecall;
  68.     procedure ClearUndo; safecall;
  69.     procedure CopyToClipboard; safecall;
  70.     procedure CutToClipboard; safecall;
  71.     procedure FlipChildren(AllLevels: WordBool); safecall;
  72.     procedure InitiateAction; safecall;
  73.     procedure PasteFromClipboard; safecall;
  74.     procedure SelectAll; safecall;
  75.     procedure Set_Alignment(Value: TxAlignment); safecall;
  76.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  77.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  78.     procedure Set_Color(Value: OLE_COLOR); safecall;
  79.     procedure Set_Ctl3D(Value: WordBool); safecall;
  80.     procedure Set_Cursor(Value: Smallint); safecall;
  81.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  82.     procedure Set_DragCursor(Value: Smallint); safecall;
  83.     procedure Set_DragMode(Value: TxDragMode); safecall;
  84.     procedure Set_Enabled(Value: WordBool); safecall;
  85.     procedure Set_Font(const Value: IFontDisp); safecall;
  86.     procedure Set_HideSelection(Value: WordBool); safecall;
  87.     procedure Set_ImeMode(Value: TxImeMode); safecall;
  88.     procedure Set_ImeName(const Value: WideString); safecall;
  89.     procedure Set_Lines(const Value: IStrings); safecall;
  90.     procedure Set_MaxLength(Value: Integer); safecall;
  91.     procedure Set_Modified(Value: WordBool); safecall;
  92.     procedure Set_OEMConvert(Value: WordBool); safecall;
  93.     procedure Set_ParentColor(Value: WordBool); safecall;
  94.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  95.     procedure Set_ParentFont(Value: WordBool); safecall;
  96.     procedure Set_ReadOnly(Value: WordBool); safecall;
  97.     procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
  98.     procedure Set_SelLength(Value: Integer); safecall;
  99.     procedure Set_SelStart(Value: Integer); safecall;
  100.     procedure Set_SelText(const Value: WideString); safecall;
  101.     procedure Set_Text(const Value: WideString); safecall;
  102.     procedure Set_Visible(Value: WordBool); safecall;
  103.     procedure Set_WantReturns(Value: WordBool); safecall;
  104.     procedure Set_WantTabs(Value: WordBool); safecall;
  105.     procedure Set_WordWrap(Value: WordBool); safecall;
  106.     procedure Undo; safecall;
  107.   end;
  108.  
  109. implementation
  110.  
  111. uses ComObj, About17;
  112.  
  113. { TMemoX }
  114.  
  115. procedure TMemoX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  116. begin
  117.   { Define property pages here.  Property pages are defined by calling
  118.     DefinePropertyPage with the class id of the page.  For example,
  119.       DefinePropertyPage(Class_MemoXPage); }
  120. end;
  121.  
  122. procedure TMemoX.EventSinkChanged(const EventSink: IUnknown);
  123. begin
  124.   FEvents := EventSink as IMemoXEvents;
  125. end;
  126.  
  127. procedure TMemoX.InitializeControl;
  128. begin
  129.   FDelphiControl := Control as TMemo;
  130.   FDelphiControl.OnChange := ChangeEvent;
  131.   FDelphiControl.OnClick := ClickEvent;
  132.   FDelphiControl.OnDblClick := DblClickEvent;
  133.   FDelphiControl.OnKeyPress := KeyPressEvent;
  134. end;
  135.  
  136. function TMemoX.ClassNameIs(const Name: WideString): WordBool;
  137. begin
  138.   Result := FDelphiControl.ClassNameIs(Name);
  139. end;
  140.  
  141. function TMemoX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  142. begin
  143.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  144. end;
  145.  
  146. function TMemoX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  147. begin
  148.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  149. end;
  150.  
  151. function TMemoX.Get_Alignment: TxAlignment;
  152. begin
  153.   Result := Ord(FDelphiControl.Alignment);
  154. end;
  155.  
  156. function TMemoX.Get_BiDiMode: TxBiDiMode;
  157. begin
  158.   Result := Ord(FDelphiControl.BiDiMode);
  159. end;
  160.  
  161. function TMemoX.Get_BorderStyle: TxBorderStyle;
  162. begin
  163.   Result := Ord(FDelphiControl.BorderStyle);
  164. end;
  165.  
  166. function TMemoX.Get_CanUndo: WordBool;
  167. begin
  168.   Result := FDelphiControl.CanUndo;
  169. end;
  170.  
  171. function TMemoX.Get_Color: OLE_COLOR;
  172. begin
  173.   Result := OLE_COLOR(FDelphiControl.Color);
  174. end;
  175.  
  176. function TMemoX.Get_Ctl3D: WordBool;
  177. begin
  178.   Result := FDelphiControl.Ctl3D;
  179. end;
  180.  
  181. function TMemoX.Get_Cursor: Smallint;
  182. begin
  183.   Result := Smallint(FDelphiControl.Cursor);
  184. end;
  185.  
  186. function TMemoX.Get_DoubleBuffered: WordBool;
  187. begin
  188.   Result := FDelphiControl.DoubleBuffered;
  189. end;
  190.  
  191. function TMemoX.Get_DragCursor: Smallint;
  192. begin
  193.   Result := Smallint(FDelphiControl.DragCursor);
  194. end;
  195.  
  196. function TMemoX.Get_DragMode: TxDragMode;
  197. begin
  198.   Result := Ord(FDelphiControl.DragMode);
  199. end;
  200.  
  201. function TMemoX.Get_Enabled: WordBool;
  202. begin
  203.   Result := FDelphiControl.Enabled;
  204. end;
  205.  
  206. function TMemoX.Get_Font: IFontDisp;
  207. begin
  208.   GetOleFont(FDelphiControl.Font, Result);
  209. end;
  210.  
  211. function TMemoX.Get_HideSelection: WordBool;
  212. begin
  213.   Result := FDelphiControl.HideSelection;
  214. end;
  215.  
  216. function TMemoX.Get_ImeMode: TxImeMode;
  217. begin
  218.   Result := Ord(FDelphiControl.ImeMode);
  219. end;
  220.  
  221. function TMemoX.Get_ImeName: WideString;
  222. begin
  223.   Result := WideString(FDelphiControl.ImeName);
  224. end;
  225.  
  226. function TMemoX.Get_Lines: IStrings;
  227. begin
  228.   GetOleStrings(FDelphiControl.Lines, Result);
  229. end;
  230.  
  231. function TMemoX.Get_MaxLength: Integer;
  232. begin
  233.   Result := FDelphiControl.MaxLength;
  234. end;
  235.  
  236. function TMemoX.Get_Modified: WordBool;
  237. begin
  238.   Result := FDelphiControl.Modified;
  239. end;
  240.  
  241. function TMemoX.Get_OEMConvert: WordBool;
  242. begin
  243.   Result := FDelphiControl.OEMConvert;
  244. end;
  245.  
  246. function TMemoX.Get_ParentColor: WordBool;
  247. begin
  248.   Result := FDelphiControl.ParentColor;
  249. end;
  250.  
  251. function TMemoX.Get_ParentCtl3D: WordBool;
  252. begin
  253.   Result := FDelphiControl.ParentCtl3D;
  254. end;
  255.  
  256. function TMemoX.Get_ParentFont: WordBool;
  257. begin
  258.   Result := FDelphiControl.ParentFont;
  259. end;
  260.  
  261. function TMemoX.Get_ReadOnly: WordBool;
  262. begin
  263.   Result := FDelphiControl.ReadOnly;
  264. end;
  265.  
  266. function TMemoX.Get_ScrollBars: TxScrollStyle;
  267. begin
  268.   Result := Ord(FDelphiControl.ScrollBars);
  269. end;
  270.  
  271. function TMemoX.Get_SelLength: Integer;
  272. begin
  273.   Result := FDelphiControl.SelLength;
  274. end;
  275.  
  276. function TMemoX.Get_SelStart: Integer;
  277. begin
  278.   Result := FDelphiControl.SelStart;
  279. end;
  280.  
  281. function TMemoX.Get_SelText: WideString;
  282. begin
  283.   Result := WideString(FDelphiControl.SelText);
  284. end;
  285.  
  286. function TMemoX.Get_Text: WideString;
  287. begin
  288.   Result := WideString(FDelphiControl.Text);
  289. end;
  290.  
  291. function TMemoX.Get_Visible: WordBool;
  292. begin
  293.   Result := FDelphiControl.Visible;
  294. end;
  295.  
  296. function TMemoX.Get_WantReturns: WordBool;
  297. begin
  298.   Result := FDelphiControl.WantReturns;
  299. end;
  300.  
  301. function TMemoX.Get_WantTabs: WordBool;
  302. begin
  303.   Result := FDelphiControl.WantTabs;
  304. end;
  305.  
  306. function TMemoX.Get_WordWrap: WordBool;
  307. begin
  308.   Result := FDelphiControl.WordWrap;
  309. end;
  310.  
  311. function TMemoX.GetControlsAlignment: TxAlignment;
  312. begin
  313.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  314. end;
  315.  
  316. function TMemoX.IsRightToLeft: WordBool;
  317. begin
  318.   Result := FDelphiControl.IsRightToLeft;
  319. end;
  320.  
  321. function TMemoX.UseRightToLeftAlignment: WordBool;
  322. begin
  323.   Result := FDelphiControl.UseRightToLeftAlignment;
  324. end;
  325.  
  326. function TMemoX.UseRightToLeftReading: WordBool;
  327. begin
  328.   Result := FDelphiControl.UseRightToLeftReading;
  329. end;
  330.  
  331. function TMemoX.UseRightToLeftScrollBar: WordBool;
  332. begin
  333.   Result := FDelphiControl.UseRightToLeftScrollBar;
  334. end;
  335.  
  336. procedure TMemoX._Set_Font(const Value: IFontDisp);
  337. begin
  338.   SetOleFont(FDelphiControl.Font, Value);
  339. end;
  340.  
  341. procedure TMemoX.AboutBox;
  342. begin
  343.   ShowMemoXAbout;
  344. end;
  345.  
  346. procedure TMemoX.Clear;
  347. begin
  348.   FDelphiControl.Clear;
  349. end;
  350.  
  351. procedure TMemoX.ClearSelection;
  352. begin
  353.   FDelphiControl.ClearSelection;
  354. end;
  355.  
  356. procedure TMemoX.ClearUndo;
  357. begin
  358.   FDelphiControl.ClearUndo;
  359. end;
  360.  
  361. procedure TMemoX.CopyToClipboard;
  362. begin
  363.   FDelphiControl.CopyToClipboard;
  364. end;
  365.  
  366. procedure TMemoX.CutToClipboard;
  367. begin
  368.   FDelphiControl.CutToClipboard;
  369. end;
  370.  
  371. procedure TMemoX.FlipChildren(AllLevels: WordBool);
  372. begin
  373.   FDelphiControl.FlipChildren(AllLevels);
  374. end;
  375.  
  376. procedure TMemoX.InitiateAction;
  377. begin
  378.   FDelphiControl.InitiateAction;
  379. end;
  380.  
  381. procedure TMemoX.PasteFromClipboard;
  382. begin
  383.   FDelphiControl.PasteFromClipboard;
  384. end;
  385.  
  386. procedure TMemoX.SelectAll;
  387. begin
  388.   FDelphiControl.SelectAll;
  389. end;
  390.  
  391. procedure TMemoX.Set_Alignment(Value: TxAlignment);
  392. begin
  393.   FDelphiControl.Alignment := TAlignment(Value);
  394. end;
  395.  
  396. procedure TMemoX.Set_BiDiMode(Value: TxBiDiMode);
  397. begin
  398.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  399. end;
  400.  
  401. procedure TMemoX.Set_BorderStyle(Value: TxBorderStyle);
  402. begin
  403.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  404. end;
  405.  
  406. procedure TMemoX.Set_Color(Value: OLE_COLOR);
  407. begin
  408.   FDelphiControl.Color := TColor(Value);
  409. end;
  410.  
  411. procedure TMemoX.Set_Ctl3D(Value: WordBool);
  412. begin
  413.   FDelphiControl.Ctl3D := Value;
  414. end;
  415.  
  416. procedure TMemoX.Set_Cursor(Value: Smallint);
  417. begin
  418.   FDelphiControl.Cursor := TCursor(Value);
  419. end;
  420.  
  421. procedure TMemoX.Set_DoubleBuffered(Value: WordBool);
  422. begin
  423.   FDelphiControl.DoubleBuffered := Value;
  424. end;
  425.  
  426. procedure TMemoX.Set_DragCursor(Value: Smallint);
  427. begin
  428.   FDelphiControl.DragCursor := TCursor(Value);
  429. end;
  430.  
  431. procedure TMemoX.Set_DragMode(Value: TxDragMode);
  432. begin
  433.   FDelphiControl.DragMode := TDragMode(Value);
  434. end;
  435.  
  436. procedure TMemoX.Set_Enabled(Value: WordBool);
  437. begin
  438.   FDelphiControl.Enabled := Value;
  439. end;
  440.  
  441. procedure TMemoX.Set_Font(const Value: IFontDisp);
  442. begin
  443.   SetOleFont(FDelphiControl.Font, Value);
  444. end;
  445.  
  446. procedure TMemoX.Set_HideSelection(Value: WordBool);
  447. begin
  448.   FDelphiControl.HideSelection := Value;
  449. end;
  450.  
  451. procedure TMemoX.Set_ImeMode(Value: TxImeMode);
  452. begin
  453.   FDelphiControl.ImeMode := TImeMode(Value);
  454. end;
  455.  
  456. procedure TMemoX.Set_ImeName(const Value: WideString);
  457. begin
  458.   FDelphiControl.ImeName := TImeName(Value);
  459. end;
  460.  
  461. procedure TMemoX.Set_Lines(const Value: IStrings);
  462. begin
  463.   SetOleStrings(FDelphiControl.Lines, Value);
  464. end;
  465.  
  466. procedure TMemoX.Set_MaxLength(Value: Integer);
  467. begin
  468.   FDelphiControl.MaxLength := Value;
  469. end;
  470.  
  471. procedure TMemoX.Set_Modified(Value: WordBool);
  472. begin
  473.   FDelphiControl.Modified := Value;
  474. end;
  475.  
  476. procedure TMemoX.Set_OEMConvert(Value: WordBool);
  477. begin
  478.   FDelphiControl.OEMConvert := Value;
  479. end;
  480.  
  481. procedure TMemoX.Set_ParentColor(Value: WordBool);
  482. begin
  483.   FDelphiControl.ParentColor := Value;
  484. end;
  485.  
  486. procedure TMemoX.Set_ParentCtl3D(Value: WordBool);
  487. begin
  488.   FDelphiControl.ParentCtl3D := Value;
  489. end;
  490.  
  491. procedure TMemoX.Set_ParentFont(Value: WordBool);
  492. begin
  493.   FDelphiControl.ParentFont := Value;
  494. end;
  495.  
  496. procedure TMemoX.Set_ReadOnly(Value: WordBool);
  497. begin
  498.   FDelphiControl.ReadOnly := Value;
  499. end;
  500.  
  501. procedure TMemoX.Set_ScrollBars(Value: TxScrollStyle);
  502. begin
  503.   FDelphiControl.ScrollBars := TScrollStyle(Value);
  504. end;
  505.  
  506. procedure TMemoX.Set_SelLength(Value: Integer);
  507. begin
  508.   FDelphiControl.SelLength := Value;
  509. end;
  510.  
  511. procedure TMemoX.Set_SelStart(Value: Integer);
  512. begin
  513.   FDelphiControl.SelStart := Value;
  514. end;
  515.  
  516. procedure TMemoX.Set_SelText(const Value: WideString);
  517. begin
  518.   FDelphiControl.SelText := String(Value);
  519. end;
  520.  
  521. procedure TMemoX.Set_Text(const Value: WideString);
  522. begin
  523.   FDelphiControl.Text := TCaption(Value);
  524. end;
  525.  
  526. procedure TMemoX.Set_Visible(Value: WordBool);
  527. begin
  528.   FDelphiControl.Visible := Value;
  529. end;
  530.  
  531. procedure TMemoX.Set_WantReturns(Value: WordBool);
  532. begin
  533.   FDelphiControl.WantReturns := Value;
  534. end;
  535.  
  536. procedure TMemoX.Set_WantTabs(Value: WordBool);
  537. begin
  538.   FDelphiControl.WantTabs := Value;
  539. end;
  540.  
  541. procedure TMemoX.Set_WordWrap(Value: WordBool);
  542. begin
  543.   FDelphiControl.WordWrap := Value;
  544. end;
  545.  
  546. procedure TMemoX.Undo;
  547. begin
  548.   FDelphiControl.Undo;
  549. end;
  550.  
  551. procedure TMemoX.ChangeEvent(Sender: TObject);
  552. begin
  553.   if FEvents <> nil then FEvents.OnChange;
  554. end;
  555.  
  556. procedure TMemoX.ClickEvent(Sender: TObject);
  557. begin
  558.   if FEvents <> nil then FEvents.OnClick;
  559. end;
  560.  
  561. procedure TMemoX.DblClickEvent(Sender: TObject);
  562. begin
  563.   if FEvents <> nil then FEvents.OnDblClick;
  564. end;
  565.  
  566. procedure TMemoX.KeyPressEvent(Sender: TObject; var Key: Char);
  567. var
  568.   TempKey: Smallint;
  569. begin
  570.   TempKey := Smallint(Key);
  571.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  572.   Key := Char(TempKey);
  573. end;
  574.  
  575. initialization
  576.   TActiveXControlFactory.Create(
  577.     ComServer,
  578.     TMemoX,
  579.     TMemo,
  580.     Class_MemoX,
  581.     17,
  582.     '{695CDB59-02E5-11D2-B20D-00C04FA368D4}',
  583.     0,
  584.     tmApartment);
  585. end.
  586.