⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 rm_wwrichedit.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 

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

unit RM_wwRichEdit;

interface

{$I RM.inc}

{$IFDEF InfoPower}
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Menus,
  Forms, Dialogs, Stdctrls, RM_Class, RM_Common, RM_Ctrls, RM_DsgCtrls, DB, Clipbrd,
  RichEdit, wwriched, ComCtrls, ToolWin, ExtCtrls
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER4_UP}, ImgList{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

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

  TRMSubscriptStyle = (rmssNone, rmssSubscript, rmssSuperscript);

 { TRMwwRichView }
  TRMWWRichView = class(TRMStretcheableView)
  private
    FStartCharPos, FEndCharPos, FSaveCharPos: Integer;
    FRichEdit, FSRichEdit: TwwDBRichEdit;
    FUseSRichEdit: Boolean;

    function SRichEdit: TwwDBRichEdit;
    procedure GetRichData(ASource: TCustomMemo);
    procedure DrawRichText(aDC: HDC; aFormatDC: HDC; const aRect: TRect; aCharRange: TCharRange);
    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 CalcHeight: Integer; override;
    function RemainHeight: Integer; 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 GetBlob; override;
    procedure LoadFromRichEdit(aRichEdit: TwwDBRichEdit);
    procedure DefinePopupMenu(aPopup: TRMCustomMenuItem); override;
    procedure ShowEditor; override;
  published
    property RichEdit: TwwDBRichEdit 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;

  { TRMwwRichForm }
  TRMwwRichForm = 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;
    ItemEditSelectAll: TMenuItem;
    N20: TMenuItem;
    ItemEditFind: TMenuItem;
    ItemEditFindNext: TMenuItem;
    ItemEditReplace: 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;
    btnJustify: TToolButton;
    ItemFormatParagraph: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RichEditChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    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 ItemFileExitClick(Sender: TObject);
    procedure ItemFormatFontClick(Sender: TObject);
    procedure ItemInserObjectClick(Sender: TObject);
    procedure btnUndoClick(Sender: TObject);
    procedure ItemEditFindNextClick(Sender: TObject);
    procedure ItemEditReplaceClick(Sender: TObject);
    procedure btnInsertFieldClick(Sender: TObject);
    procedure ItemEditSelectAllClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnBulletsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ItemInsertPictureClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ItemFormatParagraphClick(Sender: TObject);
  private
    tempDown: boolean;
    FUpdating: Boolean;
    FFileName: string;
    FcmbFont: TRMFontComboBox;
    FcmbFontSize: TComboBox;
    FOpenPictureDialog: TOpenDialog;
    FRuler: TRMRuler;
    FBtnFontColor: TRMColorPickerButton;
    FBtnBackColor: TRMColorPickerButton;

    procedure SetFileName(const FileName: string);
    procedure UpdateCursorPos;
    procedure FocusEditor;
    procedure PerformFileOpen(const AFileName: string);
    procedure SetModified(Value: Boolean);
    procedure OnCmbFontChange(Sender: TObject);
    procedure OnCmbFontSizeChange(Sender: TObject);
    procedure RefreshControls;
    procedure SelectionChange(Sender: TObject);
    procedure OnColorChangeEvent(Sender: TObject);
    procedure Localize;
  public
    Editor: TwwDBRichEdit;
  end;
{$ENDIF}

implementation

{$IFDEF InfoPower}

{$R *.DFM}

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

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

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;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMWWRichView}

constructor TRMWWRichView.Create;
begin
  inherited Create;
  BaseName := 'wwRich';

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

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

procedure TRMwwRichView.GetRichData(ASource: TCustomMemo);
var
  R: string;
  i, j: Integer;
  lStr: WideString;
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 := RMAnsiGetBrackedVariable(Text, i, j);
        InternalOnGetValue(Self, R, lStr);
        SelLength := j - i + 1;
        SelText := lStr;

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

function TRMwwRichView.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}

procedure TRMwwRichView.DrawRichText(aDC: HDC; aFormatDC: HDC; const aRect: TRect; aCharRange: TCharRange);
begin
  FormatRange(aDC, aFormatDC, aRect, aCharRange, True);
end;

function TRMwwRichView.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: TwwDBRichEdit;
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
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -