frxrichedit.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{*******************************************************}
{ }
{ Delphi VCL Extensions (RX) }
{ }
{ Copyright (c) 1998 Master-Bank }
{ }
{ Changes made by Alexander Tzyganenko:}
{-removed ifdefs to match Delphi4 and above }
{-removed maxmin unit from uses list }
{ }
{*******************************************************}

unit frxRichEdit;

{$I frx.inc}

interface

uses
  Windows, ActiveX, ComObj, CommCtrl, Messages, SysUtils, Classes, Controls,
  Forms, Graphics, StdCtrls, Dialogs, RichEdit, Menus, ComCtrls;

type
  TRichEditVersion = 1..3;

{$IFDEF BCB}
  TCharFormat2A = record
    cbSize:UINT;
    dwMask:DWORD;
    dwEffects:DWORD;
    yHeight:Longint;
    yOffset:Longint;
    crTextColor:TColorRef;
    bCharSet:Byte;
    bPitchAndFamily:Byte;
    szFaceName:array[0..LF_FACESIZE-1] of AnsiChar;
    { new fields in version 2.0 }
    wWeight:Word; { Font weight (LOGFONT value) }
    sSpacing:Smallint; { Amount to space between letters }
    crBackColor:TColorRef; { Background color }
    lid:LCID; { Locale ID }
    dwReserved:DWORD; { Reserved. Must be 0 }
    sStyle:Smallint; { Style handle }
    wKerning:Word; { Twip size above which to kern char pair }
    bUnderlineType:Byte; { Underline type }
    bAnimation:Byte; { Animated text like marching ants }
    bRevAuthor:Byte; { Revision author index }
    bReserved1:Byte;
  end;
  TCharFormat2 = TCharFormat2A;

  TParaFormat2 = record
    cbSize:UINT;
    dwMask:DWORD;
    wNumbering:Word;
    wReserved:Word;
    dxStartIndent:Longint;
    dxRightIndent:Longint;
    dxOffset:Longint;
    wAlignment:Word;
    cTabCount:Smallint;
    rgxTabs:array [0..MAX_TAB_STOPS-1] of Longint;
    { new fields in version 2.0 }
    dySpaceBefore:Longint; { Vertical spacing before paragraph }
    dySpaceAfter:Longint; { Vertical spacing after paragraph }
    dyLineSpacing:Longint; { Line spacing depending on Rule }
    sStyle:Smallint; { Style handle }
    bLineSpacingRule:Byte; { Rule for line spacing (see tom.doc) }
    bCRC:Byte; { Reserved for CRC for rapid searching }
    wShadingWeight:Word; { Shading in hundredths of a per cent }
    wShadingStyle:Word; { Nibble 0:style, 1:cfpat, 2:cbpat }
    wNumberingStart:Word; { Starting value for numbering }
    wNumberingStyle:Word; { Alignment, roman/arabic, (), ), ., etc.}
    wNumberingTab:Word; { Space bet 1st indent and 1st-line text }
    wBorderSpace:Word; { Space between border and text (twips) }
    wBorderWidth:Word; { Border pen width (twips) }
    wBorders:Word; { Byte 0:bits specify which borders }
                                { Nibble 2:border style, 3:color index }
  end;
{$ENDIF}

type
  TRxCustomRichEdit = class;

