rm_class.pas

report machine 2.3 功能强大

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TRMReportDesigner }
  TRMReportDesigner = class(TForm)
  private
  protected
    PreviewDesign: Boolean;
    FirstInstance: Boolean;
    Modify_flag: Boolean;
    function GetDesignerPage: TWinControl; virtual; abstract;
    function GetModified: Boolean; virtual; abstract;
    procedure SetModified(Value: Boolean); virtual; abstract;
  public
    Page: TRMPage;
    procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: string; ButtonTag: Integer; IsControl: Boolean); virtual; abstract;
    procedure RegisterTool(MenuCaption: string; ButtonBmp: TBitmap; OnClick: TNotifyEvent); virtual; abstract;
    constructor CreateDesigner(AFirstInstance: Boolean); virtual;
    procedure BeforeChange; virtual; abstract;
    procedure AfterChange; virtual; abstract;
    procedure RedrawPage; virtual; abstract;
    procedure SelectObject(ObjName: string); virtual; abstract;
    function InsertDBField: string; virtual; abstract;
    function InsertExpression: string; virtual; abstract;
    property Modified: Boolean read GetModified write SetModified;
  end;

  { TRMObjEditorForm }
  TRMObjEditorForm = class(TForm)
  public
    function ShowEditor(View: TRMView): TModalResult; virtual;
  end;

  { TRMExportFilter }
  TRMExportFilter = class(TComponent)
  protected
    FileName: string;
    Stream: TStream;
    Lines: TList;
    FShowDialog: Boolean;
    FOnBeforeExport: TRMBeforeExportEvent;
    FOnAfterExport: TRMAfterExportEvent;
    procedure ClearLines;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ShowModal: Word; virtual;
    procedure OnBeginDoc; virtual;
    procedure OnEndDoc; virtual;
    procedure OnBeginPage; virtual;
    procedure OnEndPage; virtual;
    procedure OnData(x, y: Integer; View: TRMView); virtual;
    procedure OnText(DrawRect: TRect; x, y: Integer;
      const text: string; FrameTyp: Integer; View: TRMView); virtual;
  published
    property ShowDialog: Boolean read FShowDialog write FShowDialog default True;
    property OnBeforeExport: TRMBeforeExportEvent read FOnBeforeExport write FOnBeforeExport;
    property OnAfterExport: TRMAfterExportEvent read FOnAfterExport write FOnAfterExport;
  end;

  { TRMCompressor }
  TRMCompressor = class(TObject)
  public
    Enabled: Boolean;
    constructor Create;
    procedure Compress(StreamIn, StreamOut: TStream); virtual;
    procedure DeCompress(StreamIn, StreamOut: TStream); virtual;
  end;

  TRMFunctionType = (RMftBoolean, RMftDateTime, RMftMath, RMftstring,
    RMftInterpreter, RMftOther, rmftAggregate);

  TRMFunctionItemClass = class of TObject;

  TRMFunction = class(TObject)
  private
  protected
  public
    procedure DoFunction(p1, p2, p3: Variant; var val: Variant); virtual; abstract;
  end;

  TRMFunctionClass = class of TRMFunction;

  TRMFunctionItem = class
  private
    FDescription: string;
    FData: string;
    FItem: TRMFunctionItemClass;
    FName: string;
    FFuncType: TRMFunctionType;
  public
    property Arguments: string read FData write FData;
    property Description: string read FDescription write FDescription;
    property Name: string read FName write FName;
    property Item: TRMFunctionItemClass read FItem write FItem;
    property FuncType: TRMFunctionType read FFuncType write FFuncType;
  end;

  { TRMFunctionLib }
  TRMFunctionLib = class(TObject)
  private
    FList: TStringList;
    FList1: TList;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function Count: integer;
    procedure Add(aItem: TRMFunctionItemClass; const AName, ADescription, AArguments: string; AFuncType: TRMFunctionType);
    procedure GetCategoryList(s: TStrings);
    procedure GetFunctionList(const Index: string; s: TStrings);
    function GetFunction(Name: string): TRMFunction;
    function GetDescription(const FuncName: string): string;
    function GetArguments(const FuncName: string): string;
  published
  end;

  PRMFunctionDesc = ^TRMFunctionDesc;
  TRMFunctionDesc = packed record
    FuncName: string;
    FuncType: TRMFunctionType;
    Description: string;
    FuncPara: string;
  end;

  { TRMFunctionLibrary }
  TRMFunctionLibrary = class(TObject)
  private
    FFuncList: TList;
    procedure Clear;
  public
    List: TStringList;
    constructor Create; virtual;
    destructor Destroy; override;
    function OnFunction(const FName: string; p1, p2, p3: Variant; var val: Variant): Boolean; virtual;
    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: Variant); virtual; abstract;
    procedure AddFunctionDesc(const FuncName: string; FuncType: TRMFunctionType;
      const Description, FuncPara: string);
  end;

  { TRMLocale }
  TRMLocale = class
  private
    FDllHandle: THandle;
    FLoaded: Boolean;
    FLocalizedPropertyNames: Boolean;
    FOnLocalize: TRMLocalizeEvent;
    FIDEMode: Boolean;
  public
    constructor Create;
    function LoadBmp(const ID: string): HBitmap;
    function LoadStr(ID: Integer): string;
    procedure LoadDll(const Name: string);
    procedure UnloadDll;
    property LocalizedPropertyNames: Boolean read FLocalizedPropertyNames
      write FLocalizedPropertyNames;
    property OnLocalize: TRMLocalizeEvent read FOnLocalize write FOnLocalize;
  end;

  { TRMGlobals }
  TRMGlobals = class
  public
    constructor Create;
    destructor Destroy; override;
    procedure Localize;
  end;

  PRMTextRec = ^TRMTextRec;
  TRMTextRec = record
    Next: PRMTextRec;
    X: Integer;
    Text: string[255];
    FontName: string[32];
    FontSize, FontStyle, FontColor, FillColor: Integer;
    FontCharset: WORD;
    FrameTyp: integer;
    DrawRect: TRect;
  end;

