rxrichedit(unicode).pas

delphi下UDP协议穿透[打洞]源代码

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1998 Master-Bank                }
{                                                       }
{*******************************************************}
{                                                       }
{         UNICODE Version                               }
{                                                       }
{         Copyright (c) 2001 Wang Junjiao               }
{         www.wjjsoft.com  [e-mail]            }
{                                                       }
{*******************************************************}
//
//Please READ:
//Unicode supported now, but not tested entirely!!!
//Use at you own entire risk.
//Source redistributions MUST retain this entire copyright notice;
//
//Notes:
//I disable some original macro definations for simplification.
//The modifications might be compiled normally only with D4/CB5
//since i have no other versions below the D4/CB5 installed to test it.
//Don't call 'FindText' method, as I have not worked on it at all.
//Plus, Don't access any TWideStrings::**** member functions
//except for LoadFrom.../SaveTo...
//In addition, RxRichEdit::Ansi****/Wide**** member functions have been
//tested by/for myself and work well .
//
//      Wang Junjiao [www.wjjsoft.com]
//      2001.2.18
//      Any comments, pls let me know at [e-mail]
//
{*******************************************************}


unit RxRichEdit;
{$IFNDEF _DEBUG_}
  {$D-}
{$ENDIF}

//{$I RX.INC}
{$DEFINE RX_D3}
{$DEFINE RX_D4}

{$IFDEF VER130} {Borland Delphi 5.0 }
{$DEFINE RX_D5}
{$ENDIF}

{$DEFINE UNICODE} {added by Junjiao.wang 2001.2.15}

//{.$DEFINE RICHEDIT_VER_10}
{$UNDEF RICHEDIT_VER_10}

{$R-}

interface

uses Windows, {$IFDEF RX_D3} ActiveX, ComObj ,{$ELSE} Ole2, OleAuto, {$ENDIF}
  CommCtrl, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
  Dialogs, ComCtrls, ExtCtrls,Menus, RichEdit;

type
  TRichEditVersion = 1..3;

type
  TRxCustomRichEdit = class;

//-----------------------------------------------------------------------------
{ TRxTextAttributes }

  TRxAttributeType = (atDefaultText, atSelected, atWord);

  TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript);

  TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utWave);

  TAnimationType = (aniNone, aniLasVegas, aniBlink, aniSparkle, aniBlackAnts,
                    aniRedAnts, aniShimmer);

  TRxConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize,
    caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink,
    caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor
    , caLanguage, caIndexKind, caSpacing, caKerning, caULType
    , caAnimation, caSmallCaps, caAllCaps, caOutline
    , caShadow, caEmboss, caImprint, caURL );

  TRxConsistentAttributes = set of TRxConsistentAttribute;

  TRxTextAttributes = class(TPersistent)
  private
    RichEdit: TRxCustomRichEdit;
    FType: TRxAttributeType;
    procedure AssignFont(Font: TFont);
    procedure GetAttributes(var Format: TCharFormat2W);
{$IFNDEF VER90}
    function GetCharset: TFontCharset;
    procedure SetCharset(Value: TFontCharset);
{$ENDIF}
    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: TCharFormat2W);
    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);

    function GetWeight: Word;
    procedure SetWeight(Value: Word);
    function GetSpacing: Double;
    procedure SetSpacing(Value: Double);
    function GetKerning: Double;
    procedure SetKerning(Value: Double);
    function GetAnimation: TAnimationType;
    procedure SetAnimation(Value: TAnimationType);
    function GetSmallCaps: Boolean;
    procedure SetSmallCaps(Value: Boolean);
    function GetAllCaps: Boolean;
    procedure SetAllCaps(Value: Boolean);
    function GetOutline: Boolean;
    procedure SetOutline(Value: Boolean);
    function GetShadow: Boolean;
    procedure SetShadow(Value: Boolean);
    function GetEmboss: Boolean;
    procedure SetEmboss(Value: Boolean);
    function GetImprint: Boolean;
    procedure SetImprint(Value: Boolean);
    function GetIsURL: Boolean;
    procedure SetIsURL(Value: Boolean);

  protected
    procedure InitFormat(var Format: TCharFormat2W);
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TRxCustomRichEdit; AttributeType: TRxAttributeType);
    procedure Assign(Source: TPersistent); override;
{$IFNDEF VER90}
    property Charset: TFontCharset read GetCharset write SetCharset;
{$ENDIF}
    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;

    property Weight: Word read GetWeight write SetWeight;
    property Spacing: Double read GetSpacing write SetSpacing;
    property Kerning: Double read GetKerning write SetKerning;
    property Animation: TAnimationType read GetAnimation write SetAnimation;
    property SmallCaps: Boolean read GetSmallCaps write SetSmallCaps;
    property AllCaps: Boolean read GetAllCaps write SetAllCaps;
    property Outline: Boolean read GetOutline write SetOutline;
    property Shadow: Boolean read GetShadow write SetShadow;
    property Emboss: Boolean read GetEmboss write SetEmboss;
    property Imprint: Boolean read GetImprint write SetImprint;
    property IsURL: Boolean read GetIsURL write SetIsURL;

  end;

