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

  1. unit RedtImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelC_TLB, ComCtrls;
  8.  
  9. type
  10.   TRichEditX = class(TActiveXControl, IRichEditX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TRichEdit;
  14.     FEvents: IRichEditXEvents;
  15.     procedure ChangeEvent(Sender: TObject);
  16.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  17.     procedure ProtectChangeEvent(Sender: TObject; StartPos, EndPos: Integer;
  18.       var AllowChange: Boolean);
  19.     procedure SaveClipboardEvent(Sender: TObject; NumObjects,
  20.       NumChars: Integer; var SaveClipboard: Boolean);
  21.     procedure SelectionChangeEvent(Sender: TObject);
  22.   protected
  23.     { Protected declarations }
  24.     procedure InitializeControl; override;
  25.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  26.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  27.     function Get_Alignment: TxAlignment; safecall;
  28.     function Get_BorderStyle: TxBorderStyle; safecall;
  29.     function Get_Color: TColor; safecall;
  30.     function Get_Ctl3D: WordBool; safecall;
  31.     function Get_Cursor: Smallint; safecall;
  32.     function Get_DragCursor: Smallint; safecall;
  33.     function Get_DragMode: TxDragMode; safecall;
  34.     function Get_Enabled: WordBool; safecall;
  35.     function Get_Font: Font; safecall;
  36.     function Get_HideScrollBars: WordBool; safecall;
  37.     function Get_HideSelection: WordBool; safecall;
  38.     function Get_ImeMode: TxImeMode; safecall;
  39.     function Get_ImeName: WideString; safecall;
  40.     function Get_Lines: IStrings; safecall;
  41.     function Get_MaxLength: Integer; safecall;
  42.     function Get_Modified: WordBool; safecall;
  43.     function Get_ParentColor: WordBool; safecall;
  44.     function Get_ParentCtl3D: WordBool; safecall;
  45.     function Get_PlainText: WordBool; safecall;
  46.     function Get_ReadOnly: WordBool; safecall;
  47.     function Get_ScrollBars: TxScrollStyle; safecall;
  48.     function Get_SelLength: Integer; safecall;
  49.     function Get_SelStart: Integer; safecall;
  50.     function Get_SelText: WideString; safecall;
  51.     function Get_Text: WideString; safecall;
  52.     function Get_Visible: WordBool; safecall;
  53.     function Get_WantReturns: WordBool; safecall;
  54.     function Get_WantTabs: WordBool; safecall;
  55.     function Get_WordWrap: WordBool; safecall;
  56.     procedure AboutBox; safecall;
  57.     procedure Clear; safecall;
  58.     procedure ClearSelection; safecall;
  59.     procedure CopyToClipboard; safecall;
  60.     procedure CutToClipboard; safecall;
  61.     procedure PasteFromClipboard; safecall;
  62.     procedure Print(const Caption: WideString); safecall;
  63.     procedure SelectAll; safecall;
  64.     procedure Set_Alignment(Value: TxAlignment); safecall;
  65.     procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
  66.     procedure Set_Color(Value: TColor); safecall;
  67.     procedure Set_Ctl3D(Value: WordBool); safecall;
  68.     procedure Set_Cursor(Value: Smallint); safecall;
  69.     procedure Set_DragCursor(Value: Smallint); safecall;
  70.     procedure Set_DragMode(Value: TxDragMode); safecall;
  71.     procedure Set_Enabled(Value: WordBool); safecall;
  72.     procedure Set_Font(const Value: Font); safecall;
  73.     procedure Set_HideScrollBars(Value: WordBool); safecall;
  74.     procedure Set_HideSelection(Value: WordBool); safecall;
  75.     procedure Set_ImeMode(Value: TxImeMode); safecall;
  76.     procedure Set_ImeName(const Value: WideString); safecall;
  77.     procedure Set_Lines(const Value: IStrings); safecall;
  78.     procedure Set_MaxLength(Value: Integer); safecall;
  79.     procedure Set_Modified(Value: WordBool); safecall;
  80.     procedure Set_ParentColor(Value: WordBool); safecall;
  81.     procedure Set_ParentCtl3D(Value: WordBool); safecall;
  82.     procedure Set_PlainText(Value: WordBool); safecall;
  83.     procedure Set_ReadOnly(Value: WordBool); safecall;
  84.     procedure Set_ScrollBars(Value: TxScrollStyle); safecall;
  85.     procedure Set_SelLength(Value: Integer); safecall;
  86.     procedure Set_SelStart(Value: Integer); safecall;
  87.     procedure Set_SelText(const Value: WideString); safecall;
  88.     procedure Set_Text(const Value: WideString); safecall;
  89.     procedure Set_Visible(Value: WordBool); safecall;
  90.     procedure Set_WantReturns(Value: WordBool); safecall;
  91.     procedure Set_WantTabs(Value: WordBool); safecall;
  92.     procedure Set_WordWrap(Value: WordBool); safecall;
  93.   end;
  94.  
  95. implementation
  96.  
  97. uses About23;
  98.  
  99. { TRichEditX }
  100.  
  101. procedure TRichEditX.InitializeControl;
  102. begin
  103.   FDelphiControl := Control as TRichEdit;
  104.   FDelphiControl.OnChange := ChangeEvent;
  105.   FDelphiControl.OnKeyPress := KeyPressEvent;
  106.   FDelphiControl.OnProtectChange := ProtectChangeEvent;
  107.   FDelphiControl.OnSaveClipboard := SaveClipboardEvent;
  108.   FDelphiControl.OnSelectionChange := SelectionChangeEvent;
  109. end;
  110.  
  111. procedure TRichEditX.EventSinkChanged(const EventSink: IUnknown);
  112. begin
  113.   FEvents := EventSink as IRichEditXEvents;
  114. end;
  115.  
  116. procedure TRichEditX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  117. begin
  118.   { Define property pages here.  Property pages are defined by calling
  119.     DefinePropertyPage with the class id of the page.  For example,
  120.       DefinePropertyPage(Class_RichEditXPage); }
  121. end;
  122.  
  123. function TRichEditX.Get_Alignment: TxAlignment;
  124. begin
  125.   Result := Ord(FDelphiControl.Alignment);
  126. end;
  127.  
  128. function TRichEditX.Get_BorderStyle: TxBorderStyle;
  129. begin
  130.   Result := Ord(FDelphiControl.BorderStyle);
  131. end;
  132.  
  133. function TRichEditX.Get_Color: TColor;
  134. begin
  135.   Result := FDelphiControl.Color;
  136. end;
  137.  
  138. function TRichEditX.Get_Ctl3D: WordBool;
  139. begin
  140.   Result := FDelphiControl.Ctl3D;
  141. end;
  142.  
  143. function TRichEditX.Get_Cursor: Smallint;
  144. begin
  145.   Result := Smallint(FDelphiControl.Cursor);
  146. end;
  147.  
  148. function TRichEditX.Get_DragCursor: Smallint;
  149. begin
  150.   Result := Smallint(FDelphiControl.DragCursor);
  151. end;
  152.  
  153. function TRichEditX.Get_DragMode: TxDragMode;
  154. begin
  155.   Result := Ord(FDelphiControl.DragMode);
  156. end;
  157.  
  158. function TRichEditX.Get_Enabled: WordBool;
  159. begin
  160.   Result := FDelphiControl.Enabled;
  161. end;
  162.  
  163. function TRichEditX.Get_Font: Font;
  164. begin
  165.   GetOleFont(FDelphiControl.Font, Result);
  166. end;
  167.  
  168. function TRichEditX.Get_HideScrollBars: WordBool;
  169. begin
  170.   Result := FDelphiControl.HideScrollBars;
  171. end;
  172.  
  173. function TRichEditX.Get_HideSelection: WordBool;
  174. begin
  175.   Result := FDelphiControl.HideSelection;
  176. end;
  177.  
  178. function TRichEditX.Get_ImeMode: TxImeMode;
  179. begin
  180.   Result := Ord(FDelphiControl.ImeMode);
  181. end;
  182.  
  183. function TRichEditX.Get_ImeName: WideString;
  184. begin
  185.   Result := WideString(FDelphiControl.ImeName);
  186. end;
  187.  
  188. function TRichEditX.Get_Lines: IStrings;
  189. begin
  190.   GetOleStrings(FDelphiControl.Lines, Result);
  191. end;
  192.  
  193. function TRichEditX.Get_MaxLength: Integer;
  194. begin
  195.   Result := FDelphiControl.MaxLength;
  196. end;
  197.  
  198. function TRichEditX.Get_Modified: WordBool;
  199. begin
  200.   Result := FDelphiControl.Modified;
  201. end;
  202.  
  203. function TRichEditX.Get_ParentColor: WordBool;
  204. begin
  205.   Result := FDelphiControl.ParentColor;
  206. end;
  207.  
  208. function TRichEditX.Get_ParentCtl3D: WordBool;
  209. begin
  210.   Result := FDelphiControl.ParentCtl3D;
  211. end;
  212.  
  213. function TRichEditX.Get_PlainText: WordBool;
  214. begin
  215.   Result := FDelphiControl.PlainText;
  216. end;
  217.  
  218. function TRichEditX.Get_ReadOnly: WordBool;
  219. begin
  220.   Result := FDelphiControl.ReadOnly;
  221. end;
  222.  
  223. function TRichEditX.Get_ScrollBars: TxScrollStyle;
  224. begin
  225.   Result := Ord(FDelphiControl.ScrollBars);
  226. end;
  227.  
  228. function TRichEditX.Get_SelLength: Integer;
  229. begin
  230.   Result := FDelphiControl.SelLength;
  231. end;
  232.  
  233. function TRichEditX.Get_SelStart: Integer;
  234. begin
  235.   Result := FDelphiControl.SelStart;
  236. end;
  237.  
  238. function TRichEditX.Get_SelText: WideString;
  239. begin
  240.   Result := WideString(FDelphiControl.SelText);
  241. end;
  242.  
  243. function TRichEditX.Get_Text: WideString;
  244. begin
  245.   Result := WideString(FDelphiControl.Text);
  246. end;
  247.  
  248. function TRichEditX.Get_Visible: WordBool;
  249. begin
  250.   Result := FDelphiControl.Visible;
  251. end;
  252.  
  253. function TRichEditX.Get_WantReturns: WordBool;
  254. begin
  255.   Result := FDelphiControl.WantReturns;
  256. end;
  257.  
  258. function TRichEditX.Get_WantTabs: WordBool;
  259. begin
  260.   Result := FDelphiControl.WantTabs;
  261. end;
  262.  
  263. function TRichEditX.Get_WordWrap: WordBool;
  264. begin
  265.   Result := FDelphiControl.WordWrap;
  266. end;
  267.  
  268. procedure TRichEditX.AboutBox;
  269. begin
  270.   ShowRichEditXAbout;
  271. end;
  272.  
  273. procedure TRichEditX.Clear;
  274. begin
  275.  
  276. end;
  277.  
  278. procedure TRichEditX.ClearSelection;
  279. begin
  280.  
  281. end;
  282.  
  283. procedure TRichEditX.CopyToClipboard;
  284. begin
  285.  
  286. end;
  287.  
  288. procedure TRichEditX.CutToClipboard;
  289. begin
  290.  
  291. end;
  292.  
  293. procedure TRichEditX.PasteFromClipboard;
  294. begin
  295.  
  296. end;
  297.  
  298. procedure TRichEditX.Print(const Caption: WideString);
  299. begin
  300.  
  301. end;
  302.  
  303. procedure TRichEditX.SelectAll;
  304. begin
  305.  
  306. end;
  307.  
  308. procedure TRichEditX.Set_Alignment(Value: TxAlignment);
  309. begin
  310.   FDelphiControl.Alignment := TAlignment(Value);
  311. end;
  312.  
  313. procedure TRichEditX.Set_BorderStyle(Value: TxBorderStyle);
  314. begin
  315.   FDelphiControl.BorderStyle := TBorderStyle(Value);
  316. end;
  317.  
  318. procedure TRichEditX.Set_Color(Value: TColor);
  319. begin
  320.   FDelphiControl.Color := Value;
  321. end;
  322.  
  323. procedure TRichEditX.Set_Ctl3D(Value: WordBool);
  324. begin
  325.   FDelphiControl.Ctl3D := Value;
  326. end;
  327.  
  328. procedure TRichEditX.Set_Cursor(Value: Smallint);
  329. begin
  330.   FDelphiControl.Cursor := TCursor(Value);
  331. end;
  332.  
  333. procedure TRichEditX.Set_DragCursor(Value: Smallint);
  334. begin
  335.   FDelphiControl.DragCursor := TCursor(Value);
  336. end;
  337.  
  338. procedure TRichEditX.Set_DragMode(Value: TxDragMode);
  339. begin
  340.   FDelphiControl.DragMode := TDragMode(Value);
  341. end;
  342.  
  343. procedure TRichEditX.Set_Enabled(Value: WordBool);
  344. begin
  345.   FDelphiControl.Enabled := Value;
  346. end;
  347.  
  348. procedure TRichEditX.Set_Font(const Value: Font);
  349. begin
  350.   SetOleFont(FDelphiControl.Font, Value);
  351. end;
  352.  
  353. procedure TRichEditX.Set_HideScrollBars(Value: WordBool);
  354. begin
  355.   FDelphiControl.HideScrollBars := Value;
  356. end;
  357.  
  358. procedure TRichEditX.Set_HideSelection(Value: WordBool);
  359. begin
  360.   FDelphiControl.HideSelection := Value;
  361. end;
  362.  
  363. procedure TRichEditX.Set_ImeMode(Value: TxImeMode);
  364. begin
  365.   FDelphiControl.ImeMode := TImeMode(Value);
  366. end;
  367.  
  368. procedure TRichEditX.Set_ImeName(const Value: WideString);
  369. begin
  370.   FDelphiControl.ImeName := TImeName(Value);
  371. end;
  372.  
  373. procedure TRichEditX.Set_Lines(const Value: IStrings);
  374. begin
  375.   SetOleStrings(FDelphiControl.Lines, Value);
  376. end;
  377.  
  378. procedure TRichEditX.Set_MaxLength(Value: Integer);
  379. begin
  380.   FDelphiControl.MaxLength := Value;
  381. end;
  382.  
  383. procedure TRichEditX.Set_Modified(Value: WordBool);
  384. begin
  385.   FDelphiControl.Modified := Value;
  386. end;
  387.  
  388. procedure TRichEditX.Set_ParentColor(Value: WordBool);
  389. begin
  390.   FDelphiControl.ParentColor := Value;
  391. end;
  392.  
  393. procedure TRichEditX.Set_ParentCtl3D(Value: WordBool);
  394. begin
  395.   FDelphiControl.ParentCtl3D := Value;
  396. end;
  397.  
  398. procedure TRichEditX.Set_PlainText(Value: WordBool);
  399. begin
  400.   FDelphiControl.PlainText := Value;
  401. end;
  402.  
  403. procedure TRichEditX.Set_ReadOnly(Value: WordBool);
  404. begin
  405.   FDelphiControl.ReadOnly := Value;
  406. end;
  407.  
  408. procedure TRichEditX.Set_ScrollBars(Value: TxScrollStyle);
  409. begin
  410.   FDelphiControl.ScrollBars := TScrollStyle(Value);
  411. end;
  412.  
  413. procedure TRichEditX.Set_SelLength(Value: Integer);
  414. begin
  415.   FDelphiControl.SelLength := Value;
  416. end;
  417.  
  418. procedure TRichEditX.Set_SelStart(Value: Integer);
  419. begin
  420.   FDelphiControl.SelStart := Value;
  421. end;
  422.  
  423. procedure TRichEditX.Set_SelText(const Value: WideString);
  424. begin
  425.   FDelphiControl.SelText := String(Value);
  426. end;
  427.  
  428. procedure TRichEditX.Set_Text(const Value: WideString);
  429. begin
  430.   FDelphiControl.Text := TCaption(Value);
  431. end;
  432.  
  433. procedure TRichEditX.Set_Visible(Value: WordBool);
  434. begin
  435.   FDelphiControl.Visible := Value;
  436. end;
  437.  
  438. procedure TRichEditX.Set_WantReturns(Value: WordBool);
  439. begin
  440.   FDelphiControl.WantReturns := Value;
  441. end;
  442.  
  443. procedure TRichEditX.Set_WantTabs(Value: WordBool);
  444. begin
  445.   FDelphiControl.WantTabs := Value;
  446. end;
  447.  
  448. procedure TRichEditX.Set_WordWrap(Value: WordBool);
  449. begin
  450.   FDelphiControl.WordWrap := Value;
  451. end;
  452.  
  453. procedure TRichEditX.ChangeEvent(Sender: TObject);
  454. begin
  455.   if FEvents <> nil then FEvents.OnChange;
  456. end;
  457.  
  458. procedure TRichEditX.KeyPressEvent(Sender: TObject; var Key: Char);
  459. var
  460.   TempKey: Smallint;
  461. begin
  462.   TempKey := Smallint(Key);
  463.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  464.   Key := Char(TempKey);
  465. end;
  466.  
  467. procedure TRichEditX.ProtectChangeEvent(Sender: TObject; StartPos,
  468.   EndPos: Integer; var AllowChange: Boolean);
  469. var
  470.   TempAllowChange: WordBool;
  471. begin
  472.   TempAllowChange := WordBool(AllowChange);
  473.   if FEvents <> nil then FEvents.OnProtectChange(StartPos, EndPos, TempAllowChange);
  474.   AllowChange := Boolean(TempAllowChange);
  475. end;
  476.  
  477. procedure TRichEditX.SaveClipboardEvent(Sender: TObject; NumObjects,
  478.   NumChars: Integer; var SaveClipboard: Boolean);
  479. var
  480.   TempSaveClipboard: WordBool;
  481. begin
  482.   TempSaveClipboard := WordBool(SaveClipboard);
  483.   if FEvents <> nil then FEvents.OnSaveClipboard(NumObjects, NumChars, TempSaveClipboard);
  484.   SaveClipboard := Boolean(TempSaveClipboard);
  485. end;
  486.  
  487. procedure TRichEditX.SelectionChangeEvent(Sender: TObject);
  488. begin
  489.   if FEvents <> nil then FEvents.OnSelectionChange;
  490. end;
  491.  
  492. initialization
  493.   TActiveXControlFactory.Create(
  494.     ComServer,
  495.     TRichEditX,
  496.     TRichEdit,
  497.     Class_RichEditX,
  498.     23,
  499.     '{FA7B855E-9ED7-11D0-AA40-444553540000}',
  500.     0);
  501. end.
  502.