var
  RMPixPerInch: TPoint;
  RegRootKey: string;
  RMDesigner: TRMReportDesigner; // designer reference
  RMDesignerClass: TClass;
  RMParser: TRMParser; // parser reference
  RMInterpretator: TRMInterpretator; // interpretator reference
  RMVariables: TRMVariables; // report variables reference
  RMDialogForm: TForm; // dialog form reference
  CurReport: TRMReport; // currently proceeded report
  MasterReport: TRMReport; // reference to main composite report
  CurView: TRMView; // currently proceeded view
  CurBand: TRMBand; // currently proceeded band
  RMAggrBand: TRMBand; // used for aggregate functions
  CurPage: TRMPage; // currently proceeded page
  DocMode: TRMDocMode; // current mode
  DisableDrawing: Boolean;
  RMFunctionLib: TRMFunctionLib;
  PageNo: Integer; // current page number in Building mode
  RMCharset: 0..255;
  RMVersion: Byte; // version of currently loaded report
  ErrorFlag: Boolean; // error occured through TfrView drawing
  ErrorStr: string; // error description
  SMemo: TStringList; // temporary memo used during TfrView drawing
  ShowBandTitles: Boolean;
//  RMThreadDone: Boolean;
  Flag_NewPage: Boolean;
  Flag_TableEmpty: Boolean;

  // editors
  RMMemoEditor: TNotifyEvent;
  RMScript_BeforePrintEditor: TNotifyEvent;
  RMScript_AfterPrintEditor: TNotifyEvent;
  RMPictureEditor: TNotifyEvent;
  RMBKPictureEditor: TNotifyEvent;
  RMTagEditor: TNotifyEvent;
  RMRestrEditor: TNotifyEvent;
  RMHighlightEditor: TNotifyEvent;
  RMFieldEditor: TNotifyEvent;
  RMDataSourceEditor: TNotifyEvent;
  RMCrossDataSourceEditor: TNotifyEvent;
  RMGroupEditor: TNotifyEvent;
  RMCalcMemoEditor: TNotifyEvent;
  RMFontEditor: TNotifyEvent;
  RMFrameEditor: TNotifyEvent;

  RMGlobals: TRMGlobals;
  RMBandNames: array[TRMBandType] of string;
  RMDateFormats: array[0..6] of string;
  RMTimeFormats: array[0..3] of string;
  RMFormatBoolStr: array[0..3] of string;

function SBmp: TBitmap;
function RMCompressor: TRMCompressor;
function RMConsts: TRMVariables; // some constants like 'clRed'
function RMLocale: TRMLocale;

function RMCreateObject(Typ: Byte; const ClassName: string): TRMView;
procedure RegisterRMFunction(FunctionClass: TRMFunctionItemClass; Name, Description, Arguments: string; FuncType: TRMFunctionType);
function GetDefaultDataSet: TDataSet;
procedure RMPrintGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic; aIsPrinting: Boolean);