//-----------------------------------------------------------------------------
{ TRxParaAttributes }

  TRxNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter,nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman , nsSequence);

  TRxNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple);

  TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify);

  TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore,lsSpecified, lsMultiple);
  //Richedit98 difinations:
  //TLineSpacingRule = (lsrOrdinary, lsr15, lsrDouble, lsrAtLeast, lsrExactly,lsrMultiple);

  THeadingStyle = 0..9;

  TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell);

  TRxParaAttributes = class(TPersistent)
  private
    RichEdit: TRxCustomRichEdit;
    procedure GetAttributes(var Paragraph: TParaFormat2);
    function GetAlignment: TParaAlignment;
    function GetHeadingStyle: THeadingStyle;

    //function GetFirstIndent: Longint;
    //function GetLeftIndent: Longint;
    //function GetRightIndent: Longint;
    //procedure SetFirstIndent(Value: Longint);
    //procedure SetLeftIndent(Value: Longint);
    //procedure SetRightIndent(Value: Longint);
    function GetFirstIndent: Double;
    procedure SetFirstIndent(Value: Double);
    function GetLeftIndent: Double;
    procedure SetLeftIndent(Value: Double);
    function GetRightIndent: Double;
    procedure SetRightIndent(Value: Double);

    //function GetLineSpacing: Longint;
    //function GetLineSpacingRule: TLineSpacingRule;
    function GetLineSpacing: Double;
    function GetLineSpacingRule: TLineSpacingRule;

    function GetNumbering: TRxNumbering;
    function GetNumberingStyle: TRxNumberingStyle;
    function GetNumberingTab: Word;

    function GetNumberingStart: Word;
    procedure SetNumberingStart(Value: Word);

    function GetTab(Index: Byte): Longint;
    function GetTabCount: Integer;
    function GetTableStyle: TParaTableStyle;
    procedure SetAlignment(Value: TParaAlignment);
    procedure SetAttributes(var Paragraph: TParaFormat2);
    procedure SetHeadingStyle(Value: THeadingStyle);

    //function GetSpaceAfter: Longint;
    //function GetSpaceBefore: Longint;
    //procedure SetSpaceAfter(Value: Longint);
    //procedure SetSpaceBefore(Value: Longint);
    function GetSpaceBefore: Double;
    procedure SetSpaceBefore(Value: Double);
    function GetSpaceAfter: Double;
    procedure SetSpaceAfter(Value: Double);

    //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 HeadingStyle: THeadingStyle read GetHeadingStyle write SetHeadingStyle;

    //property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
    //property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
    //property RightIndent: Longint read GetRightIndent write SetRightIndent;
    property FirstIndent: Double read GetFirstIndent write SetFirstIndent;
    property LeftIndent: Double read GetLeftIndent write SetLeftIndent;
    property RightIndent: Double read GetRightIndent write SetRightIndent;

    //property LineSpacing: Longint read GetLineSpacing write SetLineSpacing;
    //property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule;
    property LineSpacing: Double read GetLineSpacing;
    property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule;
    procedure SetLineSpacing(Rule: TLineSpacingRule; Value: Double);

    property Numbering: TRxNumbering read GetNumbering write SetNumbering;
    property NumberingStyle: TRxNumberingStyle read GetNumberingStyle write SetNumberingStyle;
    property NumberingTab: Word read GetNumberingTab write SetNumberingTab;
    property NumberingStart: Word read GetNumberingStart write SetNumberingStart;

    //property SpaceAfter: Longint read GetSpaceAfter write SetSpaceAfter;
    //property SpaceBefore: Longint read GetSpaceBefore write SetSpaceBefore;
    property SpaceBefore: Double read GetSpaceBefore write SetSpaceBefore;
    property SpaceAfter: Double read GetSpaceAfter write SetSpaceAfter;

    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;

