rm_rxrichedit.pas

胜天进销存源码,国产优秀的进销存

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

unit RM_RxRichEdit;

interface

{$I RM.inc}

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

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

 { TRMRxRichView }
  TRMRxRichView = 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;
  public
    constructor Create; override;
    destructor Destroy; override;

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

    procedure GetBlob; override;
    function CalcHeight: Integer; override;
    function RemainHeight: Integer; 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;
  end;

  {TRMRxRichForm}
  TRMRxRichForm = 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;

    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;

{$ENDIF}

implementation

{$IFDEF RX}
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}

function GetSpecial(const s: string; Pos: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
{  for i := 1 to Pos do
  begin
    if s[i] in [#10, #13] then
      Inc(Result);
  end;
}
//WHF Add
  i := 1;
  while i <= Pos do
  begin
    if ByteType(s, i) = mbLeadByte then
    begin
      Result := Result + 2;
      Inc(i);
    end
    else if s[i] in [#10, #13] then
      Inc(Result);
    Inc(i);
  end;
end;

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;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMRxRichView }

constructor TRMRxRichView.Create;
begin
  inherited Create;
  BaseName := 'RxRich';

  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 TRMRxRichView.Destroy;
begin
  if RMDialogForm <> nil then
  begin
    FRichEdit.Free;
    FRichEdit := nil;
    FSRichEdit.Free;
    FSRichEdit := nil;
  end;
  inherited Destroy;
end;

function TRMRxRichView.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 TRMRxRichView.GetRichData(ASource: TCustomMemo);
var
  R, S: string;
  i, j: Integer;
begin
  if ParentReport.Flag_TableEmpty then
  begin
    ASource.Lines.Text := '';
    Exit;
  end;

  with ASource do
  begin
    try
      Lines.BeginUpdate;
      i := Pos('[', Text);
      while i > 0 do
      begin
        SelStart := i - 1 - GetSpecial(Text, i) div 2;
        R := RMGetBrackedVariable(Text, i, j);
        InternalOnGetValue(Self, R, S, False);
        SelLength := j - i + 1;
        SelText := S;

        i := Pos('[', Text);
      end;
    finally
      Lines.EndUpdate;
    end;
  end;
end;

function TRMRxRichView.DoCalcHeight: Integer;
var
  liFormatRange: TFormatRange;
  liLastChar, liMaxLen: Integer;
  liPixelsPerInchX: Integer;
  liPixelsPerInchY: Integer;
  lTextMetric: TTextMetric;
  liTolerance: Integer;
  liPrinter: TRMPrinter;
  liDC: HDC;
  liPrinterWidth: Integer;
  liFont: TFont;
begin
  liPrinter := GetPrinter;
  if (liPrinter <> nil) and (liPrinter.DC <> 0) then
    liDC := liPrinter.DC
  else
    liDC := GetDC(0);

  try
    FillChar(liFormatRange, SizeOf(TFormatRange), 0);
    liFormatRange.hdc := liDC;
    liFormatRange.hdcTarget := liFormatRange.hdc;
    liPixelsPerInchX := GetDeviceCaps(liDC, LOGPIXELSX);
    liPixelsPerInchY := GetDeviceCaps(liDC, LOGPIXELSY);

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

    liPrinterWidth := Round(RMFromMMThousandths_Printer(
      (mmSaveWidth - mmSaveGapX * 2 - _CalcHFrameWidth(mmSaveFWLeft, mmSaveFWRight)),
      rmrtHorizontal, liPrinter));
    liPrinterWidth := Round(liPrinterWidth * 1440.0 / liPixelsPerInchX);
    liTolerance := Round(Abs(SRichEdit.SelAttributes.Size) * liPixelsPerInchY / 72);

    liFormatRange.rc := Rect(0, 0, liPrinterWidth, Round(10000000 * 1440.0 / liPixelsPerInchY));
    liFormatRange.rcPage := liFormatRange.rc;
    liLastChar := FStartCharPos;
    liMaxLen := SRichEdit.GetTextLen;
    liFormatRange.chrg.cpMin := liLastChar;
    liFormatRange.chrg.cpMax := -1;
    SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@liFormatRange));
    if liMaxLen = 0 then
      Result := 0
    else if (liFormatRange.rcPage.bottom <> liFormatRange.rc.bottom) then
      Result := Round(liFormatRange.rc.bottom / (1440.0 / liPixelsPerInchY))
    else
      Result := 0;

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

{$WARNINGS OFF}

function TRMRxRichView.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 := (aRect.Left * 1440 div liPixelsPerInchX) + 45;
  liFormatRange.rc.right := aRect.Right * 1440 div liPixelsPerInchX;
  liFormatRange.rc.top := aRect.Top * 1440 div liPixelsPerInchY;
  liFormatRange.rc.bottom := aRect.Bottom * 1440 div 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 TRMRxRichView.ShowRichText(aRender: Boolean);
var
  liCharRange: TCharRange;

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

  procedure _ShowRichOnScreen;
  var
    liMetaFile: TMetaFile;
    liMetaFileCanvas: TMetaFileCanvas;
    liDC: HDC;
    liPrinter: TRMPrinter;
    liBitmap: TBitmap;
    liCanvasRect: TRect;
    liWidth, liHeight: Integer;
  begin
    liPrinter := RMPrinter;
    if liPrinter.DC <> 0 then
      liDC := liPrinter.DC
    else