rm_class.pas

这是一个功能强大

{*****************************************}
{                                         }
{              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, ExtCtrls, ShellAPI, CommCtrl,
  RM_Common, RM_Ctrls, RM_Const, RM_Const1, RM_Dataset, RM_Progr, RM_Printer,
  RM_AutoSearchField, RM_Parser, rm_ZlibEx
{$IFDEF USE_INTERNAL_JVCL}
  , rm_JvInterpreter, rm_JvInterpreterParser, rm_JvJCLUtils
{$ELSE}
  , JvInterpreter, JvInterpreterParser, JvJCLUtils
{$ENDIF}
{$IFDEF COMPILER6_UP}, StrUtils, 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, rmstStretcheable);
  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, rmbtCrossFooter, rmbtCrossMasterData, rmbtCrossDetailData,
    rmbtCrossGroupHeader, rmbtCrossGroupFooter, rmbtCrossChild,
    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 aParName: string; var PaarValue: Variant) of object;
  TRMLoadSaveReportSettingEvent = procedure(aReport: TRMReport) of object;
  TRMProgressEvent = procedure(n: Integer) of object;
  TRMBeginPageEvent = procedure(aPageNo: Integer) of object;
  TRMEndPageEvent = procedure(aPageNo: Integer) of object;
  TRMAfterPrintEvent = procedure(const aView: TRMReportView) of object;
  TRMOnBeforePrintEvent = procedure(aMemo: TWideStringList; aView: 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(aColNo: Integer; var aWidth: Integer) of object;
  TRMBeforePrintBandEvent = procedure(aBand: TRMBand; var aPrintBand: Boolean) of object;
  TRMEndPrintPageEvent = procedure(var aPageNo: Integer; var aNewPrintJob: Boolean) of object;
  TRMReadOneEndPageEvent = procedure(const aPageNo, aTotalPages: Integer) of object;
  TRMBandBeforePrintRecordEvent = procedure(var aRePrintCount: Integer) of object;

  TRMPreviewClickEvent = procedure(Sender: TRMReportView; Button: TMouseButton;
    Shift: TShiftState; var Modified: Boolean) of object;
  TRMPreviewClickUrlEvent = procedure(Sender: TRMReportView) 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;

  TRMFormat = packed record
    FormatIndex1, FormatIndex2: Byte;
    FormatPercent: Byte;
    FormatdelimiterChar: Char;
  end;

  { TRMHighlight }
  TRMHighlight = class(TRMPersistent)
  private
    FColor: TColor;
    FFont: TFont;
    FCondition: string;
    FFontAdapter: TRMPersistentCompAdapter;
    procedure SetFont(Value: TFont);
    procedure SetColor(Value: TColor);
    function GetFontAdapter: TRMPersistentCompAdapter;
  public
    constructor Create; override;
    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;
    property FontAdapter: TRMPersistentCompAdapter read GetFontAdapter;
  end;

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

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

    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;

 { TRMShadowStyle }
  TRMShadowStyle = class(TPersistent)
  private
    FParentView: TRMView;
    FVisible: Boolean;
    FColor: TColor;
    FmmWidth: Integer;

    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 Color: TColor read FColor write SetColor;
    property Width: Double read GetWidth write SetWidth;
  end;

  { TRMTextStyle }
  TRMTextStyle = class(TCollectionItem)
  private
    FFont: TFont;
    FHAlign: TRMHAlign;
    FVAlign: TRMVAlign;
    FDisplayFormat: TRMFormat;
    FFillColor: TColor;
    FmmWidth, FmmHeight: Integer;
    FStyleName: string;

    procedure SetFont(Value: TFont);
    function GetspLeft(Index: Integer): Integer;
    procedure SetspLeft(Index: Integer; Value: Integer);
  protected
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure CreateUniqueName;

    property DisplayFormat: TRMFormat read FDisplayFormat write FDisplayFormat;
    property mmWidth: Integer read FmmWidth write FmmWidth;
    property mmHeight: Integer read FmmHeight write FmmHeight;
    property spWidth: Integer index 0 read GetspLeft write SetspLeft;
    property spHeight: Integer index 1 read GetspLeft write SetspLeft;
  published
    property StyleName: string read FStyleName write FStyleName;
    property Font: TFont read FFont write SetFont;
    property HAlign: TRMHAlign read FHAlign write FHAlign;
    property VAlign: TRMVAlign read FVAlign write FVAlign;
    property FillColor: TColor read FFillColor write FFillColor;
  end;

  TRMStyleClass = class of TRMTextStyle;

  { TRMTextStyles }
  TRMTextStyles = class(TCollection)
  private
    FReport: TRMReport;

    function GetColumn(Index: Integer): TRMTextStyle;
    procedure SetColumn(Index: Integer; Value: TRMTextStyle);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(aReport: TRMReport);

    procedure Apply;
    function Add: TRMTextStyle;
    function IndexOfName(const aStyleName: string): TRMTextStyle;
    procedure LoadFromStream(aStream: TStream);
    procedure SaveToStream(aStream: TStream);

    property Items[Index: Integer]: TRMTextStyle read GetColumn write SetColumn; default;
  published
  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: TWideStringList;
    FRestrictions: TRMRestrictions;
    FIsStringValue: Boolean;
    FLeftFrame: TRMFrameLine;
    FTopFrame: TRMFrameLine;
    FRightFrame: TRMFrameLine;
    FBottomFrame: TRMFrameLine;
    FLeftRightFrame: Word;
    FShadowStyle: TRMShadowStyle;
    FFillColor: TColor;
    FBrushStyle: TBrushStyle;
    FTag: Integer;
    FTagStr: string;
    FUrl: string;
    FFlowTo: string;
    FStyle: string;
    FCursor: TCursor;
    FExpressionDelimiters: string;
    FTabOrder: Integer;

    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 SetMemo(Value: TWideStringList);
    procedure SetMemo1(Value: TWideStringList);
    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;
    FNewFlags: LongWord;
    ParentBand: TRMBand;
    FDataSet: TRMDataset;
    FDataFieldName: string;
    IsBlobField: Boolean;
    FNeedWrapped: Boolean;
    ObjectID: Integer;
    IsPrinting: Boolean;
    FComponent: TComponent;
    DrawFocusedFrame: Boolean;

    mmSaveGapX, mmSaveGapY: Integer;