frxrichedit.pas

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

    function GetSelection:TCharRange;
    function GetTextRange(StartPos, EndPos:Longint):string;
    function LineFromChar(CharIndex:Integer):Integer;
    function GetLineIndex(LineNo:Integer):Integer;
    function GetLineLength(CharIndex:Integer):Integer;
    function WordAtCursor:string;
    function FindText(const SearchStr:string;
      StartPos, Length:Integer; Options:TRichSearchTypes):Integer;
    function GetSelTextBuf(Buffer:PChar; BufSize:Integer):Integer; override;
    function GetCaretPos:TPoint; override;
    function GetCharPos(CharIndex:Integer):TPoint;
    function InsertObjectDialog:Boolean;
    function ObjectPropertiesDialog:Boolean;
    function PasteSpecialDialog:Boolean;
    function FindDialog(const SearchStr:string):TFindDialog;
    function ReplaceDialog(const SearchStr, ReplaceStr:string):TReplaceDialog;
    function FindNext:Boolean;
    procedure Print(const Caption:string); virtual;
    class procedure RegisterConversionFormat(const AExtension:string;
      APlainText:Boolean; AConversionClass:TConversionClass);
    procedure ClearUndo;
    procedure Redo;
    procedure StopGroupTyping;
    property CanFindNext:Boolean read GetCanFindNext;
    property CanRedo:Boolean read GetCanRedo;
    property CanPaste:Boolean read GetCanPaste;
    property RedoName:TUndoName read GetRedoName;
    property UndoName:TUndoName read GetUndoName;
    property DefaultConverter:TConversionClass read FDefaultConverter
      write FDefaultConverter;
    property DefAttributes:TRxTextAttributes read FDefAttributes write SetDefAttributes;
    property SelAttributes:TRxTextAttributes read FSelAttributes write SetSelAttributes;
    property WordAttributes:TRxTextAttributes read FWordAttributes write SetWordAttributes;
    property PageRect:TRect read FPageRect write FPageRect;
    property Paragraph:TRxParaAttributes read FParagraph;
    property SelectionType:TRichSelectionType read GetSelectionType;
  end;

  TRxRichEdit = class(TRxCustomRichEdit)
  published
    property Align;
    property Alignment;
    property AutoURLDetect;
    property AutoVerbMenu;
    property AllowObjects;
    property AllowInPlace;
    property Anchors;
    property BiDiMode;
    property BorderWidth;
    property DragKind;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property HideScrollBars;
    property Title;
    property ImeMode;
    property ImeName;
    property Constraints;
    property ParentBiDiMode;
    property LangOptions;
    property Lines;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PlainText;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property SelectionBar;
    property ShowHint;
    property StreamFormat;
    property StreamMode;
    property TabOrder;
    property TabStop;
    property UndoLimit;
    property Visible;
    property WantTabs;
    property WantReturns;
    property WordSelection;
    property WordWrap;
    property OnChange;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
{$IFDEF Delphi5}
    property OnContextPopup;
{$ENDIF}
    property OnEndDock;
    property OnStartDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnProtectChange; { obsolete }
    property OnProtectChangeEx;
    property OnResizeRequest;
    property OnSaveClipboard;
    property OnSelectionChange;
    property OnStartDrag;
    property OnTextNotFound;
    property OnCloseFindDialog;
    property OnURLClick;
  end;

var
  RichEditVersion:TRichEditVersion;

implementation

uses Printers, ComStrs, OleConst, OleDlg, OleCtnrs;

const
  RTFConversionFormat:TRichConversionFormat = (
    ConversionClass:TConversion;
    Extension:'rtf';
    PlainText:False;
    Next:nil);
  TextConversionFormat:TRichConversionFormat = (
    ConversionClass:TConversion;
    Extension:'txt';
    PlainText:True;
    Next:@RTFConversionFormat);

var
  ConversionFormatList:PRichConversionFormat = @TextConversionFormat;

const
  RichEdit10ModuleName = 'RICHED32.DLL';
  RichEdit20ModuleName = 'RICHED20.DLL';
// for support RichEdit 3.0
  EM_SETTYPOGRAPHYOPTIONS = WM_USER+202;
  EM_GETTYPOGRAPHYOPTIONS = WM_USER+203;
  TO_ADVANCEDTYPOGRAPHY = 1;
  TO_SIMPLELINEBREAK = 2;
  FT_DOWN = 1;

type
  PENLink = ^TENLink;
  PENOleOpFailed = ^TENOleOpFailed;
  TFindTextEx = TFindTextExA;

  TTextRangeA = record
    chrg:TCharRange;
    lpstrText:PAnsiChar;
  end;
  TTextRangeW = record
    chrg:TCharRange;
    lpstrText:PWideChar;
  end;
  TTextRange = TTextRangeA;

function ResStr(const Ident:string):string;
begin
  Result:= Ident;
end;

{ TRxTextAttributes }

const
  AttrFlags:array[TRxAttributeType] of Word = (0, SCF_SELECTION,
    SCF_WORD or SCF_SELECTION);

constructor TRxTextAttributes.Create(AOwner:TRxCustomRichEdit;
  AttributeType:TRxAttributeType);
begin
  inherited Create;
  RichEdit:= AOwner;
  FType:= AttributeType;
end;

procedure TRxTextAttributes.InitFormat(var Format:TCharFormat2);
begin
  FillChar(Format, SizeOf(Format), 0);
  if RichEditVersion >= 2 then Format.cbSize:= SizeOf(Format)
  else Format.cbSize:= SizeOf(TCharFormat);
end;

function TRxTextAttributes.GetConsistentAttributes:TRxConsistentAttributes;
var
  Format:TCharFormat2;
