rm_common.pas

这是一个功能强大

unit RM_Common;

interface

{$I RM.INC}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, ExtCtrls, TypInfo
  ,RM_System
{$IFDEF TntUnicode}, TntClasses{$ENDIF}
{$IFDEF USE_INTERNAL_JVCL}
  , rm_JvInterpreter, rm_JvInterpreterParser, rm_JclWideStrings
{$ELSE}
  , JvInterpreter, JvInterpreterParser,JclWideStrings
{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

const
  RMPenStyles: array[psSolid..psInsideFrame] of DWORD =
  (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL, PS_INSIDEFRAME);

type
{    <Table>
    Value               Meaning
    ---------------------------
    rmutInches            Display in inches.
    rmutMillimeters       Display in millimeters.
    rmutScreenPixels      Display in screen pixels.
    rmutPrinterPixels     Display in printer pixels.
    rmutMMThousandths     Display in thousandths of millimeters.
    </Table>}
  TRMResolutionType = (rmrtHorizontal, rmrtVertical);
  TRMUnitType = (rmutScreenPixels, rmutInches, rmutMillimeters, rmutMMThousandths);
  TRMPrinterOrientation = (rmpoPortrait, rmpoLandscape);
  TRMPreviewZoom = (pzDefault, pzPageWidth, pzOnePage, pzTwoPages);
  TRMPreviewButton = (pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbDesign,
    pbSaveToXLS, pbExport, pbNavigator);
  TRMPreviewButtons = set of TRMPreviewButton;
  TRMScaleMode = (mdNone, mdPageWidth, mdOnePage, mdTwoPages, mdPrinterZoom);
  TRMExportMode = (rmemText, rmemRtf, rmemPicture);

  TRMValueType = (rmvaList, rmvaInt8, rmvaInt16, rmvaInt32, rmvaExtended,
    rmvaString, rmvaIdent, rmvaFalse, rmvaTrue, rmvaBinary, rmvaSet, rmvaLString,
    rmvaNil, rmvaSingle, rmvaCurrency, rmvaDate, rmvaWideString,
    rmvaInt64, rmvaUTF8String);
  TRMDataType = (rmdtBoolean, rmdtDate, rmdtTime, rmdtDateTime, rmdtInteger, rmdtSingle,
    rmdtDouble, rmdtExtended, rmdtCurrency, rmdtChar, rmdtString, rmdtVariant,
    rmdtLongint, rmdtBLOB, rmdtMemo, rmdtGraphic, rmdtNotKnown, rmdtLargeInt);
  TRMSearchOperatorType = (rmsoEqual, rmsoNotEqual,
    rmsoLessThan, rmsoLessThanOrEqualTo,
    rmsoGreaterThan, rmsoGreaterThanOrEqualTo,
    rmsoLike, rmsoNotLike,
    rmsoBetween, soNotBetween,
    rmsoInList, rmsoNotInList,
    rmsoBlank, rmsoNotBlank);

  TRMPageInfo = record // print info about page size, margins e.t.c
    PrinterPageWidth, PrinterPageHeight: Integer; // page width/height (printer)
    ScreenPageWidth, ScreenPageHeight: Integer; // page width/height (screen)
    PrinterOffsetX, PrinterOffsetY: Integer; // offset x/y
  end;

  TRMReportInfo = packed record
    Title: string;
    Author: string;
    Company: string;
    CopyRight: string;
    Comment: string;
  end;

  TRMClass = class of TRMCustomView;
  TRMCustomReport = class;

  TRMPreviewSaveReportEvent = procedure(aReport: TObject) of object;


  TRMVariableItem =RM_System.TRMVariableItem;
  TRMVariables  =RM_System.TRMVariables;

  TRMEventPropVars  =RM_System.TRMEventPropVars;
  TRMPersistentCompAdapter = RM_System.TRMPersistentCompAdapter;
  TRMPersistent = RM_System.TRMPersistent;
  TRMComponent = RM_System.TRMComponent;

  TRMPersistentCompAdapterClass = class of TRMPersistentCompAdapter;

 { TRMVariables }

 { TRMCustomView }
  TRMCustomView = class(TRMPersistent)
  public
    class function CanPlaceOnGridView: Boolean; virtual;
    class procedure DefaultSize(var aKx, aKy: Integer); virtual;
  end;

  { TRMPreviewOptions }
  TRMPreviewOptions = class(TPersistent)
  private
    FRulerUnit: TRMUnitType;
    FRulerVisible: Boolean;
    FDrawBorder: Boolean;
    FBorderPen: TPen;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
  published
    property RulerUnit: TRMUnitType read FRulerUnit write FRulerUnit;
    property RulerVisible: Boolean read FRulerVisible write FRulerVisible;
    property DrawBorder: Boolean read FDrawBorder write FDrawBorder;
    property BorderPen: TPen read FBorderPen write FBorderPen;
  end;

  { TRMCustomPreview}
  TRMCustomPreview = class(TPanel)
  private
    FOptions: TRMPreviewOptions;

    procedure SetOptions(Value: TRMPreviewOptions);
  protected
    NeedRepaint: Boolean;
    procedure InternalOnProgress(aReport: TRMCustomReport; aPercent: Integer); virtual; abstract;
    procedure BeginPrepareReport(aReport: TRMCustomReport); virtual; abstract;
    procedure EndPrepareReport(aReport: TRMCustomReport); virtual; abstract;
    procedure CloseForm; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ShowReport(aReport: TRMCustomReport); virtual; abstract;
    procedure Connect(aReport: TRMCustomReport); virtual; abstract;
    procedure Print; virtual; abstract;
  published
    property Options: TRMPreviewOptions read FOptions write SetOptions;
  end;

  { TRMBandMsg }
  TRMBandMsg = class(TPersistent)
  private
    FFont: TFont;
    FLeftMemo, FCenterMemo, FRightMemo: TStringList;
    procedure SetFont(Value: TFont);
    procedure SetLeftMemo(Value: TStringList);
    procedure SetCenterMemo(Value: TStringList);
    procedure SetRightMemo(Value: TStringList);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Font: TFont read FFont write SetFont;
    property LeftMemo: TStringList read FLeftMemo write SetLeftMemo;
    property CenterMemo: TStringList read FCenterMemo write SetCenterMemo;
    property RightMemo: TStringList read FRightMemo write SetRightMemo;
  end;

  { TRMPageCaptionMsg }
  TRMPageCaptionMsg = class(TPersistent)
  private
    FTitleFont: TFont;
    FCaptionMsg: TRMBandMsg;
    FTitleMemo: TStringList;

    procedure SetTitleFont(Value: TFont);
    procedure SetTitleMemo(Value: TStringList);
    procedure SetCaptionMsg(Value: TRMBandMsg);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property CaptionMsg: TRMBandMsg read FCaptionMsg write SetCaptionMsg;
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property TitleMemo: TStringList read FTitleMemo write SetTitleMemo;
  end;

 { TRMCustomReport }
  TRMCustomReport = class(TRMComponent)
  private
    FTerminated: Boolean;
    FConvertNulls: Boolean;
  protected
  public
    property Terminated: Boolean read FTerminated write FTerminated;
    property ConvertNulls: Boolean read FConvertNulls write FConvertNulls;
  end;

  TRMCustomExportFilter = class(TComponent)
  end;

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

  { TRMCustomParser }
  TRMCustomParser = class(TRMPersistent)
  private
  protected
    FParentReport: TComponent;
  public
    function Str2OPZ(aStr: WideString): WideString; virtual; abstract;
    function Calc(aStr: Variant): Variant; virtual; abstract;
    function GetIdentify(const aStr: WideString; var i: Integer): WideString; virtual; abstract;
    procedure GetParameters(const aStr: WideString; var aIndex: Integer; var aParams: array of Variant); virtual; abstract;

    property ParentReport: TComponent read FParentReport write FParentReport;
  end;

  { TRMFunctionLibrary }
  TRMCustomFunctionLibrary = class(TObject)
  private
    FFunctionList: TList;
    FList: TStringList;
    procedure Clear;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function OnFunction(aParser: TRMCustomParser; const aFunctionName: string;
      aParams: array of Variant; var aValue: Variant): Boolean; virtual;
    procedure DoFunction(aParser: TRMCustomParser; aFuncNo: Integer; aParams: array of Variant;
      var aValue: Variant); virtual;
    procedure AddFunctionDesc(const aFuncName, aCategory, aDescription, aFuncPara: string);

    property FunctionList: TList read FFunctionList;
    property List: TStringList read FList;
  end;

 { TRMAddInObjectInfo }
  TRMAddInObjectInfo = class(TObject)
  private
    FIsPage: Boolean;
    FPage: string;
    FClassRef: TRMClass;
    FEditorFormClass: TFormClass;
    FButtonBmpRes: string;
    FButtonHint: string;
    FIsControl: Boolean;
  public
    constructor Create(AClassRef: TClass; AEditorFormClass: TFormClass;
      const AButtonBmpRes: string; const AButtonHint: string; AIsControl: Boolean);
    property ClassRef: TRMClass read FClassRef write FClassRef;
    property EditorFormClass: TFormClass read FEditorFormClass write FEditorFormClass;
    property ButtonBmpRes: string read FButtonBmpRes write FButtonBmpRes;
    property ButtonHint: string read FButtonHint write FButtonHint;
    property IsControl: Boolean read FIsControl write FIsControl;
    property Page: string read FPage write FPage;
    property IsPage: Boolean read FIsPage write FIsPage;
  end;

  { TRMExportFilterInfo }
  TRMExportFilterInfo = class(TObject)
  private
    FFilter: TRMCustomExportFilter;
    FFilterDesc: string;
    FFilterExt: string;
  public
    constructor Create(AClassRef: TRMCustomExportFilter; const AFilterDesc: string; const AFilterExt: string);
    property Filter: TRMCustomExportFilter read FFilter write FFilter;
    property FilterDesc: string read FFilterDesc write FFilterDesc;
    property FilterExt: string read FFilterExt write FFilterExt;
  end;

  { TRMPageEditorInfo }
  TRMPageEditorInfo = class(TObject)
  private
    FPageClass: TClass;
    FPageEditorClass: TClass;
  public
    constructor Create(aPageClass: TClass; aPageEditorClass: TClass);
    property PageClass: TClass read FPageClass;
    property PageEditorClass: TClass read FPageEditorClass;
  end;

  { TRMToolsInfo }
  TRMToolsInfo = class(TObject)
  private
    FCaption: string;
    FButtonBmpRes: string;
    FOnClick: TNotifyEvent;
    FIsReportPage: Boolean;
    FPageClassName: string;
  public
    constructor Create(const ACaption: string; const AButtonBmpRes: string; AOnClick: TNotifyEvent);
    property Caption: string read FCaption write FCaption;
    property ButtonBmpRes: string read FButtonBmpRes write FButtonBmpRes;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property IsReportPage: Boolean read FIsReportPage;
    property PageClassName: string read FPageClassName;
  end;

  { TRMTempFileStream }
  TRMTempFileStream = class(TFileStream)
  private
    FFileName: string;
  public
    constructor Create;
    destructor Destroy; override;
    property FileName: string read FFileName;
  end;

function RMHavePropertyName(aObject: TObject; const aPropName: string): Boolean;
function RMGetPropValue_1(aObject: TObject; aPropName: string; var aValue: Variant): Boolean;
function RMSetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean;

procedure RMResigerReportPageClass(ClassRef: TClass);
procedure RMRegisterObjectByRes(ClassRef: TClass; const ButtonBmpRes: string;
  const ButtonHint: string; EditorFormClass: TFormClass);
procedure RMRegisterControl(ClassRef: TClass; const ButtonBmpRes, ButtonHint: string); overload;
procedure RMRegisterControl(const aPage, aPageButtonBmpRes: string; aIsControl: Boolean;
  aClassRef: TClass; aButtonBmpRes, aButtonHint: string); overload;
procedure RMRegisterControls(const aPage, aPageButtonBmpRes: string; aIsControl: Boolean;
  AryClassRef: array of TClass; AryButtonBmpRes: array of string; AryButtonHint: array of string);

procedure RMRegisterComAdapter(aClassRef: TClass; aComAdapterClass: TRMPersistentCompAdapterClass);

procedure RMRegisterPageEditor(aClassRef, aPageEditorClass: TClass);
procedure RMRegisterExportFilter(Filter: TRMCustomExportFilter; const FilterDesc, FilterExt: string);
procedure RMUnRegisterExportFilter(Filter: TRMCustomExportFilter);
procedure RMRegisterTool(const MenuCaption: string; const ButtonBmpRes: string; OnClick: TNotifyEvent);
procedure RMUnRegisterTool(const MenuCaption: string);
procedure RMRegisterFunctionLibrary(ClassRef: TClass);
procedure RMUnRegisterFunctionLibrary(ClassRef: TClass);
procedure RMRegisterPageButton(const Hint: string; const ButtonBmpRes: string;
  aIsReportPage: Boolean; aPageClass: string);

function RMPageEditor(Index: Integer): TRMPageEditorInfo;
function RMPageEditorCount: Integer;
function RMAddIns(index: Integer): TRMAddInObjectInfo;
function RMAddInsCount: Integer;
function RMAddInReportPage(Index: Integer): TRMAddInObjectInfo;
function RMAddInReportPageCount: Integer;
function RMFilters(index: Integer): TRMExportFilterInfo;
function RMFiltersCount: Integer;
function RMDsgPageButton(Index: Integer): TRMToolsInfo;
function RMDsgPageButtonCount: Integer;
function RMTools(index: Integer): TRMToolsInfo;
function RMToolsCount: Integer;
function RMAddInFunctions(Index: Integer): TRMCustomFunctionLibrary;
function RMAddInFunctionCount: Integer;
function RMDataSetList: TList;
function RMComAdapterList: TList;

function RMGetBrackedVariable(const aStr: WideString; var aBeginPos, aEndPos: Integer): WideString;
function RMAnsiGetBrackedVariable(const aStr: string; var aBeginPos, aEndPos: Integer): string;
function RMCmp(const S1, S2: string): Boolean;
function RMCreateAdapter(aClassType: TClass; aParent: TObject): TRMPersistentCompAdapter;

var
  RMRegRootKey: string;

{$IFDEF TntUnicode}
type
  TWideStringList = TTntStringList;
  TWideStrings = TTntStrings;
{$ELSE}
type
  TWideStrings = TWStrings;
  TWideStringList = TWStringList;
{$ENDIF}

type
 { TRMFunctionSplitter }
  TRMFunctionSplitter = class(TObject)
  protected
    FMatchFuncs, FSplitTo: TWideStringList;
    FParser: TRMCustomParser;
    FVariables: TRMVariables;
  public
    constructor Create(aMatchFuncs, aSplitTo: TWideStringList; aVariables: TRMVariables);
    destructor Destroy; override;
    procedure Split(aStr: WideString);
  end;

implementation

uses
  Consts, Math, RM_Const, RM_Const1, RM_Utils, RM_Parser
{$IFDEF COMPILER6_UP}
  , RtlConsts
{$ENDIF};

var
  FDataSetList: TList = nil;

function RMCreateAdapter(aClassType: TClass; aParent: TObject): TRMPersistentCompAdapter;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to RMComAdapterList.Count - 1 do
  begin
    if TRMPageEditorInfo(RMComAdapterList[i]).PageClass = aClassType then
    begin
      Result := TRMPersistentCompAdapterClass(TRMPageEditorInfo(RMComAdapterList[i]).PageEditorClass).CreateComp(aParent);
      Break;
    end;
  end;
end;

function RMAnsiGetBrackedVariable(const aStr: string;
  var aBeginPos, aEndPos: Integer): string;
var
  c: Integer;
  lFlag1, lFlag2: Boolean;
  lStrLen: Integer;
begin
  Result := '';
  aEndPos := aBeginPos; lFlag1 := True; lFlag2 := True; c := 0;
  lStrLen := Length(aStr);
  if (aStr = '') or (aBeginPos >= lStrLen) then Exit;

  Dec(aEndPos);
  repeat
    Inc(aEndPos);
    if lFlag1 and lFlag2 then
    begin
      if aStr[aEndPos] = '[' then
      begin
        if c = 0 then
          aBeginPos := aEndPos;

        Inc(c);
      end
      else if aStr[aEndPos] = ']' then
        Dec(c);
    end;

    if lFlag1 then
    begin
      if aStr[aEndPos] = '"' then
        lFlag2 := not lFlag2;
    end;

    if lFlag2 then
    begin
      if aStr[aEndPos] = '''' then
        lFlag1 := not lFlag1;
    end;
  until (c = 0) or (aEndPos >= lStrLen);

  Result := Copy(aStr, aBeginPos + 1, aEndPos - aBeginPos - 1);
end;