rm_class.pas.~1~

胜天进销存源码,国产优秀的进销存

    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;

  PRMFunctionDesc = ^TRMFunctionDesc;
  TRMFunctionDesc = packed record
    FuncName: string;
    Category: string;
    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; p: array of Variant; var val: Variant): Boolean; virtual;
    procedure DoFunction(FNo: Integer; p: array of Variant; var val: Variant); virtual; abstract;
    procedure AddFunctionDesc(const aFuncName, aCategory, aDescription, aFuncPara: string);
    property FuncList: TList read FFuncList;
  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;
    DrawRect: TRect;
    FrameTyp, FrameWidth, FrameColor, Alignment: Integer;
  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;
  PageNo: Integer; // current page number in Building mode
  RMCharset: 0..255;
  RMVersion: Byte; // version of currently loaded report
  ErrorFlag: Boolean; // error occured through TRMView drawing
  ErrorStr: string; // error description
  SMemo: TStringList; // temporary memo used during TRMView drawing
  ShowBandTitles: Boolean;
//  RMThreadDone: Boolean;
  Flag_NewPage, Flag_ColumnNewPage: Boolean;
  Flag_TableEmpty: Boolean;
  FSaveDesignerAutoSave: 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;
  rmfrAggregate, rmftDateTime, rmftString, rmftOther, rmftMath, rmftBoolean, rmftInterpreter: 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 RMPrintGraphic(aCanvas: TCanvas; DestRect: TRect; aGraph: TGraphic; aIsPrinting: Boolean);

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

implementation

uses
  IniFiles, Registry, 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;

const
  CM_BeforeModal = WM_USER + 1;

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; p: array of 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
  FTempBMP: TBitmap; // temporary bitmap used by TRMMemoView
  FCurDate, FCurTime, FCurDateTime: 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;
  InDictionary: Boolean;
  AggrBand: TRMBand;

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

function RMProgressForm: TRMProgressForm;
begin
  if FRMProgressForm = nil then
    FRMProgressForm := TRMProgressForm.Create(nil);
  Result := FRMProgressForm;
end;

//WHF Add

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

function RMConvertToPixels(aValue: Extended; aUnit: TRMSizeUnits): extended;
begin
  case aUnit of
    rmsuPixels: Result := aValue;
    rmsuMM: Result := aValue * RMPixPerInch.X * RMInchPerMM;
    rmsuInches: Result := aValue * RMPixPerInch.X;
//    rmsuMM: Result := aValue / (254 / RMPixPerInch.X);
//    rmsuInches: Result := aValue / (254 / RMPixPerInch.X) / RMInchPerMM / 100;
  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
          if VarType(v) in [varSingle, varDouble] then
            Result := FormatFloat('0.########', v)
          else
            Result := v;
        end;
      1: //数字型
        begin
          DecimalSeparator := Chr(Format and $FF);
          case f2 of
            0: Result := FormatFloat('##0.' + Dup('#', (Format div $0100) and $FF), v);
            1: Result := FloatToStrF(v, ffFixed, 15, (Format div $0100) and $FF);
            2: Result := FormatFloat('#,##0.' + Dup('#', (Format div $0100) and $FF), v);
            3: Result := FloatToStrF(v, ffNumber, 15, (Format div $0100) and $FF);
            4: Result := FormatFloat(FormatStr, v);
          end;
        end;
      2: //日期型
        begin
          if f2 > High(RMDateFormats) then
            Result := RMFormatDateTime(FormatStr, v)
          else
            Result := RMFormatDateTime(RMDateFormats[f2], v);
        end;
      3: //时间型
        begin
          if f2 = 4 then
            Result := FormatDateTime(FormatStr, v)
          else
            Result := FormatDateTime(RMTimeFormats[f2], v);
        end;
      4: //逻辑型
        begin
          if f2 = 4 then
            s := FormatStr
          else
            s := RMFormatBoolStr[f2];
          if Integer(v) = 0 then
            Result := Copy(s, 1, Pos(';', s) - 1)
          else
            Result := Copy(s, Pos(';', s) + 1, 255);
        end;
    end;
  except
    Result := v;
  end;
  DecimalSeparator := c;
end;

procedure RMGetFormatStr(var ParName, FormatStr: string; var Format: integer);
var
  i: Integer;
begin
  if CurView <> nil then
  begin
    Format := CurView.Format;
    FormatStr := CurView.FormatStr;
  end
  else
  begin
    Format := 0;
    FormatStr := '