rm_wwrtf.pas

report machine 2.3 功能强大

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

unit RM_wwrtf;

interface

{$I RM.inc}

{$IFDEF InfoPower}
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Menus,
  Forms, Dialogs, Stdctrls, RM_DBRel, RM_Class, RM_common, DB, Clipbrd,
  RichEdit, wwriched, {$IFDEF Delphi4}ImgList, {$ENDIF}ComCtrls,
  ToolWin, ExtCtrls{$IFDEF Delphi6}, Variants{$ENDIF};

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

 { TRMwwRichView }
  TRMWWRichView = class(TRMStretcheable)
  private
    FCurChar, FLastChar, FCharFrom: Integer;
    FFlag: Boolean;
    procedure GetRichData(ASource: TCustomMemo);
    function DoCalcHeight: Integer;
    procedure ShowRich(Render: Boolean);
    procedure P1Click(Sender: TObject);
    procedure RichEditor(Sender: TObject);
  protected
    function GetViewCommon: string; override;
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    RichEdit: TwwDBRichEdit;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(Canvas: TCanvas); override;
    procedure StreamOut(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure GetBlob(b: TField); override;
    function CalcHeight: Integer; override;
    function MinHeight: Integer; override;
    function LostSpace: Integer; override;
    function RemainHeight: Integer; override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
    procedure ShowEditor; override;
  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;
    ToolButton1: TToolButton;
    btnSuperscript: TToolButton;
    btnSubscript: TToolButton;
    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 btnSubscriptClick(Sender: TObject);
  private
    tempDown: boolean;
    FUpdating: Boolean;
    FFileName: string;
    FcmbFont: TRMFontComboBox;
    FcmbFontSize: TRMComboBox;
    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_Pars, RM_Intrp, RM_Utils, RM_Const, RM_Const1, RM_CmpReg, Printers, RM_Rich
{$IFDEF OPENPICTUREDLG}, ExtDlgs{$ENDIF}
{$IFDEF JPeg}, JPeg{$ENDIF}
{$IFDEF RXGIF}, RxGIF{$ENDIF};

var
  FRichEdit: TwwDBRichEdit; // temporary rich used during TRichView drawing

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

procedure AssignRich(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;
  RichEdit := TwwDBRichEdit.Create(RMDialogForm);
  RichEdit.Parent := RMDialogForm;
  RichEdit.Visible := False;
  RichEdit.Font.Charset := StrToInt(RMLoadStr(SCharset));
  RichEdit.Font.Name := RMLoadStr(SRMDefaultFontName);
  RichEdit.Font.Size := 11;
  BaseName := 'wwRich';
end;

destructor TRMWWRichView.Destroy;
begin
  if RMDialogForm <> nil then
    RichEdit.Free;

  inherited Destroy;
end;

procedure TRMWWRichView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('GapX', [RMdtInteger], nil);
  AddProperty('GapY', [RMdtInteger], nil);
  AddProperty('Lines', [RMdtHasEditor, RMdtOneObject], RichEditor);
  AddProperty('Stretched', [RMdtBoolean], nil);
  AddProperty('TextOnly', [RMdtBoolean], nil);
  AddProperty('DataField', [RMdtOneObject, RMdtHasEditor, RMdtString], RMFieldEditor);

  AddProperty('OnBeforePrint', [RMdtHasEditor, RMdtOneObject], RMScript_BeforePrintEditor);
  AddProperty('OnAfterPrint', [RMdtHasEditor, RMdtOneObject], RMScript_AfterPrintEditor);
end;

procedure TRMWWRichView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'TEXTONLY' then
    Flags := (Flags and not flTextOnly) or Word(Boolean(Value)) * flTextOnly;
end;

function TRMWWRichView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then
    Exit;
  if Index = 'TEXTONLY' then
    Result := (Flags and flTextOnly) <> 0;
end;

procedure TRMWWRichView.GetRichData(ASource: TCustomMemo);
var
  R, S: string;
  i, j: Integer;
begin
  if 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);
        CurReport.InternalOnGetValue(R, S);
        SelLength := j - i + 1;
        SelText := S;
        i := Pos('[', Text);
      end;
    finally
      Lines.EndUpdate;
    end;
  end;
end;

function TRMWWRichView.DoCalcHeight: Integer;
var
  Range: TFormatRange;
  LastChar, MaxLen, LogX, LogY: Integer;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Range do
  begin
    hdc := GetDC(0);
    hdcTarget := hdc;
    LogX := Screen.PixelsPerInch;
    LogY := LogX;

    rc := Rect(0, 0, Round((DX - GapX * 2) * 1440 / LogX), Round(10000000 * 1440.0 / LogY));
    rcPage := rc;
    LastChar := FCharFrom;
    MaxLen := SRichEdit.GetTextLen;
    chrg.cpMin := LastChar;
    chrg.cpMax := -1;
    SRichEdit.Perform(EM_FORMATRANGE, 0, Integer(@Range));
    ReleaseDC(0, hdc);
    if MaxLen = 0 then
      Result := 0
    else if (rcPage.bottom <> rc.bottom) then
      Result := Round(rc.bottom / (1440.0 / LogY)) + 2 * GapY
    else
      Result := 0;
  end;
  SRichEdit.Perform(EM_FORMATRANGE, 0, 0);
end;

{$WARNINGS OFF}

procedure TRMWWRichView.ShowRich(Render: Boolean);
var
  Range: TFormatRange;
  LogX, LogY, mm: Integer;
  EMF: TMetafile;
  EMFCanvas: TMetafileCanvas;
  re: TwwDBRichEdit;
  BMP: TBitmap;
begin
  if Render then
    re := RichEdit
  else
    re := SRichEdit;
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Range do
  begin
    if Render then
      hdc := Canvas.Handle
    else
      hdc := GetDC(0);
    if Render then
    begin
      if IsPrinting then
      begin
        LogX := GetDeviceCaps(hdc, LOGPIXELSX);
        LogY := GetDeviceCaps(hdc, LOGPIXELSY);
        rc := Rect(DRect.Left * 1440 div LogX, DRect.Top * 1440 div LogY,
          DRect.Right * 1440 div LogX, Round(DRect.Bottom * 1440 / LogY));
      end
      else
      begin
        LogX := Screen.PixelsPerInch;
        LogY := LogX;
        rc := Rect(0, 0, Round((SaveDX - SaveGX * 2) * 1440 / LogX),
          Round((SaveDY - SaveGY * 2) * 1440 / LogY));
        EMF := TMetafile.Create;
        EMF.Width := SaveDX - SaveGX * 2;
        EMF.Height := SaveDY - SaveGY * 2;
        EMFCanvas := TMetafileCanvas.Create(EMF, 0);
        EMFCanvas.Brush.Style := bsClear;
        hdc := EMFCanvas.Handle;
      end;
    end
    else
    begin
      LogX := Screen.PixelsPerInch;
      LogY := LogX;
      rc := Rect(0, 0, Round((DX - GapX * 2) * 1440 / LogX),
        Round((DY - GapY * 2) * 1440 / LogY));
    end;