{ TRxTextAttributes }

  TRxAttributeType = (atDefaultText, atSelected, atWord);
  TRxConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize,
    caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink,
    caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor);
  TRxConsistentAttributes = set of TRxConsistentAttribute;
  TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript);
  TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utWave);

  TRxTextAttributes = class(TPersistent)
  private
    RichEdit:TRxCustomRichEdit;
    FType:TRxAttributeType;
    procedure AssignFont(Font:TFont);
    procedure GetAttributes(var Format:TCharFormat2);
    function GetCharset:TFontCharset;
    procedure SetCharset(Value:TFontCharset);
    function GetSubscriptStyle:TSubscriptStyle;
    procedure SetSubscriptStyle(Value:TSubscriptStyle);
    function GetBackColor:TColor;
    function GetColor:TColor;
    function GetConsistentAttributes:TRxConsistentAttributes;
    function GetHeight:Integer;
    function GetHidden:Boolean;
    function GetDisabled:Boolean;
    function GetLink:Boolean;
    function GetName:TFontName;
    function GetOffset:Integer;
    function GetPitch:TFontPitch;
    function GetProtected:Boolean;
    function GetRevAuthorIndex:Byte;
    function GetSize:Integer;
    function GetStyle:TFontStyles;
    function GetUnderlineType:TUnderlineType;
    procedure SetAttributes(var Format:TCharFormat2);
    procedure SetBackColor(Value:TColor);
    procedure SetColor(Value:TColor);
    procedure SetDisabled(Value:Boolean);
    procedure SetHeight(Value:Integer);
    procedure SetHidden(Value:Boolean);
    procedure SetLink(Value:Boolean);
    procedure SetName(Value:TFontName);
    procedure SetOffset(Value:Integer);
    procedure SetPitch(Value:TFontPitch);
    procedure SetProtected(Value:Boolean);
    procedure SetRevAuthorIndex(Value:Byte);
    procedure SetSize(Value:Integer);
    procedure SetStyle(Value:TFontStyles);
    procedure SetUnderlineType(Value:TUnderlineType);
  protected
    procedure InitFormat(var Format:TCharFormat2);
    procedure AssignTo(Dest:TPersistent); override;
  public
    constructor Create(AOwner:TRxCustomRichEdit; AttributeType:TRxAttributeType);
    procedure Assign(Source:TPersistent); override;
    property Charset:TFontCharset read GetCharset write SetCharset;
    property BackColor:TColor read GetBackColor write SetBackColor;
    property Color:TColor read GetColor write SetColor;
    property ConsistentAttributes:TRxConsistentAttributes read GetConsistentAttributes;
    property Disabled:Boolean read GetDisabled write SetDisabled;
    property Hidden:Boolean read GetHidden write SetHidden;
    property Link:Boolean read GetLink write SetLink;
    property Name:TFontName read GetName write SetName;
    property Offset:Integer read GetOffset write SetOffset;
    property Pitch:TFontPitch read GetPitch write SetPitch;
    property Protected:Boolean read GetProtected write SetProtected;
    property RevAuthorIndex:Byte read GetRevAuthorIndex write SetRevAuthorIndex;
    property SubscriptStyle:TSubscriptStyle read GetSubscriptStyle write SetSubscriptStyle;
    property Size:Integer read GetSize write SetSize;
    property Style:TFontStyles read GetStyle write SetStyle;
    property Height:Integer read GetHeight write SetHeight;
    property UnderlineType:TUnderlineType read GetUnderlineType write SetUnderlineType;
  end;

