fr_class.pas

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

    Text: string;

    FontName: string[32];

    FontSize, FontStyle, FontColor, FontCharset, FillColor: Integer;

    DrawRect: TRect;

    FrameTyp, FrameWidth, FrameColor, Alignment: Integer;

  end;

  TfrAddInObjectInfo = record

    ClassRef: TClass;

    ButtonBmp: TBitmap;

    ButtonHint: string;

    IsControl: Boolean;

  end;

  TfrExportFilterInfo = record

    Filter: TfrExportFilter;

    FilterDesc, FilterExt: string;

  end;

  TfrFunctionInfo = record

    FunctionLibrary: TfrFunctionLibrary;

  end;

  TfrToolsInfo = record

    Caption: string;

    ButtonBmp: TBitmap;

    OnClick: TNotifyEvent;

  end;

var

  frDesigner: TfrReportDesigner; // designer reference

  frDesignerClass: TClass;

  frDataManager: TfrDataManager; // data manager reference

  frParser: TfrParser; // parser reference

  frInterpretator: TfrInterpretator; // interpretator reference

  frVariables: TfrVariables; // report variables reference

  frConsts: TfrVariables; // some constants like 'clRed' as 13872

  frCompressor: TfrCompressor; // compressor reference

  frDialogForm: TForm; // dialog form reference

  CurReport: TfrReport; // currently proceeded report

  MasterReport: TfrReport; // reference to main composite report

  CurView: TfrView; // currently proceeded view

  CurBand: TfrBand; // currently proceeded band

  CurPage: TfrPage; // currently proceeded page

  DocMode: TfrDocMode; // current mode

  DisableDrawing: Boolean;

  frAddIns: array[0..63] of TfrAddInObjectInfo; // add-in objects

  frAddInsCount: Integer;

  frFilters: array[0..63] of TfrExportFilterInfo; // export filters

  frFiltersCount: Integer;

  frFunctions: array[0..63] of TfrFunctionInfo; // function libraries

  frFunctionsCount: Integer;

  frTools: array[0..63] of TfrToolsInfo; // tools

  frToolsCount: Integer;

  frInstalledFunctions: TfrInstalledFunctions;

  PageNo: Integer; // current page number in Building mode

  frCharset: 0..255;

  frBandNames: array[0..50] of string;

  frDateFormats, frTimeFormats: array[0..3] of string;

  frVersion: 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 = True;

  frThreadDone: Boolean;

  frProgressForm: TfrProgressForm;

  // editors

  frMemoEditor: TNotifyEvent;

  frTagEditor: TNotifyEvent;

  frRestrEditor: TNotifyEvent;

  frHighlightEditor: TNotifyEvent;

  frFieldEditor: TNotifyEvent;

  frDataSourceEditor: TNotifyEvent;

  frCrossDataSourceEditor: TNotifyEvent;

  frGroupEditor: TNotifyEvent;

  frPictureEditor: TNotifyEvent;

  frFontEditor: TNotifyEvent;

  frGlobals: TfrGlobals;

implementation

uses

  FR_Fmted, FR_PrDlg, FR_Prntr, FR_Utils, FR_Const, FR_passw, ShellApi

{$IFDEF Delphi6}, MaskUtils{$ELSE}, Mask{$ENDIF}

{$IFDEF JPEG}, JPEG{$ENDIF};

{$R FR_Lng1.RES}

type

  TfrStdFunctionLibrary = class(TfrFunctionLibrary)

  public

    constructor Create; override;

    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant;

      var val: Variant); override;

  end;

  TInterpretator = class(TfrInterpretator)

  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(TfrFunctionSplitter)

  public

    constructor CreateSplitter(SplitTo: TStrings);

    destructor Destroy; override;

    procedure SplitMemo(Memo: Tstrings);

    procedure SplitScript(Script: TStrings);

  end;

  PfrFunctionDesc = ^TfrFunctionDesc;

  TfrFunctionDesc = record

    FunctionLibrary: TfrFunctionLibrary;

    Name, Category, Description: string;

  end;

const

  atNone = 10;

  atSum = 11;

  atMin = 12;

  atMax = 13;

  atAvg = 14;

  atCount = 15;

