rm_class.pas

report machine 2.3 功能强大

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

unit RM_class;

interface

{$I RM.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Printers,
  Forms, StdCtrls, ComCtrls, Dialogs, Menus, Buttons, Commctrl, RM_const,
  RM_DBRel, RM_Pars, RM_Intrp, RM_DSet, RM_DBSet, RM_View, DB
{$IFDEF Delphi6}, Variants{$ENDIF};

const
// object flags
  flStretched = 1;
  flWordWrap = 2;
  flWordBreak = 4;
  flAutoSize = 8;
  flTextOnly = $10;
  flSuppressRepeated = $20;
  flHideZeros = $40;
  flUnderlines = $80;
  flChildView = $100;
  flRTLReading = $200;
  flPrintFrame = $400;
  flPrintVisible = $800;
  flTotalCalc = $2000;
  flCalcNoVisible = $4000;

  flBandNewPageAfter = 2;
  flBandPrintifSubsetEmpty = 4;
  flBandBreaked = 8;
  flBandOnFirstPage = $10;
  flBandOnLastPage = $20;
  flBandRepeatHeader = $40;
  flBandPrintChildIfInvisible = $80;
  flBandAutoAppendBlank = $100;
  flBandAlignTop = $200;
  flBandPrintColFirst = $400;
  flBandRepeatHeader1 = $800;
  flBandPrintIfEmpty = $1000;

  flPictCenter = 2;
  flPictRatio = 4;

  flDontUndo = $4000;
  flWantHook = $8000;
  flOnePerPage = $10000;

// object types
  gtMemo = 0;
  gtPicture = 1;
  gtBand = 2;
  gtSubReport = 3;
  gtLine = 4;
  gtCalcMemo = 5;
  gtCross = 6;
  gtMoneyMemo = 7; //Add by david
  gtRegion = 8;
  gtAddIn = 10;

// frame types
  RMftNone = 0;
  RMftRight = 1;
  RMftBottom = 2;
  RMftLeft = 4;
  RMftTop = 8;
  RMftDouble = $10;

// text align
  rmtaLeft = 0;
  rmtaRight = 1;
  rmtaCenter = 2;
  rmtaVertical = 4;
  rmtaMiddle = 8;
  rmtaDown = 16;

// band align
  rmbaNone = 0;
  rmbaLeft = 1;
  rmbaRight = 2;
  rmbaCenter = 3;
  rmbaWidth = 4;
  rmbaBottom = 5;
  rmbaTop = 6;
  rmbaClient = 7;
  rmbaHeight = 8;
  rmbaRest = 9;

// restriction flags
  rmrfDontEditMemo = 1;
  rmrfDontEditScript = 2;
  rmrfDontEditContents = 4;
  rmrfDontModify = 8;
  rmrfDontSize = 16;
  rmrfDontMove = 32;
  rmrfDontDelete = 64;

  psDouble = 7;

type

  TRMSizeUnits = (rmsuPixels, rmsuMM, rmsuInches);
  TRMAlignment = (rmtaLeftJustify, rmtaRightJustify, rmtaCenterJustify, rmtaEuqalJustify);
  TRMLayout = (rmtlTop, rmtlCenter, rmtlBottom);
  TRMDocMode = (dmDesigning, dmPrinting);
  TRMDrawMode = (drAll, drAfterCalcHeight, drPart);
  TRMBandType = (btReportTitle, btReportSummary,
    btPageHeader, btPageFooter,
    btMasterHeader, btMasterData, btMasterFooter,
    btDetailHeader, btDetailData, btDetailFooter,
    btSubDetailHeader, btSubDetailData, btSubDetailFooter,
    btOverlay, btColumnHeader, btColumnFooter,
    btGroupHeader, btGroupFooter,
    btCrossHeader, btCrossData, btCrossFooter, btChild, btNone);
  TRMPageType = (ptReport, ptDialog);
  TRMDataSetPosition = (psLocal, psGlobal);
  TRMPageMode = (pmNormal, pmBuildList);
  TRMBandRecType = (rtShowBand, rtFirst, rtNext);
  TRMRgnType = (rtNormal, rtExtended);
  TRMReportType = (rtSimple, rtMultiple);
  TRMDataType = (RMdtString, RMdtInteger, RMdtFloat, RMdtBoolean,
    RMdtColor, RMdtEnum, RMdtHasEditor, RMdtSize, RMdtOneObject, rmdtDate);
  TRMDataTypes = set of TRMDataType;
  TRMPrintPages = (RMAll, RMOdd, RMEven);
  //WHF Add
  TRMDBCalcType = (rmdcSum, rmdcCount, rmdcAvg, rmdcMax, rmdcMin);