function RMConvertFromPixels(aValue: extended; aUnit: TRMSizeUnits): extended;
function RMConvertToPixels(aValue: extended; aUnit: TRMSizeUnits): extended;

implementation

uses
  Math, RM_const1, RM_Fmted, RM_PrDlg, RM_CmpReg, RM_Prntr, RM_Utils, RM_progr,
  RM_ChineseMoneyMemo, RM_PrvDlg
{$IFDEF JPEG}, JPEG{$ENDIF}
{$IFDEF RXGIF}, RxGIF{$ENDIF}
{$IFDEF Delphi6}, MaskUtils{$ELSE}, Mask{$ENDIF};

{$R RM_LNG1.RES}

const
  atNone = 10;
  atSum = 11;
  atMin = 12;
  atMax = 13;
  atAvg = 14;
  atCount = 15;

type
  TInterpretator = class(TRMInterpretator)
  public
    procedure GetValue(const Name: string; var Value: Variant); override;
    procedure SetValue(const Name: string; Value: Variant); override;
    procedure DoFunction(const name: string; p1, p2, p3: Variant; var val: Variant); override;
  end;

  TAggregateFunctionsSplitter = class(TRMFunctionSplitter)
  public
    constructor CreateSplitter(SplitTo: TStrings);
    destructor Destroy; override;
    procedure SplitMemo(Memo: TStrings);
    procedure SplitScript(Script: TStrings);
  end;

var
  FRMCompressor: TRMCompressor;
  FBmp: TBitmap;
  FRMProgressForm: TRMProgressForm;
  FRMConsts: TRMVariables; // some constants like 'clRed'
  FLocale: TRMLocale = nil;

  VHeight: Integer; // used for height calculation of TRMMemoView
  TempBmp: TBitmap; // temporary bitmap used by TRMMemoView
  CurDate, CurTime: TDateTime; // date/time of report starting
  CurValue: Variant; // used for highlighting
  CurVariable: string;
  IsColumns: Boolean;
  SavedAllPages: Integer; // number of pages in entire report
  SubValue: string; // used in GetValue event handler
  ObjID: Integer = 0;
  HookList: TList;

// aggregate handling
  InitAggregate: Boolean;
  AggrBand: TRMBand;

// variables used through report building
  PrevY, PrevBottomY, ColumnXAdjust: Integer;
  Append, WasPF: Boolean;
  CompositeMode: Boolean;
  DontShowReport: Boolean;

//WHF Add

function RMConvertFromPixels(aValue: Extended; aUnit: TRMSizeUnits): extended;
begin
  case aUnit of
    rmsuPixels: Result := aValue;
    rmsuMM: Result := aValue * (254 / RMPixPerInch.X);
    rmsuInches: Result := aValue * 254.0;
  else
    result := aValue;
  end
end;

function RMConvertToPixels(aValue: Extended; aUnit: TRMSizeUnits): extended;
begin
  case aUnit of
    rmsuPixels: Result := aValue;
    rmsuMM: Result := aValue / (254 / RMPixPerInch.X);
    rmsuInches: Result := aValue / 254.0;
  else
    result := aValue;
  end;
end;

function RMFormatValue(V: Variant; Format: Integer; const FormatStr: string): string;
var
  f1, f2: Integer;
  c: Char;
  s: string;

  function Dup(ch: Char; Count: Integer): string;
  var
    i: Integer;
  begin
    Result := '';
    for i := 1 to Count do
      Result := Result + ch;
  end;

  function RMFormatDateTime(const Format: string; DateTime: TDateTime): string;
  var
    SaveDateSeparator: Char;
  begin
    SaveDateSeparator := DateSeparator;
    try
      if Pos('/', Format) > 0 then
        DateSeparator := '/';
      Result := FormatDateTime(Format, DateTime);
    finally
      DateSeparator := SaveDateSeparator;
    end;
  end;

begin
  if (TVarData(v).VType = varEmpty) or (v = Null)
    or ((TVarData(v).VType = varString) and (Trim(v) = '')) then
  begin
    Result := '';
    Exit;
  end;

  c := DecimalSeparator;
  f1 := (Format div $01000000) and $0F;
  f2 := (Format div $00010000) and $FF;
  try
    case f1 of
      0: //字符型
        begin