{ TRxParaAttributes }

  TRxNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter,
    nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman);
  TRxNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple);
  TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify);
  TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore,
    lsSpecified, lsMultiple);
  THeadingStyle = 0..9;
  TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell);

  TRxParaAttributes = class(TPersistent)
  private
    RichEdit:TRxCustomRichEdit;
    procedure GetAttributes(var Paragraph:TParaFormat2);
    function GetAlignment:TParaAlignment;
    function GetFirstIndent:Longint;
    function GetHeadingStyle:THeadingStyle;
    function GetLeftIndent:Longint;
    function GetRightIndent:Longint;
    function GetSpaceAfter:Longint;
    function GetSpaceBefore:Longint;
    function GetLineSpacing:Longint;
    function GetLineSpacingRule:TLineSpacingRule;
    function GetNumbering:TRxNumbering;
    function GetNumberingStyle:TRxNumberingStyle;
    function GetNumberingTab:Word;
    function GetTab(Index:Byte):Longint;
    function GetTabCount:Integer;
    function GetTableStyle:TParaTableStyle;
    procedure SetAlignment(Value:TParaAlignment);
    procedure SetAttributes(var Paragraph:TParaFormat2);
    procedure SetFirstIndent(Value:Longint);
    procedure SetHeadingStyle(Value:THeadingStyle);
    procedure SetLeftIndent(Value:Longint);
    procedure SetRightIndent(Value:Longint);
    procedure SetSpaceAfter(Value:Longint);
    procedure SetSpaceBefore(Value:Longint);
    procedure SetLineSpacing(Value:Longint);
    procedure SetLineSpacingRule(Value:TLineSpacingRule);
    procedure SetNumbering(Value:TRxNumbering);
    procedure SetNumberingStyle(Value:TRxNumberingStyle);
    procedure SetNumberingTab(Value:Word);
    procedure SetTab(Index:Byte; Value:Longint);
    procedure SetTabCount(Value:Integer);
    procedure SetTableStyle(Value:TParaTableStyle);
  protected
    procedure InitPara(var Paragraph:TParaFormat2);
    procedure AssignTo(Dest:TPersistent); override;
  public
    constructor Create(AOwner:TRxCustomRichEdit);
    procedure Assign(Source:TPersistent); override;
    property Alignment:TParaAlignment read GetAlignment write SetAlignment;
    property FirstIndent:Longint read GetFirstIndent write SetFirstIndent;
    property HeadingStyle:THeadingStyle read GetHeadingStyle write SetHeadingStyle;
    property LeftIndent:Longint read GetLeftIndent write SetLeftIndent;
    property LineSpacing:Longint read GetLineSpacing write SetLineSpacing;
    property LineSpacingRule:TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule;
    property Numbering:TRxNumbering read GetNumbering write SetNumbering;
    property NumberingStyle:TRxNumberingStyle read GetNumberingStyle write SetNumberingStyle;
    property NumberingTab:Word read GetNumberingTab write SetNumberingTab;
    property RightIndent:Longint read GetRightIndent write SetRightIndent;
    property SpaceAfter:Longint read GetSpaceAfter write SetSpaceAfter;
    property SpaceBefore:Longint read GetSpaceBefore write SetSpaceBefore;
    property Tab[Index:Byte]:Longint read GetTab write SetTab;
    property TabCount:Integer read GetTabCount write SetTabCount;
    property TableStyle:TParaTableStyle read GetTableStyle write SetTableStyle;
  end;

{ TOEMConversion }

  TOEMConversion = class(TConversion)
  public
    function ConvertReadStream(Stream:TStream; Buffer:PChar; BufSize:Integer):Integer; override;
    function ConvertWriteStream(Stream:TStream; Buffer:PChar; BufSize:Integer):Integer; override;
  end;