begin
  Result:= [];
  if RichEdit.HandleAllocated and (FType<>atDefaultText) then begin
    InitFormat(Format);
    SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
      AttrFlags[FType], LPARAM(@Format));
    with Format do begin
      if (dwMask and CFM_BOLD)<>0 then Include(Result, caBold);
      if (dwMask and CFM_COLOR)<>0 then Include(Result, caColor);
      if (dwMask and CFM_FACE)<>0 then Include(Result, caFace);
      if (dwMask and CFM_ITALIC)<>0 then Include(Result, caItalic);
      if (dwMask and CFM_SIZE)<>0 then Include(Result, caSize);
      if (dwMask and CFM_STRIKEOUT)<>0 then Include(Result, caStrikeOut);
      if (dwMask and CFM_UNDERLINE)<>0 then Include(Result, caUnderline);
      if (dwMask and CFM_PROTECTED)<>0 then Include(Result, caProtected);
      if (dwMask and CFM_OFFSET)<>0 then Include(Result, caOffset);
      if (dwMask and CFM_HIDDEN)<>0 then Include(result, caHidden);
      if RichEditVersion >= 2 then begin
        if (dwMask and CFM_LINK)<>0 then Include(Result, caLink);
        if (dwMask and CFM_BACKCOLOR)<>0 then Include(Result, caBackColor);
        if (dwMask and CFM_DISABLED)<>0 then Include(Result, caDisabled);
        if (dwMask and CFM_WEIGHT)<>0 then Include(Result, caWeight);
        if (dwMask and CFM_SUBSCRIPT)<>0 then Include(Result, caSubscript);
        if (dwMask and CFM_REVAUTHOR)<>0 then Include(Result, caRevAuthor);
      end;
    end;
  end;
end;

procedure TRxTextAttributes.GetAttributes(var Format:TCharFormat2);
begin
  InitFormat(Format);
  if RichEdit.HandleAllocated then
    SendMessage(RichEdit.Handle, EM_GETCHARFORMAT, AttrFlags[FType],
      LPARAM(@Format));
end;

procedure TRxTextAttributes.SetAttributes(var Format:TCharFormat2);
begin
  if RichEdit.HandleAllocated then
    SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, AttrFlags[FType],
      LPARAM(@Format));
end;

function TRxTextAttributes.GetCharset:TFontCharset;
var
  Format:TCharFormat2;
begin
  GetAttributes(Format);
  Result:= Format.bCharset;
end;

procedure TRxTextAttributes.SetCharset(Value:TFontCharset);
var
  Format:TCharFormat2;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask:= CFM_CHARSET;
    bCharSet:= Value;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetProtected:Boolean;
var
  Format:TCharFormat2;
begin
  GetAttributes(Format);
  with Format do
    Result:= (dwEffects and CFE_PROTECTED)<>0;
end;

procedure TRxTextAttributes.SetProtected(Value:Boolean);
var
  Format:TCharFormat2;
begin
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_PROTECTED;
    if Value then dwEffects:= CFE_PROTECTED;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetLink:Boolean;
var
  Format:TCharFormat2;
begin
  Result:= False;
  if RichEditVersion < 2 then Exit;
  GetAttributes(Format);
  with Format do Result:= (dwEffects and CFE_LINK)<>0;
end;

procedure TRxTextAttributes.SetLink(Value:Boolean);
var
  Format:TCharFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_LINK;
    if Value then dwEffects:= CFE_LINK;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetRevAuthorIndex:Byte;
var
  Format:TCharFormat2;
begin
  GetAttributes(Format);
  Result:= Format.bRevAuthor;
end;

procedure TRxTextAttributes.SetRevAuthorIndex(Value:Byte);
var
  Format:TCharFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_REVAUTHOR;
    bRevAuthor:= Value;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetHidden:Boolean;
var
  Format:TCharFormat2;
begin
  Result:= False;
  if RichEditVersion < 2 then Exit;
  GetAttributes(Format);
  Result:= Format.dwEffects and CFE_HIDDEN<>0;
end;

procedure TRxTextAttributes.SetHidden(Value:Boolean);
var
  Format:TCharFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_HIDDEN;
    if Value then dwEffects:= CFE_HIDDEN;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetDisabled:Boolean;
var
  Format:TCharFormat2;
begin
  Result:= False;
  if RichEditVersion < 2 then Exit;
  GetAttributes(Format);
  Result:= Format.dwEffects and CFE_DISABLED<>0;
end;

procedure TRxTextAttributes.SetDisabled(Value:Boolean);
var
  Format:TCharFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_DISABLED;
    if Value then dwEffects:= CFE_DISABLED;
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetColor:TColor;
var
  Format:TCharFormat2;
begin
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_AUTOCOLOR)<>0 then Result:= clWindowText
    else Result:= crTextColor;
end;

procedure TRxTextAttributes.SetColor(Value:TColor);
var
  Format:TCharFormat2;
begin
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_COLOR;
    if (Value = clWindowText) or (Value = clDefault) then
      dwEffects:= CFE_AUTOCOLOR
    else crTextColor:= ColorToRGB(Value);
  end;
  SetAttributes(Format);
end;

function TRxTextAttributes.GetBackColor:TColor;
var
  Format:TCharFormat2;
begin
  if RichEditVersion < 2 then begin
    Result:= clWindow;
    Exit;
  end;
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_AUTOBACKCOLOR)<>0 then Result:= clWindow
    else Result:= crBackColor;
end;

procedure TRxTextAttributes.SetBackColor(Value:TColor);
var
  Format:TCharFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitFormat(Format);
  with Format do begin
    dwMask:= CFM_BACKCOLOR;