rm_class.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,744 行 · 第 1/5 页

{*****************************************}
{                                         }
{              Report Machine             }
{             Report classes              }
{                                         }
{*****************************************}

unit RM_Class;

{$I RM.INC}
{$R RM_LNG1.RES}

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, TypInfo,
  Forms, StdCtrls, Dialogs, IniFiles, Registry, DB, RM_Ctrls,
  RM_Const, RM_Const1, RM_Dataset, RM_Progr, RM_Printer, RM_Common,
  RM_AutoSearchField, RM_Parser, rm_ZlibEx
  {$IFDEF USE_INTERNAL_JVCL}
  , rm_JvInterpreter, rm_JvInterpreterParser, rm_JvInterpreterFm
  {$ELSE}
  , JvInterpreter, JvInterpreterParser, JvInterpreterFm
  {$ENDIF}
  {$IFDEF TntUnicode}, TntSysUtils{$ENDIF}
  {$IFDEF Delphi6}, Variants{$ENDIF};

const
  rmgtMemo = 0;
  rmgtPicture = 1;
  rmgtSubReport = 2;
  //  rmgtLine = 3;
  rmgtCalcMemo = 4;
  rmgtBand = 5;
  rmgtShape = 6;
  rmgtOutline = 7;
  rmgtAddIn = 100;