  TRMView = class;
  TRMBand = class;
  TRMPage = class;
  TRMReport = class;
  TRMExportFilter = class;
  TRMEMFPages = class;

  TRMDetailEvent = procedure(const ParName: string; var ParValue: Variant) of object;
  TRMEnterRectEvent = procedure(Memo: TStringList; View: TRMView) of object;
  TRMAfterPrintEvent = procedure(const View: TRMView) of object;
  TRMBeginDocEvent = procedure of object;
  TRMEndDocEvent = procedure of object;
  TRMBeginPageEvent = procedure(pgNo: Integer) of object;
  TRMEndPageEvent = procedure(pg: Integer) of object;
  TRMBeginBandEvent = procedure(Band: TRMBand) of object;
  TRMBeforePrintBandEvent = procedure(Band: TRMBand; var PrintBand: Boolean) of object;
  TRMEndBandEvent = procedure(Band: TRMBand) of object;
  TRMProgressEvent = procedure(n: Integer) of object;
  TRMBeginColumnEvent = procedure(Band: TRMBand) of object;
  TRMPrintColumnEvent = procedure(ColNo: Integer; var Width: Integer) of object;
  TRMManualBuildEvent = procedure(Page: TRMPage) of object;
  TRMObjectClickEvent = procedure(EMFPages: TRMEMFPages; aPageNo: Integer; View: TRMView) of object;
  TRMMouseOverObjectEvent = procedure(View: TRMView; var Cursor: TCursor) of object;
  TRMBeforeExportEvent = procedure(var FileName: string; var bContinue: Boolean) of object;
  TRMAfterExportEvent = procedure(const FileName: string) of object;
  TRMPrintReportEvent = procedure of object;
  TRMLocalizeEvent = procedure(StringID: Integer; var ResultString: string) of object;

  { TRMFrameLine }
  TRMFrameLine = packed record
    Visible: Boolean;
    Style: Byte;
    Color: TColor;
    Width: Single;
  end;

  TRMHighlightAttr = packed record
    FontStyle: Word;
    FontColor, FillColor: TColor;
  end;

  TRMPrnInfo = record // print info about page size, margins e.t.c
    PPgw, PPgh, Pgw, Pgh: Integer; // page width/height (printer/screen)
    POfx, POfy, Ofx, Ofy: Integer; // offset x/y
    PPw, PPh, Pw, Ph: Integer; // printable width/height
  end;

  PRMPageInfo = ^TRMPageInfo;
  TRMPageInfo = packed record // pages of a preview
    R: TRect;
    pgSize: Word;
    pgWidth, pgHeight: Integer;
    pgOr: TPrinterOrientation; //纸：横放，竖放
    pgBin: integer;
    UseMargins: Boolean; //是否使用边界
    pgMargins: TRect; //是否使用边界
    PrnInfo: TRMPrnInfo;
    Visible: Boolean;
    Stream: TMemoryStream;
    Page: TRMPage;
    bkPictureIndex: Integer;
  end;

  PRMBandRec = ^TRMBandRec;
  TRMBandRec = packed record
    Band: TRMBand;
    Action: TRMBandRecType;
    TableEmpty: Boolean;
  end;

  PRMPropRec = ^TRMPropRec;
  TRMPropRec = record
    PropName: string[32];
    PropType: TRMDataTypes;
    Enum: TStringList;
    EnumValues: Variant;
    PropEditor: TNotifyEvent;
  end;

  PRMCacheItem = ^TRMCacheItem;
  TRMCacheItem = record
    DataSet: TDataSet;
    DataField: string;
  end;

 { TRMObject }
  TRMObject = class(TObject)
  private
  protected
    PropList: TList;
    procedure ClearPropList;
    procedure RemoveProperty(const APropName: string);
    procedure AddProperty(const APropName: string; APropType: TRMDataTypes; APropEditor: TNotifyEvent);
    procedure AddEnumProperty(const APropName, AEnum: string; const AEnumValues: array of Variant);
    procedure SetPropValue(Index: string; Value: Variant); virtual;
    function GetPropValue(Index: string): Variant; virtual;
    function GetPropRec(const Index: string): PRMPropRec;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; virtual;
// helper methods
    procedure SetFontProp(Font: TFont; const Prop: string; Value: Variant);
    function GetFontProp(Font: TFont; const Prop: string): Variant;
    function LinesMethod(Lines: TStrings; const MethodName, LinesName: string;
      Par1, Par2, Par3: Variant): Variant;
  public
    constructor Create;
    destructor Destroy; override;
    procedure DefineProperties; virtual;
    property Prop[Index: string]: Variant read GetPropValue write SetPropValue;
    property PropRec[const Index: string]: PRMPropRec read GetPropRec;
  end;

