rm_class.pas.~2~

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

    function GetCalcNoVisible: Boolean;
    procedure SetCalcNoVisible(aValue: Boolean);
    function GetOutBigNum: Boolean;
    procedure SetOutBigNum(Value: Boolean);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Pars: array of Variant): Variant; override;
    procedure ExpandMemoVariables; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure DoAggregate;
    procedure Reset;

    procedure StreamOut(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;

    property Expression: string read FExpression write FExpression;
    property CalcType: TRMDBCalcType read FCalcType write FCalcType;
    property Filter: string read FFilter write FFilter;
    property ResetAfterPrint: Boolean read FResetAfterPrint write FResetAfterPrint;
    property AggrBandName: string read FAggrBandName write FAggrBandName;
    property PTotalCalc: Boolean read GetTotalCalc write SetTotalCalc;
    property PCalcNoVisible: Boolean read GetCalcNoVisible write SetCalcNoVisible;
    property IntalizeValue: string read FIntalizeValue write FIntalizeValue;
    property AggregateValue: string read FAggregateValue write FAggregateValue;
    property POutBigNum: Boolean read GetOutBigNum write SetOutBigNum;
  published
  end;

  { TRMBand }
  TRMBand = class(TObject)
  private
    FParentPage: TRMPage;
    FBandView: TRMBandView;
    FFlags: Word;
    FNext, FPrev: TRMBand;
    FNextGroup, FPrevGroup: TRMBand;
    FFirstGroup, FLastGroup: TRMBand;
    FChild: TRMBand;
    FAggrBand: TRMBand;
    FSubIndex, FMaxY: Integer;
    FEOFReached: Boolean;
    FEOFArr: array[0..31] of Boolean;
    FPositions: array[TRMDatasetPosition] of Integer;
    FLastGroupValue: Variant;
    FHeaderBand, FFooterBand, FDataBand, FLastBand: TRMBand;
    FCount: Integer;
    FValues: TRMVariables;
    FDisableInit: Boolean;
    FCalculatedHeight: Integer;
    FCurColumn: Integer;
    FSaveXAdjust, FSaveTop: Integer;
    FSaveCury: Boolean;
    FCallNewPage, FCallNewColumn: Integer;
    FMaxColumns: Integer;
    FNowLine: LongInt;
    FSaveRangeBegin: TRMRangeBegin;
    FSaveRangeEnd: TRMRangeEnd;
    FSaveRangeEndCount: Integer;
    FDisableBandScript: Boolean;
    FPageBreak: Boolean;
    FNewPageCondition: string;
    FFirstTime: Boolean;

    procedure InitDataSet(Desc: string);
    procedure FreeDataSet;
    function CalcHeight: Integer;
    procedure StretchObjects(MaxHeight: Integer);
    procedure UnStretchObjects;
    procedure DrawObject(t: TRMView);
    procedure PrepareSubReports;
    procedure DoSubReports;
    function DrawObjects: Boolean;
    procedure DrawCrossCell(Parnt: TRMBand; CurX: Integer);
    procedure DrawCross;
    function CheckPageBreak(y, dy: Integer; PBreak: Boolean): Boolean;
    procedure DrawPageBreak;
    function HasCross: Boolean;
    function DoCalcHeight: Integer;
    procedure DoDraw;
    function Draw: Boolean;
    procedure InitValues;
    procedure DoAggregate;
    function ExtractField(const s: string; FieldNo: Integer): string;
    procedure AddAggregateValue(const s: string; v: Variant);
    function GetAggregateValue(const s: string): Variant;

    function GetOnFirstPage: Boolean;
    function GetOnLastPage: Boolean;
    function GetRepeatHeader: Boolean;
  public
    Name: string;
    x, y, dx, dy, maxdy: Integer;
    Typ: TRMBandType;
    PrintIfSubsetEmpty, NewPageAfter, Stretched, PrintChildIfInvisible: Boolean;
    AutoAppendBlank: Boolean;
    LinesPerPage: Word;
    Visible: Boolean;
    Objects: TList;
    Memo, Script, Script_AfterPrint: TStringList;
    DataSet: TRMDataSet;
    IsVirtualDS: Boolean;
    VCDataSet: TRMDataSet;
    IsVirtualVCDS: Boolean;
    GroupCondition: string;
    constructor Create(ATyp: TRMBandType; AParent: TRMPage);
    destructor Destroy; override;

    property POnFirstPage: Boolean read GetOnFirstPage;
    property POnLastPage: Boolean read GetOnLastPage;
    property PRepeatHeader: Boolean read GetRepeatHeader;
  end;

  { TRMPage }
  TRMPage = class(TRMObject)
  private
    FParentPage: TRMPage;
    FBands: array[TRMBandType] of TRMBand;
    FSkip, FInitFlag, FCanDisableControls: Boolean;
    FCurColumn, FLastStaticColumnY, FXAdjust, FSaveBottom: Integer;
    FList: TList;
    FMode: TRMPageMode;
    FPlayFrom: Integer;
    FLastBand: TRMBand;
    FColPos, FCurPos: Integer;
    FWasBand: TRMBand;
    FDisableRepeatHeader: Boolean;
    //WHF Add
    FAggrList: TList;
    FDrawRepeatHeader: Boolean;
    FFirstTime: Boolean;
    FmmMarginLeft, FmmMarginTop, FmmMarginRight, FmmMarginBottom: Longint;
    FmmColumnGap: Longint;
    FmmPageWidth, FmmPageHeight: Longint;
    FpgSize: Integer;
    FpgOr: TPrinterOrientation;
    FpgBin: integer;

    function GetpgWidth: Integer;
    function GetpgHeight: Integer;
    function GetColGap: Integer;
    procedure SetColGap(Value: Integer);
    function GetpgMargins: TRect;
    procedure SetpgMargins(aValue: TRect);

    procedure InitPage;
    procedure DonePage;
    procedure TossObjects;
    procedure PrepareObjects;
    procedure PrepareAggrObjects; //计算字段
    procedure FormPage; //打印主程序
    procedure AddRecord(b: TRMBand; rt: TRMBandRecType);
    procedure ClearRecList;
    function PlayRecList: Boolean;
    procedure DrawPageFooters(aLastPage: Boolean);
    procedure DrawColumnFooter;
    function BandExists(b: TRMBand): Boolean;
    procedure AfterPrint;
    procedure LoadFromStream(Stream: TStream; AReport: TRMReport);
    procedure SaveToStream(Stream: TStream);
    procedure ShowBand(b: TRMBand);
    function LeftOffset: Integer;
    procedure DoScript(Script: TStrings);
    procedure DialogFormActivate(Sender: TObject);
    procedure ResetPosition(b: TRMBand; ResetTo: Integer);

    procedure DoDetailHeaderAggrs(b: TRMBand);
    procedure DoGroupHeaderAggrs(aGroupHeader: TRMBand);
  protected
    FbkPicture: TPicture;
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Pars: array of Variant): Variant; override;
  public
    Name: string;
    PrintToPrevPage: WordBool;
    PrnInfo: TRMPrnInfo;
    ColCount, ColWidth: Integer;
    PageType: TRMPageType;
    Objects: TList;
    CurY, CurBottomY: Integer;
    AutoHCenter: Boolean;
    // dialog properties
    BorderStyle: Byte;
    Caption: string;
    Color: TColor;
    Left, Top, Width, Height: Integer;
    Position: Byte;
    Form: TForm;
    Script: TStringList;
    Visible: Boolean;
    bkPictureLeft, bkPictureTop: Integer;
    bkPictureWidth, bkPictureHeight: Integer;
    PageNumber: Integer;
    constructor Create(ASize, AWidth, AHeight, ABin: integer; AOr: TPrinterOrientation); virtual;
    destructor Destroy; override;
    procedure DefineProperties; override;
    procedure CreateUniqueName;
    function TopMargin: Integer;
    function BottomMargin: Integer;
    function LeftMargin: Integer;
    function RightMargin: Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    function FindObjectByID(ID: Integer): Integer;
    function FindObject(Name: string): TRMView;
    procedure ChangePaper(ASize, AWidth, AHeight, ABin: Integer; AOr: TPrinterOrientation);
    procedure ShowBandByName(s: string);
    procedure ShowBandByType(bt: TRMBandType);
    procedure NewPage;
    procedure NewColumn(Band: TRMBand);
    procedure ScriptEditor(Sender: TObject);
    procedure SetbkPicture(aGraphic: TGraphic);

    property CanDisableControls: Boolean read FCanDisableControls;
    property ColGap: Integer read GetColGap write SetColGap;
    property mmColumnGap: Longint read FmmColumnGap write FmmColumnGap;
    property pgMargins: TRect read GetpgMargins write SetpgMargins;
    property mmMarginLeft: Longint read FmmMarginLeft write FmmMarginLeft;
    property mmMarginTop: Longint read FmmMarginTop write FmmMarginTop;
    property mmMarginRight: Longint read FmmMarginRight write FmmMarginRight;
    property mmMarginBottom: Longint read FmmMarginBottom write FmmMarginBottom;
    property pgWidth: Integer read GetpgWidth;
    property pgHeight: Integer read GetpgHeight;
    property pgSize: Integer read FpgSize;
    property pgOr: TPrinterOrientation read FpgOr;
    property pgBin: integer read FpgBin;
    property mmPageWidth: Longint read FmmPageWidth;
    property mmPageHeight: Longint read FmmPageHeight;
  end;

  { TRMPages }
  TRMPages = class(TObject)
  private
    FParent: TRMReport;
    function GetCount: Integer;
    function GetPages(Index: Integer): TRMPage;
    procedure RefreshObjects;
    procedure MakeTmpObjects;
  protected
    FPages: TList;
  public
    constructor Create(AParent: TRMReport);
    destructor Destroy; override;
    procedure Clear;
    function Add: TRMPage;
    procedure Delete(Index: Integer);
    procedure Move(OldIndex, NewIndex: Integer);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    property Pages[Index: Integer]: TRMPage read GetPages; default;
    property Count: Integer read GetCount;
  end;

  { TRMBkPicture }
  TRMBkPicture = class(TObject)
  private
    FLeft, FTop: Integer;
    FWidth, FHeight: Integer;
    FPicture: TPicture;
  public
    constructor Create(aLeft, aTop, aWidth, aHeight: Integer; aPic: TPicture);
    destructor Destroy; override;

    property Left: Integer read FLeft;
    property Top: Integer read FTop;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Picture: TPicture read FPicture;
  end;

  { TRMEMFPages }
  TRMEMFPages = class(TObject)
  private
    FPages: TList;
    FParent: TRMReport;
    FbkPictures: TList;
    FOnClearEvent: TNotifyEvent;

    procedure _LoadFromStream(aStream: TStream);
    function GetCount: Integer;
    function GetPages(Index: Integer): PRMPageInfo;
    procedure ExportData(Index: Integer);
    procedure AddbkPicture(aLeft, aTop, aWidth, aHeight: Integer; aPicture: TPicture);
    function GetbkPicture(Index: Integer): TRMBkPicture;
  protected
    property OnClearEvent: TNotifyEvent read FOnClearEvent write FOnClearEvent;
  public
    constructor Create(AParent: TRMReport);
    destructor Destroy; override;
    procedure Clear;
    procedure Draw(Index: Integer; aCanvas: TCanvas; DrawRect: TRect);
    procedure Add(APage: TRMPage);
    procedure AddFrom(aReport: TRMReport);
    procedure InsertFromPageInfo(Index: Integer; APageInfo: TRMPageInfo);
    procedure Insert(Index: Integer; APage: TRMPage);
    procedure Delete(Index: Integer);
    procedure AppendFromStream(aStream: TStream);
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToStream(AStream: TStream);
    procedure PageToObjects(Index: Integer);
    procedure ObjectsToPage(Index: Integer);
    function DoClick(Index: Integer; pt: TPoint; Click: Boolean; var Cursor: TCursor): Boolean;

    property Pages[Index: Integer]: PRMPageInfo read GetPages; default;
    property Count: Integer read GetCount;
    property bkPictures[Index: Integer]: TRMbkPicture read GetbkPicture;
  end;

  { TRMDataDictionary }
  TRMDataDictionary = class(TObject)
  private
    FVersion: Integer;
    FCache: TStringList;
    FDisabledDatasets: TStringList;
    function GetValue(const VarName: string): Variant;
    function GetRealFieldName(const ItemName: string): string;
    function GetRealDataSetName(const ItemName: string): string;
    function GetRealDataSourceName(const ItemName: string): string;
    function GetAliasName(const ItemName: string): string;
    procedure AddCacheItem(const index: string; ADataSet: TDataSet; const ADataField: string);
    procedure ClearCache;
    procedure _LoadFromStream(Stream: TStream);
  public
    Variables: TRMVariables;
    FieldAliases: TRMVariables;
    BandDatasources: TRMVariables;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(AFileName: string);
    procedure SaveToFile(AFileName: string);
    procedure MergeFromFile(aFileName: string);
    procedure MergeFromStream(Stream: TStream);
    procedure ExtractFieldName(const ComplexName: string; var DSName, FieldName: string);
    function IsVariable(const VarName: string): Boolean;
    function DatasetEnabled(const DatasetName: string): Boolean;
    procedure GetDatasetList(List: TStrings);
    procedure GetFieldList(DSName: string; List: TStrings);
    procedure GetBandDatasourceList(List: TStrings);
    procedure GetCategoryList(List: TStrings);