{ TRxCustomRichEdit }

  TUndoName = (unUnknown, unTyping, unDelete, unDragDrop, unCut, unPaste);
  TRichSearchType = (stWholeWord, stMatchCase, stBackward, stSetSelection);
  TRichSearchTypes = set of TRichSearchType;
  TRichSelection = (stText, stObject, stMultiChar, stMultiObject);
  TRichSelectionType = set of TRichSelection;
  TRichLangOption = (rlAutoKeyboard, rlAutoFont, rlImeCancelComplete,
    rlImeAlwaysSendNotify);
  TRichLangOptions = set of TRichLangOption;
  TRichStreamFormat = (sfDefault, sfRichText, sfPlainText);
  TRichStreamMode = (smSelection, smPlainRtf, smNoObjects, smUnicode);
  TRichStreamModes = set of TRichStreamMode;
  TRichEditURLClickEvent = procedure(Sender:TObject; const URLText:string;
    Button:TMouseButton) of object;
  TRichEditProtectChangeEx = procedure(Sender:TObject; const Message:TMessage;
    StartPos, EndPos:Integer; var AllowChange:Boolean) of object;
  TRichEditFindErrorEvent = procedure(Sender:TObject; const FindText:string) of object;
  TRichEditFindCloseEvent = procedure(Sender:TObject; Dialog:TFindDialog) of object;

  PRichConversionFormat = ^TRichConversionFormat;
  TRichConversionFormat = record
    ConversionClass:TConversionClass;
    Extension:string;
    PlainText:Boolean;
    Next:PRichConversionFormat;
  end;

  TRxCustomRichEdit = class(TCustomMemo)
  private
    FHideScrollBars:Boolean;
    FSelectionBar:Boolean;
    FAutoURLDetect:Boolean;
    FWordSelection:Boolean;
    FPlainText:Boolean;
    FSelAttributes:TRxTextAttributes;
    FDefAttributes:TRxTextAttributes;
    FWordAttributes:TRxTextAttributes;
    FParagraph:TRxParaAttributes;
    FOldParaAlignment:TParaAlignment;
    FScreenLogPixels:Integer;
    FUndoLimit:Integer;
    FRichEditStrings:TStrings;
    FMemStream:TMemoryStream;
    FHideSelection:Boolean;
    FLangOptions:TRichLangOptions;
    FModified:Boolean;
    FLinesUpdating:Boolean;
    FPageRect:TRect;
    FClickRange:TCharRange;
    FClickBtn:TMouseButton;
    FFindDialog:TFindDialog;
    FReplaceDialog:TReplaceDialog;
    FLastFind:TFindDialog;
    FAllowObjects:Boolean;
    FCallback:TObject;
    FRichEditOle:IUnknown;
    FPopupVerbMenu:TPopupMenu;
    FTitle:string;
    FAutoVerbMenu:Boolean;
    FAllowInPlace:Boolean;
    FDefaultConverter:TConversionClass;
    FOnSelChange:TNotifyEvent;
    FOnResizeRequest:TRichEditResizeEvent;
    FOnProtectChange:TRichEditProtectChange;
    FOnProtectChangeEx:TRichEditProtectChangeEx;
    FOnSaveClipboard:TRichEditSaveClipboard;
    FOnURLClick:TRichEditURLClickEvent;
    FOnTextNotFound:TRichEditFindErrorEvent;
    FOnCloseFindDialog:TRichEditFindCloseEvent;
    function GetAutoURLDetect:Boolean;
    function GetWordSelection:Boolean;
    function GetLangOptions:TRichLangOptions;
    function GetCanRedo:Boolean;
    function GetCanPaste:Boolean;
    function GetRedoName:TUndoName;
    function GetUndoName:TUndoName;
    function GetStreamFormat:TRichStreamFormat;
    function GetStreamMode:TRichStreamModes;
    function GetSelectionType:TRichSelectionType;
    procedure PopupVerbClick(Sender:TObject);
    procedure ObjectPropsClick(Sender:TObject);
    procedure CloseObjects;
    procedure UpdateHostNames;
    procedure SetAllowObjects(Value:Boolean);
    procedure SetStreamFormat(Value:TRichStreamFormat);
    procedure SetStreamMode(Value:TRichStreamModes);
    procedure SetAutoURLDetect(Value:Boolean);
    procedure SetWordSelection(Value:Boolean);
    procedure SetHideScrollBars(Value:Boolean);
    procedure SetHideSelection(Value:Boolean);
    procedure SetTitle(const Value:string);
    procedure SetLangOptions(Value:TRichLangOptions);
    procedure SetRichEditStrings(Value:TStrings);
    procedure SetDefAttributes(Value:TRxTextAttributes);
    procedure SetSelAttributes(Value:TRxTextAttributes);
    procedure SetWordAttributes(Value:TRxTextAttributes);
    procedure SetSelectionBar(Value:Boolean);
    procedure SetUndoLimit(Value:Integer);
    procedure UpdateTextModes(Plain:Boolean);
    procedure AdjustFindDialogPosition(Dialog:TFindDialog);
    procedure SetupFindDialog(Dialog:TFindDialog; const SearchStr,
      ReplaceStr:string);
    function FindEditText(Dialog:TFindDialog; AdjustPos, Events:Boolean):Boolean;
    function GetCanFindNext:Boolean;
    procedure FindDialogFind(Sender:TObject);
    procedure ReplaceDialogReplace(Sender:TObject);
    procedure FindDialogClose(Sender:TObject);
    procedure SetUIActive(Active:Boolean);
    procedure CMDocWindowActivate(var Message:TMessage); message CM_DOCWINDOWACTIVATE;
    procedure CMUIDeactivate(var Message:TMessage); message CM_UIDEACTIVATE;
    procedure CMBiDiModeChanged(var Message:TMessage); message CM_BIDIMODECHANGED;
    procedure CMColorChanged(var Message:TMessage); message CM_COLORCHANGED;
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure CNNotify(var Message:TWMNotify); message CN_NOTIFY;
    procedure EMReplaceSel(var Message:TMessage); message EM_REPLACESEL;
    procedure WMDestroy(var Msg:TWMDestroy); message WM_DESTROY;
    procedure WMMouseMove(var Message:TMessage); message WM_MOUSEMOVE;
    procedure WMPaint(var Message:TWMPaint); message WM_PAINT;
    procedure WMSetCursor(var Message:TWMSetCursor); message WM_SETCURSOR;
    procedure WMSetFont(var Message:TWMSetFont); message WM_SETFONT;
{$IFDEF Delphi5}
    procedure WMRButtonUp(var Message:TMessage); message WM_RBUTTONUP;
{$ENDIF}
  protected
    procedure CreateParams(var Params:TCreateParams); override;
    procedure CreateWindowHandle(const Params:TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    function GetPopupMenu:TPopupMenu; override;
    procedure TextNotFound(Dialog:TFindDialog); virtual;
    procedure RequestSize(const Rect:TRect); virtual;
    procedure SelectionChange; dynamic;
    function ProtectChange(const Message:TMessage; StartPos,
      EndPos:Integer):Boolean; dynamic;
    function SaveClipboard(NumObj, NumChars:Integer):Boolean; dynamic;
    procedure URLClick(const URLText:string; Button:TMouseButton); dynamic;
    procedure SetPlainText(Value:Boolean); virtual;
    procedure CloseFindDialog(Dialog:TFindDialog); virtual;
    procedure DoSetMaxLength(Value:Integer); override;
    function GetSelLength:Integer; override;
    function GetSelStart:Integer; override;
    function GetSelText:string; override;
    procedure SetSelLength(Value:Integer); override;
    procedure SetSelStart(Value:Integer); override;
    property AllowInPlace:Boolean read FAllowInPlace write FAllowInPlace default True;
    property AllowObjects:Boolean read FAllowObjects write SetAllowObjects default True;
    property AutoURLDetect:Boolean read GetAutoURLDetect write SetAutoURLDetect default True;
    property AutoVerbMenu:Boolean read FAutoVerbMenu write FAutoVerbMenu default True;
    property HideSelection:Boolean read FHideSelection write SetHideSelection default True;
    property HideScrollBars:Boolean read FHideScrollBars
      write SetHideScrollBars default True;
    property Title:string read FTitle write SetTitle;
    property LangOptions:TRichLangOptions read GetLangOptions write SetLangOptions default [rlAutoFont];
    property Lines:TStrings read FRichEditStrings write SetRichEditStrings;
    property PlainText:Boolean read FPlainText write SetPlainText default False;
    property SelectionBar:Boolean read FSelectionBar write SetSelectionBar default True;
    property StreamFormat:TRichStreamFormat read GetStreamFormat write SetStreamFormat default sfDefault;
    property StreamMode:TRichStreamModes read GetStreamMode write SetStreamMode default [];
    property UndoLimit:Integer read FUndoLimit write SetUndoLimit default 100;
    property WordSelection:Boolean read GetWordSelection write SetWordSelection default True;
    property ScrollBars default ssBoth;
    property TabStop default True;
    property OnSaveClipboard:TRichEditSaveClipboard read FOnSaveClipboard
      write FOnSaveClipboard;
    property OnSelectionChange:TNotifyEvent read FOnSelChange write FOnSelChange;
    property OnProtectChange:TRichEditProtectChange read FOnProtectChange
      write FOnProtectChange; { obsolete }
    property OnProtectChangeEx:TRichEditProtectChangeEx read FOnProtectChangeEx
      write FOnProtectChangeEx;
    property OnResizeRequest:TRichEditResizeEvent read FOnResizeRequest
      write FOnResizeRequest;
    property OnURLClick:TRichEditURLClickEvent read FOnURLClick write FOnURLClick;
    property OnTextNotFound:TRichEditFindErrorEvent read FOnTextNotFound write FOnTextNotFound;
    property OnCloseFindDialog:TRichEditFindCloseEvent read FOnCloseFindDialog
      write FOnCloseFindDialog;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Clear; override;
    procedure SetSelection(StartPos, EndPos:Longint; ScrollCaret:Boolean);