rm_view.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{             Report Machine v2.0         }
{             Report preview              }
{                                         }
{*****************************************}

unit RM_view;

interface

{$I RM.inc}
{$R RMachine.res}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, Printers, RM_Const;

type
  TRMPreviewZoom = (pzDefault, pzPageWidth, pzOnePage, pzTwoPages);
  TRMPreviewButton = (pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbDesign);
  TRMPreviewButtons = set of TRMPreviewButton;
  TRMScaleMode = (mdNone, mdPageWidth, mdOnePage, mdTwoPages);

  TRMPreview = class;

  { TRMDrawPanel }
  TRMDrawPanel = class(TPanel)
  private
    FDown, FDFlag: Boolean;
    FLastClick: Integer;
    FLastX, FLastY: Integer;
    FPreview: TRMPreview;
    FOldMousePos: TPoint;
    FLastLeft, FLastRight: Integer;

    procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DblClick; override;
  end;

  { TRMPreview }
  TRMPreview = class(TPanel)
  private
    FDoc: Pointer;
    FEMFPages: Pointer;
    FCurPage: Integer;
    Fofx, Fofy, FOldV, FOldH: Integer;
    Fper: Double;
    FMode: TRMScaleMode;
    FPaintAllowed: Boolean;
    FLastScale: Double;
    FLastScaleMode: TRMScaleMode;
    FAutoScale: Boolean;

    FStrFound: Boolean;
    FStrBounds: TRect;
    FFindStr: string;
    FCaseSensitive: Boolean;
    FLastFoundPage, FLastFoundObject: Integer;

    FScrollBox: TScrollBox;
    FRPanel: TPanel;
    FBPanel: TPanel;
    FBevel: TBevel;
    FLabel: TLabel;
    FVScrollBar: TScrollBar;
    FHScrollBar: TScrollBar;
    FPgUp: TSpeedButton;
    FPgDown: TSpeedButton;
    FPBox: TRMDrawPanel;
    FScrollBars: TScrollStyle;
    FKWheel: Integer;
    FParentForm: TForm;

    FOnStatusChange: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    FOnAfterPageSetup: TNotifyEvent;

    procedure DoStatusChange;
    procedure SetPage(Value: Integer);
    function GetZoom: Double;
    procedure SetZoom(Value: Double);
    function GetAllPages: Integer;
    procedure SetScrollBars(Value: TScrollStyle);

    procedure ShowPageNum;
    procedure SetToCurPage;
    procedure FindInEMF(emf: TMetafile);
    procedure OnResizeEvent(Sender: TObject);
    procedure OnVScrollBarChange(Sender: TObject);
    procedure OnHScrollBarChange(Sender: TObject);
    procedure OnPgUpClick(Sender: TObject);
    procedure OnPgDnClick(Sender: TObject);
    procedure SetAutoScale(Value: Boolean);
{$IFDEF Delphi4}
    procedure OnMouseWheelUpEvent(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure OnMouseWheelDownEvent(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
{$ENDIF}
  protected
    FCanModify: Boolean;
    property OnAfterPageSetup: TNotifyEvent read FOnAfterPageSetup write FOnAfterPageSetup;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function CanModify: Boolean;
    procedure Connect(aDoc: TObject);
    procedure Connect_1(aDoc: TObject);
    procedure ConnectBack;
    procedure Disconnect;

    procedure ClearScreen;
    procedure RedrawAll(ResetPage: Boolean);
    procedure OnePage;
    procedure TwoPages;
    procedure PageWidth;
    procedure First;
    procedure Next;
    procedure Prev;
    procedure Last;
    procedure LoadFromFile(name: string);
    procedure SaveToFile(name: string; aIndex: Integer);
    procedure Print;
    procedure PrintCurrentPage;
    procedure DlgPageSetup;
    procedure Find;
    procedure FindNext;
    procedure AddPage;
    procedure DeletePage(PageNo: integer);
    procedure EditPage(PageNo: integer);
    procedure DesignReport;

    property ParentForm: TForm read FParentForm write FParentForm;
    property EMFPages: Pointer read FEMFPages;
    property Doc: Pointer read FDoc;
    property AllPages: Integer read GetAllPages;
    property Page: Integer read FCurPage write SetPage;
    property Zoom: Double read GetZoom write SetZoom;
    property VScrollBar: TScrollbar read FVScrollBar write FVScrollBar;
    property HScrollBar: TScrollbar read FHScrollBar write FHScrollBar;
    property ZoomMode: TRMScaleMode read FMode write FMode;
    property LastScale: Double read FLastScale write FLastScale;
    property ScrollBox: TScrollBox read FScrollBox;
    property FindStr: string read FFindStr write FFindstr;
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
    property LastFoundPage: integer read FLastFoundPage write FLastFoundPage;
    property LastFoundObject: integer read FLastFoundObject write FLastFoundObject;
    property CurPage: integer read FCurPage;
    property StrFound: Boolean read FStrFound write FStrFound;
    property StrBounds: TRect read FStrBounds write FStrBounds;
    property AutoScale: Boolean read FAutoScale write SetAutoScale;
  published
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
    property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
  end;

implementation

uses RM_pgopt, RM_CmpReg, RM_Class, RM_Prntr, RM_PrDlg, RM_Utils, RM_Srch;

var
  crMagnifier: Integer = 0;
  CurPreview: TRMPreview;
  RecordNum: Integer;

function EnumEMFRecordsProc(DC: HDC; HandleTable: PHandleTable;
  EMFRecord: PEnhMetaRecord; nObj: Integer; OptData: Pointer): Bool; stdcall;
var
  Typ: Byte;
  s: string;
  t: TEMRExtTextOut;
begin
  Result := True;
  Typ := EMFRecord^.iType;
  if Typ in [83, 84] then
  begin
    t := PEMRExtTextOut(EMFRecord)^;
    s := WideCharLenToString(PWideChar(PChar(EMFRecord) + t.EMRText.offString),
      t.EMRText.nChars);
    if not CurPreview.CaseSensitive then s := AnsiUpperCase(s);
    CurPreview.StrFound := Pos(CurPreview.FindStr, s) <> 0;
    if CurPreview.StrFound and (RecordNum >= CurPreview.LastFoundObject) then
    begin
      CurPreview.StrBounds := t.rclBounds;
      Result := False;
    end;
  end;
  Inc(RecordNum);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDrawPanel }

constructor TRMDrawPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

procedure TRMDrawPanel.WMEraseBackground(var Message: TMessage);
begin
end;

procedure TRMDrawPanel.Paint;
var
  i: Integer;
  r, r1: TRect;
  Pages: TRMEMFPages;
  h: HRGN;
  liScale: Double;

  procedure DrawMargins(i: Integer);
  begin
    with Pages[i].PrnInfo, Pages[i].pgMargins do
    begin
      if Pages[i].UseMargins then
      begin
        if Left = 0 then
          r1.Left := Round(Ofx * liScale)
        else
          r1.Left := Round(Left * liScale);
        if Top = 0 then
          r1.Top := Round(Ofy * liScale)
        else
          r1.Top := Round(Top * liScale);
        if Right = 0 then
          r1.Right := Round((Ofx + Pw) * liScale)
        else
          r1.Right := Round((Pgw - Right) * liScale);
        if Bottom = 0 then
          r1.Bottom := Round((Ofy + Ph) * liScale)
        else
          r1.Bottom := Round((Pgh - Bottom) * liScale);
        OffsetRect(r1, r.Left, r.Top);
      end
      else
      begin
        r1.Left := Round((Ofx + Left) * liScale);
        r1.Top := Round((Ofy + Top) * liScale);
        r1.Right := r1.Left + Round((Pw - (Left + Right)) * liScale);
        r1.Bottom := r1.Top + Round((Ph - (Top + Bottom)) * liScale);
        OffsetRect(r1, r.Left, r.Top);
      end;
    end;
    with Canvas do
    begin
      Pen.Color := clGray;
      MoveTo(r1.Left, r1.Top); LineTo(r1.Left, r1.Top - Round(20 * liScale)); //左上
      MoveTo(r1.Left, r1.Top); LineTo(r1.Left - Round(20 * liScale), r1.Top);
      MoveTo(r1.Right, r1.Top); LineTo(r1.Right, r1.Top - Round(20 * liScale)); //右上
      MoveTo(r1.Right, r1.Top); LineTo(r1.Right + Round(20 * liScale), r1.Top);
      MoveTo(r1.Left, r1.Bottom); LineTo(r1.Left, r1.Bottom + Round(20 * liScale)); //左下
      MoveTo(r1.Left, r1.Bottom); LineTo(r1.Left - Round(20 * liScale), r1.Bottom);
      MoveTo(r1.Right, r1.Bottom); LineTo(r1.Right, r1.Bottom + Round(20 * liScale)); //右下
      MoveTo(r1.Right, r1.Bottom); LineTo(r1.Right + Round(20 * liScale), r1.Bottom);
    end;
  end;

  procedure DrawbkPicture;
  var
    lbkPic: TRMbkPicture;
    lPic: TPicture;
    lPicWidth, lPicHeight: Integer;
  begin
    lbkPic := Pages.bkPictures[Pages[i].bkPictureIndex];
    if lbkPic = nil then Exit;
    lPic := lbkPic.Picture;
    if lPic.Graphic <> nil then
    begin
//      lPicWidth := lPic.Width; lPicHeight := lPic.Height;
			lPicWidth := lbkPic.Width;
      lPicHeight := lbkPic.Height;

      r1 := Rect(0, 0, Round(lPicWidth * liScale), Round(lPicHeight * liScale));
      OffsetRect(r1, Round(lbkPic.Left * liScale), Round(lbkPic.Top * liScale));
      OffsetRect(r1, r.Left, r.Top);
      try
        IntersectClipRect(Canvas.Handle, r.Left + 1, r.Top + 1, r.Right - 1, r.Bottom - 1);
        RMPrintGraphic(Canvas, r1, lPic.Graphic, False);
      finally
        SelectClipRgn(Canvas.Handle, h);
      end;
    end;
  end;

begin
  if not FPreview.FPaintAllowed then
  begin
    inherited;
    Exit;
  end;

  if FPreview.FEMFPages = nil then
  begin
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(ClientRect);
    Exit;
  end;

  Pages := TRMEMFPages(FPreview.FEMFPages);
  h := CreateRectRgn(0, 0, Width, Height);
  GetClipRgn(Canvas.Handle, h);

  for i := 0 to Pages.Count - 1 do // drawing window background
  begin
    r := Pages[i].R;
    OffsetRect(r, FPreview.Fofx, FPreview.Fofy);
    if (r.Top > 2000) or (r.Bottom < 0) then
      Pages[i].Visible := False
    else
      Pages[i].Visible := RectVisible(Canvas.Handle, r);

    if Pages[i].Visible then
      ExcludeClipRect(Canvas.Handle, r.Left + 1, r.Top + 1, r.Right - 1, r.Bottom - 1);
  end;

  with Canvas do
  begin
    Brush.Color := clGray;
    FillRect(Rect(0, 0, Width, Height));
    Pen.Color := clBlack;
    Pen.Width := 1;
    Pen.Mode := pmCopy;
    Pen.Style := psSolid;
    Brush.Color := clWhite;
  end;

  SelectClipRgn(Canvas.Handle, h);
  for i := 0 to Pages.Count - 1 do // drawing page background
  begin
    if Pages[i].Visible then
    begin
      r := Pages[i].r;
      OffsetRect(r, FPreview.FOfx, FPreview.FOfy);
      Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
      Canvas.Polyline([Point(r.Left + 1, r.Bottom), Point(r.Right, r.Bottom),
        Point(r.Right, r.Top + 1)]);

      FLastLeft := r.Left; FLastRight := r.Right;
      liScale := FPreview.FPer;
      DrawMargins(i);
      DrawbkPicture;
    end;
  end;

  for i := 0 to Pages.Count - 1 do // drawing page content
  begin
    if Pages[i].Visible then
    begin
      r := Pages[i].r;
      OffsetRect(r, FPreview.FOfx, FPreview.FOfy);
      if Pages[i].UseMargins then
        Pages.Draw(i, Canvas, r)
      else
      begin
        with Pages[i].PrnInfo, Pages[i].pgMargins do
        begin
          r1.Left := Round((Ofx + Left) * FPreview.Fper);
          r1.Top := Round((Ofy + Top) * FPreview.Fper);
          r1.Right := r1.Left + Round((Pw - (Left + Right)) * FPreview.Fper);
          r1.Bottom := r1.Top + Round((Ph - (Top + Bottom)) * FPreview.Fper);
          OffsetRect(r1, r.Left, r.Top);
        end;
        Pages.Draw(i, Canvas, r1);
      end;
    end
    else
      Pages.Draw(i, Canvas, Rect(0, 0, 0, 0)); // remove it from cache
  end;
  DeleteObject(h);
end;

procedure TRMDrawPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  pt: TPoint;
  r: TRect;
  C: TCursor;
begin
  FOldMousePos := Point(X, Y);
  if FPreview.FEMFPages = nil then Exit;
  if FDFlag then
  begin
    FDFlag := False;
    Exit;
  end;

  with FPreview do
  begin
    if Button = mbLeft then
    begin
      FLastClick := 0;
      pt := Point(x - Fofx, y - Fofy);
      for i := 0 to TRMEMFPages(FEMFPages).Count - 1 do
      begin
        r := TRMEMFPages(FEMFPages)[i].r;
        if PtInRect(r, pt) then
        begin
          FLastClick := i + 1;
          pt := Point(Round((pt.X - r.Left) / Fper), Round((pt.Y - r.Top) / Fper));
          if TRMEMFPages(FEMFPages).DoClick(i, pt, TRUE, C) then
            Exit;
        end;
      end;
      FDown := True;
      FLastX := X; FLastY := Y;
      if FLastClick > 0 then
        FCurPage := FLastClick;
      ShowPageNum;
    end
    else if Button = mbRight then
    begin
      pt := Self.ClientToScreen(Point(X, Y));
      if RMDesigner <> nil then
      begin
      end;
    end;
  end;
end;

procedure TRMDrawPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  pt: TPoint;
  r: TRect;
  C: TCursor;
begin
  pt := Self.ClientToScreen(Point(X, Y));
  if FPreview.AutoScale and (pt.X >= FLastLeft) and (pt.X <= FLastRight) then
    Cursor := crMagnifier
  else
    Cursor := crDefault;

  if FDown then
  begin
    FPreview.HScrollBar.Position := FPreview.HScrollBar.Position - (X - FLastX);
    FPreview.VScrollBar.Position := FPreview.VScrollBar.Position - (Y - FLastY);
    FLastX := X; FLastY := Y;
  end
  else
  begin
    with FPreview do
    begin
      if (Doc <> nil) and Assigned(TRMReport(Doc).OnMouseOverObject) then
      begin
        pt := Point(x - FOfx, y - FOfy);
        for i := 0 to TRMEMFPages(FEMFPages).Count - 1 do
        begin
          r := TRMEMFPages(FEMFPages)[i].r;
          if PtInRect(r, pt) then
          begin
            C := crDefault;
            pt := Point(Round((pt.X - r.Left) / FPer), Round((pt.Y - r.Top) / FPer));
            if TRMEMFPages(FEMFPages).DoClick(i, pt, False, C) then
              Self.Cursor := C
            else
              Self.Cursor := crDefault;
            Break;
          end;