//-----------------------------------------------------------------------------
{ TWideStrings class } {Added by junjiao.wang 2001.2.15}

  TWideStrings = class(TPersistent)
  private
    FUpdateCount: Integer;
  protected
    /// procedure DefineProperties(Filer: TFiler); override;
    procedure Error(const Msg: string; Data: Integer); overload;
    procedure Error(Msg: PResStringRec; Data: Integer); overload;
    procedure SetUpdateState(Updating: Boolean); virtual;

    function GetCount: Integer; virtual; abstract;
    function GetCapacity: Integer; virtual;
    procedure SetCapacity(NewCapacity: Integer); virtual;

    procedure Put(Index: Integer; const S: string); virtual;
    procedure WidePut(Index: Integer; const S: WideString); virtual;
    
    procedure PutObject(Index: Integer; AObject: TObject); virtual;
    function GetObject(Index: Integer): TObject; virtual;

    function Get(Index: Integer): string; virtual;
    function WideGet(Index: Integer): WideString; virtual; abstract;

    function GetText: string; virtual;
    function WideGetText: WideString; virtual;

    procedure SetText(const Value: string); virtual;
    procedure WideSetText(const Value: WideString); virtual;

    //procedure ReadData(Reader: TReader);
    //procedure WriteData(Writer: TWriter);
    function GetCodePage: Word; virtual;
    property __cp : Word read GetCodePage;

  public
    destructor Destroy; override;
    procedure Clear; virtual; abstract;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Delete(Index: Integer); virtual; abstract;
    procedure Exchange(Index1, Index2: Integer); virtual;
    procedure Move(CurIndex, NewIndex: Integer); virtual;
    procedure Assign(Source: TPersistent); override;

    function Add(const S: string): Integer; virtual;
    function WideAdd(const S: WideString): Integer; virtual;

    function AddObject(const S: WideString; AObject: TObject): Integer; virtual;

    procedure AddStrings(Strings: TWideStrings); virtual;
    function Equals(Strings: TWideStrings): Boolean;

    function IndexOf(const S: string): Integer; virtual;
    function WideIndexOf(const S: WideString): Integer; virtual;
    function IndexOfObject(AObject: TObject): Integer;

    procedure Insert(Index: Integer; const S: string); virtual;
    procedure WideInsert(Index: Integer; const S: WideString); virtual; abstract;

    procedure InsertObject(Index: Integer; const S: string; AObject: TObject);
    procedure WideInsertObject(Index: Integer; const S: WideString; AObject: TObject);

    procedure LoadFromFile(const FileName: string); virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToFile(const FileName: string); virtual;
    procedure SaveToStream(Stream: TStream); virtual;

    property Capacity: Integer read GetCapacity write SetCapacity;
    property Count: Integer read GetCount;
    property Objects[Index: Integer]: TObject read GetObject write PutObject;
    property Strings[Index: Integer]: string read Get write Put;
    property WideStrings[Index: Integer]: WideString read WideGet write WidePut; default;

    property Text: string read GetText write SetText;
    property WideText: WideString read WideGetText write WideSetText;
    
  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;
{$IFDEF RX_D3}
  TRichEditFindCloseEvent = procedure(Sender: TObject; Dialog: TFindDialog) of object;
{$ENDIF}

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