rm_richedit.pas

这是一个功能强大

{*****************************************}
{                                         }
{         Report Machine v2.0             }
{          RxRich Add-In Object           }
{                                         }
{*****************************************}

unit RM_RichEdit;

interface

{$I RM.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Menus, Db,
  Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ClipBrd, ToolWin,
  RM_Class, RM_common, RM_Ctrls, RM_DsgCtrls, RichEdit
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF JVCLCTLS}, JvRichEdit{$ELSE}, RM_JvRichEdit{$ENDIF}
{$IFDEF COMPILER4_UP}, ImgList{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

type
  TRMRichObject = class(TComponent) // fake component
  end;

 { TRMRichView }
  TRMRichView = class(TRMStretcheableView)
  private
    FRichEdit, FSRichEdit: TJvRichEdit;
    FSaveCharPos, FEndCharPos, FStartCharPos: Integer;
    FUseSRichEdit: Boolean;

    function SRichEdit: TJvRichEdit;
    procedure GetRichData(ASource: TCustomMemo);
    function FormatRange(aDC: HDC; aFormatDC: HDC; const aRect: TRect; aCharRange: TCharRange;
      aRender: Boolean): Integer;
    function DoCalcHeight: Integer;
    procedure ShowRichText(aRender: Boolean);
  protected
    procedure Prepare; override;
    procedure GetMemoVariables; override;
    function GetViewCommon: string; override;
    procedure ClearContents; override;
    function GetExportMode: TRMExportMode; override;
    function GetExportData: string; override;

    function CalcHeight: Integer; override;
    function RemainHeight: Integer; override;

    procedure GetBlob; override;
    procedure PlaceOnEndPage(aStream: TStream); override;
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Draw(aCanvas: TCanvas); override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;

    procedure DefinePopupMenu(Popup: TRMCustomMenuItem); override;
    procedure ShowEditor; override;
    procedure LoadFromRichEdit(aRichEdit: TJvRichEdit);
  published
    property RichEdit: TJvRichEdit read FRichEdit;
    property GapLeft;
    property GapTop;
    property ShiftWith;
    property StretchWith;
    property TextOnly;
    property BandAlign;
    property LeftFrame;
    property RightFrame;
    property TopFrame;
    property BottomFrame;
    property FillColor;
    property PrintFrame;
    property Printable;
    property OnPreviewClick;
    property OnPreviewClickUrl;
  end;

  TRMRxRichView = class(TRMRichView)
  public
    constructor Create; override;
    destructor Destroy; override;
  end;

  {TRMRxRichForm}
  TRMRichForm = class(TForm)
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    FontDialog: TFontDialog;
    StatusBar: TStatusBar;
    ImageList1: TImageList;
    EditPopupMenu: TPopupMenu;
    ItmCut: TMenuItem;
    ItmCopy: TMenuItem;
    ItmPaste: TMenuItem;
    MainMenu: TMainMenu;
    MenuFile: TMenuItem;
    ItemFileNew: TMenuItem;
    ItemFileOpen: TMenuItem;
    ItemFileSaveAs: TMenuItem;
    MenuItem5: TMenuItem;
    ItemFilePrint: TMenuItem;
    MenuItem7: TMenuItem;
    ItemFileExit: TMenuItem;
    MenuEdit: TMenuItem;
    ItemEditUndo: TMenuItem;
    MenuItem11: TMenuItem;
    ItemEditCut: TMenuItem;
    ItemEditCopy: TMenuItem;
    ItemEditPaste: TMenuItem;
    ItemFormatFont: TMenuItem;
    MenuItem16: TMenuItem;
    ItemInsertField: TMenuItem;
    MenuInsert: TMenuItem;
    MenuFormat: TMenuItem;
    ItemInserObject: TMenuItem;
    ItemInsertPicture: TMenuItem;
    ItemEditRedo: TMenuItem;
    ItemEditPasteSpecial: TMenuItem;
    ItemEditSelectAll: TMenuItem;
    N20: TMenuItem;
    ItemEditFind: TMenuItem;
    ItemEditFindNext: TMenuItem;
    ItemEditReplace: TMenuItem;
    N23: TMenuItem;
    ItemEditObjProps: TMenuItem;
    PrintDialog: TPrintDialog;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    btnFileNew: TToolButton;
    btnFileOpen: TToolButton;
    btnFileSave: TToolButton;
    ToolButton4: TToolButton;
    btnFind: TToolButton;
    ToolButton6: TToolButton;
    btnCut: TToolButton;
    btnCopy: TToolButton;
    btnPaste: TToolButton;
    ToolButton10: TToolButton;
    btnUndo: TToolButton;
    btnRedo: TToolButton;
    ToolButton13: TToolButton;
    btnInsertField: TToolButton;
    ToolButton15: TToolButton;
    btnOK: TToolButton;
    btnCancel: TToolButton;
    ToolButton18: TToolButton;
    btnFontBold: TToolButton;
    btnFontItalic: TToolButton;
    btnFontUnderline: TToolButton;
    ToolButton22: TToolButton;
    ToolButton25: TToolButton;
    btnAlignLeft: TToolButton;
    btnAlignCenter: TToolButton;
    btnAlignRight: TToolButton;
    ToolButton29: TToolButton;
    btnBullets: TToolButton;
    ToolButton31: TToolButton;
    btnSuperscript: TToolButton;
    btnSubscript: TToolButton;
    ItemFormatParagraph: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RichEditChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure EditorProtectChange(Sender: TObject; StartPos,
      EndPos: Integer; var AllowChange: Boolean);
    procedure EditorTextNotFound(Sender: TObject; const FindText: string);
    procedure EditSelectAll(Sender: TObject);
    procedure btnFileNewClick(Sender: TObject);
    procedure btnFileOpenClick(Sender: TObject);
    procedure btnFileSaveClick(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure btnCutClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnPasteClick(Sender: TObject);
    procedure btnUndoApplyAlign(Sender: TObject; Align: TAlign;
      var Apply: Boolean);
    procedure btnRedoClick(Sender: TObject);
    procedure btnFontBoldClick(Sender: TObject);
    procedure btnFontItalicClick(Sender: TObject);
    procedure btnFontUnderlineClick(Sender: TObject);
    procedure btnAlignLeftClick(Sender: TObject);
    procedure btnBulletsClick(Sender: TObject);
    procedure ItemFileSaveAsClick(Sender: TObject);
    procedure ItemFilePrintClick(Sender: TObject);
    procedure ItemFormatFontClick(Sender: TObject);
    procedure ItemInserObjectClick(Sender: TObject);
    procedure ItemInsertPictureClick(Sender: TObject);
    procedure btnUndoClick(Sender: TObject);
    procedure ItemEditPasteSpecialClick(Sender: TObject);
    procedure ItemEditFindNextClick(Sender: TObject);
    procedure ItemEditReplaceClick(Sender: TObject);
    procedure ItemEditObjPropsClick(Sender: TObject);
    procedure btnInsertFieldClick(Sender: TObject);
    procedure btnSuperscriptClick(Sender: TObject);
    procedure ItemEditSelectAllClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ItemFormatParagraphClick(Sender: TObject);
  private
    FFileName: string;
    FUpdating: Boolean;
    FProtectChanging: Boolean;
//    FClipboardMonitor: TJvClipboardMonitor;
    FOpenPictureDialog: TOpenDialog;
    FcmbFont: TRMFontComboBox;
    FcmbFontSize: TComboBox;
    FRuler: TRMRuler;
    FBtnFontColor: TRMColorPickerButton;
    FBtnBackColor: TRMColorPickerButton;
    FView: TRMRichView;

    function CurrText: TJvTextAttributes;
    procedure SetFileName(const FileName: string);
{$IFDEF OPENPICTUREDLG}
    procedure EditFindDialogClose(Sender: TObject; Dialog: TFindDialog);
{$ENDIF}
    procedure SetEditRect;
    procedure UpdateCursorPos;
    procedure FocusEditor;
    procedure ClipboardChanged(Sender: TObject);
    procedure PerformFileOpen(const AFileName: string);
    procedure SetModified(Value: Boolean);
    procedure OnCmbFontChange(Sender: TObject);
    procedure OnCmbFontSizeChange(Sender: TObject);
    procedure SelectionChange(Sender: TObject);
    procedure OnColorChangeEvent(Sender: TObject);
    procedure Localize;
  public
    Editor: TJvRichEdit;
  end;

implementation

uses RM_Parser, RM_Utils, RM_Const, RM_Const1, RM_Printer,
  {JvVclUtils,}RM_RxParaFmt
{$IFDEF OPENPICTUREDLG}, ExtDlgs{$ENDIF}
{$IFDEF JPeg}, JPeg{$ENDIF}
{$IFDEF RXGIF}, JvGIF{$ENDIF};

const
  RulerAdj = 4 / 3;
  GutterWid = 6;
  UndoNames: array[TUndoName] of string =
  ('', 'typing', 'delete', 'drag and drop', 'cut', 'paste');

{$R *.DFM}

procedure RMRxAssignRich(Rich1, Rich2: TJvRichEdit);
var
  st: TMemoryStream;
begin
  st := TMemoryStream.Create;
  Rich2.Lines.SaveToStream(st);
  st.Position := 0;
  Rich1.Lines.LoadFromStream(st);
  st.Free;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMRichView }

constructor TRMRichView.Create;
begin
  inherited Create;
  BaseName := 'Rich';

  FUseSRichEdit := False;
  FRichEdit := TJvRichEdit.Create(RMDialogForm);
  with FRichEdit do
  begin
    Parent := RMDialogForm;
    Visible := False;
    Font.Charset := StrToInt(RMLoadStr(SCharset));
    Font.Name := RMLoadStr(SRMDefaultFontName);
    Font.Size := 11;
  end;
end;

destructor TRMRichView.Destroy;
begin
  if RMDialogForm <> nil then
  begin
    FRichEdit.Free;
    FRichEdit := nil;
    FSRichEdit.Free;
    FSRichEdit := nil;
  end;
  inherited Destroy;
end;

function TRMRichView.SRichEdit: TJvRichEdit;
begin
  if FSRichEdit = nil then
  begin
    FSRichEdit := TJvRichEdit.Create(RMDialogForm);
    with FSRichEdit do
    begin
      Parent := RMDialogForm;
      Visible := False;
    end;
  end;
  Result := FSRichEdit;
end;

procedure TRMRichView.GetRichData(ASource: TCustomMemo);
var
//  lVarName: string;
  i, j: Integer;
  lVarName, lStr: WideString;
  lSpecialNum: Integer;

  function _FindPos(aPos: Integer): Integer;
  var
    lPos: Integer;
    lStr: string;
  begin
    Result := 0;
    lStr := aSource.Text;
    lPos := aPos;
    lPos := RMPosEx('[', lStr, lPos);
    while lPos > 0 do
    begin
      if (lPos > 0) and (ByteType(lStr, lPos) = mbSingleByte) then
      begin
        Result := lPos;
        Break;
      end;

      lPos := RMPosEx('[', lStr, lPos + 1);
    end;
  end;

  function _GetSpecial(const s: WideString; aPos: Integer): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 1 to aPos do
    begin
      if RM_utils.RMWideCharIn(s[i] ,[#10, #13]) then
        Inc(Result);
    end;
  end;

begin
  if ParentReport.Flag_TableEmpty then
  begin
    ASource.Lines.Text := '';
    Exit;
  end;

  with ASource do
  begin
    try
      Lines.BeginUpdate;
      i := RMPosEx('[', WideString(Text), 1);
      while (i > 0) do
      begin
        lSpecialNum := _GetSpecial(Text, i) div 2;
        SelStart := i - 1 - lSpecialNum;
        lVarName := RMGetBrackedVariable{RMAnsiGetBrackedVariable}(Text, i, j);
        if lVarName <> '' then
        begin
          InternalOnGetValue(Self, lVarName, lStr);
          SelLength := j - i + 1;
          SelText := lStr;
          i := RMPosEx('[', WideString(Text), i + Length(lStr) + 1);
        end
        else
          Break;  
      end;
    finally
      Lines.EndUpdate;
    end;
  end;
end;

function TRMRichView.DoCalcHeight: Integer;
var
  lFormatRange: TFormatRange;
  lLastChar, lMaxLen: Integer;
  lPixelsPerInchX: Integer;
  lPixelsPerInchY: Integer;
  lTextMetric: TTextMetric;
  lTolerance: Integer;
  lPrinter: TRMPrinter;
  lDC: HDC;
  lPrinterWidth: Integer;
  lFont: TFont;
begin
  lPrinter := GetPrinter;
  if (lPrinter <> nil) and (lPrinter.DC <> 0) then
    lDC := lPrinter.DC
  else
    lDC := GetDC(0);

  try
    FillChar(lFormatRange, SizeOf(TFormatRange), 0);
    lFormatRange.hdc := lDC;
    lFormatRange.hdcTarget := lFormatRange.hdc;
    lPixelsPerInchX := GetDeviceCaps(lDC, LOGPIXELSX);
    lPixelsPerInchY := GetDeviceCaps(lDC, LOGPIXELSY);

    if (lPrinter <> nil) and (lPrinter.DC <> 0) then
    begin
      lFont := TFont.Create;
      lFont.Assign(SRichEdit.SelAttributes);
      lPrinter.Canvas.Font := lFont;
      GetTextMetrics(lPrinter.Canvas.Handle, lTextMetric);
      lFont.Free;
    end
    else
      lTextMetric.tmDescent := 0;

    lPrinterWidth := Round(RMFromMMThousandths_Printer(
      (mmSaveWidth - mmSaveGapX * 2 - _CalcHFrameWidth(mmSaveFWLeft, mmSaveFWRight)),
      rmrtHorizontal, lPrinter));
    lPrinterWidth := Round(lPrinterWidth * 1440.0 / lPixelsPerInchX);
    lTolerance := Round(Abs(SRichEdit.SelAttributes.Size) * lPixelsPerInchY / 72);

    lFormatRange.rc := Rect(0, 0, lPrinterWidth, Round(10000000 * 1440.0 / lPixelsPerInchY));
    lFormatRange.rcPage := lFormatRange.rc;
    lLastChar := FStartCharPos;
    lMaxLen := SRichEdit.GetTextLen;
    lFormatRange.chrg.cpMin := lLastChar;
    lFormatRange.chrg.cpMax := -1;
    SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@lFormatRange));
    if lMaxLen = 0 then
      Result := 0
    else if (lFormatRange.rcPage.bottom <> lFormatRange.rc.bottom) then
      Result := Round(lFormatRange.rc.bottom / (1440.0 / lPixelsPerInchY))
    else
      Result := 0;

    SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    Result := Result + lTextMetric.tmDescent + lTolerance;
    Result := Round(RMToMMThousandths_Printer(Result, rmrtVertical, lPrinter) + 0.5);
  finally
    if (lPrinter = nil) or (lPrinter.DC = 0) then
      ReleaseDC(lDC, 0);
  end;
end;

{$WARNINGS OFF}

function TRMRichView.FormatRange(aDC: HDC; aFormatDC: HDC; const aRect: TRect;
  aCharRange: TCharRange; aRender: Boolean): Integer;
var
  liFormatRange: TFormatRange;
  liSaveMapMode: Integer;
  liPixelsPerInchX: Integer;
  liPixelsPerInchY: Integer;
  liRender: Integer;
  liRichEdit: TJvRichEdit;
begin
  if aRender then liRichEdit := FRichEdit else liRichEdit := SRichEdit;

  FillChar(liFormatRange, SizeOf(TFormatRange), 0);
  liFormatRange.hdc := aDC;
  liFormatRange.hdcTarget := aFormatDC;

  liPixelsPerInchX := GetDeviceCaps(aDC, LOGPIXELSX);
  liPixelsPerInchY := GetDeviceCaps(aDC, LOGPIXELSY);

  liFormatRange.rc.left := Round(aRect.Left * 1440.0 / liPixelsPerInchX) + 45;
  liFormatRange.rc.right := Round(aRect.Right * 1440.0 / liPixelsPerInchX);
  liFormatRange.rc.top := Round(aRect.Top * 1440.0 / liPixelsPerInchY);
  liFormatRange.rc.bottom := Round(aRect.Bottom * 1440.0 / liPixelsPerInchY);
  liFormatRange.rcPage := liFormatRange.rc;
  liFormatRange.chrg.cpMin := aCharRange.cpMin;
  liFormatRange.chrg.cpMax := aCharRange.cpMax;

  if aRender then
    liRender := 1
  else
    liRender := 0;

  liSaveMapMode := SetMapMode(liFormatRange.hdc, MM_TEXT);
  liRichEdit.Perform(EM_FORMATRANGE, 0, 0); { flush buffer}
  try
    Result := liRichEdit.Perform(EM_FORMATRANGE, liRender, Longint(@liFormatRange));
  finally
    liRichEdit.Perform(EM_FORMATRANGE, 0, 0);
    SetMapMode(liFormatRange.hdc, liSaveMapMode);
  end;
end;

procedure TRMRichView.ShowRichText(aRender: Boolean);
var
  lCharRange: TCharRange;

  procedure _ShowRichOnPrinter;
  begin
    FormatRange(Canvas.Handle, Canvas.Handle, RealRect, lCharRange, True);
  end;

  procedure _ShowRichOnScreen;
  var
    lMetaFile: TMetaFile;
    lMetaFileCanvas: TMetaFileCanvas;
    lDC: HDC;
    lPrinter: TRMPrinter;
    lBitmap: TBitmap;
    lCanvasRect: TRect;
    lWidth, lHeight: Integer;
  begin
    lPrinter := RMPrinter;
    if lPrinter.DC <> 0 then
      lDC := lPrinter.DC
    else
      lDC := GetDC(0);

    lMetaFile := TMetaFile.Create;
    lBitmap := nil;
    lMetaFileCanvas := nil;