type

  TRMPrintMethodType = (rmptMetafile, rmptBitmap);
  TRMPictureSource = (rmpsPicture, rmpsFileName);
  TRMReportStatus = (rmrsReady, rmrsBusy, rmrsFinished);
  TRMCompressionLevel = (rmzcNone, rmzcFastest, rmzcDefault, rmzcMax);

  TRMDocMode = (rmdmDesigning, rmdmPrinting, rmdmPreviewing, rmdmNone);
  TRMHAlign = (rmhLeft, rmhCenter, rmhRight, rmhEuqal);
  TRMVAlign = (rmvTop, rmvCenter, rmvBottom);
  TRMDrawMode = (rmdmAll, rmdmAfterCalcHeight, rmdmPart);
  TRMPrintPages = (rmppAll, rmppOdd, rmppEven);
  TRMColumnDirectionType = (rmcdTopBottomLeftRight, rmcdLeftRightTopBottom);
  TRMDBCalcType = (rmdcSum, rmdcCount, rmdcAvg, rmdcMax, rmdcMin, rmdcUser);
  TRMRotationType = (rmrtNone, rmrt90, rmrt180, rmrt270, rmrt360);
  TRMScaleFontType = (rmstNone, rmstByWidth, rmstByHeight);
  TRMCompositeMode = (rmReportPerReport, rmPagePerPage);
  TRMReportType = (rmrtSimple, rmrtMultiple);
  TRMStreamMode = (rmsmDesigning, rmsmPrinting);
  TRMDataSetPosition = (rmpsLocal, rmpsGlobal);
  TRMRestriction = (rmrtDontModify, rmrtDontSize, rmrtDontMove, rmrtDontDelete, rmrtDontEditMemo);
  TRMRestrictions = set of TRMRestriction;
  TRMBandAlign = (rmbaNone, rmbaLeft, rmbaRight, rmbaBottom, rmbaTop, rmbaCenter);
  TRMShiftMode = (rmsmAlways, rmsmNever, rmsmWhenOverlapped);
  TRMRgnType = (rmrtNormal, rmrtExtended);
  TRMSubReportType = (rmstFixed, rmstChild);
  TRMShapeType = (rmskRectangle, rmskRoundRectangle, rmskEllipse, rmskTriangle,
    rmskDiagonal1, rmskDiagonal2, rmskSquare, rmskRoundSquare, rmskCircle, rmHorLine,
    rmRightAndLeft, rmTopAndBottom, rmVertLine);

  TRMBandRecType = (rmrtShowBand, rmrtFirst, rmrtNext);
  TRMBandType = (rmbtReportTitle, rmbtReportSummary,
    rmbtPageHeader, rmbtPageFooter,
    rmbtHeader, rmbtFooter,
    rmbtMasterData, rmbtDetailData,
    rmbtOverlay, rmbtColumnHeader, rmbtColumnFooter,
    rmbtGroupHeader, rmbtGroupFooter,
    rmbtCrossHeader, rmbtCrossData, rmbtCrossFooter, rmbtChild, rmbtNone);
  TRMDesignerRestriction =
    (rmdrDontEditObj, rmdrDontModifyObj, rmdrDontSizeObj, rmdrDontMoveObj,
    rmdrDontDeleteObj, rmdrDontCreateObj,
    rmdrDontDeletePage, rmdrDontCreatePage, rmdrDontEditPage,
    rmdrDontCreateReport, rmdrDontLoadReport, rmdrDontSaveReport,
    rmdrDontPreviewReport, rmdrDontEditVariables, rmdrDontChangeReportOptions, rmdtDontEditScript);
  TRMDesignerRestrictions = set of TRMDesignerRestriction;

  TRMView = class;
  TRMReportView = class;
  TRMBand = class;
  TRMCustomPage = class;
  TRMReportPage = class;
  TRMPages = class;
  TRMReport = class;
  TRMReportDesigner = class;
  TRMEndPage = class;
  TRMEndPages = class;

  TRMGetValueEvent = procedure(const ParName: string; var ParValue: Variant) of object;
  TRMLoadSaveReportSettingEvent = procedure(aReport: TRMReport) of object;
  TRMProgressEvent = procedure(n: Integer) of object;
  TRMBeginPageEvent = procedure(PageNo: Integer) of object;
  TRMEndPageEvent = procedure(PageNo: Integer) of object;
  TRMAfterPrintEvent = procedure(const View: TRMReportView) of object;
  TRMOnBeforePrintEvent = procedure(Memo: TStrings; View: TRMReportView) of object;
  TRMBeginBandEvent = procedure(aBand: TRMBand) of object;
  TRMEndBandEvent = procedure(aBand: TRMBand) of object;
  TRMManualBuildEvent = procedure(aPage: TRMReportPage) of object;
  TRMBeginColumnEvent = procedure(aBand: TRMBand) of object;
  TRMPrintColumnEvent = procedure(ColNo: Integer; var Width: Integer) of object;
  TRMBeforePrintBandEvent = procedure(aBand: TRMBand; var PrintBand: Boolean) of object;
  TRMEndPrintPageEvent = procedure(var aPageNo: Integer) of object;
  TRMReadOneEndPageEvent = procedure(const aPageNo, aTotalPages: Integer) of object;

  TRMPreviewClickEvent = procedure(Sender: TRMReportView; Button: TMouseButton;
    Shift: TShiftState; var Modified: Boolean) of object;

  TRMBeforeExportEvent = procedure(var aFileName: string; var aContinue: Boolean) of object;
  TRMAfterExportEvent = procedure(const aFileName: string) of object;

  PRMCacheItem = ^TRMCacheItem;
  TRMCacheItem = record
    DataSet: TRMDataSet;
    DataFieldName: string;
  end;

  { TRMHighlight }
  TRMHighlight = class(TPersistent)
  private
    FColor: TColor;
    FFont: TFont;
    FCondition: string;
    procedure SetFont(Value: TFont);
    procedure SetColor(Value: TColor);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Color: TColor read FColor write SetColor;
    property Condition: string read FCondition write FCondition;
    property Font: TFont read FFont write SetFont;
  end;

  { TRMFrameLine }
  TRMFrameLine = class(TPersistent)
  private
    FVisible: Boolean;
    FStyle: TPenStyle;
    FColor: TColor;
    FmmWidth: Integer;
    FParentView: TRMView;
    FDoubleFrame: Boolean;

    function GetWidth: Double;
    procedure SetWidth(Value: Double);
    function GetspWidth: Integer;
    procedure SetspWidth(Value: Integer);
    procedure SetColor(Value: TColor);
  public
    constructor Create(aParentView: TRMView);
    procedure Assign(Source: TPersistent); override;
    function GetUnits: TRMUnitType;

    property mmWidth: Integer read FmmWidth write FmmWidth;
    property spWidth: Integer read GetspWidth write SetspWidth;
  published
    property Visible: Boolean read FVisible write FVisible;
    property Style: TPenStyle read FStyle write FStyle;
    property Color: TColor read FColor write SetColor;
    property Width: Double read GetWidth write SetWidth;
    property DoubleFrame: Boolean read FDoubleFrame write FDoubleFrame;
  end;

  { TRMView }
  TRMView = class(TRMCustomView)
  private
    FParentFont: Boolean;
    FIsBand, FIsCrossBand: Boolean;
    FParentPage: TRMCustomPage;
    FParentReport: TRMReport;
    FmmLeft, FmmTop, FmmWidth, FmmHeight: Integer;
    FmmGapLeft, FmmGapTop: Integer;
    FVisible: Boolean;
    FMemo, FMemo1: TStrings;
    FRestrictions: TRMRestrictions;
    FIsStringValue: Boolean;
    FLeftFrame: TRMFrameLine;
    FTopFrame: TRMFrameLine;
    FRightFrame: TRMFrameLine;
    FBottomFrame: TRMFrameLine;
    FLeftRightFrame: Word;
    FFillColor: TColor;
    FBrushStyle: TBrushStyle;
    FTag: Integer;
    FTagStr: string;
    FUrl: string;
    FFlowTo: string;
    FStyle: string;
    FCursor: TCursor;
    FExpressionDelimiters: string;

    function GetProp(Index: string): Variant;
    procedure SetProp(Index: string; Value: Variant);
    function GetLeft(Index: Integer): Double;
    procedure SetLeft(Index: Integer; Value: Double);
    function GetspLeft(Index: Integer): Integer;
    procedure SetspLeft(Index: Integer; Value: Integer);
    function GetspLeft_Designer(Index: Integer): Integer;
    procedure SetspLeft_Designer(Index: Integer; Value: Integer);

    procedure SetFillColor(Value: TColor);
    procedure SetMemo(Value: TStrings);
    procedure SetMemo1(Value: TStrings);
    function GetWantHook: Boolean;
    procedure SetWantHook(const value: Boolean);
    function GetStretched: Boolean;
    procedure SetStretched(const value: Boolean);
    function GetStretchedMax: Boolean;
    procedure SetStretchedMax(const value: Boolean);
    function GetTransparent: Boolean;
    procedure SetTransparent(value: Boolean);
    function GetHideZeros: Boolean;
    procedure SetHideZeros(Value: Boolean);
    function GetDontUndo: Boolean;
    procedure SetDontUndo(Value: Boolean);
    function GetOnePerPage: Boolean;
    procedure SetOnePerPage(Value: Boolean);
    function GetIsChildView: Boolean;
    procedure SetIsChildView(Value: Boolean);
    function GetUseDoublePass: Boolean;
    procedure SetUseDoublePass(Value: Boolean);
    procedure SetParentFont(Value: Boolean);
    procedure SetStyle(Value: string);
    procedure SetFlowTo(Value: string);
    procedure SetTagStr(Value: string);
    procedure SetUrl(Value: string);
  protected
    Typ: Byte; // 对象类型
    BaseName: string;
    Canvas: TCanvas;
    StreamMode: TRMStreamMode;
    FFlags: LongWord;
    ParentBand: TRMBand;
    FDataSet: TRMDataset;
    FDataFieldName: string;
    IsBlobField: Boolean;
    FNeedWrapped: Boolean;
    ObjectID: Integer;
    IsPrinting: Boolean;
    FComponent: TComponent;

    mmSaveGapX, mmSaveGapY: Integer;
    mmSaveLeft, mmSaveTop, mmSaveWidth, mmSaveHeight: Integer;
    mmSaveFWLeft, mmSaveFWTop, mmSaveFWRight, mmSaveFWBottom: Integer;
    mmSaveFontWidth: Integer;
    SaveFontWidth: Integer;
    RealRect: TRect;
    OriginalRect: TRect;

    FactorX, FactorY: Double; // used for scaling objects in preview
    OffsetLeft, OffsetTop: Integer; //

    procedure SetPropertyValue(aPropName: string; aValue: Variant);
    procedure ClearContents; virtual;
    procedure SetName(const Value: string); override;
    procedure InternalOnGetValue(aView: TRMReportView; aParName: string; var aParValue: string; aUnicode: Boolean);
    procedure InternalOnBeforePrint(Memo: TStrings; View: TRMReportView);
    function _CalcVFrameWidth(aTopWidth, aBottomWidth: Double): Integer;
    function _CalcHFrameWidth(aLeftWidth, aRightWidth: Double): Integer;
    function _DrawRect: TRect;
    function GetPrinter: TRMPrinter;
    procedure AfterChangeName; virtual;
    function DocMode: TRMDocMode;
    procedure OnHook(View: TRMView); virtual;
    procedure Loaded; virtual;
    procedure CalcGaps; virtual;
    procedure RestoreCoord; virtual;
    procedure ShowBackGround; virtual;
    procedure Prepare; virtual;
    procedure UnPrepare; virtual;
    function GetViewCommon: string; virtual;
    function GetParentBand: TRMBand;
    procedure SetParentPage(Value: TRMCustomPage); virtual;
    function IsCrossView: Boolean; virtual;
    function IsContainer: Boolean; virtual;

    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
    function SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean; override;

    property Tag: Integer read FTag write FTag;
    property TagStr: string read FTagStr write SetTagStr;
    property Url: string read FUrl write SetUrl;
    property FlowTo: string read FFlowTo write SetFlowTo;
    property Style: string read FStyle write SetStyle;
    property BrushStyle: TBrushStyle read FBrushStyle write FBrushStyle;
    property ParentFont: Boolean read FParentFont write SetParentFont;
    property ParentReport: TRMReport read FParentReport write FParentReport;
    property WantHook: Boolean read GetWantHook write SetWantHook;
    property Stretched: Boolean read GetStretched write SetStretched;
    property StretchedMax: Boolean read GetStretchedMax write SetStretchedMax;
    property Transparent: Boolean read GetTransparent write SetTransparent;
    property HideZeros: Boolean read GetHideZeros write SetHideZeros;
    property Visible: Boolean read FVisible write FVisible;
    property Left: Double index 0 read GetLeft write SetLeft;
    property Top: Double index 1 read GetLeft write SetLeft;
    property Width: Double index 2 read GetLeft write SetLeft;
    property Height: Double index 3 read GetLeft write SetLeft;
    property Cursor: TCursor read FCursor write FCursor;
    property ExpressionDelimiters: string read FExpressionDelimiters write FExpressionDelimiters;

    property mmGapLeft: Integer read FmmGapLeft;
    property mmGapTop: integer read FmmGapTop;
    property mmLeft: Integer read FmmLeft;
    property mmTop: Integer read FmmTop;
    property mmWidth: Integer read FmmWidth;
    property mmHeight: Integer read FmmHeight;
    property DontUndo: Boolean read GetDontUndo write SetDontUndo;
    property OnePerPage: Boolean read GetOnePerPage write SetOnePerPage;
    property IsChildView: Boolean read GetIsChildView write SetIsChildView;
    property UseDoublePass: Boolean read GetUseDoublePass write SetUseDoublePass;
  public
    Selected: Boolean; // used in designer
    NeedCreateName: Boolean;

    constructor Create; override;
    destructor Destroy; override;
    procedure Assign(aSource: TPersistent); override;
    procedure ShowEditor; virtual;
    procedure DefinePopupMenu(aPopup: TRMCustomMenuItem); virtual;

    function GetClipRgn(rt: TRMRgnType): HRGN; virtual;
    function GetUnits: TRMUnitType;
    procedure CreateName(aReport: TRMReport);
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Double);
    procedure SetspBounds(aLeft, aTop, aWidth, aHeight: Integer);
    procedure LoadFromStream(aStream: TStream); virtual; abstract;
    procedure SaveToStream(aStream: TStream); virtual; abstract;
    procedure Draw(aCanvas: TCanvas); virtual; abstract;
    procedure SetFrameVisible(aVisible: Boolean);

    property Prop[Index: string]: Variant read GetProp write SetProp; default;
    property IsBand: Boolean read FIsBand;
    property IsCrossBand: Boolean read FIsCrossBand;
    property ParentPage: TRMCustomPage read FParentPage write SetParentPage;

    property spLeft_Designer: Integer index 0 read GetspLeft_Designer write SetspLeft_Designer;
    property spTop_Designer: Integer index 1 read GetspLeft_Designer write SetspLeft_Designer;
    property spWidth_Designer: Integer index 2 read GetspLeft_Designer write SetspLeft_Designer;
    property spHeight_Designer: Integer index 3 read GetspLeft_Designer write SetspLeft_Designer;
    property spRight_Designer: Integer index 4 read GetspLeft_Designer;