var

  SBmp: TBitmap; // small bitmap used by TfrBandView drawing

  TempBmp: TBitmap; // temporary bitmap used by TfrMemoView

  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;

  BoolStr: array[0..3] of string;

  HookList: TList;

  // aggregate handling

  InitAggregate: Boolean;

  AggrBand: TfrBand;

  // variables used through report building

  PrevY, PrevBottomY, ColumnXAdjust: Integer;

  Append, WasPF: Boolean;

  CompositeMode: Boolean;

  DontShowReport: Boolean;

  FLocale: TfrLocale = nil;

  {----------------------------------------------------------------------------}

function frCreateObject(Typ: Byte; const ClassName: string): TfrView;

var

  i: Integer;

begin

  Result := nil;

  case Typ of

    gtMemo: Result := TfrMemoView.Create;

    gtPicture: Result := TfrPictureView.Create;

    gtBand: Result := TfrBandView.Create;

    gtSubReport: Result := TfrSubReportView.Create;

    gtLine: Result := TfrLineView.Create;

    //    gtCross:     Result := TfrCrossView.Create;

    gtAddIn:

      begin

        for i := 0 to frAddInsCount - 1 do

          if frAddIns[i].ClassRef.ClassName = ClassName then

          begin

            Result := TfrView(frAddIns[i].ClassRef.NewInstance);

            Result.Create;

            Result.Typ := gtAddIn;

            break;

          end;

        if Result = nil then

        begin

          ErrorFlag := True;

          ErrorStr := ErrorStr + ClassName + #13;

          raise EClassNotFound.Create(ErrorStr);

        end;

      end;

  end;

  if Result <> nil then

  begin

    Result.ID := ObjID;

    Inc(ObjID);

  end;

end;

procedure frRegisterObject(ClassRef: TClass; ButtonBmp: TBitmap;

  const ButtonHint: string);

var

  i: Integer;

begin

  for i := 0 to frAddInsCount - 1 do

    if frAddIns[i].ClassRef = ClassRef then
      Exit;

  i := frAddInsCount;

  frAddIns[i].ClassRef := ClassRef;

  frAddIns[i].ButtonBmp := ButtonBmp;

  frAddIns[i].ButtonHint := ButtonHint;

  frAddIns[i].IsControl := False;

  if ButtonBmp <> nil then

    ButtonBmp.Dormant;

  Inc(frAddInsCount);

end;

procedure frRegisterControl(ClassRef: TClass; ButtonBmp: TBitmap;

  const ButtonHint: string);

var

  i: Integer;

begin

  for i := 0 to frAddInsCount - 1 do

    if frAddIns[i].ClassRef = ClassRef then
      Exit;

  i := frAddInsCount;

  frAddIns[i].ClassRef := ClassRef;

  frAddIns[i].ButtonBmp := ButtonBmp;

  frAddIns[i].ButtonHint := ButtonHint;

  frAddIns[i].IsControl := True;

  if ButtonBmp <> nil then

    ButtonBmp.Dormant;

  Inc(frAddInsCount);

end;

procedure frUnRegisterObject(ClassRef: TClass);

var

  i, j: Integer;

begin

  for i := 0 to frAddInsCount - 1 do

    if frAddIns[i].ClassRef = ClassRef then

    begin

      for j := i to frAddInsCount - 2 do

        frAddIns[j] := frAddIns[j + 1];

      Dec(frAddInsCount);

    end;

end;

procedure frRegisterExportFilter(Filter: TfrExportFilter;

  const FilterDesc, FilterExt: string);

var

  i: Integer;

begin

  for i := 0 to frFiltersCount - 1 do

    if frFilters[i].Filter.ClassName = Filter.ClassName then
      Exit;

  frFilters[frFiltersCount].Filter := Filter;

  frFilters[frFiltersCount].FilterDesc := FilterDesc;

  frFilters[frFiltersCount].FilterExt := FilterExt;

  Inc(frFiltersCount);

end;

procedure frUnRegisterExportFilter(Filter: TfrExportFilter);

var

  i, j: Integer;

begin

  for i := 0 to frFiltersCount - 1 do

    if frFilters[i].Filter.ClassName = Filter.ClassName then

    begin

      for j := i to frFiltersCount - 2 do

        frFilters[j] := frFilters[j + 1];

      Dec(frFiltersCount);

    end;

