fr_class.pas

FastReport2.51.FS.Delphi567.rar是DELPHI中的一个报表控件.

{******************************************}
{                                          }
{            FastReport v2.51              }
{             Report classes               }
{                                          }
{Copyright(c) 1998-2003 by FastReports Inc.}
{                                          }
{******************************************}

{*BUILD ID 816*}

unit FR_Class;

interface

{$I FR.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Printers, Controls,
  Forms, StdCtrls, ComCtrls, Dialogs, Menus, Buttons,
  FR_Progr, FR_View, FR_Pars, FR_Intrp, FR_DSet, FR_DBSet, FR_DBRel
{$IFDEF IBO}
  , IB_Components, IB_Header
{$ELSE}
  , DB
{$ENDIF}

{$IFDEF Delphi6}
  , Variants
{$ENDIF};

const
  // object flags
  flStretched = 1;
  flWordWrap = 2;
  flWordBreak = 4;
  flAutoSize = 8;
  flTextOnly = $10;
  flSuppressRepeated = $20;
  flHideZeros = $40;
  flUnderlines = $80;
  flRTLReading = $100;
  flBandNewPageAfter = 2;
  flBandPrintifSubsetEmpty = 4;
  flBandBreaked = 8;
  flBandOnFirstPage = $10;
  flBandOnLastPage = $20;
  flBandRepeatHeader = $40;
  flBandPrintChildIfInvisible = $80;
  flPictCenter = 2;
  flPictRatio = 4;
  flWantHook = $8000;
  flDontUndo = $4000;
  flOnePerPage = $2000;

  // object types
  gtMemo = 0;
  gtPicture = 1;
  gtBand = 2;
  gtSubReport = 3;
  gtLine = 4;
  gtCross = 5;
  gtAddIn = 10;

  // frame types
  frftNone = 0;
  frftRight = 1;
  frftBottom = 2;
  frftLeft = 4;
  frftTop = 8;

  // text align
  frtaLeft = 0;
  frtaRight = 1;
  frtaCenter = 2;
  frtaVertical = 4;
  frtaMiddle = 8;
  frtaDown = 16;

  // band align

  baNone = 0;
  baLeft = 1;
  baRight = 2;
  baCenter = 3;
  baWidth = 4;
  baBottom = 5;
  baTop = 6;
  baRest = 7;

  // restriction flags
  frrfDontEditMemo = 1;
  frrfDontEditScript = 2;
  frrfDontEditContents = 4;
  frrfDontModify = 8;
  frrfDontSize = 16;
  frrfDontMove = 32;
  frrfDontDelete = 64;

  psDouble = 5;
  frtName = 77;

type
  TfrDocMode = (dmDesigning, dmPrinting);

  TfrDrawMode = (drAll, drAfterCalcHeight, drPart);

  TfrBandType = (btReportTitle, btReportSummary,

    btPageHeader, btPageFooter,

    btMasterHeader, btMasterData, btMasterFooter,

    btDetailHeader, btDetailData, btDetailFooter,

    btSubDetailHeader, btSubDetailData, btSubDetailFooter,

    btOverlay, btColumnHeader, btColumnFooter,

    btGroupHeader, btGroupFooter,

    btCrossHeader, btCrossData, btCrossFooter,

    btChild, btNone);

  TfrPageType = (ptReport, ptDialog);

  TfrDataSetPosition = (psLocal, psGlobal);

  TfrPageMode = (pmNormal, pmBuildList);

  TfrBandRecType = (rtShowBand, rtFirst, rtNext);

  TfrRgnType = (rtNormal, rtExtended);

  TfrReportType = (rtSimple, rtMultiple);

  TfrDataType = (frdtString, frdtInteger, frdtFloat, frdtBoolean,

    frdtColor, frdtEnum, frdtHasEditor, frdtSize,

    frdtOneObject);

  TfrDataTypes = set of TfrDataType;

  TfrPrintPages = (frAll, frOdd, frEven);

  TfrView = class;

  TfrBand = class;

  TfrPage = class;

  TfrReport = class;

  TfrExportFilter = class;

  TDetailEvent = procedure(const ParName: string; var ParValue: Variant) of
    object;

  TEnterRectEvent = procedure(Memo: TStringList; View: TfrView) of object;

  TBeginDocEvent = procedure of object;

  TEndDocEvent = procedure of object;

  TBeginPageEvent = procedure(pgNo: Integer) of object;

  TEndPageEvent = procedure(pgNo: Integer) of object;

  TBeginBandEvent = procedure(Band: TfrBand) of object;

  TEndBandEvent = procedure(Band: TfrBand) of object;

  TProgressEvent = procedure(n: Integer) of object;

  TBeginColumnEvent = procedure(Band: TfrBand) of object;

  TPrintColumnEvent = procedure(ColNo: Integer; var Width: Integer) of object;

  TManualBuildEvent = procedure(Page: TfrPage) of object;

  TObjectClickEvent = procedure(View: TfrView) of object;

