home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RxRichEd.pas < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  159KB  |  4,950 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1998 Master-Bank                }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit RxRichEd;
  10.  
  11. {$I RX.INC}
  12.  
  13. {.$DEFINE RICHEDIT_VER_10}
  14.  
  15. {$R-}
  16.  
  17. interface
  18.  
  19. uses Windows, {$IFDEF RX_D3} ActiveX, ComObj {$ELSE} Ole2, OleAuto {$ENDIF},
  20.   CommCtrl, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
  21.   Dialogs, RichEdit, Menus, ComCtrls;
  22.  
  23. type
  24.   TRichEditVersion = 1..3;
  25.  
  26. {$IFNDEF RX_D3}
  27.  
  28.   TCharFormat2A = record
  29.     cbSize: UINT;
  30.     dwMask: DWORD;
  31.     dwEffects: DWORD;
  32.     yHeight: Longint;
  33.     yOffset: Longint;
  34.     crTextColor: TColorRef;
  35.     bCharSet: Byte;
  36.     bPitchAndFamily: Byte;
  37.     szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
  38.     { new fields in version 2.0 }
  39.     wWeight: Word;                   { Font weight (LOGFONT value)             }
  40.     sSpacing: Smallint;              { Amount to space between letters         }
  41.     crBackColor: TColorRef;          { Background color                        }
  42.     lid: LCID;                       { Locale ID                               }
  43.     dwReserved: DWORD;               { Reserved. Must be 0                     }
  44.     sStyle: Smallint;                { Style handle                            }
  45.     wKerning: Word;                  { Twip size above which to kern char pair }
  46.     bUnderlineType: Byte;            { Underline type                          }
  47.     bAnimation: Byte;                { Animated text like marching ants        }
  48.     bRevAuthor: Byte;                { Revision author index                   }
  49.     bReserved1: Byte;
  50.   end;
  51.   TCharFormat2 = TCharFormat2A;
  52.  
  53.   TParaFormat2 = record
  54.     cbSize: UINT;
  55.     dwMask: DWORD;
  56.     wNumbering: Word;
  57.     wReserved: Word;
  58.     dxStartIndent: Longint;
  59.     dxRightIndent: Longint;
  60.     dxOffset: Longint;
  61.     wAlignment: Word;
  62.     cTabCount: Smallint;
  63.     rgxTabs: array [0..MAX_TAB_STOPS - 1] of Longint;
  64.     { new fields in version 2.0 }
  65.     dySpaceBefore: Longint;     { Vertical spacing before paragraph      }
  66.     dySpaceAfter: Longint;      { Vertical spacing after paragraph       }
  67.     dyLineSpacing: Longint;     { Line spacing depending on Rule         }
  68.     sStyle: Smallint;           { Style handle                           }
  69.     bLineSpacingRule: Byte;     { Rule for line spacing (see tom.doc)    }
  70.     bCRC: Byte;                 { Reserved for CRC for rapid searching   }
  71.     wShadingWeight: Word;       { Shading in hundredths of a per cent    }
  72.     wShadingStyle: Word;        { Nibble 0: style, 1: cfpat, 2: cbpat    }
  73.     wNumberingStart: Word;      { Starting value for numbering           }
  74.     wNumberingStyle: Word;      { Alignment, roman/arabic, (), ), ., etc.}
  75.     wNumberingTab: Word;        { Space bet 1st indent and 1st-line text }
  76.     wBorderSpace: Word;         { Space between border and text (twips)  }
  77.     wBorderWidth: Word;         { Border pen width (twips)               }
  78.     wBorders: Word;             { Byte 0: bits specify which borders     }
  79.                                 { Nibble 2: border style, 3: color index }
  80.   end;
  81.  
  82. {$ENDIF RX_D3}
  83.  
  84. {$IFDEF RX_D5}
  85.   TCharFormat2 = TCharFormat2A;
  86. {$ENDIF}
  87.  
  88. type
  89.   TRxCustomRichEdit = class;
  90.  
  91. { TRxTextAttributes }
  92.  
  93.   TRxAttributeType = (atDefaultText, atSelected, atWord);
  94.   TRxConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize,
  95.     caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink,
  96.     caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor);
  97.   TRxConsistentAttributes = set of TRxConsistentAttribute;
  98.   TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript);
  99.   TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utWave);
  100.  
  101.   TRxTextAttributes = class(TPersistent)
  102.   private
  103.     RichEdit: TRxCustomRichEdit;
  104.     FType: TRxAttributeType;
  105.     procedure AssignFont(Font: TFont);
  106.     procedure GetAttributes(var Format: TCharFormat2);
  107. {$IFNDEF VER90}
  108.     function GetCharset: TFontCharset;
  109.     procedure SetCharset(Value: TFontCharset);
  110. {$ENDIF}
  111.     function GetSubscriptStyle: TSubscriptStyle;
  112.     procedure SetSubscriptStyle(Value: TSubscriptStyle);
  113.     function GetBackColor: TColor;
  114.     function GetColor: TColor;
  115.     function GetConsistentAttributes: TRxConsistentAttributes;
  116.     function GetHeight: Integer;
  117.     function GetHidden: Boolean;
  118.     function GetDisabled: Boolean;
  119.     function GetLink: Boolean;
  120.     function GetName: TFontName;
  121.     function GetOffset: Integer;
  122.     function GetPitch: TFontPitch;
  123.     function GetProtected: Boolean;
  124.     function GetRevAuthorIndex: Byte;
  125.     function GetSize: Integer;
  126.     function GetStyle: TFontStyles;
  127.     function GetUnderlineType: TUnderlineType;
  128.     procedure SetAttributes(var Format: TCharFormat2);
  129.     procedure SetBackColor(Value: TColor);
  130.     procedure SetColor(Value: TColor);
  131.     procedure SetDisabled(Value: Boolean);
  132.     procedure SetHeight(Value: Integer);
  133.     procedure SetHidden(Value: Boolean);
  134.     procedure SetLink(Value: Boolean);
  135.     procedure SetName(Value: TFontName);
  136.     procedure SetOffset(Value: Integer);
  137.     procedure SetPitch(Value: TFontPitch);
  138.     procedure SetProtected(Value: Boolean);
  139.     procedure SetRevAuthorIndex(Value: Byte);
  140.     procedure SetSize(Value: Integer);
  141.     procedure SetStyle(Value: TFontStyles);
  142.     procedure SetUnderlineType(Value: TUnderlineType);
  143.   protected
  144.     procedure InitFormat(var Format: TCharFormat2);
  145.     procedure AssignTo(Dest: TPersistent); override;
  146.   public
  147.     constructor Create(AOwner: TRxCustomRichEdit; AttributeType: TRxAttributeType);
  148.     procedure Assign(Source: TPersistent); override;
  149. {$IFNDEF VER90}
  150.     property Charset: TFontCharset read GetCharset write SetCharset;
  151. {$ENDIF}
  152.     property BackColor: TColor read GetBackColor write SetBackColor;
  153.     property Color: TColor read GetColor write SetColor;
  154.     property ConsistentAttributes: TRxConsistentAttributes read GetConsistentAttributes;
  155.     property Disabled: Boolean read GetDisabled write SetDisabled;
  156.     property Hidden: Boolean read GetHidden write SetHidden;
  157.     property Link: Boolean read GetLink write SetLink;
  158.     property Name: TFontName read GetName write SetName;
  159.     property Offset: Integer read GetOffset write SetOffset;
  160.     property Pitch: TFontPitch read GetPitch write SetPitch;
  161.     property Protected: Boolean read GetProtected write SetProtected;
  162.     property RevAuthorIndex: Byte read GetRevAuthorIndex write SetRevAuthorIndex;
  163.     property SubscriptStyle: TSubscriptStyle read GetSubscriptStyle write SetSubscriptStyle;
  164.     property Size: Integer read GetSize write SetSize;
  165.     property Style: TFontStyles read GetStyle write SetStyle;
  166.     property Height: Integer read GetHeight write SetHeight;
  167.     property UnderlineType: TUnderlineType read GetUnderlineType write SetUnderlineType;
  168.   end;
  169.  
  170. { TRxParaAttributes }
  171.  
  172.   TRxNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter,
  173.     nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman);
  174.   TRxNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple);
  175.   TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify);
  176.   TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore,
  177.     lsSpecified, lsMultiple);
  178.   THeadingStyle = 0..9;
  179.   TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell);
  180.  
  181.   TRxParaAttributes = class(TPersistent)
  182.   private
  183.     RichEdit: TRxCustomRichEdit;
  184.     procedure GetAttributes(var Paragraph: TParaFormat2);
  185.     function GetAlignment: TParaAlignment;
  186.     function GetFirstIndent: Longint;
  187.     function GetHeadingStyle: THeadingStyle;
  188.     function GetLeftIndent: Longint;
  189.     function GetRightIndent: Longint;
  190.     function GetSpaceAfter: Longint;
  191.     function GetSpaceBefore: Longint;
  192.     function GetLineSpacing: Longint;
  193.     function GetLineSpacingRule: TLineSpacingRule;
  194.     function GetNumbering: TRxNumbering;
  195.     function GetNumberingStyle: TRxNumberingStyle;
  196.     function GetNumberingTab: Word;
  197.     function GetTab(Index: Byte): Longint;
  198.     function GetTabCount: Integer;
  199.     function GetTableStyle: TParaTableStyle;
  200.     procedure SetAlignment(Value: TParaAlignment);
  201.     procedure SetAttributes(var Paragraph: TParaFormat2);
  202.     procedure SetFirstIndent(Value: Longint);
  203.     procedure SetHeadingStyle(Value: THeadingStyle);
  204.     procedure SetLeftIndent(Value: Longint);
  205.     procedure SetRightIndent(Value: Longint);
  206.     procedure SetSpaceAfter(Value: Longint);
  207.     procedure SetSpaceBefore(Value: Longint);
  208.     procedure SetLineSpacing(Value: Longint);
  209.     procedure SetLineSpacingRule(Value: TLineSpacingRule);
  210.     procedure SetNumbering(Value: TRxNumbering);
  211.     procedure SetNumberingStyle(Value: TRxNumberingStyle);
  212.     procedure SetNumberingTab(Value: Word);
  213.     procedure SetTab(Index: Byte; Value: Longint);
  214.     procedure SetTabCount(Value: Integer);
  215.     procedure SetTableStyle(Value: TParaTableStyle);
  216.   protected
  217.     procedure InitPara(var Paragraph: TParaFormat2);
  218.     procedure AssignTo(Dest: TPersistent); override;
  219.   public
  220.     constructor Create(AOwner: TRxCustomRichEdit);
  221.     procedure Assign(Source: TPersistent); override;
  222.     property Alignment: TParaAlignment read GetAlignment write SetAlignment;
  223.     property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
  224.     property HeadingStyle: THeadingStyle read GetHeadingStyle write SetHeadingStyle;
  225.     property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
  226.     property LineSpacing: Longint read GetLineSpacing write SetLineSpacing;
  227.     property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule;
  228.     property Numbering: TRxNumbering read GetNumbering write SetNumbering;
  229.     property NumberingStyle: TRxNumberingStyle read GetNumberingStyle write SetNumberingStyle;
  230.     property NumberingTab: Word read GetNumberingTab write SetNumberingTab;
  231.     property RightIndent: Longint read GetRightIndent write SetRightIndent;
  232.     property SpaceAfter: Longint read GetSpaceAfter write SetSpaceAfter;
  233.     property SpaceBefore: Longint read GetSpaceBefore write SetSpaceBefore;
  234.     property Tab[Index: Byte]: Longint read GetTab write SetTab;
  235.     property TabCount: Integer read GetTabCount write SetTabCount;
  236.     property TableStyle: TParaTableStyle read GetTableStyle write SetTableStyle;
  237.   end;
  238.  
  239. { TOEMConversion }
  240.  
  241.   TOEMConversion = class(TConversion)
  242.   public
  243.     function ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
  244.     function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
  245.   end;
  246.  
  247. { TRxCustomRichEdit }
  248.  
  249.   TUndoName = (unUnknown, unTyping, unDelete, unDragDrop, unCut, unPaste);
  250.   TRichSearchType = (stWholeWord, stMatchCase, stBackward, stSetSelection);
  251.   TRichSearchTypes = set of TRichSearchType;
  252.   TRichSelection = (stText, stObject, stMultiChar, stMultiObject);
  253.   TRichSelectionType = set of TRichSelection;
  254.   TRichLangOption = (rlAutoKeyboard, rlAutoFont, rlImeCancelComplete,
  255.     rlImeAlwaysSendNotify);
  256.   TRichLangOptions = set of TRichLangOption;
  257.   TRichStreamFormat = (sfDefault, sfRichText, sfPlainText);
  258.   TRichStreamMode = (smSelection, smPlainRtf, smNoObjects, smUnicode);
  259.   TRichStreamModes = set of TRichStreamMode;
  260.   TRichEditURLClickEvent = procedure(Sender: TObject; const URLText: string;
  261.     Button: TMouseButton) of object;
  262.   TRichEditProtectChangeEx = procedure(Sender: TObject; const Message: TMessage;
  263.     StartPos, EndPos: Integer; var AllowChange: Boolean) of object;
  264.   TRichEditFindErrorEvent = procedure(Sender: TObject; const FindText: string) of object;
  265. {$IFDEF RX_D3}
  266.   TRichEditFindCloseEvent = procedure(Sender: TObject; Dialog: TFindDialog) of object;
  267. {$ENDIF}
  268.  
  269.   PRichConversionFormat = ^TRichConversionFormat;
  270.   TRichConversionFormat = record
  271.     ConversionClass: TConversionClass;
  272.     Extension: string;
  273.     PlainText: Boolean;
  274.     Next: PRichConversionFormat;
  275.   end;
  276.  
  277.   TRxCustomRichEdit = class(TCustomMemo)
  278.   private
  279.     FHideScrollBars: Boolean;
  280.     FSelectionBar: Boolean;
  281.     FAutoURLDetect: Boolean;
  282.     FWordSelection: Boolean;
  283.     FPlainText: Boolean;
  284.     FSelAttributes: TRxTextAttributes;
  285.     FDefAttributes: TRxTextAttributes;
  286.     FWordAttributes: TRxTextAttributes;
  287.     FParagraph: TRxParaAttributes;
  288.     FOldParaAlignment: TParaAlignment;
  289.     FScreenLogPixels: Integer;
  290.     FUndoLimit: Integer;
  291.     FRichEditStrings: TStrings;
  292.     FMemStream: TMemoryStream;
  293.     FHideSelection: Boolean;
  294.     FLangOptions: TRichLangOptions;
  295.     FModified: Boolean;
  296.     FLinesUpdating: Boolean;
  297.     FPageRect: TRect;
  298.     FClickRange: TCharRange;
  299.     FClickBtn: TMouseButton;
  300.     FFindDialog: TFindDialog;
  301.     FReplaceDialog: TReplaceDialog;
  302.     FLastFind: TFindDialog;
  303.     FAllowObjects: Boolean;
  304.     FCallback: TObject;
  305.     FRichEditOle: IUnknown;
  306.     FPopupVerbMenu: TPopupMenu;
  307.     FTitle: string;
  308.     FAutoVerbMenu: Boolean;
  309. {$IFDEF RX_D3}
  310.     FAllowInPlace: Boolean;
  311. {$ENDIF}
  312.     FDefaultConverter: TConversionClass;
  313.     FOnSelChange: TNotifyEvent;
  314.     FOnResizeRequest: TRichEditResizeEvent;
  315.     FOnProtectChange: TRichEditProtectChange;
  316.     FOnProtectChangeEx: TRichEditProtectChangeEx;
  317.     FOnSaveClipboard: TRichEditSaveClipboard;
  318.     FOnURLClick: TRichEditURLClickEvent;
  319.     FOnTextNotFound: TRichEditFindErrorEvent;
  320. {$IFDEF RX_D3}
  321.     FOnCloseFindDialog: TRichEditFindCloseEvent;
  322. {$ENDIF}
  323.     function GetAutoURLDetect: Boolean;
  324.     function GetWordSelection: Boolean;
  325.     function GetLangOptions: TRichLangOptions;
  326.     function GetCanRedo: Boolean;
  327.     function GetCanPaste: Boolean;
  328. {$IFNDEF RX_V110}
  329.     function GetCanUndo: Boolean;
  330. {$ENDIF}
  331.     function GetRedoName: TUndoName;
  332.     function GetUndoName: TUndoName;
  333.     function GetStreamFormat: TRichStreamFormat;
  334.     function GetStreamMode: TRichStreamModes;
  335.     function GetSelectionType: TRichSelectionType;
  336.     procedure PopupVerbClick(Sender: TObject);
  337.     procedure ObjectPropsClick(Sender: TObject);
  338.     procedure CloseObjects;
  339.     procedure UpdateHostNames;
  340.     procedure SetAllowObjects(Value: Boolean);
  341.     procedure SetStreamFormat(Value: TRichStreamFormat);
  342.     procedure SetStreamMode(Value: TRichStreamModes);
  343.     procedure SetAutoURLDetect(Value: Boolean);
  344.     procedure SetWordSelection(Value: Boolean);
  345.     procedure SetHideScrollBars(Value: Boolean);
  346.     procedure SetHideSelection(Value: Boolean);
  347.     procedure SetTitle(const Value: string);
  348.     procedure SetLangOptions(Value: TRichLangOptions);
  349.     procedure SetRichEditStrings(Value: TStrings);
  350.     procedure SetDefAttributes(Value: TRxTextAttributes);
  351.     procedure SetSelAttributes(Value: TRxTextAttributes);
  352.     procedure SetWordAttributes(Value: TRxTextAttributes);
  353.     procedure SetSelectionBar(Value: Boolean);
  354.     procedure SetUndoLimit(Value: Integer);
  355.     procedure UpdateTextModes(Plain: Boolean);
  356.     procedure AdjustFindDialogPosition(Dialog: TFindDialog);
  357.     procedure SetupFindDialog(Dialog: TFindDialog; const SearchStr,
  358.       ReplaceStr: string);
  359.     function FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean;
  360.     function GetCanFindNext: Boolean;
  361.     procedure FindDialogFind(Sender: TObject);
  362.     procedure ReplaceDialogReplace(Sender: TObject);
  363. {$IFDEF RX_D3}
  364.     procedure FindDialogClose(Sender: TObject);
  365.     procedure SetUIActive(Active: Boolean);
  366.     procedure CMDocWindowActivate(var Message: TMessage); message CM_DOCWINDOWACTIVATE;
  367.     procedure CMUIDeactivate(var Message: TMessage); message CM_UIDEACTIVATE;
  368. {$ENDIF}
  369. {$IFDEF RX_D4}
  370.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  371. {$ENDIF}
  372.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  373.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  374.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  375.     procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL;
  376.     procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  377.     procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
  378.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  379.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  380.     procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  381. {$IFDEF RX_D5}
  382.     procedure WMRButtonUp(var Message: TMessage); message WM_RBUTTONUP;
  383. {$ENDIF}
  384.   protected
  385.     procedure CreateParams(var Params: TCreateParams); override;
  386.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  387.     procedure CreateWnd; override;
  388.     procedure DestroyWnd; override;
  389.     function GetPopupMenu: TPopupMenu; override;
  390.     procedure TextNotFound(Dialog: TFindDialog); virtual;
  391.     procedure RequestSize(const Rect: TRect); virtual;
  392.     procedure SelectionChange; dynamic;
  393.     function ProtectChange(const Message: TMessage; StartPos,
  394.       EndPos: Integer): Boolean; dynamic;
  395.     function SaveClipboard(NumObj, NumChars: Integer): Boolean; dynamic;
  396.     procedure URLClick(const URLText: string; Button: TMouseButton); dynamic;
  397.     procedure SetPlainText(Value: Boolean); virtual;
  398. {$IFDEF RX_D3}
  399.     procedure CloseFindDialog(Dialog: TFindDialog); virtual;
  400.     procedure DoSetMaxLength(Value: Integer); override;
  401.     function GetSelLength: Integer; override;
  402.     function GetSelStart: Integer; override;
  403.     function GetSelText: string; override;
  404.     procedure SetSelLength(Value: Integer); override;
  405.     procedure SetSelStart(Value: Integer); override;
  406.     property AllowInPlace: Boolean read FAllowInPlace write FAllowInPlace default True;
  407. {$ENDIF}
  408.     property AllowObjects: Boolean read FAllowObjects write SetAllowObjects default True;
  409.     property AutoURLDetect: Boolean read GetAutoURLDetect write SetAutoURLDetect default True;
  410.     property AutoVerbMenu: Boolean read FAutoVerbMenu write FAutoVerbMenu default True;
  411.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  412.     property HideScrollBars: Boolean read FHideScrollBars
  413.       write SetHideScrollBars default True;
  414.     property Title: string read FTitle write SetTitle;
  415.     property LangOptions: TRichLangOptions read GetLangOptions write SetLangOptions default [rlAutoFont];
  416.     property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
  417.     property PlainText: Boolean read FPlainText write SetPlainText default False;
  418.     property SelectionBar: Boolean read FSelectionBar write SetSelectionBar default True;
  419.     property StreamFormat: TRichStreamFormat read GetStreamFormat write SetStreamFormat default sfDefault;
  420.     property StreamMode: TRichStreamModes read GetStreamMode write SetStreamMode default [];
  421.     property UndoLimit: Integer read FUndoLimit write SetUndoLimit default 100;
  422.     property WordSelection: Boolean read GetWordSelection write SetWordSelection default True;
  423.     property ScrollBars default ssBoth;
  424.     property TabStop default True;
  425.     property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
  426.       write FOnSaveClipboard;
  427.     property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
  428.     property OnProtectChange: TRichEditProtectChange read FOnProtectChange
  429.       write FOnProtectChange; { obsolete }
  430.     property OnProtectChangeEx: TRichEditProtectChangeEx read FOnProtectChangeEx
  431.       write FOnProtectChangeEx;
  432.     property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
  433.       write FOnResizeRequest;
  434.     property OnURLClick: TRichEditURLClickEvent read FOnURLClick write FOnURLClick;
  435.     property OnTextNotFound: TRichEditFindErrorEvent read FOnTextNotFound write FOnTextNotFound;
  436. {$IFDEF RX_D3}
  437.     property OnCloseFindDialog: TRichEditFindCloseEvent read FOnCloseFindDialog
  438.       write FOnCloseFindDialog;
  439. {$ENDIF}
  440.   public
  441.     constructor Create(AOwner: TComponent); override;
  442.     destructor Destroy; override;
  443.     procedure Clear; {$IFDEF RX_D3} override; {$ENDIF}
  444.     procedure SetSelection(StartPos, EndPos: Longint; ScrollCaret: Boolean);
  445.     function GetSelection: TCharRange;
  446.     function GetTextRange(StartPos, EndPos: Longint): string;
  447.     function LineFromChar(CharIndex: Integer): Integer;
  448.     function GetLineIndex(LineNo: Integer): Integer;
  449.     function GetLineLength(CharIndex: Integer): Integer;
  450.     function WordAtCursor: string;
  451.     function FindText(const SearchStr: string;
  452.       StartPos, Length: Integer; Options: TRichSearchTypes): Integer;
  453.     function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  454.       {$IFDEF RX_D3} override; {$ENDIF}
  455.     function GetCaretPos: TPoint; {$IFDEF RX_V110} override; {$ENDIF}
  456.     function GetCharPos(CharIndex: Integer): TPoint;
  457.     function InsertObjectDialog: Boolean;
  458.     function ObjectPropertiesDialog: Boolean;
  459.     function PasteSpecialDialog: Boolean;
  460.     function FindDialog(const SearchStr: string): TFindDialog;
  461.     function ReplaceDialog(const SearchStr, ReplaceStr: string): TReplaceDialog;
  462.     function FindNext: Boolean;
  463.     procedure Print(const Caption: string); virtual;
  464.     class procedure RegisterConversionFormat(const AExtension: string;
  465.       APlainText: Boolean; AConversionClass: TConversionClass);
  466.     procedure ClearUndo;
  467.     procedure Redo;
  468.     procedure StopGroupTyping;
  469.     property CanFindNext: Boolean read GetCanFindNext;
  470.     property CanRedo: Boolean read GetCanRedo;
  471.     property CanPaste: Boolean read GetCanPaste;
  472. {$IFNDEF RX_V110}
  473.     procedure Undo;
  474.     property CanUndo: Boolean read GetCanUndo;
  475.     property CaretPos: TPoint read GetCaretPos;
  476. {$ENDIF}
  477.     property RedoName: TUndoName read GetRedoName;
  478.     property UndoName: TUndoName read GetUndoName;
  479.     property DefaultConverter: TConversionClass read FDefaultConverter
  480.       write FDefaultConverter;
  481.     property DefAttributes: TRxTextAttributes read FDefAttributes write SetDefAttributes;
  482.     property SelAttributes: TRxTextAttributes read FSelAttributes write SetSelAttributes;
  483.     property WordAttributes: TRxTextAttributes read FWordAttributes write SetWordAttributes;
  484.     property PageRect: TRect read FPageRect write FPageRect;
  485.     property Paragraph: TRxParaAttributes read FParagraph;
  486.     property SelectionType: TRichSelectionType read GetSelectionType;
  487.   end;
  488.  
  489.   TRxRichEdit = class(TRxCustomRichEdit)
  490.   published
  491.     property Align;
  492.     property Alignment;
  493.     property AutoURLDetect;
  494.     property AutoVerbMenu;
  495.     property AllowObjects;
  496. {$IFDEF RX_D3}
  497.     property AllowInPlace;
  498. {$ENDIF}
  499. {$IFDEF RX_D4}
  500.     property Anchors;
  501.     property BiDiMode;
  502.     property BorderWidth;
  503.     property DragKind;
  504. {$ENDIF}
  505.     property BorderStyle;
  506.     property Color;
  507.     property Ctl3D;
  508.     property DragCursor;
  509.     property DragMode;
  510.     property Enabled;
  511.     property Font;
  512.     property HideSelection;
  513.     property HideScrollBars;
  514.     property Title;
  515. {$IFNDEF VER90}
  516.     property ImeMode;
  517.     property ImeName;
  518. {$ENDIF}
  519. {$IFDEF RX_D4}
  520.     property Constraints;
  521.     property ParentBiDiMode;
  522. {$ENDIF}
  523.     property LangOptions;
  524.     property Lines;
  525.     property MaxLength;
  526.     property ParentColor;
  527.     property ParentCtl3D;
  528.     property ParentFont;
  529.     property ParentShowHint;
  530.     property PlainText;
  531.     property PopupMenu;
  532.     property ReadOnly;
  533.     property ScrollBars;
  534.     property SelectionBar;
  535.     property ShowHint;
  536.     property StreamFormat;
  537.     property StreamMode;
  538.     property TabOrder;
  539.     property TabStop;
  540.     property UndoLimit;
  541.     property Visible;
  542.     property WantTabs;
  543.     property WantReturns;
  544.     property WordSelection;
  545.     property WordWrap;
  546.     property OnChange;
  547.     property OnDblClick;
  548.     property OnDragDrop;
  549.     property OnDragOver;
  550. {$IFDEF RX_D5}
  551.     property OnContextPopup;
  552. {$ENDIF}
  553. {$IFDEF RX_D4}
  554.     property OnEndDock;
  555.     property OnStartDock;
  556. {$ENDIF}
  557.     property OnEndDrag;
  558.     property OnEnter;
  559.     property OnExit;
  560.     property OnKeyDown;
  561.     property OnKeyPress;
  562.     property OnKeyUp;
  563.     property OnMouseDown;
  564.     property OnMouseMove;
  565.     property OnMouseUp;
  566. {$IFDEF RX_D4}
  567.     property OnMouseWheel;
  568.     property OnMouseWheelDown;
  569.     property OnMouseWheelUp;
  570. {$ENDIF}
  571.     property OnProtectChange; { obsolete }
  572.     property OnProtectChangeEx;
  573.     property OnResizeRequest;
  574.     property OnSaveClipboard;
  575.     property OnSelectionChange;
  576.     property OnStartDrag;
  577.     property OnTextNotFound;
  578. {$IFDEF RX_D3}
  579.     property OnCloseFindDialog;
  580. {$ENDIF}
  581.     property OnURLClick;
  582.   end;
  583.  
  584. var
  585.   RichEditVersion: TRichEditVersion;
  586.  
  587. implementation
  588.  
  589. uses Printers, ComStrs, OleConst, OleDlg {$IFDEF RX_D3}, OleCtnrs {$ENDIF},
  590.   MaxMin;
  591.  
  592. const
  593.   RTFConversionFormat: TRichConversionFormat = (
  594.     ConversionClass: TConversion;
  595.     Extension: 'rtf';
  596.     PlainText: False;
  597.     Next: nil);
  598.   TextConversionFormat: TRichConversionFormat = (
  599.     ConversionClass: TConversion;
  600.     Extension: 'txt';
  601.     PlainText: True;
  602.     Next: @RTFConversionFormat);
  603.  
  604. var
  605.   ConversionFormatList: PRichConversionFormat = @TextConversionFormat;
  606.  
  607. const
  608.   RichEdit10ModuleName = 'RICHED32.DLL';
  609.   RichEdit20ModuleName = 'RICHED20.DLL';
  610. {$IFNDEF RX_D3}
  611.   RICHEDIT_CLASSA      = 'RichEdit20A';     { Richedit 2.0 Window Class }
  612.   RICHEDIT_CLASSW      = 'RichEdit20W';     { Richedit 2.0 Unicode }
  613.   RICHEDIT_CLASS10A    = 'RICHEDIT';        { Richedit 1.0 }
  614.   RICHEDIT_CLASS       = RICHEDIT_CLASSA;
  615. {$ENDIF}
  616.  
  617. {$IFNDEF RX_D3}
  618.  
  619. const
  620.   EM_SETUNDOLIMIT                     = WM_USER + 82; 
  621.   EM_REDO                             = WM_USER + 84; 
  622.   EM_CANREDO                          = WM_USER + 85;
  623.   EM_GETUNDONAME                      = WM_USER + 86; 
  624.   EM_GETREDONAME                      = WM_USER + 87; 
  625.   EM_STOPGROUPTYPING                  = WM_USER + 88; 
  626.   EM_SETTEXTMODE                      = WM_USER + 89; 
  627.   EM_GETTEXTMODE                      = WM_USER + 90; 
  628.  
  629. { for use with EM_GET/SETTEXTMODE }
  630.  
  631.   TM_PLAINTEXT                       = 1; 
  632.   TM_RICHTEXT                        = 2;     { default behavior }
  633.   TM_SINGLELEVELUNDO                 = 4;
  634.   TM_MULTILEVELUNDO                  = 8;     { default behavior }
  635.   TM_SINGLECODEPAGE                  = 16; 
  636.   TM_MULTICODEPAGE                   = 32;    { default behavior }
  637.  
  638.   EM_AUTOURLDETECT                    = WM_USER + 91; 
  639.   EM_GETAUTOURLDETECT                 = WM_USER + 92;
  640.   EM_SETPALETTE                       = WM_USER + 93;
  641.   EM_GETTEXTEX                        = WM_USER + 94; 
  642.   EM_GETTEXTLENGTHEX                  = WM_USER + 95; 
  643.  
  644.   EM_SETLANGOPTIONS                   = WM_USER + 120;
  645.   EM_GETLANGOPTIONS                   = WM_USER + 121;
  646.   EM_GETIMECOMPMODE                   = WM_USER + 122;
  647.  
  648. { Options for EM_SETLANGOPTIONS and EM_GETLANGOPTIONS }
  649.  
  650.   IMF_AUTOKEYBOARD            = $0001;
  651.   IMF_AUTOFONT                = $0002;
  652.   IMF_IMECANCELCOMPLETE       = $0004;  { high completes the comp string when aborting, low cancels. }
  653.   IMF_IMEALWAYSSENDNOTIFY     = $0008;
  654.  
  655. { New notifications }
  656.  
  657.   EN_OLEOPFAILED                      = $0709;
  658.   EN_OBJECTPOSITIONS                  = $070A;
  659.   EN_LINK                             = $070B;
  660.   EN_DRAGDROPDONE                     = $070C;
  661.  
  662. { Event notification masks }
  663.  
  664.   ENM_SCROLLEVENTS                    = $00000008;
  665.   ENM_DRAGDROPDONE                    = $00000010;
  666.   ENM_LANGCHANGE                      = $01000000; 
  667.   ENM_OBJECTPOSITIONS                 = $02000000; 
  668.   ENM_LINK                            = $04000000;
  669.  
  670. { New edit control styles }
  671.  
  672.   ES_NOOLEDRAGDROP                    = $00000008; 
  673.  
  674. const
  675.   CFM_LINK = $00000020;  { Exchange hyperlink extension }
  676.  
  677.   CFM_EFFECTS = CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_COLOR or
  678.     CFM_STRIKEOUT or CFE_PROTECTED or CFM_LINK;
  679.   CFM_ALL = CFM_EFFECTS or CFM_SIZE or CFM_FACE or CFM_OFFSET or CFM_CHARSET;
  680.   PFM_ALL = PFM_STARTINDENT or PFM_RIGHTINDENT or PFM_OFFSET or
  681.     PFM_ALIGNMENT or PFM_TABSTOPS or PFM_NUMBERING or PFM_OFFSETINDENT;
  682.  
  683. { New masks and effects -- a parenthesized asterisk indicates that
  684.    the data is stored by RichEdit2.0, but not displayed }
  685.  
  686.   CFM_SMALLCAPS               = $0040;                  { (*)    }
  687.   CFM_ALLCAPS                 = $0080;                  { (*)    }
  688.   CFM_HIDDEN                  = $0100;                  { (*)    }
  689.   CFM_OUTLINE                 = $0200;                  { (*)    }
  690.   CFM_SHADOW                  = $0400;                  { (*)    }
  691.   CFM_EMBOSS                  = $0800;                  { (*)    }
  692.   CFM_IMPRINT                 = $1000;                  { (*)    }
  693.   CFM_DISABLED                = $2000;
  694.   CFM_REVISED                 = $4000;
  695.  
  696.   CFM_BACKCOLOR               = $04000000; 
  697.   CFM_LCID                    = $02000000; 
  698.   CFM_UNDERLINETYPE           = $00800000;              { (*)    }
  699.   CFM_WEIGHT                  = $00400000;
  700.   CFM_SPACING                 = $00200000;              { (*)    }
  701.   CFM_KERNING                 = $00100000;              { (*)    }
  702.   CFM_STYLE                   = $00080000;              { (*)    }
  703.   CFM_ANIMATION               = $00040000;              { (*)    }
  704.   CFM_REVAUTHOR               = $00008000; 
  705.  
  706.   CFE_LINK                    = $00000020;
  707.   CFE_AUTOCOLOR               = $40000000;   { NOTE: this corresponds to CFM_COLOR, }
  708.                                              { which controls it }
  709.   CFE_SUBSCRIPT               = $00010000;   { Superscript and subscript are }
  710.   CFE_SUPERSCRIPT             = $00020000;   { mutually exclusive            }
  711.  
  712.   CFM_SUBSCRIPT               = CFE_SUBSCRIPT or CFE_SUPERSCRIPT;
  713.   CFM_SUPERSCRIPT             = CFM_SUBSCRIPT;
  714.  
  715.   CFM_EFFECTS2 = CFM_EFFECTS or CFM_DISABLED or CFM_SMALLCAPS or CFM_ALLCAPS or 
  716.     CFM_HIDDEN  or CFM_OUTLINE or CFM_SHADOW or CFM_EMBOSS or 
  717.     CFM_IMPRINT or CFM_DISABLED or CFM_REVISED or 
  718.     CFM_SUBSCRIPT or CFM_SUPERSCRIPT or CFM_BACKCOLOR;
  719.  
  720.   CFM_ALL2 = CFM_ALL or CFM_EFFECTS2 or CFM_BACKCOLOR or CFM_LCID or 
  721.     CFM_UNDERLINETYPE or CFM_WEIGHT or CFM_REVAUTHOR or 
  722.     CFM_SPACING or CFM_KERNING or CFM_STYLE or CFM_ANIMATION;
  723.  
  724.   CFE_SMALLCAPS               = CFM_SMALLCAPS; 
  725.   CFE_ALLCAPS                 = CFM_ALLCAPS; 
  726.   CFE_HIDDEN                  = CFM_HIDDEN; 
  727.   CFE_OUTLINE                 = CFM_OUTLINE;
  728.   CFE_SHADOW                  = CFM_SHADOW; 
  729.   CFE_EMBOSS                  = CFM_EMBOSS;
  730.   CFE_IMPRINT                 = CFM_IMPRINT;
  731.   CFE_DISABLED                = CFM_DISABLED;
  732.   CFE_REVISED                 = CFM_REVISED;
  733.  
  734.   CFE_AUTOBACKCOLOR           = CFM_BACKCOLOR; 
  735.  
  736. { Underline types }
  737.  
  738.   CFU_CF1UNDERLINE            = $FF;    { map charformat's bit underline to CF2. }
  739.   CFU_INVERT                  = $FE;    { For IME composition fake a selection.  }
  740.   CFU_UNDERLINEDOTTED         = $4;     { (*) displayed as ordinary underline    }
  741.   CFU_UNDERLINEDOUBLE         = $3;     { (*) displayed as ordinary underline    }
  742.   CFU_UNDERLINEWORD           = $2;     { (*) displayed as ordinary underline    }
  743.   CFU_UNDERLINE               = $1; 
  744.   CFU_UNDERLINENONE           = 0; 
  745.  
  746. { PARAFORMAT 2.0 masks and effects }
  747.  
  748. const
  749.   PFM_SPACEBEFORE                     = $00000040;
  750.   PFM_SPACEAFTER                      = $00000080;
  751.   PFM_LINESPACING                     = $00000100; 
  752.   PFM_STYLE                           = $00000400;
  753.   PFM_BORDER                          = $00000800;      { (*)    }
  754.   PFM_SHADING                         = $00001000;      { (*)    }
  755.   PFM_NUMBERINGSTYLE                  = $00002000;      { (*)    }
  756.   PFM_NUMBERINGTAB                    = $00004000;      { (*)    }
  757.   PFM_NUMBERINGSTART                  = $00008000;      { (*)    }
  758.  
  759.   PFM_RTLPARA                         = $00010000; 
  760.   PFM_KEEP                            = $00020000;      { (*)    }
  761.   PFM_KEEPNEXT                        = $00040000;      { (*)    }
  762.   PFM_PAGEBREAKBEFORE                 = $00080000;      { (*)    }
  763.   PFM_NOLINENUMBER                    = $00100000;      { (*)    }
  764.   PFM_NOWIDOWCONTROL                  = $00200000;      { (*)    }
  765.   PFM_DONOTHYPHEN                     = $00400000;      { (*)    }
  766.   PFM_SIDEBYSIDE                      = $00800000;      { (*)    }
  767.  
  768.   PFM_TABLE                           = $C0000000;      { (*)    }
  769.  
  770. { Note: PARAFORMAT has no effects }
  771.  
  772.   PFM_EFFECTS = PFM_RTLPARA or PFM_KEEP or PFM_KEEPNEXT or PFM_TABLE or
  773.     PFM_PAGEBREAKBEFORE or PFM_NOLINENUMBER or 
  774.     PFM_NOWIDOWCONTROL or PFM_DONOTHYPHEN or PFM_SIDEBYSIDE or PFM_TABLE; 
  775.  
  776.   PFM_ALL2 = PFM_ALL or PFM_EFFECTS or PFM_SPACEBEFORE or PFM_SPACEAFTER or 
  777.     PFM_LINESPACING or PFM_STYLE or PFM_SHADING or PFM_BORDER or 
  778.     PFM_NUMBERINGTAB or PFM_NUMBERINGSTART or PFM_NUMBERINGSTYLE;
  779.  
  780.   PFE_RTLPARA                         = PFM_RTLPARA              shr 16; 
  781.   PFE_KEEP                            = PFM_KEEP                 shr 16;    { (*)    }
  782.   PFE_KEEPNEXT                        = PFM_KEEPNEXT             shr 16;    { (*)    }
  783.   PFE_PAGEBREAKBEFORE                 = PFM_PAGEBREAKBEFORE      shr 16;    { (*)    }
  784.   PFE_NOLINENUMBER                    = PFM_NOLINENUMBER         shr 16;    { (*)    }
  785.   PFE_NOWIDOWCONTROL                  = PFM_NOWIDOWCONTROL       shr 16;    { (*)    }
  786.   PFE_DONOTHYPHEN                     = PFM_DONOTHYPHEN          shr 16;    { (*)    }
  787.   PFE_SIDEBYSIDE                      = PFM_SIDEBYSIDE           shr 16;    { (*)    }
  788.  
  789.   PFE_TABLEROW                        = $C000;          { These 3 options are mutually   }
  790.   PFE_TABLECELLEND                    = $8000;          {  exclusive and each imply      }
  791.   PFE_TABLECELL                       = $4000;          {  that para is part of a table  }
  792.  
  793.   PFA_JUSTIFY                         = 4;      { New paragraph-alignment option 2.0 (*) }
  794.  
  795. const
  796.   SF_UNICODE = $0010;  { Unicode file of some kind }
  797.  
  798. type
  799.   TFindTextExA = record
  800.     chrg: TCharRange;
  801.     lpstrText: PAnsiChar;
  802.     chrgText: TCharRange;
  803.   end;
  804.  
  805.   TObjectPositions = packed record 
  806.     nmhdr: TNMHdr;
  807.     cObjectCount: Longint;
  808.     pcpPositions: PLongint;
  809.   end;
  810.  
  811.   TENLink = record 
  812.     nmhdr: TNMHdr;
  813.     msg: UINT;
  814.     wParam: WPARAM;
  815.     lParam: LPARAM;
  816.     chrg: TCharRange;
  817.   end;
  818.  
  819.   TENOleOpFailed = packed record 
  820.     nmhdr: TNMHdr;
  821.     iob: Longint;
  822.     lOper: Longint;
  823.     hr: HRESULT;
  824.   end;
  825.  
  826. { flags for the GETTEXTLENGTHEX data structure }
  827.  
  828. const
  829.   GTL_DEFAULT         = 0;      { do the default (return # of chars)        }
  830.   GTL_USECRLF         = 1;      { compute answer using CRLFs for paragraphs }
  831.   GTL_PRECISE         = 2;      { compute a precise answer                  }
  832.   GTL_CLOSE           = 4;      { fast computation of a "close" answer      }
  833.   GTL_NUMCHARS        = 8;      { return the number of characters           }
  834.   GTL_NUMBYTES        = 16;     { return the number of _bytes_              }
  835.  
  836. { EM_GETTEXTLENGTHEX info; this struct is passed in the wparam of the msg }
  837.  
  838. type
  839.   TGetTextLengthEx = record 
  840.     flags: DWORD;              { flags (see GTL_XXX defines)  }
  841.     codepage: UINT;            { code page for translation    }
  842.   end;
  843.  
  844. const
  845.   OLEOP_DOVERB = 1;
  846.  
  847. {$ENDIF RX_D3}
  848.  
  849. const
  850.   FT_DOWN = 1;
  851.  
  852. type
  853.   PENLink = ^TENLink;
  854.   PENOleOpFailed = ^TENOleOpFailed;
  855.   TFindTextEx = TFindTextExA;
  856.  
  857.   TTextRangeA = record
  858.     chrg: TCharRange;
  859.     lpstrText: PAnsiChar;
  860.   end;
  861.   TTextRangeW = record
  862.     chrg: TCharRange;
  863.     lpstrText: PWideChar;
  864.   end;
  865.   TTextRange = TTextRangeA;
  866.  
  867. {$IFDEF RX_D3}
  868. function ResStr(const Ident: string): string;
  869. begin
  870.   Result := Ident;
  871. end;
  872. {$ELSE}
  873. function ResStr(Ident: Cardinal): string;
  874. begin
  875.   Result := LoadStr(Ident);
  876. end;
  877. {$ENDIF}
  878.  
  879. { TRxTextAttributes }
  880.  
  881. const
  882.   AttrFlags: array[TRxAttributeType] of Word = (0, SCF_SELECTION,
  883.     SCF_WORD or SCF_SELECTION);
  884.  
  885. constructor TRxTextAttributes.Create(AOwner: TRxCustomRichEdit;
  886.   AttributeType: TRxAttributeType);
  887. begin
  888.   inherited Create;
  889.   RichEdit := AOwner;
  890.   FType := AttributeType;
  891. end;
  892.  
  893. procedure TRxTextAttributes.InitFormat(var Format: TCharFormat2);
  894. begin
  895.   FillChar(Format, SizeOf(Format), 0);
  896.   if RichEditVersion >= 2 then Format.cbSize := SizeOf(Format)
  897.   else Format.cbSize := SizeOf(TCharFormat);
  898. end;
  899.  
  900. function TRxTextAttributes.GetConsistentAttributes: TRxConsistentAttributes;
  901. var
  902.   Format: TCharFormat2;
  903. begin
  904.   Result := [];
  905.   if RichEdit.HandleAllocated and (FType <> atDefaultText) then begin
  906.     InitFormat(Format);
  907.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
  908.       AttrFlags[FType], LPARAM(@Format));
  909.     with Format do begin
  910.       if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
  911.       if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
  912.       if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
  913.       if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
  914.       if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
  915.       if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
  916.       if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
  917.       if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
  918.       if (dwMask and CFM_OFFSET) <> 0 then Include(Result, caOffset);
  919.       if (dwMask and CFM_HIDDEN) <> 0 then Include(result, caHidden);
  920.       if RichEditVersion >= 2 then begin
  921.         if (dwMask and CFM_LINK) <> 0 then Include(Result, caLink);
  922.         if (dwMask and CFM_BACKCOLOR) <> 0 then Include(Result, caBackColor);
  923.         if (dwMask and CFM_DISABLED) <> 0 then Include(Result, caDisabled);
  924.         if (dwMask and CFM_WEIGHT) <> 0 then Include(Result, caWeight);
  925.         if (dwMask and CFM_SUBSCRIPT) <> 0 then Include(Result, caSubscript);
  926.         if (dwMask and CFM_REVAUTHOR) <> 0 then Include(Result, caRevAuthor);
  927.       end;
  928.     end;
  929.   end;
  930. end;
  931.  
  932. procedure TRxTextAttributes.GetAttributes(var Format: TCharFormat2);
  933. begin
  934.   InitFormat(Format);
  935.   if RichEdit.HandleAllocated then
  936.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT, AttrFlags[FType],
  937.       LPARAM(@Format));
  938. end;
  939.  
  940. procedure TRxTextAttributes.SetAttributes(var Format: TCharFormat2);
  941. begin
  942.   if RichEdit.HandleAllocated then
  943.     SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, AttrFlags[FType],
  944.       LPARAM(@Format));
  945. end;
  946.  
  947. {$IFNDEF VER90}
  948. function TRxTextAttributes.GetCharset: TFontCharset;
  949. var
  950.   Format: TCharFormat2;
  951. begin
  952.   GetAttributes(Format);
  953.   Result := Format.bCharset;
  954. end;
  955.  
  956. procedure TRxTextAttributes.SetCharset(Value: TFontCharset);
  957. var
  958.   Format: TCharFormat2;
  959. begin
  960.   InitFormat(Format);
  961.   with Format do
  962.   begin
  963.     dwMask := CFM_CHARSET;
  964.     bCharSet := Value;
  965.   end;
  966.   SetAttributes(Format);
  967. end;
  968. {$ENDIF}
  969.  
  970. function TRxTextAttributes.GetProtected: Boolean;
  971. var
  972.   Format: TCharFormat2;
  973. begin
  974.   GetAttributes(Format);
  975.   with Format do
  976.     Result := (dwEffects and CFE_PROTECTED) <> 0;
  977. end;
  978.  
  979. procedure TRxTextAttributes.SetProtected(Value: Boolean);
  980. var
  981.   Format: TCharFormat2;
  982. begin
  983.   InitFormat(Format);
  984.   with Format do begin
  985.     dwMask := CFM_PROTECTED;
  986.     if Value then dwEffects := CFE_PROTECTED;
  987.   end;
  988.   SetAttributes(Format);
  989. end;
  990.  
  991. function TRxTextAttributes.GetLink: Boolean;
  992. var
  993.   Format: TCharFormat2;
  994. begin
  995.   Result := False;
  996.   if RichEditVersion < 2 then Exit;
  997.   GetAttributes(Format);
  998.   with Format do Result := (dwEffects and CFE_LINK) <> 0;
  999. end;
  1000.  
  1001. procedure TRxTextAttributes.SetLink(Value: Boolean);
  1002. var
  1003.   Format: TCharFormat2;
  1004. begin
  1005.   if RichEditVersion < 2 then Exit;
  1006.   InitFormat(Format);
  1007.   with Format do begin
  1008.     dwMask := CFM_LINK;
  1009.     if Value then dwEffects := CFE_LINK;
  1010.   end;
  1011.   SetAttributes(Format);
  1012. end;
  1013.  
  1014. function TRxTextAttributes.GetRevAuthorIndex: Byte;
  1015. var
  1016.   Format: TCharFormat2;
  1017. begin
  1018.   GetAttributes(Format);
  1019.   Result := Format.bRevAuthor;
  1020. end;
  1021.  
  1022. procedure TRxTextAttributes.SetRevAuthorIndex(Value: Byte);
  1023. var
  1024.   Format: TCharFormat2;
  1025. begin
  1026.   if RichEditVersion < 2 then Exit;
  1027.   InitFormat(Format);
  1028.   with Format do begin
  1029.     dwMask := CFM_REVAUTHOR;
  1030.     bRevAuthor := Value;
  1031.   end;
  1032.   SetAttributes(Format);
  1033. end;
  1034.  
  1035. function TRxTextAttributes.GetHidden: Boolean;
  1036. var
  1037.   Format: TCharFormat2;
  1038. begin
  1039.   Result := False;
  1040.   if RichEditVersion < 2 then Exit;
  1041.   GetAttributes(Format);
  1042.   Result := Format.dwEffects and CFE_HIDDEN <> 0;
  1043. end;
  1044.  
  1045. procedure TRxTextAttributes.SetHidden(Value: Boolean);
  1046. var
  1047.   Format: TCharFormat2;
  1048. begin
  1049.   if RichEditVersion < 2 then Exit;
  1050.   InitFormat(Format);
  1051.   with Format do begin
  1052.     dwMask := CFM_HIDDEN;
  1053.     if Value then dwEffects := CFE_HIDDEN;
  1054.   end;
  1055.   SetAttributes(Format);
  1056. end;
  1057.  
  1058. function TRxTextAttributes.GetDisabled: Boolean;
  1059. var
  1060.   Format: TCharFormat2;
  1061. begin
  1062.   Result := False;
  1063.   if RichEditVersion < 2 then Exit;
  1064.   GetAttributes(Format);
  1065.   Result := Format.dwEffects and CFE_DISABLED <> 0;
  1066. end;
  1067.  
  1068. procedure TRxTextAttributes.SetDisabled(Value: Boolean);
  1069. var
  1070.   Format: TCharFormat2;
  1071. begin
  1072.   if RichEditVersion < 2 then Exit;
  1073.   InitFormat(Format);
  1074.   with Format do begin
  1075.     dwMask := CFM_DISABLED;
  1076.     if Value then dwEffects := CFE_DISABLED;
  1077.   end;
  1078.   SetAttributes(Format);
  1079. end;
  1080.  
  1081. function TRxTextAttributes.GetColor: TColor;
  1082. var
  1083.   Format: TCharFormat2;
  1084. begin
  1085.   GetAttributes(Format);
  1086.   with Format do
  1087.     if (dwEffects and CFE_AUTOCOLOR) <> 0 then Result := clWindowText
  1088.     else Result := crTextColor;
  1089. end;
  1090.  
  1091. procedure TRxTextAttributes.SetColor(Value: TColor);
  1092. var
  1093.   Format: TCharFormat2;
  1094. begin
  1095.   InitFormat(Format);
  1096.   with Format do begin
  1097.     dwMask := CFM_COLOR;
  1098.     if (Value = clWindowText) or (Value = clDefault) then
  1099.       dwEffects := CFE_AUTOCOLOR
  1100.     else crTextColor := ColorToRGB(Value);
  1101.   end;
  1102.   SetAttributes(Format);
  1103. end;
  1104.  
  1105. function TRxTextAttributes.GetBackColor: TColor;
  1106. var
  1107.   Format: TCharFormat2;
  1108. begin
  1109.   if RichEditVersion < 2 then begin
  1110.     Result := clWindow;
  1111.     Exit;
  1112.   end;
  1113.   GetAttributes(Format);
  1114.   with Format do
  1115.     if (dwEffects and CFE_AUTOBACKCOLOR) <> 0 then Result := clWindow
  1116.     else Result := crBackColor;
  1117. end;
  1118.  
  1119. procedure TRxTextAttributes.SetBackColor(Value: TColor);
  1120. var
  1121.   Format: TCharFormat2;
  1122. begin
  1123.   if RichEditVersion < 2 then Exit;
  1124.   InitFormat(Format);
  1125.   with Format do begin
  1126.     dwMask := CFM_BACKCOLOR;
  1127.     if (Value = clWindow) or (Value = clDefault) then
  1128.       dwEffects := CFE_AUTOBACKCOLOR
  1129.     else crBackColor := ColorToRGB(Value);
  1130.   end;
  1131.   SetAttributes(Format);
  1132. end;
  1133.  
  1134. function TRxTextAttributes.GetName: TFontName;
  1135. var
  1136.   Format: TCharFormat2;
  1137. begin
  1138.   GetAttributes(Format);
  1139.   Result := Format.szFaceName;
  1140. end;
  1141.  
  1142. procedure TRxTextAttributes.SetName(Value: TFontName);
  1143. var
  1144.   Format: TCharFormat2;
  1145. begin
  1146.   InitFormat(Format);
  1147.   with Format do begin
  1148.     dwMask := CFM_FACE;
  1149.     StrPLCopy(szFaceName, Value, SizeOf(szFaceName));
  1150.   end;
  1151.   SetAttributes(Format);
  1152. end;
  1153.  
  1154. function TRxTextAttributes.GetStyle: TFontStyles;
  1155. var
  1156.   Format: TCharFormat2;
  1157. begin
  1158.   Result := [];
  1159.   GetAttributes(Format);
  1160.   with Format do begin
  1161.     if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
  1162.     if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
  1163.     if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
  1164.     if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
  1165.   end;
  1166. end;
  1167.  
  1168. procedure TRxTextAttributes.SetStyle(Value: TFontStyles);
  1169. var
  1170.   Format: TCharFormat2;
  1171. begin
  1172.   InitFormat(Format);
  1173.   with Format do begin
  1174.     dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
  1175.     if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
  1176.     if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
  1177.     if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
  1178.     if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
  1179.   end;
  1180.   SetAttributes(Format);
  1181. end;
  1182.  
  1183. function TRxTextAttributes.GetUnderlineType: TUnderlineType;
  1184. var
  1185.   Format: TCharFormat2;
  1186. begin
  1187.   Result := utNone;
  1188.   if RichEditVersion < 2 then Exit;
  1189.   GetAttributes(Format);
  1190.   with Format do begin
  1191.     if (dwEffects and CFE_UNDERLINE <> 0) and
  1192.       (dwMask and CFM_UNDERLINETYPE = CFM_UNDERLINETYPE) then
  1193.       Result := TUnderlineType(bUnderlineType);
  1194.   end;
  1195. end;
  1196.  
  1197. procedure TRxTextAttributes.SetUnderlineType(Value: TUnderlineType);
  1198. var
  1199.   Format: TCharFormat2;
  1200. begin
  1201.   if RichEditVersion < 2 then Exit;
  1202.   InitFormat(Format);
  1203.   with Format do begin
  1204.     dwMask := CFM_UNDERLINETYPE or CFM_UNDERLINE;
  1205.     bUnderlineType := Ord(Value);
  1206.     if Value <> utNone then dwEffects := dwEffects or CFE_UNDERLINE;
  1207.   end;
  1208.   SetAttributes(Format);
  1209. end;
  1210.  
  1211. function TRxTextAttributes.GetOffset: Integer;
  1212. var
  1213.   Format: TCharFormat2;
  1214. begin
  1215.   GetAttributes(Format);
  1216.   Result := Format.yOffset div 20;
  1217. end;
  1218.  
  1219. procedure TRxTextAttributes.SetOffset(Value: Integer);
  1220. var
  1221.   Format: TCharFormat2;
  1222. begin
  1223.   InitFormat(Format);
  1224.   with Format do begin
  1225.     dwMask := DWORD(CFM_OFFSET);
  1226.     yOffset := Value * 20;
  1227.   end;
  1228.   SetAttributes(Format);
  1229. end;
  1230.  
  1231. function TRxTextAttributes.GetSize: Integer;
  1232. var
  1233.   Format: TCharFormat2;
  1234. begin
  1235.   GetAttributes(Format);
  1236.   Result := Format.yHeight div 20;
  1237. end;
  1238.  
  1239. procedure TRxTextAttributes.SetSize(Value: Integer);
  1240. var
  1241.   Format: TCharFormat2;
  1242. begin
  1243.   InitFormat(Format);
  1244.   with Format do begin
  1245.     dwMask := DWORD(CFM_SIZE);
  1246.     yHeight := Value * 20;
  1247.   end;
  1248.   SetAttributes(Format);
  1249. end;
  1250.  
  1251. function TRxTextAttributes.GetHeight: Integer;
  1252. begin
  1253.   Result := MulDiv(Size, RichEdit.FScreenLogPixels, 72);
  1254. end;
  1255.  
  1256. procedure TRxTextAttributes.SetHeight(Value: Integer);
  1257. begin
  1258.   Size := MulDiv(Value, 72, RichEdit.FScreenLogPixels);
  1259. end;
  1260.  
  1261. function TRxTextAttributes.GetPitch: TFontPitch;
  1262. var
  1263.   Format: TCharFormat2;
  1264. begin
  1265.   GetAttributes(Format);
  1266.   case (Format.bPitchAndFamily and $03) of
  1267.     DEFAULT_PITCH: Result := fpDefault;
  1268.     VARIABLE_PITCH: Result := fpVariable;
  1269.     FIXED_PITCH: Result := fpFixed;
  1270.     else Result := fpDefault;
  1271.   end;
  1272. end;
  1273.  
  1274. procedure TRxTextAttributes.SetPitch(Value: TFontPitch);
  1275. var
  1276.   Format: TCharFormat2;
  1277. begin
  1278.   InitFormat(Format);
  1279.   with Format do begin
  1280.     case Value of
  1281.       fpVariable: bPitchAndFamily := VARIABLE_PITCH;
  1282.       fpFixed: bPitchAndFamily := FIXED_PITCH;
  1283.       else bPitchAndFamily := DEFAULT_PITCH;
  1284.     end;
  1285.   end;
  1286.   SetAttributes(Format);
  1287. end;
  1288.  
  1289. function TRxTextAttributes.GetSubscriptStyle: TSubscriptStyle;
  1290. var
  1291.   Format: TCharFormat2;
  1292. begin
  1293.   Result := ssNone;
  1294.   if RichEditVersion < 2 then Exit;
  1295.   GetAttributes(Format);
  1296.   with Format do begin
  1297.     if (dwEffects and CFE_SUBSCRIPT) <> 0 then
  1298.       Result := ssSubscript
  1299.     else if (dwEffects and CFE_SUPERSCRIPT) <> 0 then
  1300.       Result := ssSuperscript;
  1301.   end;
  1302. end;
  1303.  
  1304. procedure TRxTextAttributes.SetSubscriptStyle(Value: TSubscriptStyle);
  1305. var
  1306.   Format: TCharFormat2;
  1307. begin
  1308.   if RichEditVersion < 2 then Exit;
  1309.   InitFormat(Format);
  1310.   with Format do begin
  1311.     dwMask := DWORD(CFM_SUBSCRIPT);
  1312.     case Value of
  1313.       ssSubscript: dwEffects := CFE_SUBSCRIPT;
  1314.       ssSuperscript: dwEffects := CFE_SUPERSCRIPT;
  1315.     end;
  1316.   end;
  1317.   SetAttributes(Format);
  1318. end;
  1319.  
  1320. procedure TRxTextAttributes.AssignFont(Font: TFont);
  1321. var
  1322.   LogFont: TLogFont;
  1323.   Format: TCharFormat2;
  1324. begin
  1325.   InitFormat(Format);
  1326.   with Format do begin
  1327.     case Font.Pitch of
  1328.       fpVariable: bPitchAndFamily := VARIABLE_PITCH;
  1329.       fpFixed: bPitchAndFamily := FIXED_PITCH;
  1330.       else bPitchAndFamily := DEFAULT_PITCH;
  1331.     end;
  1332.     dwMask := dwMask or CFM_SIZE or CFM_BOLD or CFM_ITALIC or
  1333.       CFM_UNDERLINE or CFM_STRIKEOUT or CFM_FACE or CFM_COLOR;
  1334.     yHeight := Font.Size * 20;
  1335.     if fsBold in Font.Style then dwEffects := dwEffects or CFE_BOLD;
  1336.     if fsItalic in Font.Style then dwEffects := dwEffects or CFE_ITALIC;
  1337.     if fsUnderline in Font.Style then dwEffects := dwEffects or CFE_UNDERLINE;
  1338.     if fsStrikeOut in Font.Style then dwEffects := dwEffects or CFE_STRIKEOUT;
  1339.     StrPLCopy(szFaceName, Font.Name, SizeOf(szFaceName));
  1340.     if (Font.Color = clWindowText) or (Font.Color = clDefault) then
  1341.       dwEffects := CFE_AUTOCOLOR
  1342.     else crTextColor := ColorToRGB(Font.Color);
  1343. {$IFNDEF VER90}
  1344.     dwMask := dwMask or CFM_CHARSET;
  1345.     bCharSet := Font.Charset;
  1346. {$ENDIF}
  1347.     if GetObject(Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then begin
  1348.       dwMask := dwMask or DWORD(CFM_WEIGHT);
  1349.       wWeight := Word(LogFont.lfWeight);
  1350.     end;
  1351.   end;
  1352.   SetAttributes(Format);
  1353. end;
  1354.  
  1355. procedure TRxTextAttributes.Assign(Source: TPersistent);
  1356. var
  1357.   Format: TCharFormat2;
  1358. begin
  1359.   if Source is TFont then AssignFont(TFont(Source))
  1360.   else if Source is TTextAttributes then begin
  1361.     Name := TTextAttributes(Source).Name;
  1362. {$IFDEF RX_D3}
  1363.     Charset := TTextAttributes(Source).Charset;
  1364. {$ENDIF}
  1365.     Style := TTextAttributes(Source).Style;
  1366.     Pitch := TTextAttributes(Source).Pitch;
  1367.     Color := TTextAttributes(Source).Color;
  1368.   end
  1369.   else if Source is TRxTextAttributes then begin
  1370.     TRxTextAttributes(Source).GetAttributes(Format);
  1371.     SetAttributes(Format);
  1372.   end
  1373.   else inherited Assign(Source);
  1374. end;
  1375.  
  1376. procedure TRxTextAttributes.AssignTo(Dest: TPersistent);
  1377. begin
  1378.   if Dest is TFont then begin
  1379.     TFont(Dest).Color := Color;
  1380.     TFont(Dest).Name := Name;
  1381. {$IFNDEF VER90}
  1382.     TFont(Dest).Charset := Charset;
  1383. {$ENDIF}
  1384.     TFont(Dest).Style := Style;
  1385.     TFont(Dest).Size := Size;
  1386.     TFont(Dest).Pitch := Pitch;
  1387.   end
  1388.   else if Dest is TTextAttributes then begin
  1389.     TTextAttributes(Dest).Color := Color;
  1390.     TTextAttributes(Dest).Name := Name;
  1391. {$IFDEF RX_D3}
  1392.     TTextAttributes(Dest).Charset := Charset;
  1393. {$ENDIF}
  1394.     TTextAttributes(Dest).Style := Style;
  1395.     TTextAttributes(Dest).Pitch := Pitch;
  1396.   end
  1397.   else inherited AssignTo(Dest);
  1398. end;
  1399.  
  1400. { TRxParaAttributes }
  1401.  
  1402. constructor TRxParaAttributes.Create(AOwner: TRxCustomRichEdit);
  1403. begin
  1404.   inherited Create;
  1405.   RichEdit := AOwner;
  1406. end;
  1407.  
  1408. procedure TRxParaAttributes.InitPara(var Paragraph: TParaFormat2);
  1409. begin
  1410.   FillChar(Paragraph, SizeOf(Paragraph), 0);
  1411.   if RichEditVersion >= 2 then
  1412.     Paragraph.cbSize := SizeOf(Paragraph)
  1413.   else
  1414.     Paragraph.cbSize := SizeOf(TParaFormat);
  1415. end;
  1416.  
  1417. procedure TRxParaAttributes.GetAttributes(var Paragraph: TParaFormat2);
  1418. begin
  1419.   InitPara(Paragraph);
  1420.   if RichEdit.HandleAllocated then
  1421.     SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
  1422. end;
  1423.  
  1424. procedure TRxParaAttributes.SetAttributes(var Paragraph: TParaFormat2);
  1425. begin
  1426. {$IFDEF RX_D4}
  1427.   RichEdit.HandleNeeded; { we REALLY need the handle for BiDi }
  1428. {$ENDIF}
  1429.   if RichEdit.HandleAllocated then begin
  1430. {$IFDEF RX_D4}
  1431.     if RichEdit.UseRightToLeftAlignment then
  1432.       if Paragraph.wAlignment = PFA_LEFT then
  1433.         Paragraph.wAlignment := PFA_RIGHT
  1434.       else if Paragraph.wAlignment = PFA_RIGHT then
  1435.         Paragraph.wAlignment := PFA_LEFT;
  1436. {$ENDIF}
  1437.     SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph));
  1438.   end;
  1439. end;
  1440.  
  1441. function TRxParaAttributes.GetAlignment: TParaAlignment;
  1442. var
  1443.   Paragraph: TParaFormat2;
  1444. begin
  1445.   GetAttributes(Paragraph);
  1446.   Result := TParaAlignment(Paragraph.wAlignment - 1);
  1447. end;
  1448.  
  1449. procedure TRxParaAttributes.SetAlignment(Value: TParaAlignment);
  1450. var
  1451.   Paragraph: TParaFormat2;
  1452. begin
  1453.   InitPara(Paragraph);
  1454.   with Paragraph do
  1455.   begin
  1456.     dwMask := PFM_ALIGNMENT;
  1457.     wAlignment := Ord(Value) + 1;
  1458.   end;
  1459.   SetAttributes(Paragraph);
  1460. end;
  1461.  
  1462. function TRxParaAttributes.GetNumbering: TRxNumbering;
  1463. var
  1464.   Paragraph: TParaFormat2;
  1465. begin
  1466.   GetAttributes(Paragraph);
  1467.   Result := TRxNumbering(Paragraph.wNumbering);
  1468.   if RichEditVersion = 1 then
  1469.     if Result <> nsNone then Result := nsBullet;
  1470. end;
  1471.  
  1472. procedure TRxParaAttributes.SetNumbering(Value: TRxNumbering);
  1473. var
  1474.   Paragraph: TParaFormat2;
  1475. begin
  1476.   if RichEditVersion = 1 then
  1477.     if Value <> nsNone then Value := TRxNumbering(PFN_BULLET);
  1478.   case Value of
  1479.     nsNone: LeftIndent := 0;
  1480.     else if LeftIndent < 10 then LeftIndent := 10;
  1481.   end;
  1482.   InitPara(Paragraph);
  1483.   with Paragraph do begin
  1484.     dwMask := PFM_NUMBERING;
  1485.     wNumbering := Ord(Value);
  1486.   end;
  1487.   SetAttributes(Paragraph);
  1488. end;
  1489.  
  1490. function TRxParaAttributes.GetNumberingStyle: TRxNumberingStyle;
  1491. var
  1492.   Paragraph: TParaFormat2;
  1493. begin
  1494.   if RichEditVersion < 2 then
  1495.     Result := nsSimple
  1496.   else begin
  1497.     GetAttributes(Paragraph);
  1498.     Result := TRxNumberingStyle(Paragraph.wNumberingStyle);
  1499.   end;
  1500. end;
  1501.  
  1502. procedure TRxParaAttributes.SetNumberingStyle(Value: TRxNumberingStyle);
  1503. var
  1504.   Paragraph: TParaFormat2;
  1505. begin
  1506.   if RichEditVersion < 2 then Exit;
  1507.   InitPara(Paragraph);
  1508.   with Paragraph do begin
  1509.     dwMask := PFM_NUMBERINGSTYLE;
  1510.     wNumberingStyle := Ord(Value);
  1511.   end;
  1512.   SetAttributes(Paragraph);
  1513. end;
  1514.  
  1515. function TRxParaAttributes.GetNumberingTab: Word;
  1516. var
  1517.   Paragraph: TParaFormat2;
  1518. begin
  1519.   GetAttributes(Paragraph);
  1520.   Result := Paragraph.wNumberingTab div 20;
  1521. end;
  1522.  
  1523. procedure TRxParaAttributes.SetNumberingTab(Value: Word);
  1524. var
  1525.   Paragraph: TParaFormat2;
  1526. begin
  1527.   if RichEditVersion < 2 then Exit;
  1528.   InitPara(Paragraph);
  1529.   with Paragraph do begin
  1530.     dwMask := PFM_NUMBERINGTAB;
  1531.     wNumberingTab := Value * 20;
  1532.   end;
  1533.   SetAttributes(Paragraph);
  1534. end;
  1535.  
  1536. function TRxParaAttributes.GetFirstIndent: Longint;
  1537. var
  1538.   Paragraph: TParaFormat2;
  1539. begin
  1540.   GetAttributes(Paragraph);
  1541.   Result := Paragraph.dxStartIndent div 20;
  1542. end;
  1543.  
  1544. procedure TRxParaAttributes.SetFirstIndent(Value: Longint);
  1545. var
  1546.   Paragraph: TParaFormat2;
  1547. begin
  1548.   InitPara(Paragraph);
  1549.   with Paragraph do
  1550.   begin
  1551.     dwMask := PFM_STARTINDENT;
  1552.     dxStartIndent := Value * 20;
  1553.   end;
  1554.   SetAttributes(Paragraph);
  1555. end;
  1556.  
  1557. function TRxParaAttributes.GetHeadingStyle: THeadingStyle;
  1558. var
  1559.   Paragraph: TParaFormat2;
  1560. begin
  1561.   if RichEditVersion < 3 then Result := 0
  1562.   else begin
  1563.     GetAttributes(Paragraph);
  1564.     Result := Paragraph.sStyle;
  1565.   end;
  1566. end;
  1567.  
  1568. procedure TRxParaAttributes.SetHeadingStyle(Value: THeadingStyle);
  1569. var
  1570.   Paragraph: TParaFormat2;
  1571. begin
  1572.   if RichEditVersion < 3 then Exit;
  1573.   InitPara(Paragraph);
  1574.   with Paragraph do begin
  1575.     dwMask := PFM_STYLE;
  1576.     sStyle := Value;
  1577.   end;
  1578.   SetAttributes(Paragraph);
  1579. end;
  1580.  
  1581. function TRxParaAttributes.GetLeftIndent: Longint;
  1582. var
  1583.   Paragraph: TParaFormat2;
  1584. begin
  1585.   GetAttributes(Paragraph);
  1586.   Result := Paragraph.dxOffset div 20;
  1587. end;
  1588.  
  1589. procedure TRxParaAttributes.SetLeftIndent(Value: Longint);
  1590. var
  1591.   Paragraph: TParaFormat2;
  1592. begin
  1593.   InitPara(Paragraph);
  1594.   with Paragraph do
  1595.   begin
  1596.     dwMask := PFM_OFFSET;
  1597.     dxOffset := Value * 20;
  1598.   end;
  1599.   SetAttributes(Paragraph);
  1600. end;
  1601.  
  1602. function TRxParaAttributes.GetRightIndent: Longint;
  1603. var
  1604.   Paragraph: TParaFormat2;
  1605. begin
  1606.   GetAttributes(Paragraph);
  1607.   Result := Paragraph.dxRightIndent div 20;
  1608. end;
  1609.  
  1610. procedure TRxParaAttributes.SetRightIndent(Value: Longint);
  1611. var
  1612.   Paragraph: TParaFormat2;
  1613. begin
  1614.   InitPara(Paragraph);
  1615.   with Paragraph do
  1616.   begin
  1617.     dwMask := PFM_RIGHTINDENT;
  1618.     dxRightIndent := Value * 20;
  1619.   end;
  1620.   SetAttributes(Paragraph);
  1621. end;
  1622.  
  1623. function TRxParaAttributes.GetSpaceAfter: Longint;
  1624. var
  1625.   Paragraph: TParaFormat2;
  1626. begin
  1627.   GetAttributes(Paragraph);
  1628.   Result := Paragraph.dySpaceAfter div 20;
  1629. end;
  1630.  
  1631. procedure TRxParaAttributes.SetSpaceAfter(Value: Longint);
  1632. var
  1633.   Paragraph: TParaFormat2;
  1634. begin
  1635.   if RichEditVersion < 2 then Exit;
  1636.   InitPara(Paragraph);
  1637.   with Paragraph do begin
  1638.     dwMask := PFM_SPACEAFTER;
  1639.     dySpaceAfter := Value * 20;
  1640.   end;
  1641.   SetAttributes(Paragraph);
  1642. end;
  1643.  
  1644. function TRxParaAttributes.GetSpaceBefore: Longint;
  1645. var
  1646.   Paragraph: TParaFormat2;
  1647. begin
  1648.   GetAttributes(Paragraph);
  1649.   Result := Paragraph.dySpaceBefore div 20;
  1650. end;
  1651.  
  1652. procedure TRxParaAttributes.SetSpaceBefore(Value: Longint);
  1653. var
  1654.   Paragraph: TParaFormat2;
  1655. begin
  1656.   if RichEditVersion < 2 then Exit;
  1657.   InitPara(Paragraph);
  1658.   with Paragraph do begin
  1659.     dwMask := PFM_SPACEBEFORE;
  1660.     dySpaceBefore := Value * 20;
  1661.   end;
  1662.   SetAttributes(Paragraph);
  1663. end;
  1664.  
  1665. function TRxParaAttributes.GetLineSpacing: Longint;
  1666. var
  1667.   Paragraph: TParaFormat2;
  1668. begin
  1669.   GetAttributes(Paragraph);
  1670.   Result := Paragraph.dyLineSpacing div 20;
  1671. end;
  1672.  
  1673. procedure TRxParaAttributes.SetLineSpacing(Value: Longint);
  1674. var
  1675.   Paragraph: TParaFormat2;
  1676. begin
  1677.   if RichEditVersion < 2 then Exit;
  1678.   GetAttributes(Paragraph);
  1679.   with Paragraph do begin
  1680.     dwMask := PFM_LINESPACING;
  1681.     dyLineSpacing := Value * 20;
  1682.   end;
  1683.   SetAttributes(Paragraph);
  1684. end;
  1685.  
  1686. function TRxParaAttributes.GetLineSpacingRule: TLineSpacingRule;
  1687. var
  1688.   Paragraph: TParaFormat2;
  1689. begin
  1690.   GetAttributes(Paragraph);
  1691.   Result := TLineSpacingRule(Paragraph.bLineSpacingRule);
  1692. end;
  1693.  
  1694. procedure TRxParaAttributes.SetLineSpacingRule(Value: TLineSpacingRule);
  1695. var
  1696.   Paragraph: TParaFormat2;
  1697. begin
  1698.   if RichEditVersion < 2 then Exit;
  1699.   GetAttributes(Paragraph);
  1700.   with Paragraph do begin
  1701.     dwMask := PFM_LINESPACING;
  1702.     bLineSpacingRule := Ord(Value);
  1703.   end;
  1704.   SetAttributes(Paragraph);
  1705. end;
  1706.  
  1707. function TRxParaAttributes.GetTab(Index: Byte): Longint;
  1708. var
  1709.   Paragraph: TParaFormat2;
  1710. begin
  1711.   GetAttributes(Paragraph);
  1712.   Result := Paragraph.rgxTabs[Index] div 20;
  1713. end;
  1714.  
  1715. procedure TRxParaAttributes.SetTab(Index: Byte; Value: Longint);
  1716. var
  1717.   Paragraph: TParaFormat2;
  1718. begin
  1719.   GetAttributes(Paragraph);
  1720.   with Paragraph do
  1721.   begin
  1722.     rgxTabs[Index] := Value * 20;
  1723.     dwMask := PFM_TABSTOPS;
  1724.     if cTabCount < Index then cTabCount := Index;
  1725.     SetAttributes(Paragraph);
  1726.   end;
  1727. end;
  1728.  
  1729. function TRxParaAttributes.GetTabCount: Integer;
  1730. var
  1731.   Paragraph: TParaFormat2;
  1732. begin
  1733.   GetAttributes(Paragraph);
  1734.   Result := Paragraph.cTabCount;
  1735. end;
  1736.  
  1737. procedure TRxParaAttributes.SetTabCount(Value: Integer);
  1738. var
  1739.   Paragraph: TParaFormat2;
  1740. begin
  1741.   GetAttributes(Paragraph);
  1742.   with Paragraph do
  1743.   begin
  1744.     dwMask := PFM_TABSTOPS;
  1745.     cTabCount := Value;
  1746.     SetAttributes(Paragraph);
  1747.   end;
  1748. end;
  1749.  
  1750. function TRxParaAttributes.GetTableStyle: TParaTableStyle;
  1751. var
  1752.   Paragraph: TParaFormat2;
  1753. begin
  1754.   Result := tsNone;
  1755.   if RichEditVersion < 2 then Exit;
  1756.   GetAttributes(Paragraph);
  1757.   with Paragraph do begin
  1758.     if (wReserved and PFE_TABLEROW) <> 0 then
  1759.       Result := tsTableRow
  1760.     else if (wReserved and PFE_TABLECELLEND) <> 0 then
  1761.       Result := tsTableCellEnd
  1762.     else if (wReserved and PFE_TABLECELL) <> 0 then
  1763.       Result := tsTableCell;
  1764.   end;
  1765. end;
  1766.  
  1767. procedure TRxParaAttributes.SetTableStyle(Value: TParaTableStyle);
  1768. var
  1769.   Paragraph: TParaFormat2;
  1770. begin
  1771.   if RichEditVersion < 2 then Exit;
  1772.   InitPara(Paragraph);
  1773.   with Paragraph do begin
  1774.     dwMask := PFM_TABLE;
  1775.     case Value of
  1776.       tsTableRow: wReserved := PFE_TABLEROW;
  1777.       tsTableCellEnd: wReserved := PFE_TABLECELLEND;
  1778.       tsTableCell: wReserved := PFE_TABLECELL;
  1779.     end;
  1780.   end;
  1781.   SetAttributes(Paragraph);
  1782. end;
  1783.  
  1784. procedure TRxParaAttributes.AssignTo(Dest: TPersistent);
  1785. var
  1786.   I: Integer;
  1787. begin
  1788.   if Dest is TParaAttributes then begin
  1789.     with TParaAttributes(Dest) do begin
  1790.       if Self.Alignment = paJustify then Alignment := taLeftJustify
  1791.       else Alignment := TAlignment(Self.Alignment);
  1792.       FirstIndent := Self.FirstIndent;
  1793.       LeftIndent := Self.LeftIndent;
  1794.       RightIndent := Self.RightIndent;
  1795.       if Self.Numbering <> nsNone then
  1796.         Numbering := TNumberingStyle(nsBullet)
  1797.       else Numbering := TNumberingStyle(nsNone);
  1798.       for I := 0 to MAX_TAB_STOPS - 1 do
  1799.         Tab[I] := Self.Tab[I];
  1800.     end;
  1801.   end
  1802.   else inherited AssignTo(Dest);
  1803. end;
  1804.  
  1805. procedure TRxParaAttributes.Assign(Source: TPersistent);
  1806. var
  1807.   I: Integer;
  1808.   Paragraph: TParaFormat2;
  1809. begin
  1810.   if Source is TParaAttributes then begin
  1811.     Alignment := TParaAlignment(TParaAttributes(Source).Alignment);
  1812.     FirstIndent := TParaAttributes(Source).FirstIndent;
  1813.     LeftIndent := TParaAttributes(Source).LeftIndent;
  1814.     RightIndent := TParaAttributes(Source).RightIndent;
  1815.     Numbering := TRxNumbering(TParaAttributes(Source).Numbering);
  1816.     for I := 0 to MAX_TAB_STOPS - 1 do
  1817.       Tab[I] := TParaAttributes(Source).Tab[I];
  1818.   end
  1819.   else if Source is TRxParaAttributes then begin
  1820.     TRxParaAttributes(Source).GetAttributes(Paragraph);
  1821.     SetAttributes(Paragraph);
  1822.   end
  1823.   else inherited Assign(Source);
  1824. end;
  1825.  
  1826. { OLE utility routines }
  1827.  
  1828. function WStrLen(Str: PWideChar): Integer;
  1829. begin
  1830.   Result := 0;
  1831.   while Str[Result] <> #0 do Inc(Result);
  1832. end;
  1833.  
  1834. procedure ReleaseObject(var Obj);
  1835. begin
  1836.   if IUnknown(Obj) <> nil then begin
  1837. {$IFNDEF RX_D3}
  1838.     IUnknown(Obj).Release;
  1839. {$ENDIF}
  1840.     IUnknown(Obj) := nil;
  1841.   end;
  1842. end;
  1843.  
  1844. procedure CreateStorage(var Storage: IStorage);
  1845. var
  1846.   LockBytes: ILockBytes;
  1847. begin
  1848.   OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
  1849.   try
  1850.     OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_READWRITE
  1851.       or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Storage));
  1852.   finally
  1853.     ReleaseObject(LockBytes);
  1854.   end;
  1855. end;
  1856.  
  1857. procedure DestroyMetaPict(MetaPict: HGlobal);
  1858. begin
  1859.   if MetaPict <> 0 then begin
  1860.     DeleteMetaFile(PMetaFilePict(GlobalLock(MetaPict))^.hMF);
  1861.     GlobalUnlock(MetaPict);
  1862.     GlobalFree(MetaPict);
  1863.   end;
  1864. end;
  1865.  
  1866. function OleSetDrawAspect(OleObject: IOleObject; Iconic: Boolean;
  1867.   IconMetaPict: HGlobal; var DrawAspect: Longint): HResult;
  1868. var
  1869.   OleCache: IOleCache;
  1870.   EnumStatData: IEnumStatData;
  1871.   OldAspect, AdviseFlags, Connection: Longint;
  1872.   TempMetaPict: HGlobal;
  1873.   FormatEtc: TFormatEtc;
  1874.   Medium: TStgMedium;
  1875.   ClassID: TCLSID;
  1876.   StatData: TStatData;
  1877. begin
  1878.   Result := S_OK;
  1879.   OldAspect := DrawAspect;
  1880.   if Iconic then begin
  1881.     DrawAspect := DVASPECT_ICON;
  1882.     AdviseFlags := ADVF_NODATA;
  1883.   end
  1884.   else begin
  1885.     DrawAspect := DVASPECT_CONTENT;
  1886.     AdviseFlags := ADVF_PRIMEFIRST;
  1887.   end;
  1888.   if (DrawAspect <> OldAspect) or (DrawAspect = DVASPECT_ICON) then begin
  1889. {$IFDEF RX_D3}
  1890.     Result := OleObject.QueryInterface(IOleCache, OleCache);
  1891. {$ELSE}
  1892.     Result := OleObject.QueryInterface(IID_IOleCache, OleCache);
  1893. {$ENDIF}
  1894.     if Succeeded(Result) then
  1895.     try
  1896.       if DrawAspect <> OldAspect then begin
  1897.         { Setup new cache with the new aspect }
  1898.         FillChar(FormatEtc, SizeOf(FormatEtc), 0);
  1899.         FormatEtc.dwAspect := DrawAspect;
  1900.         FormatEtc.lIndex := -1;
  1901.         Result := OleCache.Cache(FormatEtc, AdviseFlags, Connection);
  1902.       end;
  1903.       if Succeeded(Result) and (DrawAspect = DVASPECT_ICON) then begin
  1904.         TempMetaPict := 0;
  1905.         if IconMetaPict = 0 then begin
  1906.           if Succeeded(OleObject.GetUserClassID(ClassID)) then begin
  1907.             TempMetaPict := OleGetIconOfClass(ClassID, nil, True);
  1908.             IconMetaPict := TempMetaPict;
  1909.           end;
  1910.         end;
  1911.         try
  1912.           FormatEtc.cfFormat := CF_METAFILEPICT;
  1913.           FormatEtc.ptd := nil;
  1914.           FormatEtc.dwAspect := DVASPECT_ICON;
  1915.           FormatEtc.lIndex := -1;
  1916.           FormatEtc.tymed := TYMED_MFPICT;
  1917.           Medium.tymed := TYMED_MFPICT;
  1918.           Medium.hMetaFilePict := IconMetaPict;
  1919.           Medium.unkForRelease := nil;
  1920.           Result := OleCache.SetData(FormatEtc, Medium, False);
  1921.         finally
  1922.           DestroyMetaPict(TempMetaPict);
  1923.         end;
  1924.       end;
  1925.       if Succeeded(Result) and (DrawAspect <> OldAspect) then begin
  1926.         { remove any existing caches that are set up for the old display aspect }
  1927.         OleCache.EnumCache(EnumStatData);
  1928.         if EnumStatData <> nil then
  1929.         try
  1930.           while EnumStatData.Next(1, StatData, nil) = 0 do
  1931.             if StatData.formatetc.dwAspect = OldAspect then
  1932.               OleCache.Uncache(StatData.dwConnection);
  1933.         finally
  1934.           ReleaseObject(EnumStatData);
  1935.         end;
  1936.       end;
  1937.     finally
  1938.       ReleaseObject(OleCache);
  1939.     end;
  1940.     if Succeeded(Result) and (DrawAspect <> DVASPECT_ICON) then
  1941.       OleObject.Update;
  1942.   end;
  1943. end;
  1944.  
  1945. function GetIconMetaPict(OleObject: IOleObject; DrawAspect: Longint): HGlobal;
  1946. var
  1947.   DataObject: IDataObject;
  1948.   FormatEtc: TFormatEtc;
  1949.   Medium: TStgMedium;
  1950.   ClassID: TCLSID;
  1951. begin
  1952.   Result := 0;
  1953.   if DrawAspect = DVASPECT_ICON then begin
  1954. {$IFDEF RX_D3}
  1955.     OleObject.QueryInterface(IDataObject, DataObject);
  1956. {$ELSE}
  1957.     OleObject.QueryInterface(IID_IDataObject, DataObject);
  1958. {$ENDIF}
  1959.     if DataObject <> nil then begin
  1960.       FormatEtc.cfFormat := CF_METAFILEPICT;
  1961.       FormatEtc.ptd := nil;
  1962.       FormatEtc.dwAspect := DVASPECT_ICON;
  1963.       FormatEtc.lIndex := -1;
  1964.       FormatEtc.tymed := TYMED_MFPICT;
  1965.       if Succeeded(DataObject.GetData(FormatEtc, Medium)) then
  1966.         Result := Medium.hMetaFilePict;
  1967.       ReleaseObject(DataObject);
  1968.     end;
  1969.   end;
  1970.   if Result = 0 then begin
  1971.     OleCheck(OleObject.GetUserClassID(ClassID));
  1972.     Result := OleGetIconOfClass(ClassID, nil, True);
  1973.   end;
  1974. end;
  1975.  
  1976. { Return the first piece of a moniker }
  1977.  
  1978. function OleStdGetFirstMoniker(Moniker: IMoniker): IMoniker;
  1979. var
  1980.   Mksys: Longint;
  1981.   EnumMoniker: IEnumMoniker;
  1982. begin
  1983.   Result := nil;
  1984.   if Moniker <> nil then begin
  1985.     if (Moniker.IsSystemMoniker(Mksys) = 0) and
  1986.       (Mksys = MKSYS_GENERICCOMPOSITE) then
  1987.     begin
  1988.       if Moniker.Enum(True, EnumMoniker) <> 0 then Exit;
  1989.       EnumMoniker.Next(1, Result, nil);
  1990.       ReleaseObject(EnumMoniker);
  1991.     end
  1992.     else begin
  1993. {$IFNDEF RX_D3}
  1994.       Moniker.AddRef;
  1995. {$ENDIF}
  1996.       Result := Moniker;
  1997.     end;
  1998.   end;
  1999. end;
  2000.  
  2001. { Return length of file moniker piece of the given moniker }
  2002.  
  2003. function OleStdGetLenFilePrefixOfMoniker(Moniker: IMoniker): Integer;
  2004. var
  2005.   MkFirst: IMoniker;
  2006.   BindCtx: IBindCtx;
  2007.   Mksys: Longint;
  2008.   P: PWideChar;
  2009. begin
  2010.   Result := 0;
  2011.   if Moniker <> nil then begin
  2012.     MkFirst := OleStdGetFirstMoniker(Moniker);
  2013.     if MkFirst <> nil then begin
  2014.       if (MkFirst.IsSystemMoniker(Mksys) = 0) and
  2015.         (Mksys = MKSYS_FILEMONIKER) then
  2016.       begin
  2017.         if CreateBindCtx(0, BindCtx) = 0 then begin
  2018.           if (MkFirst.GetDisplayName(BindCtx, nil, P) = 0) and (P <> nil) then
  2019.           begin
  2020.             Result := WStrLen(P);
  2021.             CoTaskMemFree(P);
  2022.           end;
  2023.           ReleaseObject(BindCtx);
  2024.         end;
  2025.       end;
  2026.       ReleaseObject(MkFirst);
  2027.     end;
  2028.   end;
  2029. end;
  2030.  
  2031. function CoAllocCStr(const S: string): PChar;
  2032. begin
  2033.   Result := StrCopy(CoTaskMemAlloc(Length(S) + 1), PChar(S));
  2034. end;
  2035.  
  2036. function WStrToString(P: PWideChar): string;
  2037. begin
  2038.   Result := '';
  2039.   if P <> nil then begin
  2040.     Result := WideCharToString(P);
  2041.     CoTaskMemFree(P);
  2042.   end;
  2043. end;
  2044.  
  2045. function GetFullNameStr(OleObject: IOleObject): string;
  2046. var
  2047.   P: PWideChar;
  2048. begin
  2049.   OleObject.GetUserType(USERCLASSTYPE_FULL, P);
  2050.   Result := WStrToString(P);
  2051. end;
  2052.  
  2053. function GetShortNameStr(OleObject: IOleObject): string;
  2054. var
  2055.   P: PWideChar;
  2056. begin
  2057.   OleObject.GetUserType(USERCLASSTYPE_SHORT, P);
  2058.   Result := WStrToString(P);
  2059. end;
  2060.  
  2061. function GetDisplayNameStr(OleLink: IOleLink): string;
  2062. var
  2063.   P: PWideChar;
  2064. begin
  2065.   OleLink.GetSourceDisplayName(P);
  2066.   Result := WStrToString(P);
  2067. end;
  2068.  
  2069. {$IFDEF RX_D3}
  2070. function GetVCLFrameForm(Form: TCustomForm): IVCLFrameForm;
  2071. begin
  2072.   if Form.OleFormObject = nil then TOleForm.Create(Form);
  2073.   Result := Form.OleFormObject as IVCLFrameForm;
  2074. end;
  2075.  
  2076. function IsFormMDIChild(Form: TCustomForm): Boolean;
  2077. begin
  2078.   Result := (Form is TForm) and (TForm(Form).FormStyle = fsMDIChild);
  2079. end;
  2080. {$ENDIF}
  2081.  
  2082. { Clipboard formats }
  2083.  
  2084. var
  2085.   CFEmbeddedObject: Integer;
  2086.   CFLinkSource: Integer;
  2087.   CFRtf: Integer;
  2088.   CFRtfNoObjs: Integer;
  2089.  
  2090. const
  2091. {$IFNDEF RX_D3}
  2092.   CF_RTFNOOBJS = 'Rich Text Format Without Objects';
  2093. {$ENDIF}
  2094.   CF_EMBEDDEDOBJECT = 'Embedded Object';
  2095.   CF_LINKSOURCE = 'Link Source';
  2096.  
  2097. {************************************************************************}
  2098.  
  2099. { OLE Extensions to the Rich Text Editor }
  2100. { Converted from RICHOLE.H               }
  2101.  
  2102. { Structure passed to GetObject and InsertObject }
  2103.  
  2104. type
  2105.   _ReObject = record
  2106.     cbStruct: DWORD;           { Size of structure                }
  2107.     cp: ULONG;                 { Character position of object     }
  2108.     clsid: TCLSID;             { Class ID of object               }
  2109.     poleobj: IOleObject;       { OLE object interface             }
  2110.     pstg: IStorage;            { Associated storage interface     }
  2111.     polesite: IOleClientSite;  { Associated client site interface }
  2112.     sizel: TSize;              { Size of object (may be 0,0)      }
  2113.     dvAspect: Longint;         { Display aspect to use            }
  2114.     dwFlags: DWORD;            { Object status flags              }
  2115.     dwUser: DWORD;             { Dword for user's use             }
  2116.   end;
  2117.   TReObject = _ReObject;
  2118.  
  2119. const
  2120.  
  2121. { Flags to specify which interfaces should be returned in the structure above }
  2122.  
  2123.   REO_GETOBJ_NO_INTERFACES   =  $00000000;
  2124.   REO_GETOBJ_POLEOBJ         =  $00000001;
  2125.   REO_GETOBJ_PSTG            =  $00000002;
  2126.   REO_GETOBJ_POLESITE        =  $00000004;
  2127.   REO_GETOBJ_ALL_INTERFACES  =  $00000007;
  2128.  
  2129. { Place object at selection }
  2130.  
  2131.   REO_CP_SELECTION    = ULONG(-1);
  2132.  
  2133. { Use character position to specify object instead of index }
  2134.  
  2135.   REO_IOB_SELECTION   = ULONG(-1);
  2136.   REO_IOB_USE_CP      = ULONG(-2);
  2137.  
  2138. { Object flags }
  2139.  
  2140.   REO_NULL            = $00000000;  { No flags                         }
  2141.   REO_READWRITEMASK   = $0000003F;  { Mask out RO bits                 }
  2142.   REO_DONTNEEDPALETTE = $00000020;  { Object doesn't need palette      }
  2143.   REO_BLANK           = $00000010;  { Object is blank                  }
  2144.   REO_DYNAMICSIZE     = $00000008;  { Object defines size always       }
  2145.   REO_INVERTEDSELECT  = $00000004;  { Object drawn all inverted if sel }
  2146.   REO_BELOWBASELINE   = $00000002;  { Object sits below the baseline   }
  2147.   REO_RESIZABLE       = $00000001;  { Object may be resized            }
  2148.   REO_LINK            = $80000000;  { Object is a link (RO)            }
  2149.   REO_STATIC          = $40000000;  { Object is static (RO)            }
  2150.   REO_SELECTED        = $08000000;  { Object selected (RO)             }
  2151.   REO_OPEN            = $04000000;  { Object open in its server (RO)   }
  2152.   REO_INPLACEACTIVE   = $02000000;  { Object in place active (RO)      }
  2153.   REO_HILITED         = $01000000;  { Object is to be hilited (RO)     }
  2154.   REO_LINKAVAILABLE   = $00800000;  { Link believed available (RO)     }
  2155.   REO_GETMETAFILE     = $00400000;  { Object requires metafile (RO)    }
  2156.  
  2157. { Flags for IRichEditOle.GetClipboardData,   }
  2158. { IRichEditOleCallback.GetClipboardData and  }
  2159. { IRichEditOleCallback.QueryAcceptData       }
  2160.  
  2161.   RECO_PASTE          = $00000000;  { paste from clipboard  }
  2162.   RECO_DROP           = $00000001;  { drop                  }
  2163.   RECO_COPY           = $00000002;  { copy to the clipboard }
  2164.   RECO_CUT            = $00000003;  { cut to the clipboard  }
  2165.   RECO_DRAG           = $00000004;  { drag                  }
  2166.  
  2167. { RichEdit GUIDs }
  2168.  
  2169.   IID_IRichEditOle: TGUID = (
  2170.     D1:$00020D00;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  2171.   IID_IRichEditOleCallback: TGUID = (
  2172.     D1:$00020D03;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  2173.  
  2174. type
  2175.  
  2176. {
  2177.  *  IRichEditOle
  2178.  *
  2179.  *  Purpose:
  2180.  *    Interface used by the client of RichEdit to perform OLE-related
  2181.  *    operations.
  2182.  *
  2183.  *    The methods herein may just want to be regular Windows messages.
  2184. }
  2185.  
  2186. {$IFDEF RX_D3}
  2187.   IRichEditOle = interface(IUnknown)
  2188.     ['{00020d00-0000-0000-c000-000000000046}']
  2189.     function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
  2190.     function GetObjectCount: HResult; stdcall;
  2191.     function GetLinkCount: HResult; stdcall;
  2192.     function GetObject(iob: Longint; out reobject: TReObject;
  2193.       dwFlags: DWORD): HResult; stdcall;
  2194.     function InsertObject(var reobject: TReObject): HResult; stdcall;
  2195.     function ConvertObject(iob: Longint; rclsidNew: TIID;
  2196.       lpstrUserTypeNew: LPCSTR): HResult; stdcall;
  2197.     function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
  2198.     function SetHostNames(lpstrContainerApp: LPCSTR;
  2199.       lpstrContainerObj: LPCSTR): HResult; stdcall;
  2200.     function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
  2201.     function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
  2202.     function HandsOffStorage(iob: Longint): HResult; stdcall;
  2203.     function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
  2204.     function InPlaceDeactivate: HResult; stdcall;
  2205.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  2206.     function GetClipboardData(var chrg: TCharRange; reco: DWORD;
  2207.       out dataobj: IDataObject): HResult; stdcall;
  2208.     function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
  2209.       hMetaPict: HGLOBAL): HResult; stdcall;
  2210.   end;
  2211. {$ELSE}
  2212.   IRichEditOle = class(IUnknown)
  2213.     function GetClientSite(var clientSite: IOleClientSite): HResult; virtual; stdcall; abstract;
  2214.     function GetObjectCount: HResult; virtual; stdcall; abstract;
  2215.     function GetLinkCount: HResult; virtual; stdcall; abstract;
  2216.     function GetObject(iob: Longint; var reobject: TReObject;
  2217.       dwFlags: DWORD): HResult; virtual; stdcall; abstract;
  2218.     function InsertObject(var reobject: TReObject): HResult; virtual; stdcall; abstract;
  2219.     function ConvertObject(iob: Longint; rclsidNew: TIID;
  2220.       lpstrUserTypeNew: LPCSTR): HResult; virtual; stdcall; abstract;
  2221.     function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; virtual; stdcall; abstract;
  2222.     function SetHostNames(lpstrContainerApp: LPCSTR;
  2223.       lpstrContainerObj: LPCSTR): HResult; virtual; stdcall; abstract;
  2224.     function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; virtual; stdcall; abstract;
  2225.     function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; virtual; stdcall; abstract;
  2226.     function HandsOffStorage(iob: Longint): HResult; virtual; stdcall; abstract;
  2227.     function SaveCompleted(iob: Longint; const stg: IStorage): HResult; virtual; stdcall; abstract;
  2228.     function InPlaceDeactivate: HResult; virtual; stdcall; abstract;
  2229.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; virtual; stdcall; abstract;
  2230.     function GetClipboardData(var chrg: TCharRange; reco: DWORD;
  2231.       var dataobj: IDataObject): HResult; virtual; stdcall; abstract;
  2232.     function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
  2233.       hMetaPict: HGLOBAL): HResult; virtual; stdcall; abstract;
  2234.   end;
  2235. {$ENDIF}
  2236.  
  2237. {
  2238.  *  IRichEditOleCallback
  2239.  *
  2240.  *  Purpose:
  2241.  *    Interface used by the RichEdit to get OLE-related stuff from the
  2242.  *    application using RichEdit.
  2243. }
  2244.  
  2245. {$IFDEF RX_D3}
  2246.   IRichEditOleCallback = interface(IUnknown)
  2247.     ['{00020d03-0000-0000-c000-000000000046}']
  2248.     function GetNewStorage(out stg: IStorage): HResult; stdcall;
  2249.     function GetInPlaceContext(out Frame: IOleInPlaceFrame;
  2250.       out Doc: IOleInPlaceUIWindow;
  2251.       lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall;
  2252.     function ShowContainerUI(fShow: BOOL): HResult; stdcall;
  2253.     function QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2254.       cp: Longint): HResult; stdcall;
  2255.     function DeleteObject(const oleobj: IOleObject): HResult; stdcall;
  2256.     function QueryAcceptData(const dataobj: IDataObject;
  2257.       var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
  2258.       hMetaPict: HGLOBAL): HResult; stdcall;
  2259.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  2260.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2261.       out dataobj: IDataObject): HResult; stdcall;
  2262.     function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2263.       var dwEffect: DWORD): HResult; stdcall;
  2264.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2265.       const chrg: TCharRange; out menu: HMENU): HResult; stdcall;
  2266.   end;
  2267. {$ELSE}
  2268.   IRichEditOleCallback = class(IUnknown)
  2269.     function GetNewStorage(var stg: IStorage): HResult; virtual; stdcall; abstract;
  2270.     function GetInPlaceContext(var Frame: IOleInPlaceFrame;
  2271.       var Doc: IOleInPlaceUIWindow;
  2272.       lpFrameInfo: POleInPlaceFrameInfo): HResult; virtual; stdcall; abstract;
  2273.     function ShowContainerUI(fShow: BOOL): HResult; virtual; stdcall; abstract;
  2274.     function QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2275.       cp: Longint): HResult; virtual; stdcall; abstract;
  2276.     function DeleteObject(const oleobj: IOleObject): HResult; virtual; stdcall; abstract;
  2277.     function QueryAcceptData(const dataobj: IDataObject;
  2278.       var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
  2279.       hMetaPict: HGLOBAL): HResult; virtual; stdcall; abstract;
  2280.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; virtual; stdcall; abstract;
  2281.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2282.       var dataobj: IDataObject): HResult; virtual; stdcall; abstract;
  2283.     function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2284.       var dwEffect: DWORD): HResult; virtual; stdcall; abstract;
  2285.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2286.       const chrg: TCharRange; var menu: HMENU): HResult; virtual; stdcall; abstract;
  2287.   end;
  2288. {$ENDIF}
  2289.  
  2290. {************************************************************************}
  2291.  
  2292. { TRichEditOleCallback }
  2293.  
  2294. type
  2295. {$IFDEF RX_D3}
  2296.   TRichEditOleCallback = class(TObject, IUnknown, IRichEditOleCallback)
  2297.   private
  2298.     FDocForm: IVCLFrameForm;
  2299.     FFrameForm: IVCLFrameForm;
  2300.     FAccelTable: HAccel;
  2301.     FAccelCount: Integer;
  2302. {$IFDEF RX_D4}
  2303.     FAutoScroll: Boolean;
  2304. {$ENDIF}
  2305.     procedure CreateAccelTable;
  2306.     procedure DestroyAccelTable;
  2307.     procedure AssignFrame;
  2308. {$ELSE}
  2309.   TRichEditOleCallback = class(IRichEditOleCallback)
  2310. {$ENDIF}
  2311.   private
  2312.     FRefCount: Longint;
  2313.     FRichEdit: TRxCustomRichEdit;
  2314.   public
  2315.     constructor Create(RichEdit: TRxCustomRichEdit);
  2316.     destructor Destroy; override;
  2317. {$IFDEF RX_D3}
  2318.     function QueryInterface(const iid: TGUID; out Obj): HResult; stdcall;
  2319.     function _AddRef: Longint; stdcall;
  2320.     function _Release: Longint; stdcall;
  2321.     function GetNewStorage(out stg: IStorage): HResult; stdcall;
  2322.     function GetInPlaceContext(out Frame: IOleInPlaceFrame;
  2323.       out Doc: IOleInPlaceUIWindow;
  2324.       lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall;
  2325.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2326.       out dataobj: IDataObject): HResult; stdcall;
  2327.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2328.       const chrg: TCharRange; out menu: HMENU): HResult; stdcall;
  2329. {$ELSE}
  2330.     function QueryInterface(const iid: TIID; var Obj): HResult; override;
  2331.     function AddRef: Longint; override;
  2332.     function Release: Longint; override;
  2333.     function GetNewStorage(var stg: IStorage): HResult; override;
  2334.     function GetInPlaceContext(var Frame: IOleInPlaceFrame;
  2335.       var Doc: IOleInPlaceUIWindow;
  2336.       lpFrameInfo: POleInPlaceFrameInfo): HResult; override;
  2337.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2338.       var dataobj: IDataObject): HResult; override;
  2339.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2340.       const chrg: TCharRange; var menu: HMENU): HResult; override;
  2341. {$ENDIF}
  2342.     function ShowContainerUI(fShow: BOOL): HResult;
  2343.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2344.     function QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2345.       cp: Longint): HResult;
  2346.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2347.     function DeleteObject(const oleobj: IOleObject): HResult;
  2348.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2349.     function QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat;
  2350.       reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult;
  2351.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2352.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult;
  2353.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2354.     function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2355.       var dwEffect: DWORD): HResult;
  2356.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2357.   end;
  2358.  
  2359. constructor TRichEditOleCallback.Create(RichEdit: TRxCustomRichEdit);
  2360. begin
  2361.   inherited Create;
  2362.   FRichEdit := RichEdit;
  2363. end;
  2364.  
  2365. destructor TRichEditOleCallback.Destroy;
  2366. begin
  2367. {$IFDEF RX_D3}
  2368.   DestroyAccelTable;
  2369.   FFrameForm := nil;
  2370.   FDocForm := nil;
  2371. {$ENDIF}
  2372.   inherited Destroy;
  2373. end;
  2374.  
  2375. {$IFDEF RX_D3}
  2376.  
  2377. function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj): HResult;
  2378. begin
  2379.   if GetInterface(iid, Obj) then Result := S_OK
  2380.   else Result := E_NOINTERFACE;
  2381. end;
  2382.  
  2383. function TRichEditOleCallback._AddRef: Longint;
  2384. begin
  2385.   Inc(FRefCount);
  2386.   Result := FRefCount;
  2387. end;
  2388.  
  2389. function TRichEditOleCallback._Release: Longint;
  2390. begin
  2391.   Dec(FRefCount);
  2392.   Result := FRefCount;
  2393. end;
  2394.  
  2395. procedure TRichEditOleCallback.CreateAccelTable;
  2396. var
  2397.   Menu: TMainMenu;
  2398. begin
  2399.   if (FAccelTable = 0) and Assigned(FFrameForm) then begin
  2400.     Menu := FFrameForm.Form.Menu;
  2401.     if Menu <> nil then
  2402.       Menu.GetOle2AcceleratorTable(FAccelTable, FAccelCount, [0, 2, 4]);
  2403.   end;
  2404. end;
  2405.  
  2406. procedure TRichEditOleCallback.DestroyAccelTable;
  2407. begin
  2408.   if FAccelTable <> 0 then begin
  2409.     DestroyAcceleratorTable(FAccelTable);
  2410.     FAccelTable := 0;
  2411.     FAccelCount := 0;
  2412.   end;
  2413. end;
  2414.  
  2415. procedure TRichEditOleCallback.AssignFrame;
  2416. begin
  2417.   if (GetParentForm(FRichEdit) <> nil) and not Assigned(FFrameForm) and
  2418.     FRichEdit.AllowInPlace then
  2419.   begin
  2420.     FDocForm := GetVCLFrameForm(ValidParentForm(FRichEdit));
  2421.     FFrameForm := FDocForm;
  2422.     if IsFormMDIChild(FDocForm.Form) then
  2423.       FFrameForm := GetVCLFrameForm(Application.MainForm);
  2424.   end;
  2425. end;
  2426.  
  2427. {$ELSE}
  2428.  
  2429. function TRichEditOleCallback.QueryInterface(const iid: TIID; var Obj): HResult;
  2430. begin
  2431.   if IsEqualIID(iid, IID_IUnknown) or
  2432.     IsEqualIID(iid, IID_IRichEditOleCallback) then
  2433.   begin
  2434.     Pointer(Obj) := Self;
  2435.     AddRef;
  2436.     Result := S_OK;
  2437.   end else begin
  2438.     Pointer(Obj) := nil;
  2439.     Result := E_NOINTERFACE;
  2440.   end;
  2441. end;
  2442.  
  2443. function TRichEditOleCallback.AddRef: Longint;
  2444. begin
  2445.   Inc(FRefCount);
  2446.   Result := FRefCount;
  2447. end;
  2448.  
  2449. function TRichEditOleCallback.Release: Longint;
  2450. begin
  2451.   Dec(FRefCount);
  2452.   Result := FRefCount;
  2453. end;
  2454.  
  2455. {$ENDIF RX_D3}
  2456.  
  2457. function TRichEditOleCallback.GetNewStorage(
  2458.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} stg: IStorage): HResult;
  2459. begin
  2460.   try
  2461.     CreateStorage(stg);
  2462.     Result := S_OK;
  2463.   except
  2464.     Result:= E_OUTOFMEMORY;
  2465.   end;
  2466. end;
  2467.  
  2468. function TRichEditOleCallback.GetInPlaceContext(
  2469.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} Frame: IOleInPlaceFrame;
  2470.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} Doc: IOleInPlaceUIWindow;
  2471.   lpFrameInfo: POleInPlaceFrameInfo): HResult;
  2472. begin
  2473. {$IFDEF RX_D3}
  2474.   AssignFrame;
  2475.   if Assigned(FFrameForm) and FRichEdit.AllowInPlace then begin
  2476.     Frame := FFrameForm;
  2477.     Doc := FDocForm;
  2478.     CreateAccelTable;
  2479.     with lpFrameInfo^ do begin
  2480.       fMDIApp := False;
  2481.       FFrameForm.GetWindow(hWndFrame);
  2482.       hAccel := FAccelTable;
  2483.       cAccelEntries := FAccelCount;
  2484.     end;
  2485.     Result := S_OK;
  2486.   end
  2487.   else Result := E_NOTIMPL;
  2488. {$ELSE}
  2489.   Result := E_NOTIMPL;
  2490. {$ENDIF}
  2491. end;
  2492.  
  2493. function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2494.   cp: Longint): HResult;
  2495. begin
  2496.   Result := NOERROR;
  2497. end;
  2498.  
  2499. function TRichEditOleCallback.DeleteObject(const oleobj: IOleObject): HResult;
  2500. begin
  2501.   if Assigned(oleobj) then oleobj.Close(OLECLOSE_NOSAVE);
  2502.   Result := NOERROR;
  2503. end;
  2504.  
  2505. function TRichEditOleCallback.QueryAcceptData(const dataobj: IDataObject;
  2506.   var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
  2507.   hMetaPict: HGLOBAL): HResult;
  2508. begin
  2509.   Result := S_OK;
  2510. end;
  2511.  
  2512. function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
  2513. begin
  2514.   Result := NOERROR;
  2515. end;
  2516.  
  2517. function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2518.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} dataobj: IDataObject): HResult;
  2519. begin
  2520.   Result := E_NOTIMPL;
  2521. end;
  2522.  
  2523. function TRichEditOleCallback.GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2524.   var dwEffect: DWORD): HResult;
  2525. begin
  2526.   Result := E_NOTIMPL;
  2527. end;
  2528.  
  2529. function TRichEditOleCallback.GetContextMenu(seltype: Word;
  2530.   const oleobj: IOleObject; const chrg: TCharRange;
  2531.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} menu: HMENU): HResult;
  2532. begin
  2533.   Result := E_NOTIMPL;
  2534. end;
  2535.  
  2536. function TRichEditOleCallback.ShowContainerUI(fShow: BOOL): HResult;
  2537. begin
  2538. {$IFDEF RX_D3}
  2539.   if not fShow then AssignFrame;
  2540.   if Assigned(FFrameForm) then begin
  2541.     if fShow then begin
  2542.       FFrameForm.SetMenu(0, 0, 0);
  2543.       FFrameForm.ClearBorderSpace;
  2544.       FRichEdit.SetUIActive(False);
  2545.       DestroyAccelTable;
  2546. {$IFDEF RX_D4}
  2547.       TForm(FFrameForm.Form).AutoScroll := FAutoScroll;
  2548. {$ENDIF}
  2549.       FFrameForm := nil;
  2550.       FDocForm := nil;
  2551.     end
  2552.     else begin
  2553. {$IFDEF RX_D4}
  2554.       FAutoScroll := TForm(FFrameForm.Form).AutoScroll;
  2555.       TForm(FFrameForm.Form).AutoScroll := False;
  2556. {$ENDIF}
  2557.       FRichEdit.SetUIActive(True);
  2558.     end;
  2559.     Result := S_OK;
  2560.   end
  2561.   else Result := E_NOTIMPL;
  2562. {$ELSE}
  2563.   Result := E_NOTIMPL;
  2564. {$ENDIF}
  2565. end;
  2566.  
  2567. { TOleUIObjInfo - helper interface for Object Properties dialog }
  2568.  
  2569. type
  2570. {$IFDEF RX_D3}
  2571.   TOleUIObjInfo = class(TInterfacedObject, IOleUIObjInfo)
  2572. {$ELSE}
  2573.   TOleUIObjInfo = class(IOleUIObjInfo)
  2574. {$ENDIF}
  2575.   private
  2576.     FRichEdit: TRxCustomRichEdit;
  2577.     FReObject: TReObject;
  2578.   public
  2579.     constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject);
  2580. {$IFNDEF RX_D3}
  2581.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  2582.     function AddRef: Longint; override;
  2583.     function Release: Longint; override;
  2584. {$ENDIF}
  2585.     function GetObjectInfo(dwObject: Longint;
  2586.       var dwObjSize: Longint; var lpszLabel: PChar;
  2587.       var lpszType: PChar; var lpszShortType: PChar;
  2588.       var lpszLocation: PChar): HResult;
  2589.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2590.     function GetConvertInfo(dwObject: Longint; var ClassID: TCLSID;
  2591.       var wFormat: Word; var ConvertDefaultClassID: TCLSID;
  2592.       var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult;
  2593.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2594.     function ConvertObject(dwObject: Longint;
  2595.       const clsidNew: TCLSID): HResult;
  2596.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2597.     function GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal;
  2598.       var dvAspect: Longint; var nCurrentScale: Integer): HResult;
  2599.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2600.     function SetViewInfo(dwObject: Longint; hMetaPict: HGlobal;
  2601.       dvAspect: Longint; nCurrentScale: Integer;
  2602.       bRelativeToOrig: BOOL): HResult;
  2603.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2604.   end;
  2605.  
  2606. constructor TOleUIObjInfo.Create(RichEdit: TRxCustomRichEdit;
  2607.   ReObject: TReObject);
  2608. begin
  2609.   inherited Create;
  2610.   FRichEdit := RichEdit;
  2611.   FReObject := ReObject;
  2612. end;
  2613.  
  2614. {$IFNDEF RX_D3}
  2615.  
  2616. function TOleUIObjInfo.QueryInterface(const iid: TIID; var obj): HResult;
  2617. begin
  2618.   Pointer(obj) := nil;
  2619.   Result := E_NOINTERFACE;
  2620. end;
  2621.  
  2622. function TOleUIObjInfo.AddRef: Longint;
  2623. begin
  2624.   Result := 0;
  2625. end;
  2626.  
  2627. function TOleUIObjInfo.Release: Longint;
  2628. begin
  2629.   Result := 0;
  2630. end;
  2631.  
  2632. {$ENDIF RX_D3}
  2633.  
  2634. function TOleUIObjInfo.GetObjectInfo(dwObject: Longint;
  2635.   var dwObjSize: Longint; var lpszLabel: PChar;
  2636.   var lpszType: PChar; var lpszShortType: PChar;
  2637.   var lpszLocation: PChar): HResult;
  2638. begin
  2639.   if @dwObjSize <> nil then
  2640.     dwObjSize := -1 { Unknown size };
  2641.   if @lpszLabel <> nil then
  2642.     lpszLabel := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
  2643.   if @lpszType <> nil then
  2644.     lpszType := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
  2645.   if @lpszShortType <> nil then
  2646.     lpszShortType := CoAllocCStr(GetShortNameStr(FReObject.poleobj));
  2647.   if (@lpszLocation <> nil) then begin
  2648.     if Trim(FRichEdit.Title) <> '' then
  2649.       lpszLocation := CoAllocCStr(Format('%s - %s',
  2650.         [FRichEdit.Title, Application.Title]))
  2651.     else
  2652.       lpszLocation := CoAllocCStr(Application.Title);
  2653.   end;
  2654.   Result := S_OK;
  2655. end;
  2656.  
  2657. function TOleUIObjInfo.GetConvertInfo(dwObject: Longint; var ClassID: TCLSID;
  2658.   var wFormat: Word; var ConvertDefaultClassID: TCLSID;
  2659.   var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult;
  2660. begin
  2661.   FReObject.poleobj.GetUserClassID(ClassID);
  2662.   Result := S_OK;
  2663. end;
  2664.  
  2665. function TOleUIObjInfo.ConvertObject(dwObject: Longint;
  2666.   const clsidNew: TCLSID): HResult;
  2667. begin
  2668.   Result := E_NOTIMPL;
  2669. end;
  2670.  
  2671. function TOleUIObjInfo.GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal;
  2672.   var dvAspect: Longint; var nCurrentScale: Integer): HResult;
  2673. begin
  2674.   if @hMetaPict <> nil then
  2675.     hMetaPict := GetIconMetaPict(FReObject.poleobj, FReObject.dvAspect);
  2676.   if @dvAspect <> nil then dvAspect := FReObject.dvAspect;
  2677.   if @nCurrentScale <> nil then nCurrentScale := 0;
  2678.   Result := S_OK;
  2679. end;
  2680.  
  2681. function TOleUIObjInfo.SetViewInfo(dwObject: Longint; hMetaPict: HGlobal;
  2682.   dvAspect: Longint; nCurrentScale: Integer;
  2683.   bRelativeToOrig: BOOL): HResult;
  2684. var
  2685.   Iconic: Boolean;
  2686. begin
  2687.   if Assigned(FRichEdit.FRichEditOle) then begin
  2688.     case dvAspect of
  2689.       DVASPECT_CONTENT:
  2690.         Iconic := False;
  2691.       DVASPECT_ICON:
  2692.         Iconic := True;
  2693.       else
  2694.         Iconic := FReObject.dvAspect = DVASPECT_ICON;
  2695.     end;
  2696.     IRichEditOle(FRichEdit.FRichEditOle).InPlaceDeactivate;
  2697.     Result := OleSetDrawAspect(FReObject.poleobj, Iconic, hMetaPict,
  2698.       FReObject.dvAspect);
  2699.     if Succeeded(Result) then
  2700.       IRichEditOle(FRichEdit.FRichEditOle).SetDvaspect(
  2701.         Longint(REO_IOB_SELECTION), FReObject.dvAspect);
  2702.   end
  2703.   else Result := E_NOTIMPL;
  2704. end;
  2705.  
  2706. { TOleUILinkInfo - helper interface for Object Properties dialog }
  2707.  
  2708. type
  2709. {$IFDEF RX_D3}
  2710.   TOleUILinkInfo = class(TInterfacedObject, IOleUILinkInfo)
  2711. {$ELSE}
  2712.   TOleUILinkInfo = class(IOleUILinkInfo)
  2713. {$ENDIF}
  2714.   private
  2715.     FReObject: TReObject;
  2716.     FRichEdit: TRxCustomRichEdit;
  2717.     FOleLink: IOleLink;
  2718.   public
  2719.     constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject);
  2720. {$IFNDEF RX_D3}
  2721.     destructor Destroy; override;
  2722.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  2723.     function AddRef: Longint; override;
  2724.     function Release: Longint; override;
  2725. {$ENDIF}
  2726.     function GetNextLink(dwLink: Longint): Longint;
  2727.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2728.     function SetLinkUpdateOptions(dwLink: Longint;
  2729.       dwUpdateOpt: Longint): HResult;
  2730.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2731.     function GetLinkUpdateOptions(dwLink: Longint;
  2732.       var dwUpdateOpt: Longint): HResult;
  2733.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2734.     function SetLinkSource(dwLink: Longint; pszDisplayName: PChar;
  2735.       lenFileName: Longint; var chEaten: Longint;
  2736.       fValidateSource: BOOL): HResult;
  2737.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2738.     function GetLinkSource(dwLink: Longint; var pszDisplayName: PChar;
  2739.       var lenFileName: Longint; var pszFullLinkType: PChar;
  2740.       var pszShortLinkType: PChar; var fSourceAvailable: BOOL;
  2741.       var fIsSelected: BOOL): HResult;
  2742.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2743.     function OpenLinkSource(dwLink: Longint): HResult;
  2744.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2745.     function UpdateLink(dwLink: Longint; fErrorMessage: BOOL;
  2746.       fErrorAction: BOOL): HResult;
  2747.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2748.     function CancelLink(dwLink: Longint): HResult;
  2749.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2750.     function GetLastUpdate(dwLink: Longint;
  2751.       var LastUpdate: TFileTime): HResult;
  2752.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2753.   end;
  2754.  
  2755. {$IFDEF RX_D3}
  2756. procedure LinkError(const Ident: string);
  2757. begin
  2758.   Application.MessageBox(PChar(Ident), PChar(SLinkProperties),
  2759.     MB_OK or MB_ICONSTOP);
  2760. end;
  2761. {$ELSE}
  2762. procedure LinkError(Ident: Integer);
  2763. begin
  2764.   Application.MessageBox(PChar(LoadStr(Ident)),
  2765.     PChar(LoadStr(SLinkProperties)), MB_OK or MB_ICONSTOP);
  2766. end;
  2767. {$ENDIF}
  2768.  
  2769. constructor TOleUILinkInfo.Create(RichEdit: TRxCustomRichEdit;
  2770.   ReObject: TReObject);
  2771. begin
  2772.   inherited Create;
  2773.   FReObject := ReObject;
  2774.   FRichEdit := RichEdit;
  2775. {$IFDEF RX_D3}
  2776.   OleCheck(FReObject.poleobj.QueryInterface(IOleLink, FOleLink));
  2777. {$ELSE}
  2778.   OleCheck(FReObject.poleobj.QueryInterface(IID_IOleLink, FOleLink));
  2779. {$ENDIF}
  2780. end;
  2781.  
  2782. {$IFNDEF RX_D3}
  2783.  
  2784. destructor TOleUILinkInfo.Destroy;
  2785. begin
  2786.   ReleaseObject(FOleLink);
  2787.   inherited Destroy;
  2788. end;
  2789.  
  2790. function TOleUILinkInfo.QueryInterface(const iid: TIID; var obj): HResult;
  2791. begin
  2792.   Pointer(obj) := nil;
  2793.   Result := E_NOINTERFACE;
  2794. end;
  2795.  
  2796. function TOleUILinkInfo.AddRef: Longint;
  2797. begin
  2798.   Result := 0;
  2799. end;
  2800.  
  2801. function TOleUILinkInfo.Release: Longint;
  2802. begin
  2803.   Result := 0;
  2804. end;
  2805.  
  2806. {$ENDIF}
  2807.  
  2808. function TOleUILinkInfo.GetNextLink(dwLink: Longint): Longint;
  2809. begin
  2810.   if dwLink = 0 then Result := Longint(FRichEdit)
  2811.   else Result := 0;
  2812. end;
  2813.  
  2814. function TOleUILinkInfo.SetLinkUpdateOptions(dwLink: Longint;
  2815.   dwUpdateOpt: Longint): HResult;
  2816. begin
  2817.   Result := FOleLink.SetUpdateOptions(dwUpdateOpt);
  2818.   if Succeeded(Result) then FRichEdit.Modified := True;
  2819. end;
  2820.  
  2821. function TOleUILinkInfo.GetLinkUpdateOptions(dwLink: Longint;
  2822.   var dwUpdateOpt: Longint): HResult;
  2823. begin
  2824.   Result := FOleLink.GetUpdateOptions(dwUpdateOpt);
  2825. end;
  2826.  
  2827. function TOleUILinkInfo.SetLinkSource(dwLink: Longint; pszDisplayName: PChar;
  2828.   lenFileName: Longint; var chEaten: Longint;
  2829.   fValidateSource: BOOL): HResult;
  2830. var
  2831.   DisplayName: string;
  2832.   Buffer: array[0..255] of WideChar;
  2833. begin
  2834.   Result := E_FAIL;
  2835.   if fValidateSource then begin
  2836.     DisplayName := pszDisplayName;
  2837.     if Succeeded(FOleLink.SetSourceDisplayName(StringToWideChar(DisplayName,
  2838.       Buffer, SizeOf(Buffer) div 2))) then
  2839.     begin
  2840.       chEaten := Length(DisplayName);
  2841.       try
  2842.         OleCheck(FReObject.poleobj.Update);
  2843.       except
  2844.         Application.HandleException(FRichEdit);
  2845.       end;
  2846.       Result := S_OK;
  2847.     end;
  2848.   end
  2849.   else LinkError(SInvalidLinkSource);
  2850. end;
  2851.  
  2852. function TOleUILinkInfo.GetLinkSource(dwLink: Longint; var pszDisplayName: PChar;
  2853.   var lenFileName: Longint; var pszFullLinkType: PChar;
  2854.   var pszShortLinkType: PChar; var fSourceAvailable: BOOL;
  2855.   var fIsSelected: BOOL): HResult;
  2856. var
  2857.   Moniker: IMoniker;
  2858. begin
  2859.   if @pszDisplayName <> nil then
  2860.     pszDisplayName := CoAllocCStr(GetDisplayNameStr(FOleLink));
  2861.   if @lenFileName <> nil then begin
  2862.     lenFileName := 0;
  2863.     FOleLink.GetSourceMoniker(Moniker);
  2864.     if Moniker <> nil then begin
  2865.       lenFileName := OleStdGetLenFilePrefixOfMoniker(Moniker);
  2866.       ReleaseObject(Moniker);
  2867.     end;
  2868.   end;
  2869.   if @pszFullLinkType <> nil then
  2870.     pszFullLinkType := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
  2871.   if @pszShortLinkType <> nil then
  2872.     pszShortLinkType := CoAllocCStr(GetShortNameStr(FReObject.poleobj));
  2873.   Result := S_OK;
  2874. end;
  2875.  
  2876. function TOleUILinkInfo.OpenLinkSource(dwLink: Longint): HResult;
  2877. begin
  2878.   try
  2879.     OleCheck(FReObject.poleobj.DoVerb(OLEIVERB_SHOW, nil, FReObject.polesite,
  2880.       0, FRichEdit.Handle, FRichEdit.ClientRect));
  2881.   except
  2882.     Application.HandleException(FRichEdit);
  2883.   end;
  2884.   Result := S_OK;
  2885. end;
  2886.  
  2887. function TOleUILinkInfo.UpdateLink(dwLink: Longint; fErrorMessage: BOOL;
  2888.   fErrorAction: BOOL): HResult;
  2889. begin
  2890.   try
  2891.     OleCheck(FReObject.poleobj.Update);
  2892.   except
  2893.     Application.HandleException(FRichEdit);
  2894.   end;
  2895.   Result := S_OK;
  2896. end;
  2897.  
  2898. function TOleUILinkInfo.CancelLink(dwLink: Longint): HResult;
  2899. begin
  2900.   LinkError(SCannotBreakLink);
  2901.   Result := E_NOTIMPL;
  2902. end;
  2903.  
  2904. function TOleUILinkInfo.GetLastUpdate(dwLink: Longint;
  2905.   var LastUpdate: TFileTime): HResult;
  2906. begin
  2907.   Result := S_OK;
  2908. end;
  2909.  
  2910. { Get RichEdit OLE interface }
  2911.  
  2912. function GetRichEditOle(Wnd: HWnd; var RichEditOle): Boolean;
  2913. begin
  2914.   Result := SendMessage(Wnd, EM_GETOLEINTERFACE, 0, Longint(@RichEditOle)) <> 0;
  2915. end;
  2916.  
  2917. { TRichEditStrings }
  2918.  
  2919. const
  2920.   ReadError  = $0001;
  2921.   WriteError = $0002;
  2922.   NoError    = $0000;
  2923.  
  2924. type
  2925.   TRichEditStrings = class(TStrings)
  2926.   private
  2927.     RichEdit: TRxCustomRichEdit;
  2928.     FFormat: TRichStreamFormat;
  2929.     FMode: TRichStreamModes;
  2930.     FConverter: TConversion;
  2931.     procedure EnableChange(const Value: Boolean);
  2932.   protected
  2933.     function Get(Index: Integer): string; override;
  2934.     function GetCount: Integer; override;
  2935.     procedure Put(Index: Integer; const S: string); override;
  2936.     procedure SetUpdateState(Updating: Boolean); override;
  2937.     procedure SetTextStr(const Value: string); override;
  2938.   public
  2939.     destructor Destroy; override;
  2940.     procedure Clear; override;
  2941.     procedure AddStrings(Strings: TStrings); override;
  2942.     procedure Delete(Index: Integer); override;
  2943.     procedure Insert(Index: Integer; const S: string); override;
  2944.     procedure LoadFromFile(const FileName: string); override;
  2945.     procedure LoadFromStream(Stream: TStream); override;
  2946.     procedure SaveToFile(const FileName: string); override;
  2947.     procedure SaveToStream(Stream: TStream); override;
  2948.     property Format: TRichStreamFormat read FFormat write FFormat;
  2949.     property Mode: TRichStreamModes read FMode write FMode;
  2950.   end;
  2951.  
  2952. destructor TRichEditStrings.Destroy;
  2953. begin
  2954.   FConverter.Free;
  2955.   inherited Destroy;
  2956. end;
  2957.  
  2958. procedure TRichEditStrings.AddStrings(Strings: TStrings);
  2959. var
  2960.   SelChange: TNotifyEvent;
  2961. begin
  2962.   SelChange := RichEdit.OnSelectionChange;
  2963.   RichEdit.OnSelectionChange := nil;
  2964.   try
  2965.     inherited AddStrings(Strings);
  2966.   finally
  2967.     RichEdit.OnSelectionChange := SelChange;
  2968.   end;
  2969. end;
  2970.  
  2971. function TRichEditStrings.GetCount: Integer;
  2972. begin
  2973.   with RichEdit do begin
  2974.     Result := SendMessage(Handle, EM_GETLINECOUNT, 0, 0);
  2975.     if GetLineLength(GetLineIndex(Result - 1)) = 0 then Dec(Result);
  2976.   end;
  2977. end;
  2978.  
  2979. function TRichEditStrings.Get(Index: Integer): string;
  2980. var
  2981.   Text: array[0..4095] of Char;
  2982.   L: Integer;
  2983. begin
  2984.   Word((@Text)^) := SizeOf(Text);
  2985.   L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
  2986.   if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2)
  2987.   else if (RichEditVersion >= 2) and (Text[L - 1] = #13) then Dec(L);
  2988.   SetString(Result, Text, L);
  2989. end;
  2990.  
  2991. procedure TRichEditStrings.Put(Index: Integer; const S: string);
  2992. var
  2993.   Selection: TCharRange;
  2994. begin
  2995.   if Index >= 0 then
  2996.   begin
  2997.     Selection.cpMin := RichEdit.GetLineIndex(Index);
  2998.     if Selection.cpMin <> -1 then begin
  2999.       Selection.cpMax := Selection.cpMin +
  3000.         RichEdit.GetLineLength(Selection.cpMin);
  3001.       SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
  3002.       RichEdit.FLinesUpdating := True;
  3003.       try
  3004.         SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  3005.       finally
  3006.         RichEdit.FLinesUpdating := False;
  3007.       end;
  3008.     end;
  3009.   end;
  3010. end;
  3011.  
  3012. procedure TRichEditStrings.Insert(Index: Integer; const S: string);
  3013. var
  3014.   L: Integer;
  3015.   Selection: TCharRange;
  3016.   Fmt: PChar;
  3017.   Str: string;
  3018. begin
  3019.   if Index >= 0 then begin
  3020.     Selection.cpMin := RichEdit.GetLineIndex(Index);
  3021.     if Selection.cpMin >= 0 then begin
  3022.       if RichEditVersion = 1 then Fmt := '%s'#13#10
  3023.       else Fmt := '%s'#13;
  3024.     end
  3025.     else begin
  3026.       Selection.cpMin := RichEdit.GetLineIndex(Index - 1);
  3027.       if Selection.cpMin < 0 then Exit;
  3028.       L := RichEdit.GetLineLength(Selection.cpMin);
  3029.       if L = 0 then Exit;
  3030.       Inc(Selection.cpMin, L);
  3031.       if RichEditVersion = 1 then Fmt := #13#10'%s'
  3032.       else Fmt := #13'%s';
  3033.     end;
  3034.     Selection.cpMax := Selection.cpMin;
  3035.     SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
  3036.     Str := SysUtils.Format(Fmt, [S]);
  3037.     RichEdit.FLinesUpdating := True;
  3038.     try
  3039.       SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(Str)));
  3040.     finally
  3041.       RichEdit.FLinesUpdating := False;
  3042.     end;
  3043.     if RichEditVersion = 1 then
  3044.       if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
  3045.         raise EOutOfResources.Create(ResStr(sRichEditInsertError));
  3046.   end;
  3047. end;
  3048.  
  3049. procedure TRichEditStrings.Delete(Index: Integer);
  3050. const
  3051.   Empty: PChar = '';
  3052. var
  3053.   Selection: TCharRange;
  3054. begin
  3055.   if Index < 0 then Exit;
  3056.   Selection.cpMin := RichEdit.GetLineIndex(Index);
  3057.   if Selection.cpMin <> -1 then begin
  3058.     Selection.cpMax := RichEdit.GetLineIndex(Index + 1);
  3059.     if Selection.cpMax = -1 then
  3060.       Selection.cpMax := Selection.cpMin +
  3061.         RichEdit.GetLineLength(Selection.cpMin);
  3062.     SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
  3063.     RichEdit.FLinesUpdating := True;
  3064.     try
  3065.       SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
  3066.     finally
  3067.       RichEdit.FLinesUpdating := False;
  3068.     end;
  3069.   end;
  3070. end;
  3071.  
  3072. procedure TRichEditStrings.Clear;
  3073. begin
  3074.   RichEdit.Clear;
  3075. end;
  3076.  
  3077. procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
  3078. begin
  3079.   if RichEdit.Showing then
  3080.     SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  3081.   if not Updating then begin
  3082.     RichEdit.Refresh;
  3083.     RichEdit.Perform(CM_TEXTCHANGED, 0, 0);
  3084.   end;
  3085. end;
  3086.  
  3087. procedure TRichEditStrings.EnableChange(const Value: Boolean);
  3088. var
  3089.   EventMask: Longint;
  3090. begin
  3091.   with RichEdit do begin
  3092.     EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  3093.     if Value then
  3094.       EventMask := EventMask or ENM_CHANGE
  3095.     else
  3096.       EventMask := EventMask and not ENM_CHANGE;
  3097.     SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
  3098.   end;
  3099. end;
  3100.  
  3101. procedure TRichEditStrings.SetTextStr(const Value: string);
  3102. begin
  3103.   EnableChange(False);
  3104.   try
  3105.     inherited SetTextStr(Value);
  3106.   finally
  3107.     EnableChange(True);
  3108.   end;
  3109. end;
  3110.  
  3111. function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
  3112. asm
  3113.         PUSH    ESI
  3114.         PUSH    EDI
  3115.         MOV     EDI,EAX
  3116.         MOV     ESI,EDX
  3117.         MOV     EDX,EAX
  3118.         CLD
  3119. @@1:    LODSB
  3120. @@2:    OR      AL,AL
  3121.         JE      @@4
  3122.         CMP     AL,0AH
  3123.         JE      @@3
  3124.         STOSB
  3125.         CMP     AL,0DH
  3126.         JNE     @@1
  3127.         MOV     AL,0AH
  3128.         STOSB
  3129.         LODSB
  3130.         CMP     AL,0AH
  3131.         JE      @@1
  3132.         JMP     @@2
  3133. @@3:    MOV     EAX,0A0DH
  3134.         STOSW
  3135.         JMP     @@1
  3136. @@4:    STOSB
  3137.         LEA     EAX,[EDI-1]
  3138.         SUB     EAX,EDX
  3139.         POP     EDI
  3140.         POP     ESI
  3141. end;
  3142.  
  3143. function StreamSave(dwCookie: Longint; pbBuff: PByte;
  3144.   cb: Longint; var pcb: Longint): Longint; stdcall;
  3145. var
  3146.   StreamInfo: PRichEditStreamInfo;
  3147. begin
  3148.   Result := NoError;
  3149.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  3150.   try
  3151.     pcb := 0;
  3152.     if StreamInfo^.Converter <> nil then
  3153.       pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
  3154.   except
  3155.     Result := WriteError;
  3156.   end;
  3157. end;
  3158.  
  3159. function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  3160.   cb: Longint; var pcb: Longint): Longint; stdcall;
  3161. var
  3162.   Buffer, pBuff: PChar;
  3163.   StreamInfo: PRichEditStreamInfo;
  3164. begin
  3165.   Result := NoError;
  3166.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  3167.   Buffer := StrAlloc(cb + 1);
  3168.   try
  3169.     cb := cb div 2;
  3170.     pcb := 0;
  3171.     pBuff := Buffer + cb;
  3172.     try
  3173.       if StreamInfo^.Converter <> nil then
  3174.         pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
  3175.       if pcb > 0 then
  3176.       begin
  3177.         pBuff[pcb] := #0;
  3178.         if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
  3179.         pcb := AdjustLineBreaks(Buffer, pBuff);
  3180.         Move(Buffer^, pbBuff^, pcb);
  3181.       end;
  3182.     except
  3183.       Result := ReadError;
  3184.     end;
  3185.   finally
  3186.     StrDispose(Buffer);
  3187.   end;
  3188. end;
  3189.  
  3190. procedure TRichEditStrings.LoadFromStream(Stream: TStream);
  3191. var
  3192.   EditStream: TEditStream;
  3193.   Position: Longint;
  3194.   TextType: Longint;
  3195.   StreamInfo: TRichEditStreamInfo;
  3196.   Converter: TConversion;
  3197. begin
  3198.   StreamInfo.Stream := Stream;
  3199.   if FConverter <> nil then Converter := FConverter
  3200.   else Converter := RichEdit.DefaultConverter.Create;
  3201.   StreamInfo.Converter := Converter;
  3202.   try
  3203.     with EditStream do
  3204.     begin
  3205.       dwCookie := Longint(Pointer(@StreamInfo));
  3206.       pfnCallBack := @StreamLoad;
  3207.       dwError := 0;
  3208.     end;
  3209.     Position := Stream.Position;
  3210.     case FFormat of
  3211.       sfDefault:
  3212.         if RichEdit.PlainText then TextType := SF_TEXT
  3213.         else TextType := SF_RTF;
  3214.       sfRichText: TextType := SF_RTF;
  3215.       else {sfPlainText} TextType := SF_TEXT;
  3216.     end;
  3217.     if TextType = SF_RTF then begin
  3218.       if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF;
  3219.     end;
  3220.     if TextType = SF_TEXT then begin
  3221.       if (smUnicode in Mode) and (RichEditVersion > 1) then
  3222.         TextType := TextType or SF_UNICODE;
  3223.     end;
  3224.     if smSelection in Mode then TextType := TextType or SFF_SELECTION;
  3225.     SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  3226.     if (EditStream.dwError <> 0) then begin
  3227.       Stream.Position := Position;
  3228.       if (TextType and SF_RTF = SF_RTF) then TextType := SF_TEXT
  3229.       else TextType := SF_RTF;
  3230.       SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  3231.       if EditStream.dwError <> 0 then
  3232.         raise EOutOfResources.Create(ResStr(sRichEditLoadFail));
  3233.     end;
  3234.     RichEdit.SetSelection(0, 0, True);
  3235.   finally
  3236.     if FConverter = nil then Converter.Free;
  3237.   end;
  3238. end;
  3239.  
  3240. procedure TRichEditStrings.SaveToStream(Stream: TStream);
  3241. var
  3242.   EditStream: TEditStream;
  3243.   TextType: Longint;
  3244.   StreamInfo: TRichEditStreamInfo;
  3245.   Converter: TConversion;
  3246. begin
  3247.   if FConverter <> nil then Converter := FConverter
  3248.   else Converter := RichEdit.DefaultConverter.Create;
  3249.   StreamInfo.Stream := Stream;
  3250.   StreamInfo.Converter := Converter;
  3251.   try
  3252.     with EditStream do
  3253.     begin
  3254.       dwCookie := Longint(Pointer(@StreamInfo));
  3255.       pfnCallBack := @StreamSave;
  3256.       dwError := 0;
  3257.     end;
  3258.     case FFormat of
  3259.       sfDefault:
  3260.         if RichEdit.PlainText then TextType := SF_TEXT
  3261.         else TextType := SF_RTF;
  3262.       sfRichText: TextType := SF_RTF;
  3263.       else {sfPlainText} TextType := SF_TEXT;
  3264.     end;
  3265.     if TextType = SF_RTF then begin
  3266.       if smNoObjects in Mode then TextType := SF_RTFNOOBJS;
  3267.       if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF;
  3268.     end
  3269.     else if TextType = SF_TEXT then begin
  3270.       if (smUnicode in Mode) and (RichEditVersion > 1) then
  3271.         TextType := TextType or SF_UNICODE;
  3272.     end;
  3273.     if smSelection in Mode then TextType := TextType or SFF_SELECTION;
  3274.     SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
  3275.     if EditStream.dwError <> 0 then
  3276.       raise EOutOfResources.Create(ResStr(sRichEditSaveFail));
  3277.   finally
  3278.     if FConverter = nil then Converter.Free;
  3279.   end;
  3280. end;
  3281.  
  3282. procedure TRichEditStrings.LoadFromFile(const FileName: string);
  3283. var
  3284.   Ext: string;
  3285.   Convert: PRichConversionFormat;
  3286.   SaveFormat: TRichStreamFormat;
  3287. begin
  3288. {$IFNDEF VER90}
  3289.   Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
  3290. {$ELSE}
  3291.   Ext := LowerCase(ExtractFileExt(Filename));
  3292. {$ENDIF}
  3293.   System.Delete(Ext, 1, 1);
  3294.   Convert := ConversionFormatList;
  3295.   while Convert <> nil do
  3296.     with Convert^ do
  3297.       if Extension <> Ext then Convert := Next
  3298.       else Break;
  3299.   if (FConverter = nil) and (Convert <> nil) then
  3300.     FConverter := Convert^.ConversionClass.Create;
  3301.   try
  3302.     SaveFormat := Format;
  3303.     try
  3304.       if Convert <> nil then begin
  3305.         if Convert^.PlainText then FFormat := sfPlainText
  3306.         else FFormat := sfRichText;
  3307.       end;
  3308.       inherited LoadFromFile(FileName);
  3309.     finally
  3310.       FFormat := SaveFormat;
  3311.     end;
  3312.   except
  3313.     FConverter.Free;
  3314.     FConverter := nil;
  3315.     raise;
  3316.   end;
  3317. end;
  3318.  
  3319. procedure TRichEditStrings.SaveToFile(const FileName: string);
  3320. var
  3321.   Ext: string;
  3322.   Convert: PRichConversionFormat;
  3323.   SaveFormat: TRichStreamFormat;
  3324. begin
  3325. {$IFNDEF VER90}
  3326.   Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
  3327. {$ELSE}
  3328.   Ext := LowerCase(ExtractFileExt(Filename));
  3329. {$ENDIF}
  3330.   System.Delete(Ext, 1, 1);
  3331.   Convert := ConversionFormatList;
  3332.   while Convert <> nil do
  3333.     with Convert^ do
  3334.       if Extension <> Ext then Convert := Next
  3335.       else Break;
  3336.   if (FConverter = nil) and (Convert <> nil) then
  3337.     FConverter := Convert^.ConversionClass.Create;
  3338.   try
  3339.     SaveFormat := Format;
  3340.     try
  3341.       if Convert <> nil then begin
  3342.         if Convert^.PlainText then FFormat := sfPlainText
  3343.         else FFormat := sfRichText;
  3344.       end;
  3345.       inherited SaveToFile(FileName);
  3346.     finally
  3347.       FFormat := SaveFormat;
  3348.     end;
  3349.   except
  3350.     FConverter.Free;
  3351.     FConverter := nil;
  3352.     raise;
  3353.   end;
  3354. end;
  3355.  
  3356. { TOEMConversion }
  3357.  
  3358. function TOEMConversion.ConvertReadStream(Stream: TStream; Buffer: PChar;
  3359.   BufSize: Integer): Integer;
  3360. var
  3361.   Mem: TMemoryStream;
  3362. begin
  3363.   Mem := TMemoryStream.Create;
  3364.   try
  3365.     Mem.SetSize(BufSize);
  3366.     Result := inherited ConvertReadStream(Stream, PChar(Mem.Memory), BufSize);
  3367.     OemToCharBuff(PChar(Mem.Memory), Buffer, Result);
  3368.   finally
  3369.     Mem.Free;
  3370.   end;
  3371. end;
  3372.  
  3373. function TOEMConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar;
  3374.   BufSize: Integer): Integer;
  3375. var
  3376.   Mem: TMemoryStream;
  3377. begin
  3378.   Mem := TMemoryStream.Create;
  3379.   try
  3380.     Mem.SetSize(BufSize);
  3381.     CharToOemBuff(Buffer, PChar(Mem.Memory), BufSize);
  3382.     Result := inherited ConvertWriteStream(Stream, PChar(Mem.Memory), BufSize);
  3383.   finally
  3384.     Mem.Free;
  3385.   end;
  3386. end;
  3387.  
  3388. { TRxCustomRichEdit }
  3389.  
  3390. constructor TRxCustomRichEdit.Create(AOwner: TComponent);
  3391. var
  3392.   DC: HDC;
  3393. begin
  3394.   inherited Create(AOwner);
  3395.   ControlStyle := ControlStyle - [csSetCaption];
  3396.   FSelAttributes := TRxTextAttributes.Create(Self, atSelected);
  3397.   FDefAttributes := TRxTextAttributes.Create(Self, atDefaultText);
  3398.   FWordAttributes := TRxTextAttributes.Create(Self, atWord);
  3399.   FParagraph := TRxParaAttributes.Create(Self);
  3400.   FRichEditStrings := TRichEditStrings.Create;
  3401.   TRichEditStrings(FRichEditStrings).RichEdit := Self;
  3402.   TabStop := True;
  3403.   Width := 185;
  3404.   Height := 89;
  3405.   AutoSize := False;
  3406. {$IFDEF RX_D4}
  3407.   DoubleBuffered := False;
  3408. {$ENDIF}
  3409.   FAllowObjects := True;
  3410. {$IFDEF RX_D3}
  3411.   FAllowInPlace := True;
  3412. {$ENDIF}
  3413.   FAutoVerbMenu := True;
  3414.   FHideSelection := True;
  3415.   FHideScrollBars := True;
  3416.   ScrollBars := ssBoth;
  3417.   FSelectionBar := True;
  3418.   FLangOptions := [rlAutoFont];
  3419.   DC := GetDC(0);
  3420.   FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
  3421.   ReleaseDC(0, DC);
  3422.   DefaultConverter := TConversion;
  3423.   FOldParaAlignment := TParaAlignment(Alignment);
  3424.   FUndoLimit := 100;
  3425.   FAutoURLDetect := True;
  3426.   FWordSelection := True;
  3427.   with FClickRange do begin
  3428.     cpMin := -1;
  3429.     cpMax := -1;
  3430.   end;
  3431.   FCallback := TRichEditOleCallback.Create(Self);
  3432. {$IFDEF RX_D4}
  3433.   Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  3434. {$ENDIF}
  3435. end;
  3436.  
  3437. destructor TRxCustomRichEdit.Destroy;
  3438. begin
  3439.   FLastFind := nil;
  3440.   FSelAttributes.Free;
  3441.   FDefAttributes.Free;
  3442.   FWordAttributes.Free;
  3443.   FParagraph.Free;
  3444.   FRichEditStrings.Free;
  3445.   FMemStream.Free;
  3446.   FPopupVerbMenu.Free;
  3447.   FFindDialog.Free;
  3448.   FReplaceDialog.Free;
  3449.   inherited Destroy;
  3450.   { be sure that callback object is destroyed after inherited Destroy }
  3451.   TRichEditOleCallback(FCallback).Free;
  3452. end;
  3453.  
  3454. procedure TRxCustomRichEdit.Clear;
  3455. begin
  3456.   CloseObjects;
  3457.   inherited Clear;
  3458.   Modified := False;
  3459. end;
  3460.  
  3461. procedure TRxCustomRichEdit.CreateParams(var Params: TCreateParams);
  3462. const
  3463.   HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
  3464.   HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
  3465.   WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
  3466.   SelectionBars: array[Boolean] of DWORD = (0, ES_SELECTIONBAR);
  3467. begin
  3468.   inherited CreateParams(Params);
  3469.   case RichEditVersion of
  3470.     1: CreateSubClass(Params, RICHEDIT_CLASS10A);
  3471.     else CreateSubClass(Params, RICHEDIT_CLASS);
  3472.   end;
  3473.   with Params do begin
  3474.     Style := (Style and not (WS_HSCROLL or WS_VSCROLL)) or ES_SAVESEL or
  3475.       (WS_CLIPSIBLINGS or WS_CLIPCHILDREN);
  3476.     { NOTE: WS_CLIPCHILDREN and WS_CLIPSIBLINGS are essential otherwise }
  3477.     { once the object is inserted you see some painting problems.       }
  3478.     Style := Style and not (WS_HSCROLL or WS_VSCROLL);
  3479.     if ScrollBars in [ssVertical, ssBoth] then
  3480.       Style := Style or WS_VSCROLL;
  3481.     if (ScrollBars in [ssHorizontal, ssBoth]) and not WordWrap then
  3482.       Style := Style or WS_HSCROLL;
  3483.     Style := Style or HideScrollBars[FHideScrollBars] or
  3484.       SelectionBars[FSelectionBar] or HideSelections[FHideSelection] and
  3485.       not WordWraps[WordWrap];
  3486.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  3487.   end;
  3488. end;
  3489.  
  3490. procedure TRxCustomRichEdit.CreateWnd;
  3491. var
  3492.   StreamFmt: TRichStreamFormat;
  3493.   Mode: TRichStreamModes;
  3494.   DesignMode: Boolean;
  3495.   Mask: Longint;
  3496. begin
  3497.   StreamFmt := TRichEditStrings(Lines).Format;
  3498.   Mode := TRichEditStrings(Lines).Mode;
  3499.   inherited CreateWnd;
  3500. {$IFNDEF VER90}
  3501.   if (SysLocale.FarEast) and not (SysLocale.PriLangID = LANG_JAPANESE) then
  3502.     Font.Charset := GetDefFontCharSet;
  3503. {$ENDIF}
  3504.   Mask := ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_PROTECTED;
  3505.   if RichEditVersion >= 2 then Mask := Mask or ENM_LINK;
  3506.   SendMessage(Handle, EM_SETEVENTMASK, 0, Mask);
  3507.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
  3508. {$IFDEF RX_D3}
  3509.   DoSetMaxLength(MaxLength);
  3510. {$ENDIF}
  3511.   SetWordSelection(FWordSelection);
  3512.   if RichEditVersion >= 2 then begin
  3513.     SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0);
  3514.     FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, FUndoLimit, 0);
  3515.     UpdateTextModes(PlainText);
  3516.     SetLangOptions(FLangOptions);
  3517.   end;
  3518.   if FAllowObjects then begin
  3519.     SendMessage(Handle, EM_SETOLECALLBACK, 0,
  3520.       LPARAM(TRichEditOleCallback(FCallback) as IRichEditOleCallback));
  3521.     GetRichEditOle(Handle, FRichEditOle);
  3522.     UpdateHostNames;
  3523.   end;
  3524.   if FMemStream <> nil then begin
  3525.     FMemStream.ReadBuffer(DesignMode, SizeOf(DesignMode));
  3526.     if DesignMode then begin
  3527.       TRichEditStrings(Lines).Format := sfPlainText;
  3528.       TRichEditStrings(Lines).Mode := [];
  3529.     end;
  3530.     try
  3531.       Lines.LoadFromStream(FMemStream);
  3532.       FMemStream.Free;
  3533.       FMemStream := nil;
  3534.     finally
  3535.       TRichEditStrings(Lines).Format := StreamFmt;
  3536.       TRichEditStrings(Lines).Mode := Mode;
  3537.     end;
  3538.   end;
  3539.   if RichEditVersion < 2 then
  3540.     SendMessage(Handle, WM_SETFONT, 0, 0);
  3541.   Modified := FModified;
  3542. end;
  3543.  
  3544. procedure TRxCustomRichEdit.DestroyWnd;
  3545. var
  3546.   StreamFmt: TRichStreamFormat;
  3547.   Mode: TRichStreamModes;
  3548.   DesignMode: Boolean;
  3549. begin
  3550.   FModified := Modified;
  3551.   FMemStream := TMemoryStream.Create;
  3552.   StreamFmt := TRichEditStrings(Lines).Format;
  3553.   Mode := TRichEditStrings(Lines).Mode;
  3554.   DesignMode := (csDesigning in ComponentState);
  3555.   FMemStream.WriteBuffer(DesignMode, SizeOf(DesignMode));
  3556.   if DesignMode then begin
  3557.     TRichEditStrings(Lines).Format := sfPlainText;
  3558.     TRichEditStrings(Lines).Mode := [];
  3559.   end;
  3560.   try
  3561.     Lines.SaveToStream(FMemStream);
  3562.     FMemStream.Position := 0;
  3563.   finally
  3564.     TRichEditStrings(Lines).Format := StreamFmt;
  3565.     TRichEditStrings(Lines).Mode := Mode;
  3566.   end;
  3567.   inherited DestroyWnd;
  3568. end;
  3569.  
  3570. procedure TRxCustomRichEdit.SetAllowObjects(Value: Boolean);
  3571. begin
  3572.   if FAllowObjects <> Value then begin
  3573.     FAllowObjects := Value;
  3574.     RecreateWnd;    
  3575.   end;
  3576. end;
  3577.  
  3578. procedure TRxCustomRichEdit.UpdateHostNames;
  3579. var
  3580.   AppName: string;
  3581. begin
  3582.   if HandleAllocated and Assigned(FRichEditOle) then begin
  3583.     AppName := Application.Title;
  3584.     if Trim(AppName) = '' then
  3585.       AppName := ExtractFileName(Application.ExeName);
  3586.     if Trim(Title) = '' then
  3587.       IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(AppName))
  3588.     else
  3589.       IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(Title));
  3590.   end;
  3591. end;
  3592.  
  3593. procedure TRxCustomRichEdit.SetTitle(const Value: string);
  3594. begin
  3595.   if FTitle <> Value then begin
  3596.     FTitle := Value;
  3597.     UpdateHostNames;
  3598.   end;
  3599. end;
  3600.  
  3601. function TRxCustomRichEdit.GetPopupMenu: TPopupMenu;
  3602. var
  3603.   EnumOleVerb: IEnumOleVerb;
  3604.   OleVerb: TOleVerb;
  3605.   Item: TMenuItem;
  3606.   ReObject: TReObject;
  3607. begin
  3608.   FPopupVerbMenu.Free;
  3609.   FPopupVerbMenu := nil;
  3610.   Result := inherited GetPopupMenu;
  3611.   if FAutoVerbMenu and (SelectionType = [stObject]) and
  3612.     Assigned(FRichEditOle) then
  3613.   begin
  3614.     FillChar(ReObject, SizeOf(ReObject), 0);
  3615.     ReObject.cbStruct := SizeOf(ReObject);
  3616.     if Succeeded(IRichEditOle(FRichEditOle).GetObject(
  3617.       Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ)) then
  3618.     try
  3619.       if Assigned(ReObject.poleobj) and
  3620.         (ReObject.dwFlags and REO_INPLACEACTIVE = 0) then
  3621.       begin
  3622.         FPopupVerbMenu := TPopupMenu.Create(Self);
  3623.         if ReObject.poleobj.EnumVerbs(EnumOleVerb) = 0 then
  3624.         try
  3625.           while (EnumOleVerb.Next(1, OleVerb, nil) = 0) and
  3626.             (OleVerb.lVerb >= 0) and
  3627.             (OleVerb.grfAttribs and OLEVERBATTRIB_ONCONTAINERMENU <> 0) do
  3628.           begin
  3629.             Item := TMenuItem.Create(FPopupVerbMenu);
  3630.             Item.Caption := WideCharToString(OleVerb.lpszVerbName);
  3631.             Item.Tag := OleVerb.lVerb;
  3632.             Item.Default := (OleVerb.lVerb = OLEIVERB_PRIMARY);
  3633.             Item.OnClick := PopupVerbClick;
  3634.             FPopupVerbMenu.Items.Add(Item);
  3635.           end;
  3636.         finally
  3637.           ReleaseObject(EnumOleVerb);
  3638.         end;
  3639.         if (Result <> nil) and (Result.Items.Count > 0) then begin
  3640.           Item := TMenuItem.Create(FPopupVerbMenu);
  3641.           Item.Caption := '-';
  3642.           Result.Items.Add(Item);
  3643.           Item := TMenuItem.Create(FPopupVerbMenu);
  3644.           Item.Caption := Format(ResStr(SPropDlgCaption),
  3645.             [GetFullNameStr(ReObject.poleobj)]);
  3646.           Item.OnClick := ObjectPropsClick;
  3647.           Result.Items.Add(Item);
  3648.           if FPopupVerbMenu.Items.Count > 0 then begin
  3649.             FPopupVerbMenu.Items.Caption := GetFullNameStr(ReObject.poleobj);
  3650.             Result.Items.Add(FPopupVerbMenu.Items);
  3651.           end;
  3652.         end
  3653.         else if FPopupVerbMenu.Items.Count > 0 then begin
  3654.           Item := TMenuItem.Create(FPopupVerbMenu);
  3655.           Item.Caption := Format(ResStr(SPropDlgCaption),
  3656.             [GetFullNameStr(ReObject.poleobj)]);
  3657.           Item.OnClick := ObjectPropsClick;
  3658.           FPopupVerbMenu.Items.Insert(0, Item);
  3659.           Result := FPopupVerbMenu;
  3660.         end;
  3661.       end;
  3662.     finally
  3663.       ReleaseObject(ReObject.poleobj);
  3664.     end;
  3665.   end;
  3666. end;
  3667.  
  3668. procedure TRxCustomRichEdit.PopupVerbClick(Sender: TObject);
  3669. var
  3670.   ReObject: TReObject;
  3671. begin
  3672.   if Assigned(FRichEditOle) then begin
  3673.     FillChar(ReObject, SizeOf(ReObject), 0);
  3674.     ReObject.cbStruct := SizeOf(ReObject);
  3675.     if Succeeded(IRichEditOle(FRichEditOle).GetObject(
  3676.       Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ or
  3677.       REO_GETOBJ_POLESITE)) then
  3678.     try
  3679.       if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then
  3680.         OleCheck(ReObject.poleobj.DoVerb((Sender as TMenuItem).Tag, nil,
  3681.           ReObject.polesite, 0, Handle, ClientRect));
  3682.     finally
  3683.       ReleaseObject(ReObject.polesite);
  3684.       ReleaseObject(ReObject.poleobj);
  3685.     end;
  3686.   end;
  3687. end;
  3688.  
  3689. procedure TRxCustomRichEdit.ObjectPropsClick(Sender: TObject);
  3690. begin
  3691.   ObjectPropertiesDialog;
  3692. end;
  3693.  
  3694. procedure TRxCustomRichEdit.WMSetFont(var Message: TWMSetFont);
  3695. begin
  3696.   FDefAttributes.Assign(Font);
  3697. end;
  3698.  
  3699. procedure TRxCustomRichEdit.CMFontChanged(var Message: TMessage);
  3700. begin
  3701.   inherited;
  3702.   FDefAttributes.Assign(Font);
  3703. end;
  3704.  
  3705. procedure TRxCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
  3706. var
  3707.   Bounds: TRect;
  3708. begin
  3709.   Bounds := BoundsRect;
  3710.   inherited CreateWindowHandle(Params);
  3711.   if HandleAllocated then BoundsRect := Bounds;
  3712. end;
  3713.  
  3714. {$IFDEF RX_D3}
  3715. procedure TRxCustomRichEdit.DoSetMaxLength(Value: Integer);
  3716. begin
  3717.   { The rich edit control's default maximum amount of text is 32K }
  3718.   { Let's set it at 16M by default }
  3719.   if Value = 0 then Value := $FFFFFF;
  3720.   SendMessage(Handle, EM_EXLIMITTEXT, 0, Value);
  3721. end;
  3722. {$ENDIF}
  3723.  
  3724. function TRxCustomRichEdit.GetCaretPos: TPoint;
  3725. var
  3726.   CharRange: TCharRange;
  3727. begin
  3728.   SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
  3729.   Result.X := CharRange.cpMax;
  3730.   Result.Y := LineFromChar(Result.X);
  3731.   Dec(Result.X, GetLineIndex(-1));
  3732. end;
  3733.  
  3734. {$IFDEF RX_D3}
  3735. function TRxCustomRichEdit.GetSelLength: Integer;
  3736. begin
  3737.   with GetSelection do
  3738.     Result := cpMax - cpMin;
  3739. end;
  3740.  
  3741. function TRxCustomRichEdit.GetSelStart: Integer;
  3742. begin
  3743.   Result := GetSelection.cpMin;
  3744. end;
  3745.  
  3746. function TRxCustomRichEdit.GetSelText: string;
  3747. begin
  3748.   with GetSelection do
  3749.     Result := GetTextRange(cpMin, cpMax);
  3750. end;
  3751. {$ENDIF RX_D3}
  3752.  
  3753. function TRxCustomRichEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  3754. var
  3755.   S: string;
  3756. begin
  3757.   S := SelText;
  3758.   Result := Length(S);
  3759.   if BufSize < Length(S) then Result := BufSize;
  3760.   StrPLCopy(Buffer, S, Result);
  3761. end;
  3762.  
  3763. {$IFDEF RX_D4}
  3764. procedure TRxCustomRichEdit.CMBiDiModeChanged(var Message: TMessage);
  3765. var
  3766.   AParagraph: TParaFormat2;
  3767. begin
  3768.   HandleNeeded; { we REALLY need the handle for BiDi }
  3769.   inherited;
  3770.   Paragraph.GetAttributes(AParagraph);
  3771.   AParagraph.dwMask := PFM_ALIGNMENT;
  3772.   AParagraph.wAlignment := Ord(Alignment) + 1;
  3773.   Paragraph.SetAttributes(AParagraph);
  3774. end;
  3775. {$ENDIF}
  3776.  
  3777. procedure TRxCustomRichEdit.SetHideScrollBars(Value: Boolean);
  3778. begin
  3779.   if HideScrollBars <> Value then begin
  3780.     FHideScrollBars := Value;
  3781.     RecreateWnd;
  3782.   end;
  3783. end;
  3784.  
  3785. procedure TRxCustomRichEdit.SetSelectionBar(Value: Boolean);
  3786. begin
  3787.   if FSelectionBar <> Value then begin
  3788.     FSelectionBar := Value;
  3789.     RecreateWnd;
  3790.   end;
  3791. end;
  3792.  
  3793. procedure TRxCustomRichEdit.SetHideSelection(Value: Boolean);
  3794. begin
  3795.   if HideSelection <> Value then begin
  3796.     FHideSelection := Value;
  3797.     SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LPARAM(True));
  3798.   end;
  3799. end;
  3800.  
  3801. function TRxCustomRichEdit.GetAutoURLDetect: Boolean;
  3802. begin
  3803.   Result := FAutoURLDetect;
  3804.   if HandleAllocated and not (csDesigning in ComponentState) then begin
  3805.     if RichEditVersion >= 2 then
  3806.       Result := Boolean(SendMessage(Handle, EM_GETAUTOURLDETECT, 0, 0));
  3807.   end;
  3808. end;
  3809.  
  3810. procedure TRxCustomRichEdit.SetAutoURLDetect(Value: Boolean);
  3811. begin
  3812.   if Value <> FAutoURLDetect then begin
  3813.     FAutoURLDetect := Value;
  3814.     if HandleAllocated and (RichEditVersion >= 2) then
  3815.       SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0);
  3816.   end;
  3817. end;
  3818.  
  3819. function TRxCustomRichEdit.GetWordSelection: Boolean;
  3820. begin
  3821.   Result := FWordSelection;
  3822.   if HandleAllocated then
  3823.     Result := (SendMessage(Handle, EM_GETOPTIONS, 0, 0) and
  3824.       ECO_AUTOWORDSELECTION) <> 0;
  3825. end;
  3826.  
  3827. procedure TRxCustomRichEdit.SetWordSelection(Value: Boolean);
  3828. var
  3829.   Options: LPARAM;
  3830. begin
  3831.   FWordSelection := Value;
  3832.   if HandleAllocated then begin
  3833.     Options := SendMessage(Handle, EM_GETOPTIONS, 0, 0);
  3834.     if Value then Options := Options or ECO_AUTOWORDSELECTION
  3835.     else Options := Options and not ECO_AUTOWORDSELECTION;
  3836.     SendMessage(Handle, EM_SETOPTIONS, ECOOP_SET, Options);
  3837.   end;
  3838. end;
  3839.  
  3840. const
  3841.   RichLangOptions: array[TRichLangOption] of DWORD = (IMF_AUTOKEYBOARD,
  3842.     IMF_AUTOFONT, IMF_IMECANCELCOMPLETE, IMF_IMEALWAYSSENDNOTIFY);
  3843.  
  3844. function TRxCustomRichEdit.GetLangOptions: TRichLangOptions;
  3845. var
  3846.   Flags: Longint;
  3847.   I: TRichLangOption;
  3848. begin
  3849.   Result := FLangOptions;
  3850.   if HandleAllocated and not (csDesigning in ComponentState) and
  3851.     (RichEditVersion >= 2) then
  3852.   begin
  3853.     Result := [];
  3854.     Flags := SendMessage(Handle, EM_GETLANGOPTIONS, 0, 0);
  3855.     for I := Low(TRichLangOption) to High(TRichLangOption) do
  3856.       if Flags and RichLangOptions[I] <> 0 then Include(Result, I);
  3857.   end;
  3858. end;
  3859.  
  3860. procedure TRxCustomRichEdit.SetLangOptions(Value: TRichLangOptions);
  3861. var
  3862.   Flags: DWORD;
  3863.   I: TRichLangOption;
  3864. begin
  3865.   FLangOptions := Value;
  3866.   if HandleAllocated and (RichEditVersion >= 2) then begin
  3867.     Flags := 0;
  3868.     for I := Low(TRichLangOption) to High(TRichLangOption) do
  3869.       if I in Value then Flags := Flags or RichLangOptions[I];
  3870.     SendMessage(Handle, EM_SETLANGOPTIONS, 0, LPARAM(Flags));
  3871.   end;
  3872. end;
  3873.  
  3874. procedure TRxCustomRichEdit.SetSelAttributes(Value: TRxTextAttributes);
  3875. begin
  3876.   FSelAttributes.Assign(Value);
  3877. end;
  3878.  
  3879. function TRxCustomRichEdit.GetCanRedo: Boolean;
  3880. begin
  3881.   Result := False;
  3882.   if HandleAllocated and (RichEditVersion >= 2) then
  3883.     Result := SendMessage(Handle, EM_CANREDO, 0, 0) <> 0;
  3884. end;
  3885.  
  3886. function TRxCustomRichEdit.GetCanPaste: Boolean;
  3887. begin
  3888.   Result := False;
  3889.   if HandleAllocated then
  3890.     Result := SendMessage(Handle, EM_CANPASTE, 0, 0) <> 0;
  3891. end;
  3892.  
  3893. {$IFNDEF RX_V110}
  3894. function TRxCustomRichEdit.GetCanUndo: Boolean;
  3895. begin
  3896.   Result := False;
  3897.   if HandleAllocated then
  3898.     Result := SendMessage(Handle, EM_CANUNDO, 0, 0) <> 0;
  3899. end;
  3900. {$ENDIF}
  3901.  
  3902. function TRxCustomRichEdit.GetRedoName: TUndoName;
  3903. begin
  3904.   Result := unUnknown;
  3905.   if (RichEditVersion >= 2) and HandleAllocated then
  3906.     Result := TUndoName(SendMessage(Handle, EM_GETREDONAME, 0, 0));
  3907. end;
  3908.  
  3909. function TRxCustomRichEdit.GetUndoName: TUndoName;
  3910. begin
  3911.   Result := unUnknown;
  3912.   if (RichEditVersion >= 2) and HandleAllocated then
  3913.     Result := TUndoName(SendMessage(Handle, EM_GETUNDONAME, 0, 0));
  3914. end;
  3915.  
  3916. function TRxCustomRichEdit.GetSelectionType: TRichSelectionType;
  3917. const
  3918.   SelTypes: array[TRichSelection] of Integer = (
  3919.     SEL_TEXT, SEL_OBJECT, SEL_MULTICHAR, SEL_MULTIOBJECT);
  3920. var
  3921.   Selection: Integer;
  3922.   I: TRichSelection;
  3923. begin
  3924.   Result := [];
  3925.   if HandleAllocated then begin
  3926.     Selection := SendMessage(Handle, EM_SELECTIONTYPE, 0, 0);
  3927.     for I := Low(TRichSelection) to High(TRichSelection) do
  3928.       if SelTypes[I] and Selection <> 0 then Include(Result, I);
  3929.   end;
  3930. end;
  3931.  
  3932. function TRxCustomRichEdit.GetSelection: TCharRange;
  3933. begin
  3934.   SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Result));
  3935. end;
  3936.  
  3937. procedure TRxCustomRichEdit.SetSelection(StartPos, EndPos: Longint;
  3938.   ScrollCaret: Boolean);
  3939. var
  3940.   CharRange: TCharRange;
  3941. begin
  3942.   with CharRange do begin
  3943.     cpMin := StartPos;
  3944.     cpMax := EndPos;
  3945.   end;
  3946.   SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
  3947.   if ScrollCaret then SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  3948. end;
  3949.  
  3950. {$IFDEF RX_D3}
  3951. procedure TRxCustomRichEdit.SetSelLength(Value: Integer);
  3952. begin
  3953.   with GetSelection do SetSelection(cpMin, cpMin + Value, True);
  3954. end;
  3955.  
  3956. procedure TRxCustomRichEdit.SetSelStart(Value: Integer);
  3957. begin
  3958.   SetSelection(Value, Value, False);
  3959. end;
  3960. {$ENDIF RX_D3}
  3961.  
  3962. function TRxCustomRichEdit.GetCharPos(CharIndex: Integer): TPoint;
  3963. var
  3964.   Res: Longint;
  3965. begin
  3966.   FillChar(Result, SizeOf(Result), 0);
  3967.   if HandleAllocated then begin
  3968.     if RichEditVersion = 2 then begin
  3969.       Res := SendMessage(Handle, Messages.EM_POSFROMCHAR, CharIndex, 0);
  3970.       Result.X := LoWord(Res);
  3971.       Result.Y := HiWord(Res);
  3972.     end
  3973.     else { RichEdit 1.0 and 3.0 }
  3974.       SendMessage(Handle, Messages.EM_POSFROMCHAR, WPARAM(@Result), CharIndex);
  3975.   end;
  3976. end;
  3977.  
  3978. function TRxCustomRichEdit.GetTextRange(StartPos, EndPos: Longint): string;
  3979. var
  3980.   TextRange: TTextRange;
  3981. begin
  3982.   SetLength(Result, EndPos - StartPos + 1);
  3983.   TextRange.chrg.cpMin := StartPos;
  3984.   TextRange.chrg.cpMax := EndPos;
  3985.   TextRange.lpstrText := PAnsiChar(Result);
  3986.   SetLength(Result, SendMessage(Handle, EM_GETTEXTRANGE, 0, Longint(@TextRange)));
  3987. end;
  3988.  
  3989. function TRxCustomRichEdit.WordAtCursor: string;
  3990. var
  3991.   Range: TCharRange;
  3992. begin
  3993.   Result := '';
  3994.   if HandleAllocated then begin
  3995.     Range.cpMax := SelStart;
  3996.     if Range.cpMax = 0 then Range.cpMin := 0
  3997.     else if SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMax) <> 0 then
  3998.       Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, Range.cpMax)
  3999.     else
  4000.       Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_LEFT, Range.cpMax);
  4001.     while SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMin) <> 0 do
  4002.       Inc(Range.cpMin);
  4003.     Range.cpMax := SendMessage(Handle, EM_FINDWORDBREAK, WB_RIGHTBREAK, Range.cpMax);
  4004.     Result := Trim(GetTextRange(Range.cpMin, Range.cpMax));
  4005.   end;
  4006. end;
  4007.  
  4008. function TRxCustomRichEdit.LineFromChar(CharIndex: Integer): Integer;
  4009. begin
  4010.   Result := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, CharIndex);
  4011. end;
  4012.  
  4013. function TRxCustomRichEdit.GetLineIndex(LineNo: Integer): Integer;
  4014. begin
  4015.   Result := SendMessage(Handle, EM_LINEINDEX, LineNo, 0);
  4016. end;
  4017.  
  4018. function TRxCustomRichEdit.GetLineLength(CharIndex: Integer): Integer;
  4019. begin
  4020.   Result := SendMessage(Handle, EM_LINELENGTH, CharIndex, 0);
  4021. end;
  4022.  
  4023. procedure TRxCustomRichEdit.SetUndoLimit(Value: Integer);
  4024. begin
  4025.   if (Value <> FUndoLimit) then begin
  4026.     FUndoLimit := Value;
  4027.     if (RichEditVersion >= 2) and HandleAllocated then
  4028.       FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, Value, 0);
  4029.   end;
  4030. end;
  4031.  
  4032. procedure TRxCustomRichEdit.SetDefAttributes(Value: TRxTextAttributes);
  4033. begin
  4034.   FDefAttributes.Assign(Value);
  4035. end;
  4036.  
  4037. procedure TRxCustomRichEdit.SetWordAttributes(Value: TRxTextAttributes);
  4038. begin
  4039.   FWordAttributes.Assign(Value);
  4040. end;
  4041.  
  4042. function TRxCustomRichEdit.GetStreamFormat: TRichStreamFormat;
  4043. begin
  4044.   Result := TRichEditStrings(Lines).Format;
  4045. end;
  4046.  
  4047. function TRxCustomRichEdit.GetStreamMode: TRichStreamModes;
  4048. begin
  4049.   Result := TRichEditStrings(Lines).Mode;
  4050. end;
  4051.  
  4052. procedure TRxCustomRichEdit.SetStreamFormat(Value: TRichStreamFormat);
  4053. begin
  4054.   TRichEditStrings(Lines).Format := Value;
  4055. end;
  4056.  
  4057. procedure TRxCustomRichEdit.SetStreamMode(Value: TRichStreamModes);
  4058. begin
  4059.   TRichEditStrings(Lines).Mode := Value;
  4060. end;
  4061.  
  4062. procedure TRxCustomRichEdit.SetPlainText(Value: Boolean);
  4063. var
  4064.   MemStream: TStream;
  4065.   StreamFmt: TRichStreamFormat;
  4066.   Mode: TRichStreamModes;
  4067. begin
  4068.   if PlainText <> Value then begin
  4069.     if HandleAllocated and (RichEditVersion >= 2) then begin
  4070.       MemStream := TMemoryStream.Create;
  4071.       try
  4072.         StreamFmt := TRichEditStrings(Lines).Format;
  4073.         Mode := TRichEditStrings(Lines).Mode;
  4074.         try
  4075.           if (csDesigning in ComponentState) or Value then
  4076.             TRichEditStrings(Lines).Format := sfPlainText
  4077.           else TRichEditStrings(Lines).Format := sfRichText;
  4078.           TRichEditStrings(Lines).Mode := [];
  4079.           Lines.SaveToStream(MemStream);
  4080.           MemStream.Position := 0;
  4081.           TRichEditStrings(Lines).EnableChange(False);
  4082.           try
  4083.             SendMessage(Handle, WM_SETTEXT, 0, 0);
  4084.             UpdateTextModes(Value);
  4085.             FPlainText := Value;
  4086.           finally
  4087.             TRichEditStrings(Lines).EnableChange(True);
  4088.           end;
  4089.           Lines.LoadFromStream(MemStream);
  4090.         finally
  4091.           TRichEditStrings(Lines).Format := StreamFmt;
  4092.           TRichEditStrings(Lines).Mode := Mode;
  4093.         end;
  4094.       finally
  4095.         MemStream.Free;
  4096.       end;
  4097.     end;
  4098.     FPlainText := Value;
  4099.   end;
  4100. end;
  4101.  
  4102. procedure TRxCustomRichEdit.UpdateTextModes(Plain: Boolean);
  4103. const
  4104.   TextModes: array[Boolean] of DWORD = (TM_RICHTEXT, TM_PLAINTEXT);
  4105.   UndoModes: array[Boolean] of DWORD = (TM_SINGLELEVELUNDO, TM_MULTILEVELUNDO);
  4106. begin
  4107.   if (RichEditVersion >= 2) and HandleAllocated then begin
  4108.     SendMessage(Handle, EM_SETTEXTMODE, TextModes[Plain] or
  4109.       UndoModes[FUndoLimit > 1], 0);
  4110.   end;
  4111. end;
  4112.  
  4113. procedure TRxCustomRichEdit.CMColorChanged(var Message: TMessage);
  4114. begin
  4115.   inherited;
  4116.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
  4117. end;
  4118.  
  4119. procedure TRxCustomRichEdit.EMReplaceSel(var Message: TMessage);
  4120. var
  4121.   CharRange: TCharRange;
  4122. begin
  4123.   Perform(EM_EXGETSEL, 0, Longint(@CharRange));
  4124.   with CharRange do
  4125.     cpMax := cpMin + Integer(StrLen(PChar(Message.lParam)));
  4126.   if (FUndoLimit > 1) and (RichEditVersion >= 2) and not FLinesUpdating then
  4127.     Message.wParam := 1; { allow Undo }
  4128.   inherited;
  4129.   if not FLinesUpdating then begin
  4130.     Perform(EM_EXSETSEL, 0, Longint(@CharRange));
  4131.     Perform(EM_SCROLLCARET, 0, 0);
  4132.   end;
  4133. end;
  4134.  
  4135. procedure TRxCustomRichEdit.SetRichEditStrings(Value: TStrings);
  4136. begin
  4137.   FRichEditStrings.Assign(Value);
  4138. end;
  4139.  
  4140. procedure TRxCustomRichEdit.CloseObjects;
  4141. var
  4142.   I: Integer;
  4143.   ReObject: TReObject;
  4144. begin
  4145.   if Assigned(FRichEditOle) then begin
  4146.     FillChar(ReObject, SizeOf(ReObject), 0);
  4147.     ReObject.cbStruct := SizeOf(ReObject);
  4148.     with IRichEditOle(FRichEditOle) do begin
  4149.       for I := GetObjectCount - 1 downto 0 do
  4150.         if Succeeded(GetObject(I, ReObject, REO_GETOBJ_POLEOBJ)) then begin
  4151.           if ReObject.dwFlags and REO_INPLACEACTIVE <> 0 then
  4152.             IRichEditOle(FRichEditOle).InPlaceDeactivate;
  4153.           ReObject.poleobj.Close(OLECLOSE_NOSAVE);
  4154.           ReleaseObject(ReObject.poleobj);
  4155.         end;
  4156.     end;
  4157.   end;
  4158. end;
  4159.  
  4160. function TRxCustomRichEdit.PasteSpecialDialog: Boolean;
  4161.  
  4162.   procedure SetPasteEntry(var Entry: TOleUIPasteEntry; Format: TClipFormat;
  4163.     tymed: DWORD; const FormatName, ResultText: string; Flags: DWORD);
  4164.   begin
  4165.     with Entry do begin
  4166.       fmtetc.cfFormat := Format;
  4167.       fmtetc.dwAspect := DVASPECT_CONTENT;
  4168.       fmtetc.lIndex := -1;
  4169.       fmtetc.tymed := tymed;
  4170.       if FormatName <> '' then lpstrFormatName := PChar(FormatName)
  4171.       else lpstrFormatName := '%s';
  4172.       if ResultText <> '' then lpstrResultText := PChar(ResultText)
  4173.       else lpstrResultText := '%s';
  4174.       dwFlags := Flags;
  4175.     end;
  4176.   end;
  4177.  
  4178. const
  4179.   PasteFormatCount = 6;
  4180. var
  4181.   Data: TOleUIPasteSpecial;
  4182.   PasteFormats: array[0..PasteFormatCount - 1] of TOleUIPasteEntry;
  4183.   Format: Integer;
  4184.   OleClientSite: IOleClientSite;
  4185.   Storage: IStorage;
  4186.   OleObject: IOleObject;
  4187.   ReObject: TReObject;
  4188.   Selection: TCharRange;
  4189. begin
  4190.   Result := False;
  4191.   if not CanPaste or not Assigned(FRichEditOle) then Exit;
  4192.   FillChar(Data, SizeOf(Data), 0);
  4193.   FillChar(PasteFormats, SizeOf(PasteFormats), 0);
  4194.   with Data do begin
  4195.     cbStruct := SizeOf(Data);
  4196.     hWndOwner := Handle;
  4197.     arrPasteEntries := @PasteFormats;
  4198.     cPasteEntries := PasteFormatCount;
  4199.     arrLinkTypes := @CFLinkSource;
  4200.     cLinkTypes := 1;
  4201.     dwFlags := PSF_SELECTPASTE;
  4202.   end;
  4203.   SetPasteEntry(PasteFormats[0], CFEmbeddedObject, TYMED_ISTORAGE, '', '',
  4204.     OLEUIPASTE_PASTE or OLEUIPASTE_ENABLEICON);
  4205.   SetPasteEntry(PasteFormats[1], CFLinkSource, TYMED_ISTREAM, '', '',
  4206.     OLEUIPASTE_LINKTYPE1 or OLEUIPASTE_ENABLEICON);
  4207.   SetPasteEntry(PasteFormats[2], CFRtf, TYMED_ISTORAGE,
  4208.     CF_RTF, CF_RTF, OLEUIPASTE_PASTE);
  4209.   SetPasteEntry(PasteFormats[3], CFRtfNoObjs, TYMED_ISTORAGE,
  4210.     CF_RTFNOOBJS, CF_RTFNOOBJS, OLEUIPASTE_PASTE);
  4211.   SetPasteEntry(PasteFormats[4], CF_TEXT, TYMED_HGLOBAL,
  4212.     'Unformatted text', 'text without any formatting', OLEUIPASTE_PASTE);
  4213.   SetPasteEntry(PasteFormats[5], CF_BITMAP, TYMED_GDI,
  4214.     'Windows Bitmap', 'bitmap image', OLEUIPASTE_PASTE);
  4215.   try
  4216.     if OleUIPasteSpecial(Data) = OLEUI_OK then begin
  4217.       Result := True;
  4218.       if Data.nSelectedIndex in [0, 1] then begin
  4219.         { CFEmbeddedObject, CFLinkSource }
  4220.         FillChar(ReObject, SizeOf(TReObject), 0);
  4221.         IRichEditOle(FRichEditOle).GetClientSite(OleClientSite);
  4222.         Storage := nil;
  4223.         try
  4224.           CreateStorage(Storage);
  4225.           case Data.nSelectedIndex of
  4226.             0: OleCheck(OleCreateFromData(Data.lpSrcDataObj,
  4227.                {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF},
  4228.                OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject));
  4229.             1: OleCheck(OleCreateLinkFromData(Data.lpSrcDataObj,
  4230.                {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF},
  4231.                OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject));
  4232.           end;
  4233.           try
  4234.             with ReObject do begin
  4235.               cbStruct := SizeOf(TReObject);
  4236.               cp := REO_CP_SELECTION;
  4237.               poleobj := OleObject;
  4238.               OleObject.GetUserClassID(clsid);
  4239.               pstg := Storage;
  4240.               polesite := OleClientSite;
  4241.               dvAspect := DVASPECT_CONTENT;
  4242.               dwFlags := REO_RESIZABLE;
  4243.               OleCheck(OleSetDrawAspect(OleObject,
  4244.                 Data.dwFlags and PSF_CHECKDISPLAYASICON <> 0,
  4245.                 Data.hMetaPict, dvAspect));
  4246.             end;
  4247.             SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection));
  4248.             Selection.cpMax := Selection.cpMin + 1;
  4249.             OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject));
  4250.             SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection));
  4251.             IRichEditOle(FRichEditOle).SetDvaspect(
  4252.               Longint(REO_IOB_SELECTION), ReObject.dvAspect);
  4253.           finally
  4254.             ReleaseObject(OleObject);
  4255.           end;
  4256.         finally
  4257.           ReleaseObject(OleClientSite);
  4258.           ReleaseObject(Storage);
  4259.         end;
  4260.       end
  4261.       else begin
  4262.         Format := PasteFormats[Data.nSelectedIndex].fmtetc.cfFormat;
  4263.         OleCheck(IRichEditOle(FRichEditOle).ImportDataObject(
  4264.           Data.lpSrcDataObj, Format, Data.hMetaPict));
  4265.       end;
  4266.       SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  4267.     end;
  4268.   finally
  4269.     DestroyMetaPict(Data.hMetaPict);
  4270.     ReleaseObject(Data.lpSrcDataObj);
  4271.   end;
  4272. end;
  4273.  
  4274. function TRxCustomRichEdit.InsertObjectDialog: Boolean;
  4275. var
  4276.   Data: TOleUIInsertObject;
  4277.   NameBuffer: array[0..255] of Char;
  4278.   OleClientSite: IOleClientSite;
  4279.   Storage: IStorage;
  4280.   OleObject: IOleObject;
  4281.   ReObject: TReObject;
  4282.   IsNewObject: Boolean;
  4283.   Selection: TCharRange;
  4284. begin
  4285.   FillChar(Data, SizeOf(Data), 0);
  4286.   FillChar(NameBuffer, SizeOf(NameBuffer), 0);
  4287.   FillChar(ReObject, SizeOf(TReObject), 0);
  4288.   if Assigned(FRichEditOle) then begin
  4289.     IRichEditOle(FRichEditOle).GetClientSite(OleClientSite);
  4290.     Storage := nil;
  4291.     try
  4292.       CreateStorage(Storage);
  4293.       with Data do begin
  4294.         cbStruct := SizeOf(Data);
  4295.         dwFlags := IOF_SELECTCREATENEW or IOF_VERIFYSERVERSEXIST or 
  4296.           IOF_CREATENEWOBJECT or IOF_CREATEFILEOBJECT or IOF_CREATELINKOBJECT;
  4297.         hWndOwner := Handle;
  4298.         lpszFile := NameBuffer;
  4299.         cchFile := SizeOf(NameBuffer);
  4300.         iid := {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF};
  4301.         oleRender := OLERENDER_DRAW;
  4302.         lpIOleClientSite := OleClientSite;
  4303.         lpIStorage := Storage;
  4304.         ppvObj := @OleObject;
  4305.       end;
  4306.       try
  4307.         Result := OleUIInsertObject(Data) = OLEUI_OK;
  4308.         if Result then
  4309.         try
  4310.           IsNewObject := Data.dwFlags and IOF_SELECTCREATENEW = IOF_SELECTCREATENEW;
  4311.           with ReObject do begin
  4312.             cbStruct := SizeOf(TReObject);
  4313.             cp := REO_CP_SELECTION;
  4314.             clsid := Data.clsid;
  4315.             poleobj := OleObject;
  4316.             pstg := Storage;
  4317.             polesite := OleClientSite;
  4318.             dvAspect := DVASPECT_CONTENT;
  4319.             dwFlags := REO_RESIZABLE;
  4320.             if IsNewObject then dwFlags := dwFlags or REO_BLANK;
  4321.             OleCheck(OleSetDrawAspect(OleObject,
  4322.               Data.dwFlags and IOF_CHECKDISPLAYASICON <> 0,
  4323.               Data.hMetaPict, dvAspect));
  4324.           end;
  4325.           SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection));
  4326.           Selection.cpMax := Selection.cpMin + 1;
  4327.           OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject));
  4328.           SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection));
  4329.           SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  4330.           IRichEditOle(FRichEditOle).SetDvaspect(
  4331.             Longint(REO_IOB_SELECTION), ReObject.dvAspect);
  4332.           if IsNewObject then OleObject.DoVerb(OLEIVERB_SHOW, nil,
  4333.             OleClientSite, 0, Handle, ClientRect);
  4334.         finally
  4335.           ReleaseObject(OleObject);
  4336.         end;
  4337.       finally
  4338.         DestroyMetaPict(Data.hMetaPict);
  4339.       end;
  4340.     finally
  4341.       ReleaseObject(OleClientSite);
  4342.       ReleaseObject(Storage);
  4343.     end;
  4344.   end
  4345.   else Result := False;
  4346. end;
  4347.  
  4348. function TRxCustomRichEdit.ObjectPropertiesDialog: Boolean;
  4349. var
  4350.   ObjectProps: TOleUIObjectProps;
  4351.   PropSheet: TPropSheetHeader;
  4352.   GeneralProps: TOleUIGnrlProps;
  4353.   ViewProps: TOleUIViewProps;
  4354.   LinkProps: TOleUILinkProps;
  4355.   DialogCaption: string;
  4356.   ReObject: TReObject;
  4357. begin
  4358.   Result := False;
  4359.   if not Assigned(FRichEditOle) or (SelectionType <> [stObject]) then Exit;
  4360.   FillChar(ObjectProps, SizeOf(ObjectProps), 0);
  4361.   FillChar(PropSheet, SizeOf(PropSheet), 0);
  4362.   FillChar(GeneralProps, SizeOf(GeneralProps), 0);
  4363.   FillChar(ViewProps, SizeOf(ViewProps), 0);
  4364.   FillChar(LinkProps, SizeOf(LinkProps), 0);
  4365.   FillChar(ReObject, SizeOf(ReObject), 0);
  4366.   ReObject.cbStruct := SizeOf(ReObject);
  4367.   if Succeeded(IRichEditOle(FRichEditOle).GetObject(Longint(REO_IOB_SELECTION),
  4368.     ReObject, REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE)) then
  4369.   try
  4370.     if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then begin
  4371.       ObjectProps.cbStruct := SizeOf(ObjectProps);
  4372.       ObjectProps.dwFlags := OPF_DISABLECONVERT;
  4373.       ObjectProps.lpPS := @PropSheet;
  4374.       ObjectProps.lpObjInfo := TOleUIObjInfo.Create(Self, ReObject);
  4375.       if (ReObject.dwFlags and REO_LINK) <> 0 then begin
  4376.         ObjectProps.dwFlags := ObjectProps.dwFlags or OPF_OBJECTISLINK;
  4377.         ObjectProps.lpLinkInfo := TOleUILinkInfo.Create(Self, ReObject);
  4378.       end;
  4379.       ObjectProps.lpGP := @GeneralProps;
  4380.       ObjectProps.lpVP := @ViewProps;
  4381.       ObjectProps.lpLP := @LinkProps;
  4382.       PropSheet.dwSize := SizeOf(PropSheet);
  4383.       PropSheet.hWndParent := Handle;
  4384. {$IFDEF RX_D3}
  4385.       PropSheet.hInstance := MainInstance;
  4386. {$ELSE}
  4387.       PropSheet.hInstance := HInstance;
  4388. {$ENDIF}
  4389.       DialogCaption := Format(ResStr(SPropDlgCaption),
  4390.         [GetFullNameStr(ReObject.poleobj)]);
  4391.       PropSheet.pszCaption := PChar(DialogCaption);
  4392.       GeneralProps.cbStruct := SizeOf(GeneralProps);
  4393.       ViewProps.cbStruct := SizeOf(ViewProps);
  4394.       ViewProps.dwFlags := VPF_DISABLESCALE;
  4395.       LinkProps.cbStruct := SizeOf(LinkProps);
  4396.       LinkProps.dwFlags := ELF_DISABLECANCELLINK;
  4397.       Result := OleUIObjectProperties(ObjectProps) = OLEUI_OK;
  4398.     end;
  4399.   finally
  4400. {$IFNDEF RX_D3}
  4401.     ObjectProps.lpLinkInfo.Free;
  4402.     ObjectProps.lpObjInfo.Free;
  4403.     ReleaseObject(ReObject.polesite);
  4404.     ReleaseObject(ReObject.poleobj);
  4405. {$ENDIF}
  4406.   end;
  4407. end;
  4408.  
  4409. procedure TRxCustomRichEdit.Print(const Caption: string);
  4410. var
  4411.   Range: TFormatRange;
  4412.   LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  4413.   SaveRect: TRect;
  4414.   TextLenEx: TGetTextLengthEx;
  4415. begin
  4416.   FillChar(Range, SizeOf(TFormatRange), 0);
  4417.   with Printer, Range do begin
  4418.     Title := Caption;
  4419.     BeginDoc;
  4420.     hdc := Handle;
  4421.     hdcTarget := hdc;
  4422.     LogX := GetDeviceCaps(Handle, LOGPIXELSX);
  4423.     LogY := GetDeviceCaps(Handle, LOGPIXELSY);
  4424.     if IsRectEmpty(PageRect) then begin
  4425.       rc.right := PageWidth * 1440 div LogX;
  4426.       rc.bottom := PageHeight * 1440 div LogY;
  4427.     end
  4428.     else begin
  4429.       rc.left := PageRect.Left * 1440 div LogX;
  4430.       rc.top := PageRect.Top * 1440 div LogY;
  4431.       rc.right := PageRect.Right * 1440 div LogX;
  4432.       rc.bottom := PageRect.Bottom * 1440 div LogY;
  4433.     end;
  4434.     rcPage := rc;
  4435.     SaveRect := rc;
  4436.     LastChar := 0;
  4437.     if RichEditVersion >= 2 then begin
  4438.       with TextLenEx do begin
  4439.         flags := GTL_DEFAULT;
  4440.         codepage := CP_ACP;
  4441.       end;
  4442.       MaxLen := Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
  4443.     end
  4444.     else MaxLen := GetTextLen;
  4445.     chrg.cpMax := -1;
  4446.     { ensure printer DC is in text map mode }
  4447.     OldMap := SetMapMode(hdc, MM_TEXT);
  4448.     SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);    { flush buffer }
  4449.     try
  4450.       repeat
  4451.         rc := SaveRect;
  4452.         chrg.cpMin := LastChar;
  4453.         LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  4454.         if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
  4455.       until (LastChar >= MaxLen) or (LastChar = -1);
  4456.       EndDoc;
  4457.     finally
  4458.       SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);  { flush buffer }
  4459.       SetMapMode(hdc, OldMap);       { restore previous map mode }
  4460.     end;
  4461.   end;
  4462. end;
  4463.  
  4464. var
  4465.   Painting: Boolean = False;
  4466.  
  4467. procedure TRxCustomRichEdit.WMPaint(var Message: TWMPaint);
  4468. var
  4469.   R, R1: TRect;
  4470. begin
  4471.   if RichEditVersion >= 2 then
  4472.     inherited
  4473.   else begin
  4474.     if GetUpdateRect(Handle, R, True) then
  4475.     begin
  4476.       with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
  4477.       if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
  4478.     end;
  4479.     if Painting then
  4480.       Invalidate
  4481.     else begin
  4482.       Painting := True;
  4483.       try
  4484.         inherited;
  4485.       finally
  4486.         Painting := False;
  4487.       end;
  4488.     end;
  4489.   end;
  4490. end;
  4491.  
  4492. procedure TRxCustomRichEdit.WMDestroy(var Msg: TWMDestroy);
  4493. begin
  4494.   CloseObjects;
  4495.   ReleaseObject(FRichEditOle);
  4496.   inherited;
  4497. end;
  4498.  
  4499. procedure TRxCustomRichEdit.WMMouseMove(var Message: TMessage);
  4500. begin
  4501.   inherited;
  4502. end;
  4503.  
  4504. procedure TRxCustomRichEdit.WMSetCursor(var Message: TWMSetCursor);
  4505. begin
  4506.   inherited;
  4507. end;
  4508.  
  4509. {$IFDEF RX_D5}
  4510. procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
  4511. begin
  4512.   { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
  4513.   { so we get no WM_CONTEXTMENU message. Simulate message here.    }
  4514.   if Win32MajorVersion < 5 then
  4515.     Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
  4516.       ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
  4517.   inherited;
  4518. end;
  4519. {$ENDIF}
  4520.  
  4521. procedure TRxCustomRichEdit.CNNotify(var Message: TWMNotify);
  4522. var
  4523.   AMsg: TMessage;
  4524. begin
  4525.   with Message do
  4526.     case NMHdr^.code of
  4527.       EN_SELCHANGE: SelectionChange;
  4528.       EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc);
  4529.       EN_SAVECLIPBOARD:
  4530.         with PENSaveClipboard(NMHdr)^ do
  4531.           if not SaveClipboard(cObjectCount, cch) then Result := 1;
  4532.       EN_PROTECTED:
  4533.         with PENProtected(NMHdr)^ do begin
  4534.           AMsg.Msg := Msg;
  4535.           AMsg.WParam := WParam;
  4536.           AMsg.LParam := LParam;
  4537.           AMsg.Result := 0;
  4538.           if not ProtectChange(AMsg, chrg.cpMin, chrg.cpMax) then
  4539.             Result := 1;
  4540.         end;
  4541.       EN_LINK:
  4542.         with PENLink(NMHdr)^ do begin
  4543.           case Msg of
  4544.             WM_RBUTTONDOWN:
  4545.               begin
  4546.                 FClickRange := chrg;
  4547.                 FClickBtn := mbRight;
  4548.               end;
  4549.             WM_RBUTTONUP:
  4550.               begin
  4551.                 if (FClickBtn = mbRight) and (FClickRange.cpMin = chrg.cpMin) and
  4552.                   (FClickRange.cpMax = chrg.cpMax) then
  4553.                   URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbRight);
  4554.                 with FClickRange do begin
  4555.                   cpMin := -1;
  4556.                   cpMax := -1;
  4557.                 end;
  4558.               end;
  4559.             WM_LBUTTONDOWN:
  4560.               begin
  4561.                 FClickRange := chrg;
  4562.                 FClickBtn := mbLeft;
  4563.               end;
  4564.             WM_LBUTTONUP:
  4565.               begin
  4566.                 if (FClickBtn = mbLeft) and (FClickRange.cpMin = chrg.cpMin) and
  4567.                   (FClickRange.cpMax = chrg.cpMax) then
  4568.                   URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbLeft);
  4569.                 with FClickRange do begin
  4570.                   cpMin := -1;
  4571.                   cpMax := -1;
  4572.                 end;
  4573.               end;
  4574.           end;
  4575.         end;
  4576.       EN_STOPNOUNDO:
  4577.         begin
  4578.           { cannot allocate enough memory to maintain the undo state }
  4579.         end;
  4580.     end;
  4581. end;
  4582.  
  4583. function TRxCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean;
  4584. begin
  4585.   Result := True;
  4586.   if Assigned(OnSaveClipboard) then
  4587.     OnSaveClipboard(Self, NumObj, NumChars, Result);
  4588. end;
  4589.  
  4590. function TRxCustomRichEdit.ProtectChange(const Message: TMessage; StartPos,
  4591.   EndPos: Integer): Boolean;
  4592. begin
  4593.   Result := False;
  4594.   if Assigned(OnProtectChangeEx) then
  4595.     OnProtectChangeEx(Self, Message, StartPos, EndPos, Result)
  4596.   else if Assigned(OnProtectChange) then
  4597.     OnProtectChange(Self, StartPos, EndPos, Result);
  4598. end;
  4599.  
  4600. procedure TRxCustomRichEdit.SelectionChange;
  4601. begin
  4602.   if Assigned(OnSelectionChange) then OnSelectionChange(Self);
  4603. end;
  4604.  
  4605. procedure TRxCustomRichEdit.RequestSize(const Rect: TRect);
  4606. begin
  4607.   if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
  4608. end;
  4609.  
  4610. procedure TRxCustomRichEdit.URLClick(const URLText: string; Button: TMouseButton);
  4611. begin
  4612.   if Assigned(OnURLClick) then OnURLClick(Self, URLText, Button);
  4613. end;
  4614.  
  4615. function TRxCustomRichEdit.FindText(const SearchStr: string;
  4616.   StartPos, Length: Integer; Options: TRichSearchTypes): Integer;
  4617. var
  4618.   Find: TFindTextEx;
  4619.   Flags: Integer;
  4620. begin
  4621.   with Find.chrg do begin
  4622.     cpMin := StartPos;
  4623.     cpMax := cpMin + Abs(Length);
  4624.   end;
  4625.   if RichEditVersion >= 2 then begin
  4626.     if not (stBackward in Options) then Flags := FT_DOWN
  4627.     else Flags := 0;
  4628.   end
  4629.   else begin
  4630.     Options := Options - [stBackward];
  4631.     Flags := 0;
  4632.   end;
  4633.   if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
  4634.   if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
  4635.   Find.lpstrText := PChar(SearchStr);
  4636.   Result := SendMessage(Handle, EM_FINDTEXTEX, Flags, Longint(@Find));
  4637.   if (Result >= 0) and (stSetSelection in Options) then begin
  4638.     SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Find.chrgText));
  4639.     SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  4640.   end;
  4641. end;
  4642.  
  4643. procedure TRxCustomRichEdit.ClearUndo;
  4644. begin
  4645.   SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0);
  4646. end;
  4647.  
  4648. procedure TRxCustomRichEdit.Redo;
  4649. begin
  4650.   SendMessage(Handle, EM_REDO, 0, 0);
  4651. end;
  4652.  
  4653. {$IFNDEF RX_V110}
  4654. procedure TRxCustomRichEdit.Undo;
  4655. begin
  4656.   SendMessage(Handle, WM_UNDO, 0, 0);
  4657. end;
  4658. {$ENDIF}
  4659.  
  4660. procedure TRxCustomRichEdit.StopGroupTyping;
  4661. begin
  4662.   if (RichEditVersion >= 2) and HandleAllocated then
  4663.     SendMessage(Handle, EM_STOPGROUPTYPING, 0, 0);
  4664. end;
  4665.  
  4666. {$IFDEF RX_D3}
  4667. procedure TRxCustomRichEdit.SetUIActive(Active: Boolean);
  4668. var
  4669.   Form: TCustomForm;
  4670. begin
  4671.   try
  4672.     Form := GetParentForm(Self);
  4673.     if Form <> nil then
  4674.       if Active then begin
  4675.         if (Form.ActiveOleControl <> nil) and
  4676.           (Form.ActiveOleControl <> Self) then
  4677.           Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0);
  4678.         Form.ActiveOleControl := Self;
  4679.         if AllowInPlace and CanFocus then SetFocus;
  4680.       end
  4681.       else begin
  4682.         if Form.ActiveOleControl = Self then Form.ActiveOleControl := nil;
  4683.         if (Form.ActiveControl = Self) and AllowInPlace then begin
  4684.           Windows.SetFocus(Handle);
  4685.           SelectionChange;
  4686.         end;
  4687.       end;
  4688.   except
  4689.     Application.HandleException(Self);
  4690.   end;
  4691. end;
  4692.  
  4693. procedure TRxCustomRichEdit.CMDocWindowActivate(var Message: TMessage);
  4694. begin
  4695.   if Assigned(FCallback) then
  4696.     with TRichEditOleCallback(FCallback) do
  4697.       if Assigned(FDocForm) and IsFormMDIChild(FDocForm.Form) then begin
  4698.         if Message.WParam = 0 then begin
  4699.           FFrameForm.SetMenu(0, 0, 0);
  4700.           FFrameForm.ClearBorderSpace;
  4701.         end;
  4702.       end;
  4703. end;
  4704.  
  4705. procedure TRxCustomRichEdit.CMUIDeactivate(var Message: TMessage);
  4706. begin
  4707.   if (GetParentForm(Self) <> nil) and Assigned(FRichEditOle) and
  4708.     (GetParentForm(Self).ActiveOleControl = Self) then
  4709.     {IRichEditOle(FRichEditOle).InPlaceDeactivate};
  4710. end;
  4711. {$ENDIF RX_D3}
  4712.  
  4713. { Find & Replace Dialogs }
  4714.  
  4715. procedure TRxCustomRichEdit.SetupFindDialog(Dialog: TFindDialog;
  4716.   const SearchStr, ReplaceStr: string);
  4717. begin
  4718.   with Dialog do begin
  4719.     if SearchStr <> '' then FindText := SearchStr;
  4720.     if RichEditVersion = 1 then
  4721.       Options := Options + [frHideUpDown, frDown];
  4722.     OnFind := FindDialogFind;
  4723. {$IFDEF RX_D3}
  4724.     OnClose := FindDialogClose;
  4725. {$ENDIF}
  4726.   end;
  4727.   if Dialog is TReplaceDialog then
  4728.     with TReplaceDialog(Dialog) do begin
  4729.       if ReplaceStr <> '' then ReplaceText := ReplaceStr;
  4730.       OnReplace := ReplaceDialogReplace;
  4731.     end;
  4732. end;
  4733.  
  4734. function TRxCustomRichEdit.FindDialog(const SearchStr: string): TFindDialog;
  4735. begin
  4736.   if FFindDialog = nil then begin
  4737.     FFindDialog := TFindDialog.Create(Self);
  4738.     if FReplaceDialog <> nil then
  4739.       FFindDialog.FindText := FReplaceDialog.FindText;
  4740.   end;
  4741.   Result := FFindDialog;
  4742.   SetupFindDialog(FFindDialog, SearchStr, '');
  4743.   FFindDialog.Execute;
  4744. end;
  4745.  
  4746. function TRxCustomRichEdit.ReplaceDialog(const SearchStr,
  4747.   ReplaceStr: string): TReplaceDialog;
  4748. begin
  4749.   if FReplaceDialog = nil then begin
  4750.     FReplaceDialog := TReplaceDialog.Create(Self);
  4751.     if FFindDialog <> nil then
  4752.       FReplaceDialog.FindText := FFindDialog.FindText;
  4753.   end;
  4754.   Result := FReplaceDialog;
  4755.   SetupFindDialog(FReplaceDialog, SearchStr, ReplaceStr);
  4756.   FReplaceDialog.Execute;
  4757. end;
  4758.  
  4759. function TRxCustomRichEdit.GetCanFindNext: Boolean;
  4760. begin
  4761.   Result := HandleAllocated and (FLastFind <> nil) and
  4762.     (FLastFind.FindText <> '');
  4763. end;
  4764.  
  4765. function TRxCustomRichEdit.FindNext: Boolean;
  4766. begin
  4767.   if CanFindNext then Result := FindEditText(FLastFind, False, True)
  4768.   else Result := False;
  4769. end;
  4770.  
  4771. procedure TRxCustomRichEdit.AdjustFindDialogPosition(Dialog: TFindDialog);
  4772. var
  4773.   TextRect, R: TRect;
  4774. begin
  4775.   if Dialog.Handle = 0 then Exit;
  4776.   with TextRect do begin
  4777.     TopLeft := ClientToScreen(GetCharPos(SelStart));
  4778.     BottomRight := ClientToScreen(GetCharPos(SelStart + SelLength));
  4779.     Inc(Bottom, 20);
  4780.   end;
  4781.   with Dialog do begin
  4782.     GetWindowRect(Handle, R);
  4783.     if PtInRect(R, TextRect.TopLeft) or PtInRect(R, TextRect.BottomRight) then
  4784.     begin
  4785.       if TextRect.Top > R.Bottom - R.Top + 20 then
  4786.         OffsetRect(R, 0, TextRect.Top - R.Bottom - 20)
  4787.       else begin
  4788.         if TextRect.Top + R.Bottom - R.Top < GetSystemMetrics(SM_CYSCREEN) then
  4789.           OffsetRect(R, 0, 40 + TextRect.Top - R.Top);
  4790.       end;
  4791.       Position := R.TopLeft;
  4792.     end;
  4793.   end;
  4794. end;
  4795.  
  4796. function TRxCustomRichEdit.FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean;
  4797. var
  4798.   Length, StartPos: Integer;
  4799.   SrchOptions: TRichSearchTypes;
  4800. begin
  4801.   with TFindDialog(Dialog) do begin
  4802.     SrchOptions := [stSetSelection];
  4803.     if frDown in Options then begin
  4804.       StartPos := Max(SelStart, SelStart + SelLength);
  4805.       Length := System.Length(Text) - StartPos + 1;
  4806.     end
  4807.     else begin
  4808.       SrchOptions := SrchOptions + [stBackward];
  4809.       StartPos := Min(SelStart, SelStart + SelLength);
  4810.       Length := StartPos + 1;
  4811.     end;
  4812.     if frMatchCase in Options then
  4813.       SrchOptions := SrchOptions + [stMatchCase];
  4814.     if frWholeWord in Options then
  4815.       SrchOptions := SrchOptions + [stWholeWord];
  4816.     Result := Self.FindText(FindText, StartPos, Length, SrchOptions) >= 0;
  4817.     if FindText <> '' then FLastFind := Dialog;
  4818.     if Result then begin
  4819.       if AdjustPos then AdjustFindDialogPosition(Dialog);
  4820.     end
  4821.     else if Events then TextNotFound(Dialog);
  4822.   end;
  4823. end;
  4824.  
  4825. procedure TRxCustomRichEdit.TextNotFound(Dialog: TFindDialog);
  4826. begin
  4827.   with Dialog do
  4828.     if Assigned(FOnTextNotFound) then FOnTextNotFound(Self, FindText);
  4829. end;
  4830.  
  4831. procedure TRxCustomRichEdit.FindDialogFind(Sender: TObject);
  4832. begin
  4833.   FindEditText(TFindDialog(Sender), True, True);
  4834. end;
  4835.  
  4836. procedure TRxCustomRichEdit.ReplaceDialogReplace(Sender: TObject);
  4837. var
  4838.   Cnt: Integer;
  4839.   SaveSelChange: TNotifyEvent;
  4840. begin
  4841.   with TReplaceDialog(Sender) do begin
  4842.     if (frReplaceAll in Options) then begin
  4843.       Cnt := 0;
  4844.       SaveSelChange := FOnSelChange;
  4845.       TRichEditStrings(Lines).EnableChange(False);
  4846.       try
  4847.         FOnSelChange := nil;
  4848.         while FindEditText(TFindDialog(Sender), False, False) do begin
  4849.           SelText := ReplaceText;
  4850.           Inc(Cnt);
  4851.         end;
  4852.         if Cnt = 0 then TextNotFound(TFindDialog(Sender))
  4853.         else AdjustFindDialogPosition(TFindDialog(Sender));
  4854.       finally
  4855.         TRichEditStrings(Lines).EnableChange(True);
  4856.         FOnSelChange := SaveSelChange;
  4857.         if Cnt > 0 then begin
  4858.           Change;
  4859.           SelectionChange;
  4860.         end;
  4861.       end;
  4862.     end
  4863.     else if (frReplace in Options) then begin
  4864.       if FindEditText(TFindDialog(Sender), True, True) then
  4865.         SelText := ReplaceText;
  4866.     end;
  4867.   end;
  4868. end;
  4869.  
  4870. {$IFDEF RX_D3}
  4871. procedure TRxCustomRichEdit.FindDialogClose(Sender: TObject);
  4872. begin
  4873.   CloseFindDialog(Sender as TFindDialog);
  4874. end;
  4875.  
  4876. procedure TRxCustomRichEdit.CloseFindDialog(Dialog: TFindDialog);
  4877. begin
  4878.   if Assigned(FOnCloseFindDialog) then FOnCloseFindDialog(Self, Dialog);
  4879. end;
  4880. {$ENDIF RX_D3}
  4881.  
  4882. { Conversion formats }
  4883.  
  4884. procedure AppendConversionFormat(const Ext: string; Plain: Boolean;
  4885.   AClass: TConversionClass);
  4886. var
  4887.   NewRec: PRichConversionFormat;
  4888. begin
  4889.   New(NewRec);
  4890.   with NewRec^ do begin
  4891. {$IFNDEF VER90}
  4892.     Extension := AnsiLowerCaseFileName(Ext);
  4893. {$ELSE}
  4894.     Extension := LowerCase(Ext);
  4895. {$ENDIF}
  4896.     PlainText := Plain;
  4897.     ConversionClass := AClass;
  4898.     Next := ConversionFormatList;
  4899.   end;
  4900.   ConversionFormatList := NewRec;
  4901. end;
  4902.  
  4903. class procedure TRxCustomRichEdit.RegisterConversionFormat(const AExtension: string;
  4904.   APlainText: Boolean; AConversionClass: TConversionClass);
  4905. begin
  4906.   AppendConversionFormat(AExtension, APlainText, AConversionClass);
  4907. end;
  4908.  
  4909. { Initialization part }
  4910.  
  4911. var
  4912.   OldError: Longint;
  4913.   FLibHandle: THandle;
  4914.   Ver: TOsVersionInfo;
  4915.  
  4916. initialization
  4917.   RichEditVersion := 1;
  4918.   OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  4919.   try
  4920. {$IFNDEF RICHEDIT_VER_10}
  4921.     FLibHandle := LoadLibrary(RichEdit20ModuleName);
  4922.     if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0;
  4923. {$ELSE}
  4924.     FLibHandle := 0;
  4925. {$ENDIF}
  4926.     if FLibHandle = 0 then begin
  4927.       FLibHandle := LoadLibrary(RichEdit10ModuleName);
  4928.       if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0;
  4929.     end
  4930.     else begin
  4931.       RichEditVersion := 2;
  4932.       Ver.dwOSVersionInfoSize := SizeOf(Ver);
  4933.       GetVersionEx(Ver);
  4934.       with Ver do begin
  4935.         if (dwPlatformId = VER_PLATFORM_WIN32_NT) and
  4936.           (dwMajorVersion >= 5) then
  4937.           RichEditVersion := 3;
  4938.       end;
  4939.     end;
  4940.   finally
  4941.     SetErrorMode(OldError);
  4942.   end;
  4943.   CFEmbeddedObject := RegisterClipboardFormat(CF_EMBEDDEDOBJECT);
  4944.   CFLinkSource := RegisterClipboardFormat(CF_LINKSOURCE);
  4945.   CFRtf := RegisterClipboardFormat(CF_RTF);
  4946.   CFRtfNoObjs := RegisterClipboardFormat(CF_RTFNOOBJS);
  4947. finalization
  4948.   if FLibHandle <> 0 then FreeLibrary(FLibHandle);
  4949. end.
  4950.