end;

procedure frRegisterFunctionLibrary(ClassRef: TClass);

var

  i: Integer;

begin

  for i := 0 to frFunctionsCount - 1 do

    if frFunctions[i].FunctionLibrary.ClassName = ClassRef.ClassName then
      Exit;

  frFunctions[frFunctionsCount].FunctionLibrary :=

  TfrFunctionLibrary(ClassRef.NewInstance);

  frFunctions[frFunctionsCount].FunctionLibrary.Create;

  Inc(frFunctionsCount);

end;

procedure frUnRegisterFunctionLibrary(ClassRef: TClass);

var

  i, j: Integer;

begin

  for i := 0 to frFunctionsCount - 1 do

    if frFunctions[i].FunctionLibrary.ClassName = ClassRef.ClassName then

    begin

      frInstalledFunctions.UnRegisterFunctionLibrary(frFunctions[i].FunctionLibrary);

      frFunctions[i].FunctionLibrary.Free;

      for j := i to frFunctionsCount - 2 do

        frFunctions[j] := frFunctions[j + 1];

      Dec(frFunctionsCount);

    end;

end;

procedure frRegisterTool(MenuCaption: string; ButtonBmp: TBitmap; OnClick:
  TNotifyEvent);

var

  i: Integer;

  Exist: Boolean;

begin

  Exist := False;

  for i := 0 to frToolsCount - 1 do

    if frTools[i].Caption = MenuCaption then

    begin

      Exist := True;

      break;

    end;

  if not Exist then

    i := frToolsCount;

  frTools[i].Caption := MenuCaption;

  frTools[i].ButtonBmp := ButtonBmp;

  frTools[i].OnClick := OnClick;

  if ButtonBmp <> nil then

    ButtonBmp.Dormant;

  if not Exist then

    Inc(frToolsCount);

end;

procedure frAddFunctionDesc(FuncLibrary: TfrFunctionLibrary;

  FuncName, Category, Description: string);

begin

  frInstalledFunctions.Add(FuncLibrary, FuncName, Category, Description);

end;

function Create90Font(Font: TFont): HFont;

var

  F: TLogFont;

begin

  GetObject(Font.Handle, SizeOf(TLogFont), @F);

  F.lfEscapement := 900;

  F.lfOrientation := 900;

  Result := CreateFontIndirect(F);

end;

function GetDefaultDataSet: TfrTDataSet;

var

  Res: TfrDataset;

begin

  Result := nil;
  Res := CurReport.Dataset;

  if (CurBand <> nil) and (CurPage <> nil) and (CurPage.PageType = ptReport)
    then

    case CurBand.Typ of

      btReportTitle, btReportSummary,

      btPageHeader, btPageFooter,

      btMasterHeader, btMasterData, btMasterFooter,

      btGroupHeader, btGroupFooter:

        Res := CurPage.Bands[btMasterData].DataSet;

      btDetailData, btDetailFooter:

        Res := CurPage.Bands[btDetailData].DataSet;

      btSubDetailData, btSubDetailFooter:

        Res := CurPage.Bands[btSubDetailData].DataSet;

      btCrossData, btCrossFooter:

        Res := CurPage.Bands[btCrossData].DataSet;

    end;

  if (Res <> nil) and (Res is TfrDBDataset) then

    Result := TfrDBDataSet(Res).GetDataSet;

end;

function ReadString(Stream: TStream): string;

begin

  if frVersion >= 23 then

    Result := frReadString(Stream)
  else

    Result := frReadString22(Stream);

end;

procedure ReadMemo(Stream: TStream; Memo: TStrings);

begin

  if frVersion >= 23 then

    frReadMemo(Stream, Memo)
  else

    frReadMemo22(Stream, Memo);

end;

procedure CreateDS(Desc: string; var DataSet: TfrDataSet; var IsVirtualDS:
  Boolean);

begin

  if (Desc <> '') and (Desc[1] in ['1'..'9']) then

  begin

    DataSet := TfrUserDataSet.Create(nil);

    DataSet.RangeEnd := reCount;

    DataSet.RangeEndCount := StrToInt(Desc);