  TMouseOverObjectEvent = procedure(View: TfrView; var Cursor: TCursor) of
    object;

  TBeforeExportEvent = procedure(var FileName: string; var bContinue: Boolean) of
    object;

  TAfterExportEvent = procedure(const FileName: string) of object;

  TPrintReportEvent = procedure of object;

  TLocalizeEvent = procedure(StringID: Integer; var ResultString: string) of
    object;

  TfrHighlightAttr = packed record

    FontStyle: Word;

    FontColor, FillColor: TColor;

  end;

  TfrPrnInfo = record // print info about page size, margins e.t.c

    PPgw, PPgh, Pgw, Pgh: Integer; // page width/height (printer/screen)

    POfx, POfy, Ofx, Ofy: Integer; // offset x/y

    PPw, PPh, Pw, Ph: Integer; // printable width/height

  end;

  PfrPageInfo = ^TfrPageInfo;

  TfrPageInfo = packed record // pages of a preview

    R: TRect;

    pgSize: Word;

    pgWidth, pgHeight: Integer;

    pgOr: TPrinterOrientation;

    pgBin: Integer;

    UseMargins: Boolean;

    pgMargins: TRect;

    PrnInfo: TfrPrnInfo;

    Visible: Boolean;

    Stream: TMemoryStream;

    Page: TfrPage;

  end;

  PfrBandRec = ^TfrBandRec;

  TfrBandRec = packed record

    Band: TfrBand;

    Action: TfrBandRecType;

  end;

  PfrPropRec = ^TfrPropRec;

  TfrPropRec = record

    PropName: string[32];

    PropType: TfrDataTypes;

    Enum: TStringList;

    EnumValues: Variant;

    PropEditor: TNotifyEvent;

  end;

  TfrObject = class(TObject)

  protected

    PropList: TList;

    procedure ClearPropList;

    procedure AddProperty(PropName: string; PropType: TfrDataTypes;

      PropEditor: TNotifyEvent);

    procedure AddEnumProperty(PropName: string; Enum: string;

      const EnumValues: array of Variant);

    procedure DelProperty(PropName: string);

    procedure SetPropValue(Index: string; Value: Variant); virtual;

    function GetPropValue(Index: string): Variant; virtual;

    function GetPropRec(Index: string): PfrPropRec;

    function DoMethod(MethodName: string; Par1, Par2, Par3: Variant): Variant;
      virtual;

    // helper methods

    procedure SetFontProp(Font: TFont; Prop: string; Value: Variant);

    function GetFontProp(Font: TFont; Prop: string): Variant;

    function LinesMethod(Lines: Tstrings; MethodName, LinesName: string;

      Par1, Par2, Par3: Variant): Variant;

  public

    constructor Create;

    destructor Destroy; override;

    procedure DefineProperties; virtual;

    property Prop[Index: string]: Variant read GetPropValue write SetPropValue;

    property PropRec[Index: string]: PfrPropRec read GetPropRec;

  end;

  TfrView = class(TfrObject)

  private

    Flag1: Boolean;

    olddy: Integer;

    procedure P1Click(Sender: TObject);

  protected

    SaveX, SaveY, SaveDX, SaveDY, SaveGX, SaveGY: Integer;

    SaveFW: Single;

    BaseName: string;

    Canvas: TCanvas;

    DRect: TRect;

    Memo1: TStringList;

    FDataSet: TfrTDataSet;

    FField: string;

    StreamMode: (smFRF, smFRP);

    procedure ShowBackground; virtual;

    procedure ShowFrame; virtual;

    procedure BeginDraw(ACanvas: TCanvas);

    procedure GetBlob(b: TfrTField); virtual;

    procedure OnHook(View: TfrView); virtual;

    procedure ExpandVariables(var s: string);

    procedure SetPropValue(Index: string; Value: Variant); override;

    function GetPropValue(Index: string): Variant; override;

    procedure Loaded; virtual;

    function DoMethod(MethodName: string; Par1, Par2, Par3: Variant): Variant;
      override;

    function ParentBand: TfrView;

  public

    Name: string;

    Typ: Byte; // One of gtXXX constants

    HVersion, LVersion: Byte;

    ID: Integer; // UID - used in designer (undo support)

    Selected: Boolean; // used in designer

    OriginalRect: TRect;

    ScaleX, ScaleY: Double; // used for scaling objects in preview

    OffsX, OffsY: Integer; //

    IsPrinting: Boolean; // True if printing on printer canvas

    x, y, dx, dy: Integer;

    Flags: Word;

    FrameTyp: Word;

    FrameWidth: Single;

    FrameColor: TColor;

    FrameStyle: Word;

    FillColor: TColor;

    Format: Integer;

    FormatStr: string;

    Visible: WordBool;

    gapx, gapy: Integer;

    Restrictions: Word;

    Tag: string;

    Memo, Script: TStringList;

    BandAlign: Byte;

    Parent: TfrBand;

    ParentPage: TfrPage;

    constructor Create; virtual;

    destructor Destroy; override;

    procedure Assign(From: TfrView);