  { TRMView }
  TRMView = class(TRMObject)
  private
    FIsStringValue: Boolean;
    FOlddy: Integer;

    procedure P1Click(Sender: TObject);
    function GetStretched: Boolean;
    procedure SetStretched(const value: Boolean);
    function GetWantHook: Boolean;
    procedure SetWantHook(const value: Boolean);
    function GetPrintFrame: Boolean;
    procedure SetPrintFrame(const value: Boolean);
    function GetPrintVisible: Boolean;
    procedure SetPrintVisible(const value: Boolean);
    function GetChildView: Boolean;
    procedure SetChildView(const Value: Boolean);
  protected
    FFlag1: Boolean;
    CanGenObject: Boolean;
    Parent: TRMBand;
    ParentPage: TRMPage;
    SaveGX, SaveGY: Integer;
    SaveX, SaveY, SaveDX, SaveDY: Integer;
    SaveFWLeft, SaveFWTop, SaveFWRight, SaveFWBottom: Single;
    BaseName: string;
    Canvas: TCanvas;
    DRect, DRect1: TRect;
    FDataSet: TDataSet;
    FField: string;
    StreamMode: (smDesigning, smPrinting);

    function GetViewCommon: string; virtual;
    procedure FreeChildControl; virtual;
    procedure GenTmpObjects; virtual;

    procedure ShowBackGround; virtual;
    procedure ShowFrame; virtual;
    procedure BeginDraw(ACanvas: TCanvas);
    procedure GetBlob(b: TField); virtual;
    procedure OnHook(View: TRMView); virtual;
    procedure ExpandVariables(var s: string);
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    procedure Loaded; virtual;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
    function ParentBand: TRMView;
    procedure AddChildView(aStringList: TStrings); virtual;
    procedure AfterCreate; virtual;
  public
    Name: string;
    Typ: Byte; // One of gtXXX constants
    HVersion, LVersion: Byte; // not used now
    ID: Integer;
    Selected: Boolean; // used in designer
    OriginalRect: TRect;
    ScaleX, ScaleY: Double; // used for scaling objects in preview
    OffsX, OffsY: Integer; //
    IsPrinting: Boolean;

    x, y, dx, dy: Integer;
    Flags: Word;
    LeftFrame, TopFrame, RightFrame, BottomFrame: TRMFrameLine;
    LeftRightFrame: Word;
    gapx, gapy: integer;
    FillColor: TColor;
    BandAlign: Byte;
    Format: Integer;
    FormatStr: string;
    Visible: WordBool;
    Restrictions: Word;
    Tag: string;
    Memo, Script, Script_AfterPrint: TStringList;
    Memo1: TStringList;
    ParentView: string;

    class function CanPlaceOnGridView: Boolean; virtual;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Assign(From: TRMView);
    procedure CalcGaps; virtual;
    procedure RestoreCoord; virtual;
    procedure Draw(Canvas: TCanvas); virtual; abstract;
    procedure StreamOut(Stream: TStream); virtual;
    procedure ExportData; virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    procedure Resized; virtual;
    procedure DefinePopupMenu(Popup: TPopupMenu); virtual;
    function GetClipRgn(rt: TRMRgnType): HRGN; virtual;
    procedure CreateUniqueName;
    procedure SetBounds(Left, Top, Width, Height: Integer); virtual;
    procedure DefineProperties; override;
    procedure ShowEditor; virtual;

    property PStretched: Boolean read GetStretched write SetStretched;
    property PWantHook: Boolean read GetWantHook write SetWantHook;
    property PPrintFrame: Boolean read GetPrintFrame write SetPrintFrame;
    property PPrintVisible: Boolean read GetPrintVisible write SetPrintVisible;
    property PChildView: Boolean read GetChildView write SetChildView;
  end;

  { TRMControl }
  TRMControl = class(TRMView)
  private
  protected
    FControl: TControl;
    procedure PaintDesignControl; virtual;
    procedure SetPropValue(Index: string; Value: Variant); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure DefineProperties; override;
    procedure PlaceControl(Form: TForm);
    procedure Draw(Canvas: TCanvas); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    property Control: TControl read FControl;
  published
  end;

  { TRMNonVisualControl }
  TRMNonVisualControl = class(TRMControl)
  protected
    Bmp: TBitmap;
    Component: TComponent;
    FFixupList: TRMVariables;
    procedure SetPropValue(Index: string; Value: Variant); override;
    procedure PaintDesignControl; override;
  public
    constructor Create; override;