    procedure CalcGaps; virtual;

    procedure RestoreCoord; virtual;

    procedure Draw(Canvas: TCanvas); virtual; abstract;

    procedure StreamOut(Stream: TStream); virtual;

    procedure ExportData; virtual;

    procedure LoadFromStream(Stream: TStream); virtual;

    procedure SaveToStream(Stream: TStream); virtual;

    procedure SaveToFR3Stream(Stream: TStream); virtual;

    procedure Resized; virtual;

    procedure DefinePopupMenu(Popup: TPopupMenu); virtual;

    function GetClipRgn(rt: TfrRgnType): HRGN; virtual;

    procedure CreateUniqueName;

    procedure SetBounds(Left, Top, Width, Height: Integer);

    procedure DefineProperties; override;

    procedure ShowEditor; virtual;

  end;

  TfrControl = class(TfrView)

  protected

    FControl: TControl;

    procedure PaintDesignControl; virtual;

    procedure SetPropValue(Index: string; Value: Variant); override;

  public

    constructor Create; override;

    destructor Destroy; override;

    procedure DefineProperties; override;

    procedure PlaceControl(Form: TForm);

    procedure Draw(Canvas: TCanvas); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

    property Control: TControl read FControl;

  end;

  TfrNonVisualControl = class(TfrControl)

  protected

    Bmp: TBitmap;

    Component: TComponent;

    FFixupList: TfrVariables;

    procedure SetPropValue(Index: string; Value: Variant); override;

    procedure PaintDesignControl; override;

  public

    constructor Create; override;

    destructor Destroy; override;

    procedure DefineProperties; override;

    procedure PlaceControl(Form: TForm);

    procedure Draw(Canvas: TCanvas); override;

  end;

  TfrStretcheable = class(TfrView)

  protected

    DrawMode: TfrDrawMode;

    function DoMethod(MethodName: string; Par1, Par2, Par3: Variant): Variant;
      override;

    function CalcHeight: Integer; virtual; abstract;

    function MinHeight: Integer; virtual; abstract;

    function LostSpace: Integer; virtual; abstract;

  end;

  TfrMemoView = class(TfrStretcheable)

  private

    FFont: TFont;

    LastValue: string;

    FWrapped: Boolean;

    VHeight: Integer; // used for height calculation of TfrMemoView

    procedure P1Click(Sender: TObject);

    procedure P2Click(Sender: TObject);

    procedure P3Click(Sender: TObject);

    procedure P5Click(Sender: TObject);

    procedure P6Click(Sender: TObject);

    procedure P8Click(Sender: TObject);

    procedure P9Click(Sender: TObject);

    procedure P10Click(Sender: TObject);

    procedure P11Click(Sender: TObject);

    procedure SetFont(Value: TFont);

  protected

    Streaming: Boolean;

    TextHeight: Integer;

    CurStrNo: Integer;

    Exporting: Boolean;

    procedure ExpandMemoVariables;

    procedure AssignFont(Canvas: TCanvas);

    procedure WrapMemo;

    procedure ShowMemo;

    procedure ShowUnderLines;

    function CalcWidth(Memo: TstringList): Integer;

    function CalcHeight: Integer; override;

    function MinHeight: Integer; override;

    function LostSpace: Integer; override;

    procedure GetBlob(b: TfrTField); override;

    procedure SetPropValue(Index: string; Value: Variant); override;

    function GetPropValue(Index: string): Variant; override;

    function DoMethod(MethodName: string; Par1, Par2, Par3: Variant): Variant;
      override;

  public

    Alignment: Integer;

    Highlight: TfrHighlightAttr;

    HighlightStr: string;

    LineSpacing, CharacterSpacing: Integer;

    constructor Create; override;

    destructor Destroy; override;

    procedure Draw(Canvas: TCanvas); override;

    procedure StreamOut(Stream: TStream); override;

    procedure ExportData; override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure SaveToStream(Stream: TStream); override;

    procedure SaveToFR3Stream(Stream: TStream); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

    procedure DefineProperties; override;

    procedure ShowEditor; override;

    property Font: TFont read FFont write SetFont;

  end;

  TfrBandView = class(TfrView)

  private

    procedure P1Click(Sender: TObject);

    procedure P2Click(Sender: TObject);

    procedure P3Click(Sender: TObject);

    procedure P4Click(Sender: TObject);

    procedure P5Click(Sender: TObject);

    procedure P6Click(Sender: TObject);

    procedure P7Click(Sender: TObject);

    function GetBandType: TfrBandType;

    procedure SetBandType(const Value: TfrBandType);

    function GetRectangleWidth: Integer;

  protected

    procedure SetPropValue(Index: string; Value: Variant); override;

    function GetPropValue(Index: string): Variant; override;

    function DoMethod(MethodName: string; Par1, Par2, Par3: Variant): Variant;
      override;

  public

    ChildBand, Master: string;

    Columns: Integer;

    ColumnWidth: Integer;

    ColumnGap: Integer;

    NewColumnAfter: Integer;

    constructor Create; override;