PageRenderTime 89ms CodeModel.GetById 27ms app.highlight 33ms RepoModel.GetById 1ms app.codeStats 2ms

/Source/FR_Class.pas

http://github.com/FastReports/FreeReport
Pascal | 7335 lines | 6646 code | 487 blank | 202 comment | 865 complexity | 52e74cfa96e31edbea7bd9f745adfb88 MD5 | raw file
   1
   2{*****************************************}
   3{                                         }
   4{             FastReport v2.3             }
   5{             Report classes              }
   6{                                         }
   7{  Copyright (c) 1998-99 by Tzyganenko A. }
   8{                                         }
   9{*****************************************}
  10
  11unit FR_Class;
  12
  13interface
  14
  15{$I FR.inc}
  16
  17uses
  18  SysUtils, Windows, Messages, Classes, Graphics, Printers, Controls,
  19  Forms, StdCtrls, ComCtrls, Dialogs, Menus, Buttons,
  20  FR_View, FR_Pars, FR_Intrp, FR_DSet, FR_DBSet, FR_DBRel
  21{$IFDEF Delphi6}
  22  , Variants
  23{$ENDIF}
  24{$IFDEF IBO}
  25 , IB_Components
  26{$ELSE}
  27 , DB
  28{$ENDIF};
  29
  30
  31const
  32// object flags
  33  flStretched = 1;
  34  flWordWrap = 2;
  35  flWordBreak = 4;
  36  flAutoSize = 8;
  37  flBandNewPageAfter = 2;
  38  flBandPrintifSubsetEmpty = 4;
  39  flBandPageBreak = 8;
  40  flBandOnFirstPage = $10;
  41  flBandOnLastPage = $20;
  42  flBandRepeatHeader = $40;
  43  flPictCenter = 2;
  44  flPictRatio = 4;
  45  flWantHook = $8000;
  46
  47// object types
  48  gtMemo = 0;
  49  gtPicture = 1;
  50  gtBand = 2;
  51  gtSubReport = 3;
  52  gtLine = 4;
  53  gtAddIn = 10;
  54
  55// frame types
  56  frftNone = 0;
  57  frftRight = 1;
  58  frftDown = 2;
  59  frftLeft = 4;
  60  frftUp = 8;
  61
  62// text align
  63  frtaLeft = 0;
  64  frtaRight = 1;
  65  frtaCenter = 2;
  66  frtaVertical = 4;
  67  frtaMiddle = 8;
  68  frtaDown = 16;
  69
  70type
  71  TfrDrawMode = (drAll, drCalcHeight, drAfterCalcHeight, drPart);
  72  TfrBandType = (btReportTitle, btReportSummary,
  73                 btPageHeader, btPageFooter,
  74                 btMasterHeader, btMasterData, btMasterFooter,
  75                 btDetailHeader, btDetailData, btDetailFooter,
  76                 btSubDetailHeader, btSubDetailData, btSubDetailFooter,
  77                 btOverlay, btColumnHeader, btColumnFooter,
  78                 btGroupHeader, btGroupFooter,
  79                 btCrossHeader, btCrossData, btCrossFooter, btNone);
  80  TfrDataSetPosition = (psLocal, psGlobal);
  81  TfrValueType = (vtNotAssigned, vtDBField, vtOther, vtFRVar);
  82  TfrPageMode = (pmNormal, pmBuildList);
  83  TfrBandRecType = (rtShowBand, rtFirst, rtNext);
  84  TfrRgnType = (rtNormal, rtExtended);
  85  TfrReportType = (rtSimple, rtMultiple);
  86
  87  TfrView = class;
  88  TfrBand = class;
  89  TfrPage = class;
  90  TfrReport = class;
  91  TfrExportFilter = class;
  92
  93  TDetailEvent = procedure(const ParName: String; var ParValue: Variant) of object;
  94  TEnterRectEvent = procedure(Memo: TStringList; View: TfrView) of object;
  95  TBeginDocEvent = procedure of object;
  96  TEndDocEvent = procedure of object;
  97  TBeginPageEvent = procedure(pgNo: Integer) of object;
  98  TEndPageEvent = procedure(pgNo: Integer) of object;
  99  TBeginBandEvent = procedure(Band: TfrBand) of object;
 100  TEndBandEvent = procedure(Band: TfrBand) of object;
 101  TProgressEvent = procedure(n: Integer) of object;
 102  TBeginColumnEvent = procedure(Band: TfrBand) of object;
 103  TPrintColumnEvent = procedure(ColNo: Integer; var Width: Integer) of object;
 104  TManualBuildEvent = procedure(Page: TfrPage) of object;
 105
 106  TfrHighlightAttr = packed record
 107    FontStyle: Word;
 108    FontColor, FillColor: TColor;
 109  end;
 110
 111  TfrPrnInfo = record // print info about page size, margins e.t.c
 112    PPgw, PPgh, Pgw, Pgh: Integer; // page width/height (printer/screen)
 113    POfx, POfy, Ofx, Ofy: Integer; // offset x/y
 114    PPw, PPh, Pw, Ph: Integer;     // printable width/height
 115  end;
 116
 117  PfrPageInfo = ^TfrPageInfo;
 118  TfrPageInfo = packed record // pages of a preview
 119    R: TRect;
 120    pgSize: Word;
 121    pgWidth, pgHeight: Integer;
 122    pgOr: TPrinterOrientation;
 123    pgMargins: Boolean;
 124    PrnInfo: TfrPrnInfo;
 125    Visible: Boolean;
 126    Stream: TMemoryStream;
 127    Page: TfrPage;
 128  end;
 129
 130  PfrBandRec = ^TfrBandRec;
 131  TfrBandRec = packed record
 132    Band: TfrBand;
 133    Action: TfrBandRecType;
 134  end;
 135
 136  TfrView = class(TObject)
 137  private
 138    procedure P1Click(Sender: TObject);
 139  protected
 140    SaveX, SaveY, SaveDX, SaveDY: Integer;
 141    SaveFW: Single;
 142    BaseName: String;
 143    Canvas: TCanvas;
 144    DRect: TRect;
 145    gapx, gapy: Integer;
 146    Memo1: TStringList;
 147    FDataSet: TfrTDataSet;
 148    FField: String;
 149    olddy: Integer;
 150    StreamMode: (smDesigning, smPrinting);
 151    procedure ShowBackGround; virtual;
 152    procedure ShowFrame; virtual;
 153    procedure BeginDraw(ACanvas: TCanvas);
 154    procedure GetBlob(b: TfrTField); virtual;
 155    procedure OnHook(View: TfrView); virtual;
 156  public
 157    Parent: TfrBand;
 158    Name: String;
 159    ID: Integer;
 160    Typ: Byte;
 161    Selected: Boolean;
 162    OriginalRect: TRect;
 163    ScaleX, ScaleY: Double;   // used for scaling objects in preview
 164    OffsX, OffsY: Integer;    //
 165    IsPrinting: Boolean;
 166    x, y, dx, dy: Integer;
 167    Flags: Word;
 168    FrameTyp: Word;
 169    FrameWidth: Single;
 170    FrameColor: TColor;
 171    FrameStyle: Word;
 172    FillColor: TColor;
 173    Format: Integer;
 174    FormatStr: String;
 175    Visible: WordBool;
 176    Memo, Script: TStringList;
 177    constructor Create; virtual;
 178    destructor Destroy; override;
 179    procedure Assign(From: TfrView); virtual;
 180    procedure CalcGaps; virtual;
 181    procedure RestoreCoord; virtual;
 182    procedure Draw(Canvas: TCanvas); virtual; abstract;
 183    procedure Print(Stream: TStream); virtual;
 184    procedure ExportData; virtual;
 185    procedure LoadFromStream(Stream: TStream); virtual;
 186    procedure SaveToStream(Stream: TStream); virtual;
 187    procedure SaveToFR3Stream(Stream: TStream); virtual;
 188    procedure Resized; virtual;
 189    procedure DefinePopupMenu(Popup: TPopupMenu); virtual;
 190    function GetClipRgn(rt: TfrRgnType): HRGN; virtual;
 191    procedure CreateUniqueName;
 192    procedure SetBounds(Left, Top, Width, Height: Integer);
 193  end;
 194
 195  TfrStretcheable = class(TfrView)
 196  protected
 197    ActualHeight: Integer;
 198    DrawMode: TfrDrawMode;
 199    function CalcHeight: Integer; virtual; abstract;
 200    function MinHeight: Integer; virtual; abstract;
 201    function RemainHeight: Integer; virtual; abstract;
 202  end;
 203
 204  TfrMemoView = class(TfrStretcheable)
 205  private
 206    FFont: TFont;
 207    procedure P1Click(Sender: TObject);
 208    procedure P2Click(Sender: TObject);
 209    procedure P3Click(Sender: TObject);
 210    procedure P4Click(Sender: TObject);
 211    procedure P5Click(Sender: TObject);
 212    procedure SetFont(Value: TFont);
 213  protected
 214    Streaming: Boolean;
 215    TextHeight: Integer;
 216    CurStrNo: Integer;
 217    Exporting: Boolean;
 218    procedure ExpandVariables;
 219    procedure AssignFont(Canvas: TCanvas);
 220    procedure WrapMemo;
 221    procedure ShowMemo;
 222    function CalcWidth(Memo: TStringList): Integer;
 223    function CalcHeight: Integer; override;
 224    function MinHeight: Integer; override;
 225    function RemainHeight: Integer; override;
 226    procedure GetBlob(b: TfrTField); override;
 227  public
 228    Adjust: Integer;
 229    Highlight: TfrHighlightAttr;
 230    HighlightStr: String;
 231    LineSpacing, CharacterSpacing: Integer;
 232    constructor Create; override;
 233    destructor Destroy; override;
 234    procedure Assign(From: TfrView); override;
 235    procedure Draw(Canvas: TCanvas); override;
 236    procedure Print(Stream: TStream); override;
 237    procedure ExportData; override;
 238    procedure LoadFromStream(Stream: TStream); override;
 239    procedure SaveToStream(Stream: TStream); override;
 240    procedure SaveToFR3Stream(Stream: TStream); override;
 241    procedure DefinePopupMenu(Popup: TPopupMenu); override;
 242    property Font: TFont read FFont write SetFont;
 243  end;
 244
 245  TfrBandView = class(TfrView)
 246  private
 247    procedure P1Click(Sender: TObject);
 248    procedure P2Click(Sender: TObject);
 249    procedure P3Click(Sender: TObject);
 250    procedure P4Click(Sender: TObject);
 251    procedure P5Click(Sender: TObject);
 252    procedure P6Click(Sender: TObject);
 253    function GetBandType: TfrBandType;
 254    procedure SetBandType(const Value: TfrBandType);
 255  public
 256    constructor Create; override;
 257    procedure Draw(Canvas: TCanvas); override;
 258    procedure DefinePopupMenu(Popup: TPopupMenu); override;
 259    function GetClipRgn(rt: TfrRgnType): HRGN; override;
 260    procedure SaveToFR3Stream(Stream: TStream); override;
 261    property BandType: TfrBandType read GetBandType write SetBandType;
 262    property DataSet: String read FormatStr write FormatStr;
 263    property GroupCondition: String read FormatStr write FormatStr;
 264  end;
 265
 266  TfrSubReportView = class(TfrView)
 267  public
 268    SubPage: Integer;
 269    constructor Create; override;
 270    procedure Assign(From: TfrView); override;
 271    procedure Draw(Canvas: TCanvas); override;
 272    procedure LoadFromStream(Stream: TStream); override;
 273    procedure SaveToStream(Stream: TStream); override;
 274    procedure SaveToFR3Stream(Stream: TStream); override;
 275    procedure DefinePopupMenu(Popup: TPopupMenu); override;
 276  end;
 277
 278  TfrPictureView = class(TfrView)
 279  private
 280    procedure P1Click(Sender: TObject);
 281    procedure P2Click(Sender: TObject);
 282  protected
 283    procedure GetBlob(b: TfrTField); override;
 284  public
 285    Picture: TPicture;
 286    constructor Create; override;
 287    destructor Destroy; override;
 288    procedure Assign(From: TfrView); override;
 289    procedure Draw(Canvas: TCanvas); override;
 290    procedure LoadFromStream(Stream: TStream); override;
 291    procedure SaveToStream(Stream: TStream); override;
 292    procedure SaveToFR3Stream(Stream: TStream); override;
 293    procedure DefinePopupMenu(Popup: TPopupMenu); override;
 294  end;
 295
 296  TfrLineView = class(TfrView)
 297  public
 298    constructor Create; override;
 299    procedure Draw(Canvas: TCanvas); override;
 300    procedure DefinePopupMenu(Popup: TPopupMenu); override;
 301    function GetClipRgn(rt: TfrRgnType): HRGN; override;
 302    procedure SaveToFR3Stream(Stream: TStream); override;
 303  end;
 304
 305  TfrBand = class(TObject)
 306  private
 307    Parent: TfrPage;
 308    View: TfrView;
 309    Flags: Word;
 310    Next, Prev: TfrBand;
 311    SubIndex, MaxY: Integer;
 312    EOFReached: Boolean;
 313    EOFArr: Array[0..31] of Boolean;
 314    Positions: Array[TfrDatasetPosition] of Integer;
 315    LastGroupValue: Variant;
 316    HeaderBand, FooterBand, LastBand: TfrBand;
 317    Values: TStringList;
 318    Count: Integer;
 319    DisableInit: Boolean;
 320    CalculatedHeight: Integer;
 321    procedure InitDataSet(Desc: String);
 322    procedure DoError;
 323    function CalcHeight: Integer;
 324    procedure StretchObjects(MaxHeight: Integer);
 325    procedure UnStretchObjects;
 326    procedure DrawObject(t: TfrView);
 327    procedure PrepareSubReports;
 328    procedure DoSubReports;
 329    function DrawObjects: Boolean;
 330    procedure DrawCrossCell(Parnt: TfrBand; CurX: Integer);
 331    procedure DrawCross;
 332    function CheckPageBreak(y, dy: Integer; PBreak: Boolean): Boolean;
 333    procedure DrawPageBreak;
 334    function HasCross: Boolean;
 335    function DoCalcHeight: Integer;
 336    procedure DoDraw;
 337    function Draw: Boolean;
 338    procedure InitValues;
 339    procedure DoAggregate;
 340  public
 341    x, y, dx, dy, maxdy: Integer;
 342    Typ: TfrBandType;
 343    PrintIfSubsetEmpty, NewPageAfter, Stretched, PageBreak, Visible: Boolean;
 344    Objects: TList;
 345    Memo, Script: TStringList;
 346    DataSet: TfrDataSet;
 347    IsVirtualDS: Boolean;
 348    VCDataSet: TfrDataSet;
 349    IsVirtualVCDS: Boolean;
 350    GroupCondition: String;
 351    ForceNewPage, ForceNewColumn: Boolean;
 352    constructor Create(ATyp: TfrBandType; AParent: TfrPage);
 353    destructor Destroy; override;
 354  end;
 355
 356  TfrValue = class
 357  public
 358    Typ: TfrValueType;
 359    OtherKind: Integer;   // for vtOther - typ, for vtDBField - format
 360    DataSet: String;      // for vtDBField
 361    Field: String;        // here is an expression for vtOther
 362    DSet: TfrTDataSet;
 363  end;
 364
 365  TfrValues = class(TPersistent)
 366  private
 367    FItems: TStringList;
 368    function GetValue(Index: Integer): TfrValue;
 369  public
 370    constructor Create; virtual;
 371    destructor Destroy; override;
 372    function AddValue: Integer;
 373    function FindVariable(const s: String): TfrValue;
 374    procedure ReadBinaryData(Stream: TStream);
 375    procedure WriteBinaryData(Stream: TStream);
 376    procedure Clear;
 377    property Items: TStringList read FItems write FItems;
 378    property Objects[Index: Integer]: TfrValue read GetValue;
 379  end;
 380
 381  TfrPage = class(TObject)
 382  private
 383    Bands: Array[TfrBandType] of TfrBand;
 384    Skip, InitFlag: Boolean;
 385    CurColumn, LastStaticColumnY, XAdjust: Integer;
 386    List: TList;
 387    Mode: TfrPageMode;
 388    PlayFrom: Integer;
 389    LastBand: TfrBand;
 390    ColPos, CurPos: Integer;
 391    procedure InitReport;
 392    procedure DoneReport;
 393    procedure TossObjects;
 394    procedure PrepareObjects;
 395    procedure FormPage;
 396    procedure DoAggregate(a: Array of TfrBandType);
 397    procedure AddRecord(b: TfrBand; rt: TfrBandRecType);
 398    procedure ClearRecList;
 399    function PlayRecList: Boolean;
 400    procedure DrawPageFooters;
 401    function BandExists(b: TfrBand): Boolean;
 402    procedure AfterPrint;
 403    procedure LoadFromStream(Stream: TStream);
 404    procedure SaveToStream(Stream: TStream);
 405    procedure ShowBand(b: TfrBand);
 406  public
 407    pgSize, pgWidth, pgHeight: Integer;
 408    pgMargins: TRect;
 409    pgOr: TPrinterOrientation;
 410    PrintToPrevPage, UseMargins: WordBool;
 411    PrnInfo: TfrPrnInfo;
 412    ColCount, ColWidth, ColGap: Integer;
 413    Objects, RTObjects: TList;
 414    CurY, CurBottomY: Integer;
 415    constructor Create(ASize, AWidth, AHeight: Integer; AOr: TPrinterOrientation);
 416    destructor Destroy; override;
 417    function TopMargin: Integer;
 418    function BottomMargin: Integer;
 419    function LeftMargin: Integer;
 420    function RightMargin: Integer;
 421    procedure Clear;
 422    procedure Delete(Index: Integer);
 423    function FindObjectByID(ID: Integer): Integer;
 424    function FindObject(Name: String): TfrView;
 425    function FindRTObject(Name: String): TfrView;
 426    procedure ChangePaper(ASize, AWidth, AHeight: Integer; AOr: TPrinterOrientation);
 427    procedure ShowBandByName(s: String);
 428    procedure ShowBandByType(bt: TfrBandType);
 429    procedure NewPage;
 430    procedure NewColumn(Band: TfrBand);
 431  end;
 432
 433  TfrPages = class(TObject)
 434  private
 435    FPages: TList;
 436    Parent: TfrReport;
 437    function GetCount: Integer;
 438    function GetPages(Index: Integer): TfrPage;
 439  public
 440    constructor Create(AParent: TfrReport);
 441    destructor Destroy; override;
 442    procedure Clear;
 443    procedure Add;
 444    procedure Delete(Index: Integer);
 445    procedure LoadFromStream(Stream: TStream);
 446    procedure SaveToStream(Stream: TStream);
 447    property Pages[Index: Integer]: TfrPage read GetPages; default;
 448    property Count: Integer read GetCount;
 449  end;
 450
 451  TfrEMFPages = class(TObject)
 452  private
 453    FPages: TList;
 454    Parent: TfrReport;
 455    function GetCount: Integer;
 456    function GetPages(Index: Integer): PfrPageInfo;
 457    procedure ExportData(Index: Integer);
 458    procedure PageToObjects(Index: Integer);
 459    procedure ObjectsToPage(Index: Integer);
 460  public
 461    constructor Create(AParent: TfrReport);
 462    destructor Destroy; override;
 463    procedure Clear;
 464    procedure Draw(Index: Integer; Canvas: TCanvas; DrawRect: TRect);
 465    procedure Add(APage: TfrPage);
 466    procedure Insert(Index: Integer; APage: TfrPage);
 467    procedure Delete(Index: Integer);
 468    procedure LoadFromStream(AStream: TStream);
 469    procedure SaveToStream(AStream: TStream);
 470    property Pages[Index: Integer]: PfrPageInfo read GetPages; default;
 471    property Count: Integer read GetCount;
 472  end;
 473
 474  TfrReport = class(TComponent)
 475  private
 476    FPages: TfrPages;
 477    FEMFPages: TfrEMFPages;
 478    FVars: TStrings;
 479    FVal: TfrValues;
 480    FDataset: TfrDataset;
 481    FGrayedButtons: Boolean;
 482    FReportType: TfrReportType;
 483    FTitle: String;
 484    FShowProgress: Boolean;
 485    FModalPreview: Boolean;
 486    FModifyPrepared: Boolean;
 487    FStoreInDFM: Boolean;
 488    FPreview: TfrPreview;
 489    FPreviewButtons: TfrPreviewButtons;
 490    FInitialZoom: TfrPreviewZoom;
 491    FOnBeginDoc: TBeginDocEvent;
 492    FOnEndDoc: TEndDocEvent;
 493    FOnBeginPage: TBeginPageEvent;
 494    FOnEndPage: TEndPageEvent;
 495    FOnBeginBand: TBeginBandEvent;
 496    FOnEndBand: TEndBandEvent;
 497    FOnGetValue: TDetailEvent;
 498    FOnEnterRect: TEnterRectEvent;
 499    FOnProgress: TProgressEvent;
 500    FOnFunction: TFunctionEvent;
 501    FOnBeginColumn: TBeginColumnEvent;
 502    FOnPrintColumn: TPrintColumnEvent;
 503    FOnManualBuild: TManualBuildEvent;
 504    FCurrentFilter: TfrExportFilter;
 505    FPageNumbers: String;
 506    FCopies: Integer;
 507    FCurPage: TfrPage;
 508    function FormatValue(V: Variant; Format: Integer;
 509      const FormatStr: String): String;
 510    procedure OnGetParsFunction(const name: String; p1, p2, p3: Variant;
 511                                var val: String);
 512    procedure PrepareDataSets;
 513    procedure BuildBeforeModal(Sender: TObject);
 514    procedure ExportBeforeModal(Sender: TObject);
 515    procedure PrintBeforeModal(Sender: TObject);
 516    function DoPrepareReport: Boolean;
 517    procedure DoBuildReport; virtual;
 518    procedure DoPrintReport(PageNumbers: String; Copies: Integer);
 519    procedure SetPrinterTo(PrnName: String);
 520    procedure SetVars(Value: TStrings);
 521  protected
 522    procedure DefineProperties(Filer: TFiler); override;
 523    procedure ReadBinaryData(Stream: TStream);
 524    procedure WriteBinaryData(Stream: TStream);
 525    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 526  public
 527    CanRebuild: Boolean;            // true, if report can be rebuilded
 528    Terminated: Boolean;
 529    PrintToDefault, DoublePass: WordBool;
 530    FinalPass: Boolean;
 531    FileName: String;
 532    FR3Stream: Boolean;
 533    constructor Create(AOwner: TComponent); override;
 534    destructor Destroy; override;
 535    // service methods
 536    function FindVariable(Variable: String): Integer;
 537    procedure GetVariableValue(const s: String; var v: Variant);
 538    procedure GetVarList(CatNo: Integer; List: TStrings);
 539    procedure GetCategoryList(List: TStrings);
 540    function FindObject(Name: String): TfrView;
 541    // internal events used through report building
 542    procedure InternalOnEnterRect(Memo: TStringList; View: TfrView);
 543    procedure InternalOnExportData(View: TfrView);
 544    procedure InternalOnExportText(x, y: Integer; const text: String; View: TfrView);
 545    procedure InternalOnGetValue(ParName: String; var ParValue: String);
 546    procedure InternalOnProgress(Percent: Integer);
 547    procedure InternalOnBeginColumn(Band: TfrBand);
 548    procedure InternalOnPrintColumn(ColNo: Integer; var ColWidth: Integer);
 549    procedure FillQueryParams;
 550    // load/save methods
 551    procedure LoadFromStream(Stream: TStream);
 552    procedure SaveToStream(Stream: TStream);
 553    procedure LoadFromFile(FName: String);
 554    procedure SaveToFile(FName: String);
 555    procedure SaveToFR3File(FName: String);
 556{$IFDEF IBO}
 557    procedure LoadFromDB(Table: TIB_DataSet; DocN: Integer);
 558    procedure SaveToDB(Table: TIB_DataSet; DocN: Integer);
 559{$ELSE}
 560    procedure LoadFromDB(Table: TDataSet; DocN: Integer);
 561    procedure SaveToDB(Table: TDataSet; DocN: Integer);
 562{$ENDIF}
 563    procedure LoadTemplate(fname: String; comm: TStrings;
 564      Bmp: TBitmap; Load: Boolean);
 565    procedure SaveTemplate(fname: String; comm: TStrings; Bmp: TBitmap);
 566    procedure LoadPreparedReport(FName: String);
 567    procedure SavePreparedReport(FName: String);
 568    // report manipulation methods
 569    procedure DesignReport;
 570    function PrepareReport: Boolean;
 571    procedure ExportTo(Filter: TClass; FileName: String);
 572    procedure ShowReport;
 573    procedure ShowPreparedReport;
 574    procedure PrintPreparedReport(PageNumbers: String; Copies: Integer);
 575    function ChangePrinter(OldIndex, NewIndex: Integer): Boolean;
 576    procedure EditPreparedReport(PageIndex: Integer);
 577    //
 578    property Pages: TfrPages read FPages;
 579    property EMFPages: TfrEMFPages read FEMFPages write FEMFPages;
 580    property Variables: TStrings read FVars write SetVars;
 581    property Values: TfrValues read FVal write FVal;
 582  published
 583    property Dataset: TfrDataset read FDataset write FDataset;
 584    property GrayedButtons: Boolean read FGrayedButtons write FGrayedButtons default False;
 585    property InitialZoom: TfrPreviewZoom read FInitialZoom write FInitialZoom;
 586    property ModalPreview: Boolean read FModalPreview write FModalPreview default True;
 587    property ModifyPrepared: Boolean read FModifyPrepared write FModifyPrepared default True;
 588    property Preview: TfrPreview read FPreview write FPreview;
 589    property PreviewButtons: TfrPreviewButtons read FPreviewButtons write FPreviewButtons;
 590    property ReportType: TfrReportType read FReportType write FReportType default rtSimple;
 591    property ShowProgress: Boolean read FShowProgress write FShowProgress default True;
 592    property StoreInDFM: Boolean read FStoreInDFM write FStoreInDFM default False;
 593    property Title: String read FTitle write FTitle;
 594    property OnBeginDoc: TBeginDocEvent read FOnBeginDoc write FOnBeginDoc;
 595    property OnEndDoc: TEndDocEvent read FOnEndDoc write FOnEndDoc;
 596    property OnBeginPage: TBeginPageEvent read FOnBeginPage write FOnBeginPage;
 597    property OnEndPage: TEndPageEvent read FOnEndPage write FOnEndPage;
 598    property OnBeginBand: TBeginBandEvent read FOnBeginBand write FOnBeginBand;
 599    property OnEndBand: TEndBandEvent read FOnEndBand write FOnEndBand;
 600    property OnGetValue: TDetailEvent read FOnGetValue write FOnGetValue;
 601    property OnEnterRect: TEnterRectEvent read FOnEnterRect write FOnEnterRect;
 602    property OnUserFunction: TFunctionEvent read FOnFunction write FOnFunction;
 603    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
 604    property OnBeginColumn: TBeginColumnEvent read FOnBeginColumn write FOnBeginColumn;
 605    property OnPrintColumn: TPrintColumnEvent read FOnPrintColumn write FOnPrintColumn;
 606    property OnManualBuild: TManualBuildEvent read FOnManualBuild write FOnManualBuild;
 607  end;
 608
 609  TfrCompositeReport = class(TfrReport)
 610  private
 611    procedure DoBuildReport; override;
 612  public
 613    Reports: TList;
 614    constructor Create(AOwner: TComponent); override;
 615    destructor Destroy; override;
 616  end;
 617
 618  TfrReportDesigner = class(TForm)
 619  public
 620    Page: TfrPage;
 621    Modified: Boolean;
 622    procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: String;
 623      ButtonTag: Integer); virtual; abstract;
 624    procedure RegisterTool(MenuCaption: String; ButtonBmp: TBitmap;
 625      OnClick: TNotifyEvent); virtual; abstract;
 626    procedure BeforeChange; virtual; abstract;
 627    procedure AfterChange; virtual; abstract;
 628    procedure RedrawPage; virtual; abstract;
 629  end;
 630
 631  TfrDataManager = class(TObject)
 632  public
 633    procedure LoadFromStream(Stream: TStream); virtual; abstract;
 634    procedure SaveToStream(Stream: TStream); virtual; abstract;
 635    procedure BeforePreparing; virtual; abstract;
 636    procedure AfterPreparing; virtual; abstract;
 637    procedure PrepareDataSet(ds: TfrTDataSet); virtual; abstract;
 638    function ShowParamsDialog: Boolean; virtual; abstract;
 639    procedure AfterParamsDialog; virtual; abstract;
 640  end;
 641
 642  TfrObjEditorForm = class(TForm)
 643  public
 644    procedure ShowEditor(t: TfrView); virtual;
 645  end;
 646
 647  TfrExportFilter = class(TObject)
 648  protected
 649    Stream: TStream;
 650    Lines: TList;
 651    procedure ClearLines;
 652  public
 653    constructor Create(AStream: TStream); virtual;
 654    destructor Destroy; override;
 655    procedure OnBeginDoc; virtual;
 656    procedure OnEndDoc; virtual;
 657    procedure OnBeginPage; virtual;
 658    procedure OnEndPage; virtual;
 659    procedure OnData(x, y: Integer; View: TfrView); virtual;
 660    procedure OnText(x, y: Integer; const text: String; View: TfrView); virtual;
 661  end;
 662
 663  TfrFunctionLibrary = class(TObject)
 664  public
 665    List: TStringList;
 666    constructor Create; virtual;
 667    destructor Destroy; override;
 668    function OnFunction(const FName: String; p1, p2, p3: Variant;
 669      var val: String): Boolean;
 670    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: String);
 671      virtual; abstract;
 672  end;
 673
 674  TfrCompressor = class(TObject)
 675  public
 676    Enabled: Boolean;
 677    procedure Compress(StreamIn, StreamOut: TStream); virtual;
 678    procedure DeCompress(StreamIn, StreamOut: TStream); virtual;
 679  end;
 680
 681
 682function frCreateObject(Typ: Byte; const ClassName: String): TfrView;
 683procedure frRegisterObject(ClassRef: TClass; ButtonBmp: TBitmap;
 684  const ButtonHint: String; EditorForm: TfrObjEditorForm);
 685procedure frRegisterExportFilter(ClassRef: TClass;
 686  const FilterDesc, FilterExt: String);
 687procedure frRegisterFunctionLibrary(ClassRef: TClass);
 688procedure frRegisterTool(MenuCaption: String; ButtonBmp: TBitmap; OnClick: TNotifyEvent);
 689function GetDefaultDataSet: TfrTDataSet;
 690
 691
 692const
 693  frCurrentVersion = 23; // this is current version (2.3)
 694  frSpecCount = 9;
 695  frSpecFuncs: Array[0..frSpecCount - 1] of String = ('PAGE#', '',
 696    'DATE', 'TIME', 'LINE#', 'LINETHROUGH#', 'COLUMN#', 'CURRENT#', 'TOTALPAGES');
 697  frColors: Array[0..15] of TColor =
 698    (clWhite, clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal,
 699     clGray, clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua);
 700
 701type
 702  PfrTextRec = ^TfrTextRec;
 703  TfrTextRec = record
 704    Next: PfrTextRec;
 705    X: Integer;
 706    Text: String[255];
 707    FontName: String[32];
 708    FontSize, FontStyle, FontColor, FontCharset, FillColor: Integer;
 709  end;
 710
 711  TfrAddInObjectInfo = record
 712    ClassRef: TClass;
 713    EditorForm: TfrObjEditorForm;
 714    ButtonBmp: TBitmap;
 715    ButtonHint: String;
 716  end;
 717
 718  TfrExportFilterInfo = record
 719    ClassRef: TClass;
 720    FilterDesc, FilterExt: String;
 721  end;
 722
 723  TfrFunctionInfo = record
 724    FunctionLibrary: TfrFunctionLibrary;
 725  end;
 726
 727  TfrToolsInfo = record
 728    Caption: String;
 729    ButtonBmp: TBitmap;
 730    OnClick: TNotifyEvent;
 731  end;
 732
 733var
 734  frDesigner: TfrReportDesigner;                  // designer reference
 735  frDataManager: TfrDataManager;                  // data manager reference
 736  frParser: TfrParser;                            // parser reference
 737  frInterpretator: TfrInterpretator;              // interpretator reference
 738  frVariables: TfrVariables;                      // report variables reference
 739  frCompressor: TfrCompressor;                    // compressor reference
 740  CurReport: TfrReport;                           // currently proceeded report
 741  MasterReport: TfrReport;               // reference to main composite report
 742  CurView: TfrView;                               // currently proceeded view
 743  CurBand: TfrBand;                               // currently proceeded band
 744  CurPage: TfrPage;                               // currently proceeded page
 745  DocMode: (dmDesigning, dmPrinting);             // current mode
 746  DisableDrawing: Boolean;
 747  frAddIns: Array[0..31] of TfrAddInObjectInfo;   // add-in objects
 748  frAddInsCount: Integer;
 749  frFilters: Array[0..31] of TfrExportFilterInfo; // export filters
 750  frFiltersCount: Integer;
 751  frFunctions: Array[0..31] of TfrFunctionInfo;   // function libraries
 752  frFunctionsCount: Integer;
 753  frTools: Array[0..31] of TfrToolsInfo;          // tools
 754  frToolsCount: Integer;
 755  PageNo: Integer;                       // current page number in Building mode
 756  frCharset: 0..255;
 757  frBandNames: Array[0..21] of String;
 758  frSpecArr: Array[0..frSpecCount - 1] of String;
 759  frDateFormats, frTimeFormats: Array[0..3] of String;
 760  frVersion: Byte;                       // version of currently loaded report
 761  SMemo: TStringList;          // temporary memo used during TfrView drawing
 762  ShowBandTitles: Boolean = True;
 763(*
 764  FRE_COMPATIBLEREAD variable added for migrating from older versions 
 765  of FreeReport and will be removed in next releases as soon as possible.
 766*)
 767{$IFDEF FREEREP2217READ}
 768  FRE_COMPATIBLE_READ: Boolean = False;
 769{$ENDIF}
 770
 771implementation
 772
 773uses
 774  FR_Fmted, FR_Prntr, FR_Progr, FR_Utils, FR_Const
 775  {$IFDEF JPEG}, JPEG {$ENDIF};
 776
 777{$R FR_Lng1.RES}
 778
 779type
 780  TfrStdFunctionLibrary = class(TfrFunctionLibrary)
 781  public
 782    constructor Create; override;
 783    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: String); override;
 784  end;
 785
 786  TInterpretator = class(TfrInterpretator)
 787  public
 788    procedure GetValue(const Name: String; var Value: Variant); override;
 789    procedure SetValue(const Name: String; Value: Variant); override;
 790    procedure DoFunction(const name: String; p1, p2, p3: Variant;
 791                         var val: String); override;
 792  end;
 793
 794
 795var
 796  VHeight: Integer;            // used for height calculation of TfrMemoView
 797  SBmp: TBitmap;               // small bitmap used by TfrBandView drawing
 798  TempBmp: TBitmap;            // temporary bitmap used by TfrMemoView
 799  CurDate, CurTime: TDateTime; // date/time of report starting
 800  CurValue: Variant;           // used for highlighting
 801  AggrBand: TfrBand;           // used for aggregate functions
 802  CurVariable: String;
 803  IsColumns: Boolean;
 804  SavedAllPages: Integer;      // number of pages in entire report
 805  ErrorFlag: Boolean;          // error occured through TfrView drawing
 806  ErrorStr: String;            // error description
 807  SubValue: String;            // used in GetValue event handler
 808  ObjID: Integer = 0;
 809  BoolStr: Array[0..3] of String;
 810  HookList: TList;
 811
 812  // variables used through report building
 813  PrevY, PrevBottomY, ColumnXAdjust: Integer;
 814  Append, WasPF: Boolean;
 815  CompositeMode: Boolean;
 816
 817{----------------------------------------------------------------------------}
 818function frCreateObject(Typ: Byte; const ClassName: String): TfrView;
 819var
 820  i: Integer;
 821begin
 822  Result := nil;
 823  case Typ of
 824    gtMemo:      Result := TfrMemoView.Create;
 825    gtPicture:   Result := TfrPictureView.Create;
 826    gtBand:      Result := TfrBandView.Create;
 827    gtSubReport: Result := TfrSubReportView.Create;
 828    gtLine:      Result := TfrLineView.Create;
 829    gtAddIn:
 830      begin
 831        for i := 0 to frAddInsCount - 1 do
 832          if frAddIns[i].ClassRef.ClassName = ClassName then
 833          begin
 834            Result := TfrView(frAddIns[i].ClassRef.NewInstance);
 835            Result.Create;
 836            Result.Typ := gtAddIn;
 837            break;
 838          end;
 839        if Result = nil then
 840          raise EClassNotFound.Create('�� ������ ����� ' + ClassName);
 841      end;
 842  end;
 843  if Result <> nil then
 844  begin
 845    Result.ID := ObjID;
 846    Inc(ObjID);
 847  end;
 848end;
 849
 850procedure frRegisterObject(ClassRef: TClass; ButtonBmp: TBitmap;
 851  const ButtonHint: String; EditorForm: TfrObjEditorForm);
 852begin
 853  frAddIns[frAddInsCount].ClassRef := ClassRef;
 854  frAddIns[frAddInsCount].EditorForm := EditorForm;
 855  frAddIns[frAddInsCount].ButtonBmp := ButtonBmp;
 856  frAddIns[frAddInsCount].ButtonHint := ButtonHint;
 857  if frDesigner <> nil then
 858    frDesigner.RegisterObject(ButtonBmp, ButtonHint,
 859      Integer(gtAddIn) + frAddInsCount);
 860  Inc(frAddInsCount);
 861end;
 862
 863procedure frRegisterExportFilter(ClassRef: TClass;
 864  const FilterDesc, FilterExt: String);
 865begin
 866  frFilters[frFiltersCount].ClassRef := ClassRef;
 867  frFilters[frFiltersCount].FilterDesc := FilterDesc;
 868  frFilters[frFiltersCount].FilterExt := FilterExt;
 869  Inc(frFiltersCount);
 870end;
 871
 872procedure frRegisterFunctionLibrary(ClassRef: TClass);
 873begin
 874  frFunctions[frFunctionsCount].FunctionLibrary :=
 875    TfrFunctionLibrary(ClassRef.NewInstance);
 876  frFunctions[frFunctionsCount].FunctionLibrary.Create;
 877  Inc(frFunctionsCount);
 878end;
 879
 880procedure frRegisterTool(MenuCaption: String; ButtonBmp: TBitmap; OnClick: TNotifyEvent);
 881begin
 882  frTools[frToolsCount].Caption := MenuCaption;
 883  frTools[frToolsCount].ButtonBmp := ButtonBmp;
 884  frTools[frToolsCount].OnClick := OnClick;
 885  if frDesigner <> nil then
 886    frDesigner.RegisterTool(MenuCaption, ButtonBmp, OnClick);
 887  Inc(frToolsCount);
 888end;
 889
 890function Create90Font(Font: TFont): HFont;
 891var
 892  F: TLogFont;
 893begin
 894  GetObject(Font.Handle, SizeOf(TLogFont), @F);
 895  F.lfEscapement := 900;
 896  F.lfOrientation := 900;
 897  Result := CreateFontIndirect(F);
 898end;
 899
 900function GetDefaultDataSet: TfrTDataSet;
 901var
 902  Res: TfrDataset;
 903begin
 904  Result := nil; Res := nil;
 905  if CurBand <> nil then
 906    case CurBand.Typ of
 907      btMasterData, btReportSummary, btMasterFooter,
 908      btGroupHeader, btGroupFooter:
 909        Res := CurPage.Bands[btMasterData].DataSet;
 910      btDetailData, btDetailFooter:
 911        Res := CurPage.Bands[btDetailData].DataSet;
 912      btSubDetailData, btSubDetailFooter:
 913        Res := CurPage.Bands[btSubDetailData].DataSet;
 914      btCrossData, btCrossFooter:
 915        Res := CurPage.Bands[btCrossData].DataSet;
 916    end;
 917  if (Res <> nil) and (Res is TfrDBDataset) then
 918    Result := TfrDBDataSet(Res).GetDataSet;
 919end;
 920
 921function ReadString(Stream: TStream): String;
 922begin
 923  if frVersion >= 23 then
 924{$IFDEF FREEREP2217READ}
 925      Result := frReadString(Stream) // load in current format
 926  else
 927    if (frVersion = 22) and FRE_COMPATIBLE_READ then
 928      Result := frReadString2217(Stream) // load in bad format
 929    else
 930{$ELSE}
 931    Result := frReadString(Stream) else
 932{$ENDIF}
 933    Result := frReadString22(Stream);
 934end;
 935
 936procedure ReadMemo(Stream: TStream; Memo: TStrings);
 937begin
 938  if frVersion >= 23 then
 939{$IFDEF FREEREP2217READ}
 940      frReadMemo(Stream, Memo) // load in current format
 941  else
 942    if (frVersion = 22) and FRE_COMPATIBLE_READ then
 943      Memo.Text := frReadString2217(Stream) // load in bad format
 944    else
 945{$ELSE}
 946    frReadMemo(Stream, Memo) else
 947{$ENDIF}
 948    frReadMemo22(Stream, Memo);
 949end;
 950
 951procedure CreateDS(Desc: String; var DataSet: TfrDataSet; var IsVirtualDS: Boolean);
 952begin
 953  if (Desc <> '') and (Desc[1] in ['1'..'9']) then
 954  begin
 955    DataSet := TfrUserDataSet.Create(nil);
 956    DataSet.RangeEnd := reCount;
 957    DataSet.RangeEndCount := StrToInt(Desc);
 958    IsVirtualDS := True;
 959  end
 960  else
 961    DataSet := frFindComponent(CurReport.Owner, Desc) as TfrDataSet;
 962  if DataSet <> nil then
 963    DataSet.Init;
 964end;
 965
 966{----------------------------------------------------------------------------}
 967constructor TfrView.Create;
 968begin
 969  inherited Create;
 970  Parent := nil;
 971  Memo := TStringList.Create;
 972  Memo1 := TStringList.Create;
 973  Script := TStringList.Create;
 974  FrameWidth := 1;
 975  FrameColor := clBlack;
 976  FillColor := clNone;
 977  Format := 2*256 + Ord(DecimalSeparator);
 978  BaseName := 'View';
 979  Visible := True;
 980  StreamMode := smDesigning;
 981  ScaleX := 1; ScaleY := 1;
 982  OffsX := 0; OffsY := 0;
 983  Flags := flStretched;
 984end;
 985
 986destructor TfrView.Destroy;
 987begin
 988  Memo.Free;
 989  Memo1.Free;
 990  Script.Free;
 991  inherited Destroy;
 992end;
 993
 994procedure TfrView.Assign(From: TfrView);
 995begin
 996  Name := From.Name;
 997  Typ := From.Typ;
 998  Selected := From.Selected;
 999  x := From.x; y := From.y; dx := From.dx; dy := From.dy;
1000  Flags := From.Flags;
1001  FrameTyp := From.FrameTyp;
1002  FrameWidth := From.FrameWidth;
1003  FrameColor := From.FrameColor;
1004  FrameStyle := From.FrameStyle;
1005  FillColor := From.FillColor;
1006  Format := From.Format;
1007  FormatStr := From.FormatStr;
1008  Visible := From.Visible;
1009  Memo.Assign(From.Memo);
1010  Script.Assign(From.Script);
1011end;
1012
1013procedure TfrView.CalcGaps;
1014var
1015  bx, by, bx1, by1, wx1, wx2, wy1, wy2: Integer;
1016begin
1017  SaveX := x; SaveY := y; SaveDX := dx; SaveDY := dy;
1018  SaveFW := FrameWidth;
1019  if DocMode = dmDesigning then
1020  begin
1021    ScaleX := 1; ScaleY := 1;
1022    OffsX := 0; OffsY := 0;
1023  end;
1024  x := Round(x * ScaleX) + OffsX;
1025  y := Round(y * ScaleY) + OffsY;
1026  dx := Round(dx * ScaleX);
1027  dy := Round(dy * ScaleY);
1028
1029  wx1 := Round((FrameWidth * ScaleX - 1) / 2);
1030  wx2 := Round(FrameWidth * ScaleX / 2);
1031  wy1 := Round((FrameWidth * ScaleY - 1) / 2);
1032  wy2 := Round(FrameWidth * ScaleY / 2);
1033  FrameWidth := FrameWidth * ScaleX;
1034  gapx := wx2 + 2; gapy := wy2 div 2 + 1;
1035  bx := x;
1036  by := y;
1037  bx1 := Round((SaveX + SaveDX) * ScaleX + OffsX);
1038  by1 := Round((SaveY + SaveDY) * ScaleY + OffsY);
1039  if (FrameTyp and $1) <> 0 then Dec(bx1, wx2);
1040  if (FrameTyp and $2) <> 0 then Dec(by1, wy2);
1041  if (FrameTyp and $4) <> 0 then Inc(bx, wx1);
1042  if (FrameTyp and $8) <> 0 then Inc(by, wy1);
1043  DRect := Rect(bx, by, bx1 + 1, by1 + 1);
1044end;
1045
1046procedure TfrView.RestoreCoord;
1047begin
1048  x := SaveX;
1049  y := SaveY;
1050  dx := SaveDX;
1051  dy := SaveDY;
1052  FrameWidth := SaveFW;
1053end;
1054
1055procedure TfrView.ShowBackground;
1056var
1057  fp: TColor;
1058begin
1059  if DisableDrawing then Exit;
1060  if (DocMode = dmPrinting) and (FillColor = clNone) then Exit;
1061  fp := FillColor;
1062  if (DocMode = dmDesigning) and (fp = clNone) then
1063    fp := clWhite;
1064  Canvas.Brush.Color := fp;
1065  if DocMode = dmDesigning then
1066    Canvas.FillRect(DRect) else
1067    Canvas.FillRect(Rect(x, y,
1068// use calculating coords instead of dx, dy - for best view
1069      Round((SaveX + SaveDX) * ScaleX + OffsX), Round((SaveY + SaveDY) * ScaleY + OffsY)));
1070end;
1071
1072procedure TfrView.ShowFrame;
1073var
1074  x1, y1: Integer;
1075  procedure Line(x, y, dx, dy: Integer);
1076  begin
1077    Canvas.MoveTo(x, y);
1078    Canvas.LineTo(x + dx, y + dy);
1079  end;
1080  procedure Line1(x, y, x1, y1: Integer);
1081  var
1082    i, w: Integer;
1083  begin
1084    if Canvas.Pen.Style = psSolid then
1085    begin
1086      if FrameStyle <> 5 then
1087      begin
1088        Canvas.MoveTo(x, y);
1089        Canvas.LineTo(x1, y1);
1090      end
1091      else
1092      begin
1093        if x = x1 then
1094        begin
1095          Canvas.MoveTo(x - Round(FrameWidth), y);
1096          Canvas.LineTo(x1 - Round(FrameWidth), y1);
1097          Canvas.Pen.Color := FillColor;
1098          Canvas.MoveTo(x, y);
1099          Canvas.LineTo(x1, y1);
1100          Canvas.Pen.Color := FrameColor;
1101          Canvas.MoveTo(x + Round(FrameWidth), y);
1102          Canvas.LineTo(x1 + Round(FrameWidth), y1);
1103        end
1104        else
1105        begin
1106          Canvas.MoveTo(x, y - Round(FrameWidth));
1107          Canvas.LineTo(x1, y1 - Round(FrameWidth));
1108          Canvas.Pen.Color := FillColor;
1109          Canvas.MoveTo(x, y);
1110          Canvas.LineTo(x1, y1);
1111          Canvas.Pen.Color := FrameColor;
1112          Canvas.MoveTo(x, y + Round(FrameWidth));
1113          Canvas.LineTo(x1, y1 + Round(FrameWidth));
1114        end;
1115      end
1116    end
1117    else
1118    begin
1119      Canvas.Brush.Color := FillColor;
1120      w := Canvas.Pen.Width;
1121      Canvas.Pen.Width := 1;
1122      if x = x1 then
1123        for i := 0 to w - 1 do
1124        begin
1125          Canvas.MoveTo(x - w div 2 + i, y);
1126          Canvas.LineTo(x - w div 2 + i, y1);
1127        end
1128      else
1129        for i := 0 to w - 1 do
1130        begin
1131          Canvas.MoveTo(x, y - w div 2 + i);
1132          Canvas.LineTo(x1, y - w div 2 + i);
1133        end;
1134      Canvas.Pen.Width := w;
1135    end;
1136  end;
1137begin
1138  if DisableDrawing then Exit;
1139  if (DocMode = dmPrinting) and ((FrameTyp and $F) = 0) then Exit;
1140  with Canvas do
1141  begin
1142    Brush.Style := bsClear;
1143    Pen.Style := psSolid;
1144    if (dx > 0) and (dy > 0) and (DocMode = dmDesigning) then
1145    begin
1146      Pen.Color := clBlack;
1147      Pen.Width := 1;
1148      Line(x, y + 3, 0, -3); Line(x, y, 4, 0);
1149      Line(x, y + dy - 3, 0, 3); Line(x, y + dy, 4, 0);
1150      Line(x + dx - 3, y, 3, 0); Line(x + dx, y, 0, 4);
1151      Line(x + dx - 3, y + dy, 3, 0); Line(x + dx, y + dy, 0, -4);
1152    end;
1153    Pen.Color := FrameColor;
1154    Pen.Width := Round(FrameWidth);
1155    if FrameStyle <> 5 then
1156      Pen.Style := TPenStyle(FrameStyle);
1157// use calculating coords instead of dx, dy - for best view
1158    x1 := Round((SaveX + SaveDX) * ScaleX + OffsX);
1159    y1 := Round((SaveY + SaveDY) * ScaleY + OffsY);
1160    if ((FrameTyp and $F) = $F) and (FrameStyle = 0) then
1161      Rectangle(x, y, x1 + 1, y1 + 1)
1162    else
1163    begin
1164      if (FrameTyp and $1) <> 0 then Line1(x1, y, x1, y1);
1165      if (FrameTyp and $4) <> 0 then Line1(x, y, x, y1);
1166      if (FrameTyp and $2) <> 0 then Line1(x, y1, x1, y1);
1167      if (FrameTyp and $8) <> 0 then Line1(x, y, x1, y);
1168    end;
1169  end;
1170end;
1171
1172procedure TfrView.BeginDraw(ACanvas: TCanvas);
1173begin
1174  Canvas := ACanvas;
1175  CurView := Self;
1176end;
1177
1178procedure TfrView.Print(Stream: TStream);
1179begin
1180  BeginDraw(Canvas);
1181  Memo1.Assign(Memo);
1182  CurReport.InternalOnEnterRect(Memo1, Self);
1183  frInterpretator.DoScript(Script);
1184  if not Visible then Exit;
1185
1186  Stream.Write(Typ, 1);
1187  if Typ = gtAddIn then
1188    frWriteString(Stream, ClassName);
1189  SaveToStream(Stream);
1190end;
1191
1192procedure TfrView.ExportData;
1193begin
1194  CurReport.InternalOnExportData(Self);
1195end;
1196
1197procedure TfrView.LoadFromStream(Stream: TStream);
1198var
1199  w: Integer;
1200begin
1201  with Stream do
1202  begin
1203    if StreamMode = smDesigning then
1204      if frVersion >= 23 then
1205        Name := ReadString(Stream) else
1206        CreateUniqueName;
1207    Read(x, 30); // this is equal to, but much faster:
1208{    Read(x, 4); Read(y, 4); Read(dx, 4); Read(dy, 4);
1209    Read(Flags, 2);
1210    Read(FrameTyp, 2);
1211    Read(FrameWidth, 4);
1212    Read(FrameColor, 4);
1213    Read(FrameStyle, 2);}
1214    Read(FillColor, 4);
1215    if StreamMode = smDesigning then
1216    begin
1217      Read(Format, 4);
1218      FormatStr := ReadString(Stream);
1219    end;
1220    ReadMemo(Stream, Memo);
1221    if (frVersion >= 23) and (StreamMode = smDesigning) then
1222    begin
1223      ReadMemo(Stream, Script);
1224      Read(Visible, 2);
1225    end;
1226    w := PInteger(@FrameWidth)^;
1227    if w <= 10 then
1228      w := w * 1000;
1229    FrameWidth := w / 1000;
1230  end;
1231end;
1232
1233procedure TfrView.SaveToStream(Stream: TStream);
1234var
1235  w: Integer;
1236  f: Single;
1237begin
1238  f := FrameWidth;
1239  if f <> Int(f) then
1240    w := Round(FrameWidth * 1000) else
1241    w := Round(f);
1242  PInteger(@FrameWidth)^ := w;
1243  with Stream do
1244  begin
1245    if StreamMode = smDesigning then
1246      frWriteString(Stream, Name);
1247    Write(x, 30); // this is equal to, but much faster:
1248{    Write(x, 4); Write(y, 4); Write(dx, 4); Write(dy, 4);
1249    Write(Flags, 2);
1250    Write(FrameTyp, 2);
1251    Write(FrameWidth, 4);
1252    Write(FrameColor, 4);
1253    Write(FrameStyle, 2);}
1254    Write(FillColor, 4);
1255    if StreamMode = smDesigning then
1256    begin
1257      Write(Format, 4);
1258      frWriteString(Stream, FormatStr);
1259      frWriteMemo(Stream, Memo);
1260    end
1261    else
1262      frWriteMemo(Stream, Memo1);
1263    if StreamMode = smDesigning then
1264    begin
1265      frWriteMemo(Stream, Script);
1266      Write(Visible, 2);
1267    end;
1268  end;
1269  FrameWidth := f;
1270end;
1271
1272procedure TfrView.SaveToFR3Stream(Stream: TStream);
1273var 
1274  FTyp: Integer;
1275  s: String;
1276
1277  procedure WriteStr(const s: String);
1278  begin
1279    Stream.Write(s[1], Length(s));
1280  end;
1281
1282begin
1283  s := ClassName;
1284  if Pos('Tfr', s) = 1 then
1285  begin
1286    Delete(s, 1, 3);
1287    s := 'Tfrx' + s;
1288    if CompareText(s, 'TfrxSubreportView') = 0 then
1289      s := 'TfrxSubreport';
1290  end;
1291  WriteStr('<' + s + ' ');
1292  WriteStr('Name="' + Name +
1293    '" Left="' + IntToStr(x) + '" Top="' + IntToStr(y) +
1294    '" Width="' + IntToStr(dx) + '" Height="' + IntToStr(dy) +
1295    '" Color="' + IntToStr(FillColor) + '"');
1296  if not Visible then
1297    WriteStr(' Visible="False"');
1298
1299  FTyp := 0;
1300  if (FrameTyp and frftLeft) <> 0 then
1301    FTyp := FTyp or 1;
1302  if (FrameTyp and frftRight) <> 0 then
1303    FTyp := FTyp or 2;
1304  if (FrameTyp and frftUp) <> 0 then
1305    FTyp := FTyp or 4;
1306  if (FrameTyp and frftDown) <> 0 then
1307    FTyp := FTyp or 8;
1308
1309  WriteStr(' Frame.Typ="' + IntToStr(FTyp) +
1310    '" Frame.Width="' + FloatToStr(FrameWidth) +
1311    '" Frame.Color="' + IntToStr(FrameColor) +
1312    '" Frame.Style="' + IntToStr(FrameStyle) +
1313    '" GapX="' + IntToStr(gapx) + '" GapY="' + IntToStr(gapy) +
1314    {'" TagStr="' + StrToXML(Tag) + }'" Memo.text="' + StrToXML(Memo.Text) + '"');
1315
1316{  ba := BandAlign;
1317  if ba = baRest then
1318    ba := baWidth
1319  else if ba = baTop then
1320    ba := baNone;
1321  WriteStr(' Align="' + IntToStr(ba) + '"');}
1322
1323  if Script.Count > 0 then
1324    WriteStr(' OnBeforePrint="' + Name + 'OnBeforePrint' +
1325      '" OnClick="' + Name + 'OnBeforePrint' +
1326      '" OnActivate="' + Name + 'OnBeforePrint"');
1327
1328{  RTyp := 0;
1329  if ((Restrictions and frrfDontEditMemo) <> 0) or
1330     ((Restrictions and frrfDontEditScript) <> 0) or
1331     ((Restrictions and frrfDontEditContents) <> 0) or
1332     ((Restrictions and frrfDontModify) <> 0) then
1333    RTyp := RTyp or 1;
1334  if (Restrictions and frrfDontSize) <> 0 then
1335    RTyp := RTyp or 2;
1336  if (Restrictions and frrfDontMove) <> 0 then
1337    RTyp := RTyp or 4;
1338  if (Restrictions and frrfDontDelete) <> 0 then
1339    RTyp := RTyp or 8;
1340  WriteStr(' Restrictions="' + IntToStr(RTyp) + '"');}
1341end;
1342
1343procedure TfrView.Resized;
1344begin
1345end;
1346
1347procedure TfrView.GetBlob(b: TfrTField);
1348begin
1349end;
1350
1351procedure TfrView.OnHook(View: TfrView);
1352begin
1353end;
1354
1355function TfrView.GetClipRgn(rt: TfrRgnType): HRGN;
1356var
1357  bx, by, bx1, by1, w1, w2: Integer;
1358begin
1359  if FrameStyle = 5 then
1360  begin
1361    w1 := Round(FrameWidth * 1.5);
1362    w2 := Round((FrameWidth - 1) / 2 + FrameWidth);
1363  end
1364  else
1365  begin
1366    w1 := Round(FrameWidth / 2);
1367    w2 := Round((FrameWidth - 1) / 2);
1368  end;
1369  bx := x; by := y; bx1 := x + dx + 1; by1 := y + dy + 1;
1370  if (FrameTyp and $1) <> 0 then Inc(bx1, w2);
1371  if (FrameTyp and $2) <> 0 then Inc(by1, w2);
1372  if (FrameTyp and $4) <> 0 then Dec(bx, w1);
1373  if (FrameTyp and $8) <> 0 then Dec(by, w1);
1374  if rt = rtNormal then
1375    Result := CreateRectRgn(bx, by, bx1, by1) else
1376    Result := CreateRectRgn(bx - 10, by - 10, bx1 + 10, by1 + 10);
1377end;
1378
1379procedure TfrView.CreateUniqueName;
1380var
1381  i: Integer;
1382begin
1383  Name := '';
1384  for i := 1 to 10000 do
1385    if CurReport.FindObject(BaseName + IntToStr(i)) = nil then
1386    begin
1387      Name := BaseName + IntToStr(i);
1388      Exit;
1389    end;
1390end;
1391
1392procedure TfrView.SetBounds(Left, Top, Width, Height: Integer);
1393begin
1394  x := Left;
1395  y := Top;
1396  dx := Width;
1397  dy := Height;
1398end;
1399
1400procedure TfrView.DefinePopupMenu(Popup: TPopupMenu);
1401var
1402  m: TMenuItem;
1403begin
1404  m := TMenuItem.Create(Popup);
1405  m.Caption := '-';
1406  Popup.Items.Add(m);
1407
1408  m := TMenuItem.Create(Popup);
1409  m.Caption := LoadStr(SStretched);
1410  m.OnClick := P1Click;
1411  m.Checked := (Flags and flStretched) <> 0;
1412  Popup.Items.Add(m);
1413end;
1414
1415procedure TfrView.P1Click(Sender: TObject);
1416var
1417  i: Integer;
1418  t: TfrView;
1419begin
1420  frDesigner.BeforeChange;
1421  with Sender as TMenuItem do
1422  begin
1423    Checked := not Checked;
1424    for i := 0 to frDesigner.Page.Objects.Count-1 do
1425    begin
1426      t := frDesigner.Page.Objects[i];
1427      if t.Selected then
1428        t.Flags := (t.Flags and not flStretched) + Word(Checked);
1429    end;
1430  end;
1431  frDesigner.AfterChange;
1432end;
1433
1434{----------------------------------------------------------------------------}
1435constructor TfrMemoView.Create;
1436begin
1437  inherited Create;
1438  Typ := gtMemo;
1439  FFont := TFont.Create;
1440  FFont.Name := 'Arial';
1441  FFont.Size := 10;
1442  FFont.Color := clBlack;
1443{$IFNDEF Delphi2}
1444  FFont.Charset := frCharset;
1445{$ENDIF}
1446  Highlight.FontColor := clBlack;
1447  Highlight.FillColor := clWhite;
1448  Highlight.FontStyle := 2; // fsBold
1449  BaseName := 'Memo';
1450  Flags := flStretched + flWordWrap;
1451  LineSpacing := 2;
1452  CharacterSpacing := 0;
1453end;
1454
1455destructor TfrMemoView.Destroy;
1456begin
1457  FFont.Free;
1458  inherited Destroy;
1459end;
1460
1461procedure TfrMemoView.SetFont(Value: TFont);
1462begin
1463  FFont.Assign(Value);
1464end;
1465
1466procedure TfrMemoView.Assign(From: TfrView);
1467begin
1468  inherited Assign(From);
1469  Font := TfrMemoView(From).Font;
1470  Adjust := TfrMemoView(From).Adjust;
1471  Highlight := TfrMemoView(From).Highlight;
1472  HighlightStr := TfrMemoView(From).HighlightStr;
1473  LineSpacing := TfrMemoView(From).LineSpacing;
1474end;
1475
1476procedure TfrMemoView.ExpandVariables;
1477var
1478  i: Integer;
1479  s: String;
1480  procedure GetData(var s: String);
1481  var
1482    i, j: Integer;
1483    s1, s2: String;
1484  begin
1485    i := 1;
1486    repeat
1487      while (i < Length(s)) and (s[i] <> '[') do Inc(i);
1488      s1 := GetBrackedVariable(s, i, j);
1489      if i <> j then
1490      begin
1491        Delete(s, i, j - i + 1);
1492        s2 := '';
1493        CurReport.InternalOnGetValue(s1, s2);
1494        Insert(s2, s, i);
1495        Inc(i, Length(s2));
1496        j := 0;
1497      end;
1498    until i = j;
1499  end;
1500begin
1501  Memo1.Clear;
1502  for i := 0 to Memo.Count - 1 do
1503  begin
1504    s := Memo[i];
1505    if Length(s) > 0 then
1506    begin
1507      GetData(s);
1508      Memo1.Text := Memo1.Text + s;
1509    end
1510    else
1511      Memo1.Add('');
1512  end;
1513end;
1514
1515procedure TfrMemoView.AssignFont(Canvas: TCanvas);
1516begin
1517  with Canvas do
1518  begin
1519    Brush.Style := bsClear;
1520    Font := Self.Font;
1521    if not IsPrinting then
1522      Font.Height := -Round(Font.Size * 96 / 72 * ScaleY);
1523  end;
1524end;
1525
1526
1527type
1528  TWordBreaks = string;
1529
1530const
1531  gl: set of Char = ['�', '�', '�', '�', '�', '�', '�', '�', '�', '�'];
1532  r_sogl: set of Char = ['�', '�'];
1533  spaces: set of Char = [' ', '.', ',', '-'];
1534
1535function BreakWord(s: String): TWordBreaks;
1536var
1537  i: Integer;
1538  CanBreak: Boolean;
1539begin
1540  Result := '';
1541  s := AnsiUpperCase(s);
1542  if Length(s) > 4 then
1543  begin
1544    i := 2;
1545    repeat
1546      CanBreak := False;
1547      if s[i] in gl then
1548      begin
1549        if (s[i + 1] in gl) or (s[i + 2] in gl) then CanBreak := True;
1550      end
1551      else
1552      begin
1553        if not (s[i + 1] in gl) and not (s[i + 1] in r_sogl) and
1554           (s[i + 2] in gl) then
1555          CanBreak := True;
1556      end;
1557      if CanBreak then
1558        Result := Result + Chr(i);
1559      Inc(i);
1560    until i > Length(s) - 2;
1561  end;
1562end;
1563
1564procedure TfrMemoView.WrapMemo;
1565var
1566  size, size1, maxwidth: Integer;
1567  b: TWordBreaks;
1568  WCanvas: TCanvas;
1569
1570  procedure OutLine(const str: String);
1571  var
1572    n, w: Word;
1573  begin
1574    n := Length(str);
1575    if (n > 0) and (str[n] = #1) then
1576      w := WCanvas.TextWidth(Copy(str, 1, n - 1)) else
1577      w := WCanvas.TextWidth(str);
1578    SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));
1579    Inc(size, size1);
1580  end;
1581
1582  procedure WrapLine(const s: String);
1583  var
1584    i, cur, beg, last: Integer;
1585    WasBreak, CRLF: Boolean;
1586  begin
1587    CRLF := False;
1588    for i := 1 to Length(s) do
1589      if s[i] in [#10, #13] then
1590      begin
1591        CRLF := True;
1592        break;
1593      end;
1594    last := 1; beg := 1;
1595    if not CRLF and ((Length(s) <= 1) or (WCanvas.TextWidth(s) <= maxwidth)) then
1596      OutLine(s + #1)
1597    else
1598    begin
1599      cur := 1;
1600      while cur <= Length(s) do
1601      begin
1602        if s[cur] in [#10, #13] then
1603        begin
1604          OutLine(Copy(s, beg, cur - beg) + #1);
1605          while (cur < Length(s)) and (s[cur] in [#10, #13]) do Inc(cur);
1606          beg := cur; last := beg;
1607          if s[cur] in [#13, #10] then
1608            Exit else
1609            continue;
1610        end;
1611        if s[cur] <> ' ' then
1612        if WCanvas.TextWidth(Copy(s, beg, cur - beg + 1)) > maxwidth then
1613        begin
1614          WasBreak := False;
1615          if (Flags and flWordBreak) <> 0 then
1616          begin
1617            i := cur;
1618            while (i <= Length(s)) and not (s[i] in spaces) do
1619              Inc(i);
1620            b := BreakWord(Copy(s, last + 1, i - last - 1));
1621            if Length(b) > 0 then
1622            begin
1623              i := 1;
1624              cur := last;
1625              while (i <= Length(b)) and
1626                (WCanvas.TextWidth(Copy(s, beg, last - beg + 1 + Ord(b[i])) + '-') <= maxwidth) do
1627              begin
1628                WasBreak := True;
1629                cur := last + Ord(b[i]);
1630                Inc(i);
1631              end;
1632              last := cur;
1633            end;
1634          end
1635          else
1636            if last = beg then last := cur;
1637          if WasBreak then
1638            OutLine(Copy(s, beg, last - beg + 1) + '-')
1639          else if s[last] = ' ' then
1640            OutLine(Copy(s, beg, last - beg)) else
1641            OutLine(Copy(s, beg, last - beg + 1));
1642          if ((Flags and flWordBreak) <> 0) and not WasBreak and (last = cur) then
1643          begin
1644            beg := cur + 1;
1645            cur := Length(s);
1646            break;
1647          end;
1648          if (Flags and flWordBreak) = 0 then
1649            if last = cur then
1650            begin
1651              beg := cur;
1652              break;
1653            end;
1654          beg := last + 1; last := beg;
1655        end;
1656        if s[cur] in spaces then last := cur;
1657        Inc(cur);
1658      end;
1659      if beg <> cur then OutLine(Copy(s, beg, cur - beg + 1) + #1);
1660    end;
1661  end;
1662
1663  procedure OutMemo;
1664  var
1665    i: Integer;
1666  begin
1667    size := y + gapy;
1668    size1 := -WCanvas.Font.Height + LineSpacing;
1669    maxwidth := dx - gapx - gapx;
1670    for i := 0 to Memo1.Count - 1 do
1671      if (Flags and flWordWrap) <> 0 then
1672        WrapLine(Memo1[i]) else
1673        OutLine(Memo1[i] + #1);
1674    VHeight := size - y + gapy;
1675    TextHeight := size1;
1676  end;
1677
1678  procedure OutMemo90;
1679  var
1680    i: Integer;
1681    h, oldh: HFont;
1682  begin
1683    h := Create90Font(WCanvas.Font);
1684    oldh := SelectObject(WCanvas.Handle, h);
1685    size := x + gapx;
1686    size1 := -WCanvas.Font.Height + LineSpacing;
1687    maxwidth := dy - gapy - gapy;
1688    for i := 0 to Memo1.Count - 1 do
1689      if (Flags and flWordWrap) <> 0 then
1690        WrapLine(Memo1[i]) else
1691        OutLine(Memo1[i]);
1692    SelectObject(WCanvas.Handle, oldh);
1693    DeleteObject(h);
1694    VHeight := size - x + gapx;
1695    TextHeight := size1;
1696  end;
1697
1698begin
1699  WCanvas := TempBmp.Canvas;
1700  WCanvas.Font.Assign(Font);
1701  WCanvas.Font.Height := -Round(Font.Size * 96 / 72);
1702  SetTextCharacterExtra(WCanvas.Handle, CharacterSpacing);
1703  SMemo.Clear;
1704  if (Adjust and $4) <> 0 then OutMemo90 else OutMemo;
1705end;
1706
1707
1708var
1709  DxArray: Array[0..2047] of Integer;
1710
1711procedure TfrMemoView.ShowMemo;
1712var
1713  DR: TRect;
1714  ad, ox, oy: Integer;
1715  GCP: TGCPRESULTS;
1716
1717  procedure OutMemo;
1718  var
1719    i, cury, th: Integer;
1720
1721    function OutLine(str: String): Boolean;
1722    var
1723      i, n, aw, nw, w, curx: Integer;
1724      ParaEnd: Boolean;
1725    begin
1726      if not Streaming or (cury + th <= DR.Bottom) then
1727      begin
1728        n := Length(str);
1729        w := Ord(str[n - 1]) * 256 + Ord(str[n]);
1730        SetLength(str, n - 2);
1731        ParaEnd := True;
1732        if Length(str) > 0 then
1733          if str[Length(str)] = #1 then
1734            SetLength(str, Length(str) - 1) else
1735            ParaEnd := False;
1736
1737        if Adjust <> 3 then
1738        begin
1739          FillChar(GCP, SizeOf(TGCPRESULTS), 0);
1740          GCP.lStructSize := SizeOf(TGCPRESULTS);
1741          GCP.lpDx := @DxArray[0];
1742          GCP.nGlyphs := Length(str);
1743          AssignFont(Canvas);
1744
1745          nw := Round(w * ScaleX);                    // needed width
1746          while (Canvas.TextWidth(str) > nw) and
1747            (Canvas.Font.Height < -1) do
1748            Canvas.Font.Height := Canvas.Font.Height + 1;
1749
1750          aw := Canvas.TextWidth(str);                // actual width
1751
1752          // preventing Win32 error when printing
1753          if (aw <> nw) and not Exporting then
1754        {$IFDEF VER180}
1755        GetCharacterPlacement(Canvas.Handle, PChar(str), Length(str), nw, GCP, GCP_JUSTIFY + GCP_MAXEXTENT)
1756        {$ELSE}
1757          {$IFDEF VER150}
1758            GetCharacterPlacement(Canvas.Handle, PChar(str), Length(str), nw, GCP, GCP_JUSTIFY + GCP_MAXEXTENT)
1759          {$ELSE}
1760            GetCharacterPlacement(Canvas.Handle, PChar(str), BOOL(Length(str)), BOOL(nw), GCP, GCP_JUSTIFY + GCP_MAXEXTENT)
1761          {$ENDIF}
1762        {$ENDIF}
1763          else
1764            GCP.lpDx := nil;
1765
1766          if Adjust = 0 then
1767            curx := x + gapx
1768          else if Adjust = 1 then
1769            curx := x + dx - 1 - gapx - nw
1770          else
1771            curx := x + gapx + (dx - gapx - gapx - nw) div 2;
1772
1773          if not Exporting then
1774            ExtTextOut(Canvas.Handle, curx, cury, ETO_CLIPPED, @DR,
1775              PChar(str), Length(str), PInteger(GCP.lpDx))
1776        end
1777        else
1778        begin
1779          curx := x + gapx;
1780          if not Exporting then
1781          begin
1782            n := 0;
1783            for i := 1 to Length(str) do
1784              if str[i] = ' ' then Inc(n);
1785            if (n <> 0) and not ParaEnd then
1786              SetTextJustification(Canvas.Handle,
1787                dx - gapx - gapx - Canvas.TextWidth(str), n);
1788
1789            ExtTextOut(Canvas.Handle, curx, cury, ETO_CLIPPED, @DR,
1790              PChar(str), Length(str), nil);
1791            SetTextJustification(Canvas.Handle, 0, 0);
1792          end;
1793        end;
1794        if Exporting then CurReport.InternalOnExportText(curx, cury, str, Self);
1795        Inc(CurStrNo);
1796        Result := False;
1797      end
1798      else Result := True;
1799      cury := cury + th;
1800    end;
1801
1802  begin
1803    cury := y + gapy;
1804    th := -Canvas.Font.Height + Round(LineSpacing * ScaleY);
1805    CurStrNo := 0;
1806    for i := 0 to Memo1.Count - 1 do
1807      if OutLine(Memo1[i]) then
1808        break;
1809  end;
1810
1811  procedure OutMemo90;
1812  var
1813    i, th, curx: Integer;
1814    h, oldh: HFont;
1815
1816    procedure OutLine(str: String);
1817    var
1818      i, n, cury: Integer;
1819      ParaEnd: Boolean;
1820    begin
1821      SetLength(str, Length(str) - 2);
1822      if str[Length(str)] = #1 then
1823      begin
1824        ParaEnd := True;
1825        SetLength(str, Length(str) - 1);
1826      end
1827      else
1828        ParaEnd := False;
1829      cury := 0;
1830      if Adjust = 4 then
1831        cury := y + dy - gapy
1832      else if Adjust = 5 then
1833        cury := y + gapy + Canvas.TextWidth(str)
1834      else if Adjust = 6 then
1835        cury := y + dy - 1 - gapy - (dy - gapy - gapy - Canvas.TextWidth(str)) div 2
1836      else if not Exporting then
1837      begin
1838        cury := y + dy - gapy;
1839        n := 0;
1840        for i := 1 to Length(str) do
1841          if str[i] = ' ' then Inc(n);
1842        if (n <> 0) and not ParaEnd then
1843          SetTextJustification(Canvas.Handle,
1844            dy - gapy - gapy - Canvas.TextWidth(str), n);
1845      end;
1846      if not Exporting then
1847      begin
1848        ExtTextOut(Canvas.Handle, curx, cury, ETO_CLIPPED, @DR,
1849          PChar(str), Length(str), nil);
1850        if Adjust <> 7 then
1851          SetTextJustification(Canvas.Handle, 0, 0);
1852      end;
1853      if Exporting then CurReport.InternalOnExportText(curx, cury, str, Self);
1854      Inc(CurStrNo);
1855      curx := curx + th;
1856    end;
1857  begin
1858    h := Create90Font(Canvas.Font);
1859    oldh := SelectObject(Canvas.Handle,h);
1860    curx := x + gapx;
1861    th := -Canvas.Font.Height + Round(LineSpacing * ScaleY);
1862    CurStrNo := 0;
1863    for i := 0 to Memo1.Count - 1 do
1864      OutLine(Memo1[i]);
1865    SelectObject(Canvas.Handle, oldh);
1866    DeleteObject(h);
1867  end;
1868
1869begin
1870  AssignFont(Canvas);
1871  SetTextCharacterExtra(Canvas.Handle, Round(CharacterSpacing * ScaleX));
1872  DR := Rect(DRect.Left + 1, DRect.Top, DRect.Right - 2, DRect.Bottom - 1);
1873  VHeight := Round(VHeight * ScaleY);
1874  if (Adjust and $18) <> 0 then
1875  begin
1876    ad := Adjust;
1877    ox := x; oy := y;
1878    Adjust := Adjust and $7;
1879    if (ad and $4) <> 0 then
1880    begin
1881      if (ad and $18) = $8 then
1882        x := x + (dx - VHeight) div 2
1883      else if (ad and $18) = $10 then
1884        x := x + dx - VHeight;
1885      OutMemo90;
1886    end
1887    else
1888    begin
1889      if (ad and $18) = $8 then
1890        y := y + (dy - VHeight) div 2
1891      else if (ad and $18) = $10 then
1892        y := y + dy - VHeight;
1893      OutMemo;
1894    end;
1895    Adjust := ad;
1896    x := ox; y := oy;
1897  end
1898  else if (Adjust and $4) <> 0 then OutMemo90 else OutMemo;
1899end;
1900
1901function TfrMemoView.CalcWidth(Memo: TStringList): Integer;
1902var
1903  CalcRect: TRect;
1904  s: String;
1905  n: Integer;
1906begin
1907  CalcRect := Rect(0, 0, dx, dy);
1908  Canvas.Font.Assign(Font);
1909  Canvas.Font.Height := -Round(Font.Size * 96 / 72);
1910  s := Memo.Text;
1911  n := Length(s);
1912  if n > 2 then
1913    if (s[n - 1] = #13) and (s[n] = #10) then
1914      SetLength(s, n - 2);
1915  SetTextCharacterExtra(Canvas.Handle, Round(CharacterSpacing * ScaleX));
1916  DrawText(Canvas.Handle, PChar(s), Length(s), CalcRect, DT_CALCRECT);
1917  Result := CalcRect.Right + Round(2 * FrameWidth) + 2;
1918end;
1919
1920procedure TfrMemoView.Draw(Canvas: TCanvas);
1921var
1922  NeedWrap: Boolean;
1923  newdx: Integer;
1924  OldScaleX, OldScaleY: Double;
1925begin
1926  BeginDraw(Canvas);
1927  if ((Flags and flAutoSize) <> 0) and (Memo.Count > 0) and
1928     (DocMode <> dmDesigning) then
1929  begin
1930    newdx := CalcWidth(Memo);
1931    if (Adjust and frtaRight) <> 0 then
1932    begin
1933      x := x + dx - newdx;
1934      dx := newdx;
1935    end
1936    else
1937      dx := newdx;
1938  end;
1939
1940  Streaming := False;
1941  Memo1.Assign(Memo);
1942
1943  OldScaleX := ScaleX; OldScaleY := ScaleY;
1944  ScaleX := 1; ScaleY := 1;
1945  CalcGaps;
1946  ScaleX := OldScaleX; ScaleY := OldScaleY;
1947  RestoreCoord;
1948  if Memo1.Count > 0 then
1949  begin
1950    NeedWrap := Pos(#1, Memo1.Text) = 0;
1951    if Memo1[Memo1.Count - 1] = #1 then
1952      Memo1.Delete(Memo1.Count - 1);
1953    if NeedWrap then
1954    begin
1955      WrapMemo;
1956      Memo1.Assign(SMemo);
1957    end;
1958  end;
1959
1960  CalcGaps;
1961  if not Exporting then ShowBackground;
1962  if not Exporting then ShowFrame;
1963  if Memo1.Count > 0 then
1964    ShowMemo;
1965  RestoreCoord;
1966end;
1967
1968procedure TfrMemoView.Print(Stream: TStream);
1969var
1970  s: String;
1971  CanExpandVar: Boolean;
1972  OldFont: TFont;
1973  OldFill: Integer;
1974  i: Integer;
1975begin
1976  BeginDraw(TempBmp.Canvas);
1977  Streaming := True;
1978  if DrawMode = drAll then
1979    frInterpretator.DoScript(Script);
1980
1981  CanExpandVar := True;
1982  if (DrawMode = drAll) and (Assigned(CurReport.OnEnterRect) or
1983     ((FDataSet <> nil) and frIsBlob(TfrTField(FDataSet.FindField(FField))))) then
1984  begin
1985    Memo1.Assign(Memo);
1986    s := Memo1.Text;
1987    CurReport.InternalOnEnterRect(Memo1, Self);
1988    if s <> Memo1.Text then CanExpandVar := False;
1989  end
1990  else if DrawMode = drAfterCalcHeight then
1991    CanExpandVar := False;
1992  if DrawMode <> drPart then
1993    if CanExpandVar then ExpandVariables;
1994
1995  if not Visible then
1996  begin
1997    DrawMode := drAll;
1998    Exit;
1999  end;
2000
2001  OldFont := TFont.Create;
2002  OldFont.Assign(Font);
2003  OldFill := FillColor;
2004  if Length(HighlightStr) <> 0 then
2005    if frParser.Calc(HighlightStr) <> 0 then
2006    begin
2007      Font.Style := frSetFontStyle(Highlight.FontStyle);
2008      Font.Color := Highlight.FontColor;
2009      FillColor := Highlight.FillColor;
2010    end;
2011
2012  if DrawMode = drPart then
2013  begin
2014    CalcGaps;
2015    ShowMemo;
2016    SMemo.Assign(Memo1);
2017    while Memo1.Count > CurStrNo do
2018      Memo1.Delete(CurStrNo);
2019    if Pos(#1, Memo1.Text) = 0 then
2020      Memo1.Add(#1);
2021  end;
2022
2023  Stream.Write(Typ, 1);
2024  if Typ = gtAddIn then
2025    frWriteString(Stream, ClassName);
2026  SaveToStream(Stream);
2027  if DrawMode = drPart then
2028  begin
2029    Memo1.Assign(SMemo);
2030    for i := 0 to CurStrNo - 1 do
2031      Memo1.Delete(0);
2032  end;
2033  Font.Assign(OldFont);
2034  OldFont.Free;
2035  FillColor := OldFill;
2036  DrawMode := drAll;
2037end;
2038
2039procedure TfrMemoView.ExportData;
2040begin
2041  inherited;
2042  Exporting := True;
2043  Draw(TempBmp.Canvas);
2044  Exporting := False;
2045end;
2046
2047function TfrMemoView.CalcHeight: Integer;
2048var
2049  s: String;
2050  CanExpandVar: Boolean;
2051  OldFont: TFont;
2052  OldFill: Integer;
2053begin
2054  Result := 0;
2055  DrawMode := drAfterCalcHeight;
2056  BeginDraw(TempBmp.Canvas);
2057  frInterpretator.DoScript(Script);
2058  if not Visible then Exit;
2059
2060  CanExpandVar := True;
2061  Memo1.Assign(Memo);
2062  s := Memo1.Text;
2063  CurReport.InternalOnEnterRect(Memo1, Self);
2064  if s <> Memo1.Text then CanExpandVar := False;
2065  if CanExpandVar then ExpandVariables;
2066
2067  OldFont := TFont.Create;
2068  OldFont.Assign(Font);
2069  OldFill := FillColor;
2070  if Length(HighlightStr) <> 0 then
2071    if frParser.Calc(HighlightStr) <> 0 then
2072    begin
2073      Font.Style := frSetFontStyle(Highlight.FontStyle);
2074      Font.Color := Highlight.FontColor;
2075      FillColor := Highlight.FillColor;
2076    end;
2077  if ((Flags and flAutoSize) <> 0) and (Memo1.Count > 0) and
2078     (DocMode <> dmDesigning) then
2079    dx := CalcWidth(Memo1);
2080
2081  CalcGaps;
2082  if Memo1.Count <> 0 then
2083  begin
2084    WrapMemo;
2085    Result := VHeight;
2086  end;
2087  Font.Assign(OldFont);
2088  OldFont.Free;
2089  FillColor := OldFill;
2090end;
2091
2092function TfrMemoView.MinHeight: Integer;
2093begin
2094  Result := TextHeight;
2095end;
2096
2097function TfrMemoView.RemainHeight: Integer;
2098begin
2099  Result := Memo1.Count * TextHeight;
2100end;
2101
2102procedure TfrMemoView.LoadFromStream(Stream: TStream);
2103var
2104  w: Word;
2105  i: Integer;
2106begin
2107  inherited LoadFromStream(Stream);
2108  Font.Name := ReadString(Stream);
2109  with Stream do
2110  begin
2111    Read(i, 4);
2112    Font.Size := i;
2113    Read(w, 2);
2114    Font.Style := frSetFontStyle(w);
2115    Read(i, 4);
2116    Font.Color := i;
2117    Read(Adjust, 4);
2118    Read(w, 2);
2119    if frVersion < 23 then
2120      w := frCharset;
2121{$IFNDEF Delphi2}
2122    Font.Charset := w;
2123{$ENDIF}
2124    if StreamMode = smDesigning then
2125    begin
2126      Read(Highlight, 10);
2127      HighlightStr := ReadString(Stream);
2128    end;
2129  end;
2130  if frVersion = 21 then
2131    Flags := Flags or flWordWrap;
2132end;
2133
2134procedure TfrMemoView.SaveToStream(Stream: TStream);
2135var
2136  i: Integer;
2137  w: Word;
2138begin
2139  inherited SaveToStream(Stream);
2140  frWriteString(Stream, Font.Name);
2141  with Stream do
2142  begin
2143    i := Font.Size;
2144    Write(i, 4);
2145    w := frGetFontStyle(Font.Style);
2146    Write(w, 2);
2147    i := Font.Color;
2148    Write(i, 4);
2149    Write(Adjust, 4);
2150{$IFDEF Delphi2}
2151    w := frCharset;
2152{$ELSE}
2153    w := Font.Charset;
2154{$ENDIF}
2155    Write(w, 2);
2156    if StreamMode = smDesigning then
2157    begin
2158      Write(Highlight, 10);
2159      frWriteString(Stream, HighlightStr);
2160    end;
2161  end;
2162end;
2163
2164procedure TfrMemoView.SaveToFR3Stream(Stream: TStream);
2165var
2166  fs: Integer;
2167  f1, f2: Integer;
2168  s: String;
2169
2170  procedure WriteStr(const s: String);
2171  begin
2172    Stream.Write(s[1], Length(s));
2173  end;
2174
2175begin
2176  inherited;
2177
2178  if (Flags and flStretched) <> 0 then
2179    WriteStr(' StretchMode="smMaxHeight"');
2180  if (Flags and flWordWrap) = 0 then
2181    WriteStr(' WordWrap="False"');
2182  if (Flags and flAutoSize) <> 0 then
2183    WriteStr(' AutoWidth="True"');
2184//  if (Flags and flTextOnly) <> 0 then
2185//    WriteStr(' AllowExpressions="False"');
2186//  if (Flags and flSuppressRepeated) <> 0 then
2187//    WriteStr(' SuppressRepeated="True"');
2188//  if (Flags and flHideZeros) <> 0 then
2189//    WriteStr(' HideZeros="True"');
2190//  if (Flags and flUnderlines) <> 0 then
2191//    WriteStr(' Underlines="True"');
2192//  if (Flags and flRTLReading) <> 0 then
2193//    WriteStr(' RTLReading="True"');
2194
2195  fs := 0;
2196  if fsBold in Font.Style then
2197    fs := fs or 1;
2198  if fsItalic in Font.Style then
2199    fs := fs or 2;
2200  if fsUnderline in Font.Style then
2201    fs := fs or 4;
2202  if fsStrikeout in Font.Style then
2203    fs := fs or 8;
2204
2205  WriteStr(' Font.Name="' + Font.Name +
2206    '" Font.Height="' + IntToStr(Font.Height) +
2207    '" Font.Color="' + IntToStr(Font.Color) +
2208    '" Font.Style="' + IntToStr(fs) + '"');
2209
2210  WriteStr(' LineSpacing="' + IntToStr(LineSpacing) +
2211    '" CharSpacing="' + IntToStr(CharacterSpacing) + '"');
2212
2213  if HighlightStr <> '' then
2214    WriteStr(' Highlight.Condition="' + StrToXML(HighlightStr) +
2215      '" Highlight.Font.Style="' + IntToStr(Highlight.FontStyle) +
2216      '" Highlight.Font.Color="' + IntToStr(Highlight.FontColor) +
2217      '" Highlight.Color="' + IntToStr(Highlight.FillColor) + '"');
2218
2219{  al := 0;
2220  if ((Alignment and frtaRight) <> 0) and ((Alignment and frtaCenter) <> 0) then
2221    al := 3
2222  else if (Alignment and frtaRight) <> 0 then
2223    al := 1
2224  else if (Alignment and frtaCenter) <> 0 then
2225    al := 2;
2226  WriteStr(' HAlign="' + IntToStr(al) + '"');
2227
2228  al := 0;
2229  if (Alignment and frtaMiddle) <> 0 then
2230    al := 2
2231  else if (Alignment and frtaDown) <> 0 then
2232    al := 1;
2233  WriteStr(' VAlign="' + IntToStr(al) + '"');
2234
2235  if (Alignment and frtaVertical) <> 0 then
2236    WriteStr(' Rotation="90"');}
2237
2238  f1 := (Format div $01000000) and $0F;
2239  f2 := (Format div $00010000) and $FF;
2240  s := '';
2241  case f1 of
2242    0: ;
2243    1:
2244      begin
2245        s := ' DisplayFormat.Kind="fkNumeric"';
2246        s := s + ' DisplayFormat.DecimalSeparator="' + Chr(Format and $FF) + '"';
2247        case f2 of
2248          0: s := s + ' DisplayFormat.FormatStr="%g"';
2249          1: s := s + ' DisplayFormat.FormatStr="%2.2f"';
2250          2: s := s + ' DisplayFormat.FormatStr="%2.2n"';
2251          3: s := s + ' DisplayFormat.FormatStr="%2.2m"';
2252          4: s := s + ' DisplayFormat.FormatStr="' + StrToXML(FormatStr) + '"';
2253        end;
2254      end;
2255    2:
2256      begin
2257        s := ' DisplayFormat.Kind="fkDateTime"';
2258        if f2 = 4 then
2259          s := s + ' DisplayFormat.FormatStr="' + StrToXML(FormatStr) + '"'
2260        else if f2 = 3 then
2261          s := s + ' DisplayFormat.FormatStr="dd mmmm yyyy"'
2262        else
2263          s := s + ' DisplayFormat.FormatStr="' + frDateFormats[f2] + '"'
2264      end;
2265    3:
2266      begin
2267        s := ' DisplayFormat.Kind="fkDateTime"';
2268        if f2 = 4 then
2269          s := s + ' DisplayFormat.FormatStr="' + StrToXML(FormatStr) + '"' else
2270          s := s + ' DisplayFormat.FormatStr="' + frTimeFormats[f2] + '"'
2271      end;
2272    4:
2273       begin
2274         s := ' DisplayFormat.Kind="fkBoolean"';
2275         if f2 = 4 then
2276           s := s + ' DisplayFormat.FormatStr="' + StrToXML(FormatStr) + '"' else
2277           s := s + ' DisplayFormat.FormatStr="' + BoolStr[f2] + '"'
2278       end;
2279  end;
2280  if s <> '' then
2281    WriteStr(s);
2282end;
2283
2284procedure TfrMemoView.GetBlob(b: TfrTField);
2285begin
2286{$IFDEF IBO}
2287  b.AssignTo(Memo1);
2288{$ELSE}
2289  Memo1.Assign(b);
2290{$ENDIF}
2291end;
2292
2293procedure TfrMemoView.DefinePopupMenu(Popup: TPopupMenu);
2294var
2295  m: TMenuItem;
2296begin
2297  m := TMenuItem.Create(Popup);
2298  m.Caption := LoadStr(SVarFormat);
2299  m.OnClick := P1Click;
2300  Popup.Items.Add(m);
2301
2302  m := TMenuItem.Create(Popup);
2303  m.Caption := LoadStr(SFont);
2304  m.OnClick := P4Click;
2305  Popup.Items.Add(m);
2306  inherited DefinePopupMenu(Popup);
2307
2308  m := TMenuItem.Create(Popup);
2309  m.Caption := LoadStr(SWordWrap);
2310  m.OnClick := P2Click;
2311  m.Checked := (Flags and flWordWrap) <> 0;
2312  Popup.Items.Add(m);
2313
2314  if LoadStr(SWordBreak) <> '' then
2315  begin
2316    m := TMenuItem.Create(Popup);
2317    m.Caption := LoadStr(SWordBreak);
2318    m.OnClick := P3Click;
2319    m.Enabled := (Flags and flWordWrap) <> 0;
2320    if m.Enabled then
2321      m.Checked := (Flags and flWordBreak) <> 0;
2322    Popup.Items.Add(m);
2323  end;
2324
2325  m := TMenuItem.Create(Popup);
2326  m.Caption := LoadStr(SAutoSize);
2327  m.OnClick := P5Click;
2328  m.Checked := (Flags and flAutoSize) <> 0;
2329  Popup.Items.Add(m);
2330end;
2331
2332procedure TfrMemoView.P1Click(Sender: TObject);
2333var
2334  t: TfrView;
2335  i: Integer;
2336begin
2337  frDesigner.BeforeChange;
2338  frFmtForm := TfrFmtForm.Create(nil);
2339  with frFmtForm do
2340  begin
2341    Format := Self.Format;
2342    Edit1.Text := Self.FormatStr;
2343    if ShowModal = mrOk then
2344      for i := 0 to frDesigner.Page.Objects.Count - 1 do
2345      begin
2346        t := frDesigner.Page.Objects[i];
2347        if t.Selected then
2348        begin
2349          (t as TfrMemoView).Format := Format;
2350          (t as TfrMemoView).FormatStr := Edit1.Text;
2351        end;
2352      end;
2353  end;
2354  frFmtForm.Free;
2355end;
2356
2357procedure TfrMemoView.P2Click(Sender: TObject);
2358var
2359  i: Integer;
2360  t: TfrView;
2361begin
2362  frDesigner.BeforeChange;
2363  with Sender as TMenuItem do
2364  begin
2365    Checked := not Checked;
2366    for i := 0 to frDesigner.Page.Objects.Count - 1 do
2367    begin
2368      t := frDesigner.Page.Objects[i];
2369      if t.Selected then
2370        t.Flags := (t.Flags and not flWordWrap) + Word(Checked) * flWordWrap;
2371    end;
2372  end;
2373  frDesigner.AfterChange;
2374end;
2375
2376procedure TfrMemoView.P3Click(Sender: TObject);
2377var
2378  i: Integer;
2379  t: TfrView;
2380begin
2381  frDesigner.BeforeChange;
2382  with Sender as TMenuItem do
2383  begin
2384    Checked := not Checked;
2385    for i := 0 to frDesigner.Page.Objects.Count - 1 do
2386    begin
2387      t := frDesigner.Page.Objects[i];
2388      if t.Selected then
2389        t.Flags := (t.Flags and not flWordBreak) + Word(Checked) * flWordBreak;
2390    end;
2391  end;
2392  frDesigner.AfterChange;
2393end;
2394
2395procedure TfrMemoView.P4Click(Sender: TObject);
2396var
2397  t: TfrView;
2398  i: Integer;
2399  fd: TFontDialog;
2400begin
2401  frDesigner.BeforeChange;
2402  fd := TFontDialog.Create(nil);
2403  with fd do
2404  begin
2405    Font.Assign(Self.Font);
2406    if Execute then
2407      for i := 0 to frDesigner.Page.Objects.Count - 1 do
2408      begin
2409        t := frDesigner.Page.Objects[i];
2410        if t.Selected then
2411        begin
2412          if Font.Name <> Self.Font.Name then
2413            TfrMemoView(t).Font.Name := Font.Name;
2414          if Font.Size <> Self.Font.Size then
2415            TfrMemoView(t).Font.Size := Font.Size;
2416          if Font.Color <> Self.Font.Color then
2417            TfrMemoView(t).Font.Color := Font.Color;
2418          if Font.Style <> Self.Font.Style then
2419            TfrMemoView(t).Font.Style := Font.Style;
2420{$IFNDEF Delphi2}
2421          if Font.Charset <> Self.Font.Charset then
2422            TfrMemoView(t).Font.Charset := Font.Charset;
2423{$ENDIF}
2424        end;
2425      end;
2426  end;
2427  fd.Free;
2428  frDesigner.AfterChange;
2429end;
2430
2431procedure TfrMemoView.P5Click(Sender: TObject);
2432var
2433  i: Integer;
2434  t: TfrView;
2435begin
2436  frDesigner.BeforeChange;
2437  with Sender as TMenuItem do
2438  begin
2439    Checked := not Checked;
2440    for i := 0 to frDesigner.Page.Objects.Count - 1 do
2441    begin
2442      t := frDesigner.Page.Objects[i];
2443      if t.Selected then
2444        t.Flags := (t.Flags and not flAutoSize) + Word(Checked) * flAutoSize;
2445    end;
2446  end;
2447  frDesigner.AfterChange;
2448end;
2449
2450{----------------------------------------------------------------------------}
2451constructor TfrBandView.Create;
2452begin
2453  inherited Create;
2454  Typ := gtBand;
2455  Format := 0;
2456  BaseName := 'Band';
2457  Flags := flBandOnFirstPage + flBandOnLastPage;
2458end;
2459
2460procedure TfrBandView.Draw(Canvas: TCanvas);
2461var
2462  h, oldh: HFont;
2463begin
2464  FrameWidth := 1;
2465  if TfrBandType(FrameTyp) in [btCrossHeader..btCrossFooter] then
2466  begin
2467    y := 0; dy := frDesigner.Page.PrnInfo.Pgh;
2468  end
2469  else
2470  begin
2471    x := 0; dx := frDesigner.Page.PrnInfo.Pgw;
2472  end;
2473  BeginDraw(Canvas);
2474  CalcGaps;
2475  with Canvas do
2476  begin
2477    Brush.Bitmap := SBmp;
2478    FillRect(DRect);
2479    Font.Name := 'Arial';
2480    Font.Style := [];
2481    Font.Size := 8;
2482    Font.Color := clBlack;
2483    Pen.Width := 1;
2484    Pen.Color := clBtnFace;
2485    Pen.Style := psSolid;
2486    Brush.Style := bsClear;
2487    Rectangle(x, y, x + dx + 1, y + dy + 1);
2488    Brush.Color := clBtnFace;
2489    if ShowBandTitles then
2490      if TfrBandType(FrameTyp) in [btCrossHeader..btCrossFooter] then
2491      begin
2492        FillRect(Rect(x - 18, y, x, y + 100));
2493        Pen.Color := clBtnShadow;
2494        MoveTo(x - 18, y + 98); LineTo(x, y + 98);
2495        Pen.Color := clBlack;
2496        MoveTo(x - 18, y + 99); LineTo(x, y + 99);
2497        Pen.Color := clBtnHighlight;
2498        MoveTo(x - 18, y + 99); LineTo(x - 18, y);
2499        h := Create90Font(Font);
2500        oldh := SelectObject(Handle, h);
2501        TextOut(x - 15, y + 94, frBandNames[FrameTyp]);
2502        SelectObject(Handle, oldh);
2503        DeleteObject(h);
2504      end
2505      else
2506      begin
2507        FillRect(Rect(x, y - 18, x + 100, y));
2508        Pen.Color := clBtnShadow;
2509        MoveTo(x + 98, y - 18); LineTo(x + 98, y);
2510        Pen.Color := clBlack;
2511        MoveTo(x + 99, y - 18); LineTo(x + 99, y);
2512        TextOut(x + 4, y - 17, frBandNames[FrameTyp]);
2513      end
2514    else
2515    begin
2516      Brush.Style := bsClear;
2517      if TfrBandType(FrameTyp) in [btCrossHeader..btCrossFooter] then
2518      begin
2519        h := Create90Font(Font);
2520        oldh := SelectObject(Handle, h);
2521        TextOut(x + 2, y + 94, frBandNames[FrameTyp]);
2522        SelectObject(Handle, oldh);
2523        DeleteObject(h);
2524      end
2525      else
2526        TextOut(x + 4, y + 2, frBandNames[FrameTyp]);
2527    end;
2528  end;
2529end;
2530
2531function TfrBandView.GetClipRgn(rt: TfrRgnType): HRGN;
2532var
2533  R: HRGN;
2534begin
2535  if not ShowBandTitles then
2536  begin
2537    Result := inherited GetClipRgn(rt);
2538    Exit;
2539  end;
2540  if rt = rtNormal then
2541    Result := CreateRectRgn(x, y, x + dx + 1, y + dy + 1) else
2542    Result := CreateRectRgn(x - 10, y - 10, x + dx + 10, y + dy + 10);
2543  if TfrBandType(FrameTyp) in [btCrossHeader..btCrossFooter] then
2544    R := CreateRectRgn(x - 18, y, x, y + 100)
2545  else
2546    R := CreateRectRgn(x, y - 18, x + 100, y);
2547  CombineRgn(Result, Result, R, RGN_OR);
2548  DeleteObject(R);
2549end;
2550
2551procedure TfrBandView.SaveToFR3Stream(Stream: TStream);
2552const
2553  BandNames: array[TfrBandType] of String =
2554    ('TfrxReportTitle', 'TfrxReportSummary',
2555     'TfrxPageHeader', 'TfrxPageFooter',
2556     'TfrxHeader', 'TfrxMasterData', 'TfrxFooter',
2557     'TfrxHeader', 'TfrxDetailData', 'TfrxFooter',
2558     'TfrxHeader', 'TfrxSubDetailData', 'TfrxFooter',
2559     'TfrxOverlay', 'TfrxColumnHeader', 'TfrxColumnFooter',
2560     'TfrxGroupHeader', 'TfrxGroupFooter',
2561     '', '', '', '');
2562var
2563  ds: TfrDataset;
2564
2565  procedure WriteStr(const s: String);
2566  begin
2567    Stream.Write(s[1], Length(s));
2568  end;
2569
2570begin
2571  if BandNames[BandType] = '' then Exit;
2572
2573  WriteStr('<' + BandNames[BandType] + ' ');
2574  WriteStr('Name="' + Name +
2575    '" Top="' + IntToStr(y) +
2576    '" Height="' + IntToStr(dy) +
2577//    '" Columns="' + IntToStr(Columns) +
2578//    '" ColumnWidth="' + IntToStr(ColumnWidth) +
2579//    '" ColumnGap="' + IntToStr(ColumnGap) +
2580    '"');
2581  if not Visible then
2582    WriteStr(' Visible="False"');
2583//  if ChildBand <> '' then
2584//    WriteStr(' Child="' + ChildBand + '"');
2585
2586  if (Flags and flStretched) <> 0 then
2587    WriteStr(' Stretched="True"');
2588  if (Flags and flBandNewPageAfter) <> 0 then
2589    WriteStr(' StartNewPage="True"');
2590  if (Flags and flBandPrintifSubsetEmpty) <> 0 then
2591    WriteStr(' PrintIfDetailEmpty="True"');
2592  if (Flags and flBandPageBreak) <> 0 then
2593    WriteStr(' AllowSplit="True"');
2594  if (Flags and flBandOnFirstPage) = 0 then
2595    WriteStr(' PrintOnFirstPage="False"');
2596  if (Flags and flBandOnLastPage) = 0 then
2597    WriteStr(' PrintOnLastPage="False"');
2598  if (Flags and flBandRepeatHeader) <> 0 then
2599    WriteStr(' ReprintOnNewPage="True"');
2600  if (Flags and flBandRepeatHeader) <> 0 then
2601    WriteStr(' ReprintOnNewPage="True"');
2602//  if (Flags and flBandPrintChildIfInvisible) <> 0 then
2603//    WriteStr(' PrintChildIfInvisible="True"');
2604
2605  if Script.Count > 0 then
2606    WriteStr(' OnBeforePrint="' + Name + 'OnBeforePrint"');
2607  if BandType in [btMasterData, btDetailData, btSubDetailData] then
2608  begin
2609    ds := frFindComponent(CurReport.Owner, DataSet) as TfrDataSet;
2610    if ds <> nil then
2611      WriteStr(' DataSetName="' + StrToXML(ds.Name) + '"');
2612  end;
2613  if BandType = btGroupHeader then
2614    WriteStr(' Condition="' + StrToXML(GroupCondition) + '"');
2615end;
2616
2617procedure TfrBandView.DefinePopupMenu(Popup: TPopupMenu);
2618var
2619  m: TMenuItem;
2620  b: TfrBandType;
2621begin
2622  b := TfrBandType(FrameTyp);
2623  if b in [btReportTitle, btReportSummary, btPageHeader, btCrossHeader,
2624    btMasterHeader..btSubDetailFooter, btGroupHeader, btGroupFooter] then
2625    inherited DefinePopupMenu(Popup);
2626
2627  if b in [btReportTitle, btReportSummary, btMasterData, btDetailData,
2628    btSubDetailData, btMasterFooter, btDetailFooter,
2629    btSubDetailFooter, btGroupHeader] then
2630  begin
2631    m := TMenuItem.Create(Popup);
2632    m.Caption := LoadStr(SFormNewPage);
2633    m.OnClick := P1Click;
2634    m.Checked := (Flags and flBandNewPageAfter) <> 0;
2635    Popup.Items.Add(m);
2636  end;
2637
2638  if b in [btMasterData, btDetailData] then
2639  begin
2640    m := TMenuItem.Create(Popup);
2641    m.Caption := LoadStr(SPrintIfSubsetEmpty);
2642    m.OnClick := P2Click;
2643    m.Checked := (Flags and flBandPrintIfSubsetEmpty) <> 0;
2644    Popup.Items.Add(m);
2645  end;
2646
2647  if b in [btReportTitle, btReportSummary, btMasterHeader..btSubDetailFooter,
2648    btGroupHeader, btGroupFooter] then
2649  begin
2650    m := TMenuItem.Create(Popup);
2651    m.Caption := LoadStr(SBreaked);
2652    m.OnClick := P3Click;
2653    m.Checked := (Flags and flBandPageBreak) <> 0;
2654    Popup.Items.Add(m);
2655  end;
2656
2657  if b in [btPageHeader, btPageFooter] then
2658  begin
2659    m := TMenuItem.Create(Popup);
2660    m.Caption := LoadStr(SOnFirstPage);
2661    m.OnClick := P4Click;
2662    m.Checked := (Flags and flBandOnFirstPage) <> 0;
2663    Popup.Items.Add(m);
2664  end;
2665
2666  if b = btPageFooter then
2667  begin
2668    m := TMenuItem.Create(Popup);
2669    m.Caption := LoadStr(SOnLastPage);
2670    m.OnClick := P5Click;
2671    m.Checked := (Flags and flBandOnLastPage) <> 0;
2672    Popup.Items.Add(m);
2673  end;
2674
2675  if b in [btMasterHeader, btDetailHeader, btSubDetailHeader,
2676    btCrossHeader, btGroupHeader] then
2677  begin
2678    m := TMenuItem.Create(Popup);
2679    m.Caption := LoadStr(SRepeatHeader);
2680    m.OnClick := P6Click;
2681    m.Checked := (Flags and flBandRepeatHeader) <> 0;
2682    Popup.Items.Add(m);
2683  end;
2684end;
2685
2686procedure TfrBandView.P1Click(Sender: TObject);
2687var
2688  i: Integer;
2689  t: TfrView;
2690begin
2691  frDesigner.BeforeChange;
2692  with Sender as TMenuItem do
2693  begin
2694    Checked := not Checked;
2695    for i := 0 to frDesigner.Page.Objects.Count - 1 do
2696    begin
2697      t := frDesigner.Page.Objects[i];
2698      if t.Selected then
2699        t.Flags := (t.Flags and not flBandNewPageAfter) +
2700          Word(Checked) * flBandNewPageAfter;
2701    end;
2702  end;
2703end;
2704
2705procedure TfrBandView.P2Click(Sender: TObject);
2706var
2707  i: Integer;
2708  t: TfrView;
2709begin
2710  frDesigner.BeforeChange;
2711  with Sender as TMenuItem do
2712  begin
2713    Checked := not Checked;
2714    for i := 0 to frDesigner.Page.Objects.Count - 1 do
2715    begin
2716      t := frDesigner.Page.Objects[i];
2717      if t.Selected then
2718        t.Flags := (t.Flags and not flBandPrintifSubsetEmpty) +
2719          Word(Checked) * flBandPrintifSubsetEmpty;
2720    end;
2721  end;
2722end;
2723
2724procedure TfrBandView.P3Click(Sender: TObject);
2725var
2726  i: Integer;
2727  t: TfrView;
2728begin
2729  frDesigner.BeforeChange;
2730  with Sender as TMenuItem do
2731  begin
2732    Checked := not Checked;
2733    for i := 0 to frDesigner.Page.Objects.Count - 1 do
2734    begin
2735      t := frDesigner.Page.Objects[i];
2736      if t.Selected then
2737        t.Flags := (t.Flags and not flBandPageBreak) + Word(Checked) * flBandPageBreak;
2738    end;
2739  end;
2740end;
2741
2742procedure TfrBandView.P4Click(Sender: TObject);
2743begin
2744  frDesigner.BeforeChange;
2745  with Sender as TMenuItem do
2746  begin
2747    Checked := not Checked;
2748    Flags := (Flags and not flBandOnFirstPage) + Word(Checked) * flBandOnFirstPage;
2749  end;
2750end;
2751
2752procedure TfrBandView.P5Click(Sender: TObject);
2753begin
2754  frDesigner.BeforeChange;
2755  with Sender as TMenuItem do
2756  begin
2757    Checked := not Checked;
2758    Flags := (Flags and not flBandOnLastPage) + Word(Checked) * flBandOnLastPage;
2759  end;
2760end;
2761
2762procedure TfrBandView.P6Click(Sender: TObject);
2763begin
2764  frDesigner.BeforeChange;
2765  with Sender as TMenuItem do
2766  begin
2767    Checked := not Checked;
2768    Flags := (Flags and not flBandRepeatHeader) + Word(Checked) * flBandRepeatHeader;
2769  end;
2770end;
2771
2772function TfrBandView.GetBandType: TfrBandType;
2773begin
2774  Result := TfrBandType(FrameTyp);
2775end;
2776
2777procedure TfrBandView.SetBandType(const Value: TfrBandType);
2778begin
2779  FrameTyp := Integer(Value);
2780end;
2781
2782{----------------------------------------------------------------------------}
2783constructor TfrSubReportView.Create;
2784begin
2785  inherited Create;
2786  Typ := gtSubReport;
2787  BaseName := 'SubReport';
2788end;
2789
2790procedure TfrSubReportView.Assign(From: TfrView);
2791begin
2792  inherited Assign(From);
2793  SubPage := (From as TfrSubReportView).SubPage;
2794end;
2795
2796procedure TfrSubReportView.Draw(Canvas: TCanvas);
2797begin
2798  BeginDraw(Canvas);
2799  FrameWidth := 1;
2800  CalcGaps;
2801  with Canvas do
2802  begin
2803    Font.Name := 'Arial';
2804    Font.Style := [];
2805    Font.Size := 8;
2806    Font.Color := clBlack;
2807{$IFNDEF Delphi2}
2808    Font.Charset := frCharset;
2809{$ENDIF}
2810    Pen.Width := 1;
2811    Pen.Color := clBlack;
2812    Pen.Style := psSolid;
2813    Brush.Color := clWhite;
2814    Rectangle(x, y, x + dx + 1, y + dy + 1);
2815    Brush.Style := bsClear;
2816    TextRect(DRect, x + 2, y + 2, LoadStr(SSubReportOnPage) + ' ' +
2817      IntToStr(SubPage + 1));
2818  end;
2819  RestoreCoord;
2820end;
2821
2822procedure TfrSubReportView.SaveToFR3Stream(Stream: TStream);
2823
2824  procedure WriteStr(const s: String);
2825  begin
2826    Stream.Write(s[1], Length(s));
2827  end;
2828 
2829begin
2830  inherited;
2831  WriteStr(' Page="Page' + IntToStr(SubPage + 1) + '"');
2832end;
2833
2834procedure TfrSubReportView.DefinePopupMenu(Popup: TPopupMenu);
2835begin
2836  // no specific items in popup menu
2837end;
2838
2839procedure TfrSubReportView.LoadFromStream(Stream: TStream);
2840begin
2841  inherited LoadFromStream(Stream);
2842  Stream.Read(SubPage, 4);
2843end;
2844
2845procedure TfrSubReportView.SaveToStream(Stream: TStream);
2846begin
2847  inherited SaveToStream(Stream);
2848  Stream.Write(SubPage, 4);
2849end;
2850
2851{----------------------------------------------------------------------------}
2852constructor TfrPictureView.Create;
2853begin
2854  inherited Create;
2855  Typ := gtPicture;
2856  Picture := TPicture.Create;
2857  Flags := flStretched + flPictRatio;
2858  BaseName := 'Picture';
2859end;
2860
2861destructor TfrPictureView.Destroy;
2862begin
2863  Picture.Free;
2864  inherited Destroy;
2865end;
2866
2867procedure TfrPictureView.Assign(From: TfrView);
2868begin
2869  inherited Assign(From);
2870  Picture.Assign(TfrPictureView(From).Picture);
2871end;
2872
2873procedure TfrPictureView.Draw(Canvas: TCanvas);
2874var
2875  r: TRect;
2876  kx, ky: Double;
2877  w, h, w1, h1: Integer;
2878
2879  procedure PrintBitmap(DestRect: TRect; Bitmap: TBitmap);
2880  var
2881    BitmapHeader: pBitmapInfo;
2882    BitmapImage: Pointer;
2883    HeaderSize: DWord;
2884    ImageSize: DWord;
2885  begin
2886    GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
2887    GetMem(BitmapHeader, HeaderSize);
2888    GetMem(BitmapImage, ImageSize);
2889    try
2890      GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
2891      StretchDIBits(
2892        Canvas.Handle,
2893        DestRect.Left, DestRect.Top,     // Destination Origin
2894        DestRect.Right - DestRect.Left,  // Destination Width
2895        DestRect.Bottom - DestRect.Top,  // Destination Height
2896        0, 0,                            // Source Origin
2897        Bitmap.Width, Bitmap.Height,     // Source Width & Height
2898        BitmapImage,
2899        TBitmapInfo(BitmapHeader^),
2900        DIB_RGB_COLORS,
2901        SRCCOPY)
2902    finally
2903      FreeMem(BitmapHeader);
2904      FreeMem(BitmapImage)
2905    end;
2906  end;
2907
2908begin
2909  BeginDraw(Canvas);
2910  CalcGaps;
2911  with Canvas do
2912  begin
2913    ShowBackground;
2914    if ((Picture.Graphic = nil) or Picture.Graphic.Empty) and (DocMode = dmDesigning) then
2915    begin
2916      Font.Name := 'Arial';
2917      Font.Size := 8;
2918      Font.Style := [];
2919      Font.Color := clBlack;
2920{$IFNDEF Delphi2}
2921      Font.Charset := frCharset;
2922{$ENDIF}
2923      TextOut(x + 2, y + 2, LoadStr(SPicture));
2924    end
2925    else if not ((Picture.Graphic = nil) or Picture.Graphic.Empty) then
2926    begin
2927      if (Flags and flStretched) <> 0 then
2928      begin
2929        r := DRect;
2930        if (Flags and flPictRatio) <> 0 then
2931        begin
2932          kx := dx / Picture.Width;
2933          ky := dy / Picture.Height;
2934          if kx < ky then
2935            r := Rect(DRect.Left, DRect.Top,
2936              DRect.Right, DRect.Top + Round(Picture.Height * kx))
2937          else
2938            r := Rect(DRect.Left, DRect.Top,
2939              DRect.Left + Round(Picture.Width * ky), DRect.Bottom);
2940          w := DRect.Right - DRect.Left;
2941          h := DRect.Bottom - DRect.Top;
2942          w1 := r.Right - r.Left;
2943          h1 := r.Bottom - r.Top;
2944          if (Flags and flPictCenter) <> 0 then
2945            OffsetRect(r, (w - w1) div 2, (h - h1) div 2);
2946        end;
2947        if IsPrinting and (Picture.Graphic is TBitmap) then
2948          PrintBitmap(r, Picture.Bitmap) else
2949          StretchDraw(r, Picture.Graphic);
2950      end
2951      else
2952      begin
2953        r := DRect;
2954        if (Flags and flPictCenter) <> 0 then
2955        begin
2956          w := DRect.Right - DRect.Left;
2957          h := DRect.Bottom - DRect.Top;
2958          OffsetRect(r, (w - Picture.Width) div 2, (h - Picture.Height) div 2);
2959        end;
2960        Draw(r.Left, r.Top, Picture.Graphic)
2961      end;
2962    end;
2963    ShowFrame;
2964  end;
2965  RestoreCoord;
2966end;
2967
2968const
2969  pkNone = 0;
2970  pkBitmap = 1;
2971  pkMetafile = 2;
2972  pkIcon = 3;
2973  pkJPEG = 4;
2974
2975procedure TfrPictureView.LoadFromStream(Stream: TStream);
2976var
2977  b: Byte;
2978  n: Integer;
2979  Graphic: TGraphic;
2980begin
2981  inherited LoadFromStream(Stream);
2982  Stream.Read(b, 1);
2983  Stream.Read(n, 4);
2984  Graphic := nil;
2985  case b of
2986    pkBitmap:   Graphic := TBitmap.Create;
2987    pkMetafile: Graphic := TMetafile.Create;
2988    pkIcon:     Graphic := TIcon.Create;
2989{$IFDEF JPEG}
2990    pkJPEG:     Graphic := TJPEGImage.Create;
2991{$ENDIF}
2992  end;
2993  Picture.Graphic := Graphic;
2994  if Graphic <> nil then
2995  begin
2996    Graphic.Free;
2997    Picture.Graphic.LoadFromStream(Stream);
2998  end;
2999  Stream.Seek(n, soFromBeginning);
3000end;
3001
3002procedure TfrPictureView.SaveToStream(Stream: TStream);
3003var
3004  b: Byte;
3005  n, o: Integer;
3006begin
3007  inherited SaveToStream(Stream);
3008  b := pkNone;
3009  if Picture.Graphic <> nil then
3010    if Picture.Graphic is TBitmap then
3011      b := pkBitmap
3012    else if Picture.Graphic is TMetafile then
3013      b := pkMetafile
3014    else if Picture.Graphic is TIcon then
3015      b := pkIcon
3016{$IFDEF JPEG}
3017    else if Picture.Graphic is TJPEGImage then
3018      b := pkJPEG
3019{$ENDIF};
3020  Stream.Write(b, 1);
3021  n := Stream.Position;
3022  Stream.Write(n, 4);
3023  if b <> pkNone then
3024    Picture.Graphic.SaveToStream(Stream);
3025  o := Stream.Position;
3026  Stream.Seek(n, soFromBeginning);
3027  Stream.Write(o, 4);
3028  Stream.Seek(0, soFromEnd);
3029end;
3030
3031procedure TfrPictureView.GetBlob(b: TfrTField);
3032begin
3033  if b.IsNull then
3034    Picture.Assign(nil)
3035  else
3036{$IFDEF IBO}
3037    b.AssignTo(Picture);
3038{$ELSE}
3039    Picture.Assign(b);
3040{$ENDIF}
3041end;
3042
3043procedure TfrPictureView.SaveToFR3Stream(Stream: TStream);
3044var
3045  ms:  TMemoryStream;
3046  ds: TfrTDataSet;
3047  fld: TfrTField;
3048
3049  procedure WriteStr(const s: String);
3050  begin
3051    Stream.Write(s[1], Length(s));
3052  end;
3053
3054begin
3055  inherited;
3056
3057  if Picture.Graphic <> nil then
3058  begin
3059    ms := TMemoryStream.Create;
3060    Picture.Graphic.SaveToStream(ms);
3061    WriteStr(' Picture.Propdata="' + frStreamToString(ms) + '"');
3062    ms.Free;
3063  end;
3064
3065  if Memo.Count <> 0 then
3066  begin
3067    frGetDataSetAndField(Memo[0], ds, fld);
3068    if (ds <> nil) and (fld <> nil) then
3069      WriteStr(' DataSet="' + ds.Owner.Name + '.' + ds.Name +
3070        '" DataField="' + StrToXML(fld.FieldName) + '"');
3071  end;
3072
3073  if (Flags and flStretched) = 0 then
3074    WriteStr(' Stretched="False"');
3075  if (Flags and flPictCenter) <> 0 then
3076    WriteStr(' Center="True"');
3077  if (Flags and flPictRatio) = 0 then
3078    WriteStr(' KeepAspectRatio="False"');
3079end;
3080
3081
3082procedure TfrPictureView.DefinePopupMenu(Popup: TPopupMenu);
3083var
3084  m: TMenuItem;
3085begin
3086  inherited DefinePopupMenu(Popup);
3087  m := TMenuItem.Create(Popup);
3088  m.Caption := LoadStr(SPictureCenter);
3089  m.OnClick := P1Click;
3090  m.Checked := (Flags and flPictCenter) <> 0;
3091  Popup.Items.Add(m);
3092
3093  m := TMenuItem.Create(Popup);
3094  m.Caption := LoadStr(SKeepAspectRatio);
3095  m.OnClick := P2Click;
3096  m.Enabled := (Flags and flStretched) <> 0;
3097  if m.Enabled then
3098    m.Checked := (Flags and flPictRatio) <> 0;
3099  Popup.Items.Add(m);
3100end;
3101
3102procedure TfrPictureView.P1Click(Sender: TObject);
3103var
3104  i: Integer;
3105  t: TfrView;
3106begin
3107  frDesigner.BeforeChange;
3108  with Sender as TMenuItem do
3109  begin
3110    Checked := not Checked;
3111    for i := 0 to frDesigner.Page.Objects.Count - 1 do
3112    begin
3113      t := frDesigner.Page.Objects[i];
3114      if t.Selected then
3115        t.Flags := (t.Flags and not flPictCenter) + Word(Checked) * flPictCenter;
3116    end;
3117  end;
3118  frDesigner.AfterChange;
3119end;
3120
3121procedure TfrPictureView.P2Click(Sender: TObject);
3122var
3123  i: Integer;
3124  t: TfrView;
3125begin
3126  frDesigner.BeforeChange;
3127  with Sender as TMenuItem do
3128  begin
3129    Checked := not Checked;
3130    for i := 0 to frDesigner.Page.Objects.Count - 1 do
3131    begin
3132      t := frDesigner.Page.Objects[i];
3133      if t.Selected then
3134        t.Flags := (t.Flags and not flPictRatio) + Word(Checked) * flPictRatio;
3135    end;
3136  end;
3137  frDesigner.AfterChange;
3138end;
3139
3140{----------------------------------------------------------------------------}
3141constructor TfrLineView.Create;
3142begin
3143  inherited Create;
3144  Typ := gtLine;
3145  FrameTyp := 4;
3146  BaseName := 'Line';
3147end;
3148
3149procedure TfrLineView.Draw(Canvas: TCanvas);
3150begin
3151  BeginDraw(Canvas);
3152  if dx > dy then
3153  begin
3154    dy := 0;
3155    FrameTyp := 8;
3156  end
3157  else
3158  begin
3159    dx := 0;
3160    FrameTyp := 4;
3161  end;
3162  CalcGaps;
3163  ShowFrame;
3164  RestoreCoord;
3165end;
3166
3167procedure TfrLineView.DefinePopupMenu(Popup: TPopupMenu);
3168begin
3169  // no specific items in popup menu
3170end;
3171
3172function TfrLineView.GetClipRgn(rt: TfrRgnType): HRGN;
3173var
3174  bx, by, bx1, by1, dd: Integer;
3175begin
3176  bx := x; by := y; bx1 := x + dx + 1; by1 := y + dy + 1;
3177  if FrameStyle <> 5 then
3178    dd := Round(FrameWidth / 2) else
3179    dd := Round(FrameWidth * 1.5);
3180  if FrameTyp = 4 then
3181  begin
3182    Dec(bx, dd);
3183    Inc(bx1, dd);
3184  end
3185  else
3186  begin
3187    Dec(by, dd);
3188    Inc(by1, dd);
3189  end;
3190  if rt = rtNormal then
3191    Result := CreateRectRgn(bx, by, bx1, by1) else
3192    Result := CreateRectRgn(bx - 10, by - 10, bx1 + 10, by1 + 10);
3193end;
3194
3195procedure TfrLineView.SaveToFR3Stream(Stream: TStream);
3196
3197  procedure WriteStr(const s: String);
3198  begin
3199    Stream.Write(s[1], Length(s));
3200  end;
3201
3202begin
3203  inherited;
3204  if (Flags and flStretched) = 0 then
3205    WriteStr(' Stretched="False"');
3206end;
3207
3208
3209{----------------------------------------------------------------------------}
3210constructor TfrBand.Create(ATyp: TfrBandType; AParent: TfrPage);
3211begin
3212  inherited Create;
3213  Typ := ATyp;
3214  Parent := AParent;
3215  Objects := TList.Create;
3216  Memo := TStringList.Create;
3217  Script := TStringList.Create;
3218  Values := TStringList.Create;
3219  Next := nil;
3220  Positions[psLocal] := 1;
3221  Positions[psGlobal] := 1;
3222  Visible := True;
3223end;
3224
3225destructor TfrBand.Destroy;
3226begin
3227  if Next <> nil then
3228    Next.Free;
3229  Objects.Free;
3230  Memo.Free;
3231  Script.Free;
3232  Values.Free;
3233  if DataSet <> nil then
3234    DataSet.Exit;
3235  if IsVirtualDS then
3236    DataSet.Free;
3237  if VCDataSet <> nil then
3238    VCDataSet.Exit;
3239  if IsVirtualVCDS then
3240    VCDataSet.Free;
3241  inherited Destroy;
3242end;
3243
3244procedure TfrBand.InitDataSet(Desc: String);
3245begin
3246  if Typ = btGroupHeader then
3247    GroupCondition := Desc
3248  else
3249    if Pos(';', Desc) = 0 then
3250      CreateDS(Desc, DataSet, IsVirtualDS);
3251  if (Typ = btMasterData) and (Dataset = nil) and
3252     (CurReport.ReportType = rtSimple) then
3253    DataSet := CurReport.Dataset;
3254end;
3255
3256procedure TfrBand.DoError;
3257var
3258  i: Integer;
3259begin
3260  ErrorFlag := True;
3261  ErrorStr := LoadStr(SErrorOccured);
3262  for i := 0 to CurView.Memo.Count - 1 do
3263    ErrorStr := ErrorStr + #13 + CurView.Memo[i];
3264  ErrorStr := ErrorStr + #13 + LoadStr(SDoc) + ' ' + CurReport.Name +
3265    #13 + LoadStr(SBand) + ' ' + frBandNames[Integer(CurView.Parent.Typ)];
3266  MasterReport.Terminated := True;
3267end;
3268
3269function TfrBand.CalcHeight: Integer;
3270var
3271  Bnd: TfrBand;
3272  DS: TfrDataSet;
3273  ddx: Integer;
3274
3275  function DoCalcHeight(CheckAll: Boolean): Integer;
3276  var
3277    i, h: Integer;
3278    t: TfrView;
3279  begin
3280    CurBand := Self;
3281    AggrBand := Self;
3282    Result := dy;
3283    for i := 0 to Objects.Count - 1 do
3284    begin
3285      t := Objects[i];
3286      t.olddy := t.dy;
3287      if t is TfrStretcheable then
3288        if (t.Parent = Self) or CheckAll then
3289        begin
3290          h := TfrStretcheable(t).CalcHeight + t.y;
3291          if h > Result then
3292            Result := h;
3293          if CheckAll then
3294            TfrStretcheable(t).DrawMode := drAll;
3295        end
3296    end;
3297  end;
3298begin
3299  Result := dy;
3300  if HasCross and (Typ <> btPageFooter) then
3301  begin
3302    Parent.ColPos := 1;
3303    CurReport.InternalOnBeginColumn(Self);
3304    if Parent.BandExists(Parent.Bands[btCrossData]) then
3305    begin
3306      Bnd := Parent.Bands[btCrossData];
3307      if Bnd.DataSet <> nil then
3308        DS := Bnd.DataSet else
3309        DS := VCDataSet;
3310      DS.First;
3311      while not DS.Eof do
3312      begin
3313        ddx := 0;
3314        CurReport.InternalOnPrintColumn(Parent.ColPos, ddx);
3315        CalculatedHeight := DoCalcHeight(True);
3316        if CalculatedHeight > Result then
3317          Result := CalculatedHeight;
3318        Inc(Parent.ColPos);
3319        DS.Next;
3320        if MasterReport.Terminated then break;
3321      end;
3322    end;
3323  end
3324  else
3325    Result := DoCalcHeight(False);
3326  CalculatedHeight := Result;
3327end;
3328
3329procedure TfrBand.StretchObjects(MaxHeight: Integer);
3330var
3331  i: Integer;
3332  t: TfrView;
3333begin
3334  for i := 0 to Objects.Count - 1 do
3335  begin
3336    t := Objects[i];
3337    if (t is TfrStretcheable) or (t is TfrLineView) then
3338      if (t.Flags and flStretched) <> 0 then
3339        t.dy := MaxHeight - t.y;
3340  end;
3341end;
3342
3343procedure TfrBand.UnStretchObjects;
3344var
3345  i: Integer;
3346  t: TfrView;
3347begin
3348  for i := 0 to Objects.Count - 1 do
3349  begin
3350    t := Objects[i];
3351    t.dy := t.olddy;
3352  end;
3353end;
3354
3355procedure TfrBand.DrawObject(t: TfrView);
3356var
3357  ox,oy: Integer;
3358begin
3359  CurPage := Parent;
3360  CurBand := Self;
3361  AggrBand := Self;
3362  try
3363    if (t.Parent = Self) and not DisableDrawing then
3364    begin
3365      ox := t.x; Inc(t.x, Parent.XAdjust - Parent.LeftMargin);
3366      oy := t.y; Inc(t.y, y);
3367      t.Print(MasterReport.EMFPages[PageNo].Stream);
3368      t.x := ox; t.y := oy;
3369      if (t is TfrMemoView) and
3370         (TfrMemoView(t).DrawMode in [drAll, drAfterCalcHeight]) then
3371        Parent.AfterPrint;
3372    end;
3373  except
3374    on exception do DoError;
3375  end;
3376end;
3377
3378procedure TfrBand.PrepareSubReports;
3379var
3380  i: Integer;
3381  t: TfrView;
3382  Page: TfrPage;
3383begin
3384  for i := SubIndex to Objects.Count - 1 do
3385  begin
3386    t := Objects[i];
3387    Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
3388    Page.Mode := pmBuildList;
3389    Page.FormPage;
3390    Page.CurY := y + t.y;
3391    Page.CurBottomY := Parent.CurBottomY;
3392    Page.XAdjust := Parent.XAdjust + t.x;
3393    Page.ColCount := 1;
3394    Page.PlayFrom := 0;
3395    EOFArr[i - SubIndex] := False;
3396  end;
3397  Parent.LastBand := nil;
3398end;
3399
3400procedure TfrBand.DoSubReports;
3401var
3402  i: Integer;
3403  t: TfrView;
3404  Page: TfrPage;
3405begin
3406  repeat
3407    if not EOFReached then
3408      for i := SubIndex to Objects.Count - 1 do
3409      begin
3410        t := Objects[i];
3411        Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
3412        Page.CurY := Parent.CurY;
3413        Page.CurBottomY := Parent.CurBottomY;
3414      end;
3415    EOFReached := True;
3416    MaxY := Parent.CurY;
3417    for i := SubIndex to Objects.Count - 1 do
3418      if not EOFArr[i - SubIndex] then
3419      begin
3420        t := Objects[i];
3421        Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
3422        if Page.PlayRecList then
3423          EOFReached := False
3424        else
3425        begin
3426          EOFArr[i - SubIndex] := True;
3427          if Page.CurY > MaxY then MaxY := Page.CurY;
3428        end;
3429      end;
3430    if not EOFReached then
3431    begin
3432      if Parent.Skip then
3433      begin
3434        Parent.LastBand := Self;
3435        Exit;
3436      end
3437      else
3438        Parent.NewPage;
3439    end;
3440  until EOFReached or MasterReport.Terminated;
3441  for i := SubIndex to Objects.Count - 1 do
3442  begin
3443    t := Objects[i];
3444    Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
3445    Page.ClearRecList;
3446  end;
3447  Parent.CurY := MaxY;
3448  Parent.LastBand := nil;
3449end;
3450
3451function TfrBand.DrawObjects: Boolean;
3452var
3453  i: Integer;
3454  t: TfrView;
3455begin
3456  Result := False;
3457  for i := 0 to Objects.Count - 1 do
3458  begin
3459    t := Objects[i];
3460    if t.Typ = gtSubReport then
3461    begin
3462      SubIndex := i;
3463      Result := True;
3464      PrepareSubReports;
3465      DoSubReports;
3466      break;
3467    end;
3468    DrawObject(t);
3469    if MasterReport.Terminated then break;
3470  end;
3471end;
3472
3473procedure TfrBand.DrawCrossCell(Parnt: TfrBand; CurX: Integer);
3474var
3475  i, sfx, sfy: Integer;
3476  t: TfrView;
3477begin
3478  if DisableDrawing then Exit;
3479  try
3480    for i := 0 to Objects.Count - 1 do
3481    begin
3482      t := Objects[i];
3483      if Parnt.Objects.IndexOf(t) <> -1 then
3484      begin
3485        sfx := t.x; Inc(t.x, CurX);
3486        sfy := t.y; Inc(t.y, Parnt.y);
3487        t.Parent := Parnt;
3488        t.Print(MasterReport.EMFPages[PageNo].Stream);
3489        if (t is TfrMemoView) and
3490           (TfrMemoView(t).DrawMode in [drAll, drAfterCalcHeight]) then
3491          Parent.AfterPrint;
3492        t.Parent := Self;
3493        t.x := sfx;
3494        t.y := sfy;
3495      end;
3496    end;
3497  except
3498    on exception do DoError;
3499  end;
3500end;
3501
3502procedure TfrBand.DrawCross;
3503var
3504  Bnd: TfrBand;
3505  sfpage: Integer;
3506  CurX, ddx: Integer;
3507  DS: TfrDataSet;
3508
3509  procedure CheckColumnPageBreak(ddx: Integer);
3510  var
3511    sfy: Integer;
3512    b: TfrBand;
3513  begin
3514    if CurX + ddx > Parent.RightMargin then
3515    begin
3516      Inc(ColumnXAdjust, CurX - Parent.LeftMargin);
3517      CurX := Parent.LeftMargin;
3518      Inc(PageNo);
3519      if PageNo >= MasterReport.EMFPages.Count then
3520      begin
3521        MasterReport.EMFPages.Add(Parent);
3522        sfy := Parent.CurY;
3523        Parent.ShowBand(Parent.Bands[btOverlay]);
3524        Parent.CurY := Parent.TopMargin;
3525        if (sfPage <> 0) or
3526          ((Parent.Bands[btPageHeader].Flags and flBandOnFirstPage) <> 0) then
3527          Parent.ShowBand(Parent.Bands[btPageHeader]);
3528        Parent.CurY := sfy;
3529        CurReport.InternalOnProgress(PageNo);
3530      end;
3531      if Parent.BandExists(Parent.Bands[btCrossHeader]) then
3532        if (Parent.Bands[btCrossHeader].Flags and flBandRepeatHeader) <> 0 then
3533        begin
3534          b := Parent.Bands[btCrossHeader];
3535          b.DrawCrossCell(Self, Parent.LeftMargin);
3536          CurX := Parent.LeftMargin + b.dx;
3537        end;
3538    end;
3539  end;
3540begin
3541  ColumnXAdjust := 0;
3542  Parent.ColPos := 1;
3543  CurX := 0;
3544  sfpage := PageNo;
3545  if Typ = btPageFooter then Exit;
3546  IsColumns := True;
3547  CurReport.InternalOnBeginColumn(Self);
3548  if Parent.BandExists(Parent.Bands[btCrossHeader]) then
3549  begin
3550    Bnd := Parent.Bands[btCrossHeader];
3551    Bnd.DrawCrossCell(Self, Bnd.x);
3552    CurX := Bnd.x + Bnd.dx;
3553  end;
3554  if Parent.BandExists(Parent.Bands[btCrossData]) then
3555  begin
3556    Bnd := Parent.Bands[btCrossData];
3557    if CurX = 0 then CurX := Bnd.x;
3558    if Bnd.DataSet <> nil then
3559      DS := Bnd.DataSet else
3560      DS := VCDataSet;
3561    if DS <> nil then
3562    begin
3563      DS.First;
3564      while not DS.Eof do
3565      begin
3566        ddx := Bnd.dx;
3567        CurReport.InternalOnPrintColumn(Parent.ColPos, ddx);
3568        CheckColumnPageBreak(ddx);
3569        Bnd.DrawCrossCell(Self, CurX);
3570
3571        if Typ in [btMasterData, btDetailData, btSubdetailData] then
3572          Parent.DoAggregate([btPageFooter, btMasterFooter, btDetailFooter,
3573             btSubDetailFooter, btGroupFooter, btCrossFooter, btReportSummary]);
3574
3575        Inc(CurX, ddx);
3576        Inc(Parent.ColPos);
3577        DS.Next;
3578        if MasterReport.Terminated then break;
3579      end;
3580    end;
3581  end;
3582  if Parent.BandExists(Parent.Bands[btCrossFooter]) then
3583  begin
3584    Bnd := Parent.Bands[btCrossFooter];
3585    if CurX = 0 then CurX := Bnd.x;
3586    CheckColumnPageBreak(Bnd.dx);
3587    AggrBand := Bnd;
3588    Bnd.DrawCrossCell(Self, CurX);
3589    Bnd.InitValues;
3590  end;
3591  PageNo := sfpage;
3592  ColumnXAdjust := 0;
3593  IsColumns := False;
3594end;
3595
3596function TfrBand.CheckPageBreak(y, dy: Integer; PBreak: Boolean): Boolean;
3597begin
3598  Result := False;
3599  with Parent do
3600  if y + Bands[btColumnFooter].dy + dy > CurBottomY then
3601  begin
3602    if not PBreak then
3603      NewColumn(Self);
3604    Result := True;
3605  end;
3606end;
3607
3608procedure TfrBand.DrawPageBreak;
3609var
3610  i: Integer;
3611  dy, oldy, olddy, maxy: Integer;
3612  t: TfrView;
3613  Flag: Boolean;
3614
3615  procedure CorrY(t: TfrView; dy: Integer);
3616  var
3617    i: Integer;
3618    t1: TfrView;
3619  begin
3620    for i := 0 to Objects.Count - 1 do
3621    begin
3622      t1 := Objects[i];
3623      if t1 <> t then
3624        if (t1.y > t.y + t.dy) and (t1.x >= t.x) and (t1.x <= t.x + t.dx) then
3625          Inc(t1.y, dy);
3626    end;
3627  end;
3628
3629begin
3630  for i := 0 to Objects.Count - 1 do
3631  begin
3632    t := Objects[i];
3633    t.Selected := True;
3634    t.OriginalRect := Rect(t.x, t.y, t.dx, t.dy);
3635  end;
3636  if not CheckPageBreak(y, maxdy, True) then
3637    DrawObjects
3638  else
3639  begin
3640    for i := 0 to Objects.Count - 1 do
3641    begin
3642      t := Objects[i];
3643      if t is TfrStretcheable then
3644        TfrStretcheable(t).ActualHeight := 0;
3645      if t is TfrMemoView then
3646      begin
3647        TfrMemoView(t).CalcHeight; // wraps a memo onto separate lines
3648        t.Memo1.Assign(SMemo);
3649      end;
3650    end;
3651    repeat
3652      dy := Parent.CurBottomY - Parent.Bands[btColumnFooter].dy - y - 2;
3653      maxy := 0;
3654      for i := 0 to Objects.Count - 1 do
3655      begin
3656        t := Objects[i];
3657        if t.Selected then
3658        if (t.y >= 0) and (t.y < dy) then
3659          if (t.y + t.dy < dy) then
3660          begin
3661            if maxy < t.y + t.dy then maxy := t.y + t.dy;
3662            DrawObject(t);
3663            t.Selected := False;
3664          end
3665          else
3666          begin
3667            if t is TfrStretcheable then
3668            begin
3669              olddy := t.dy;
3670              t.dy := dy - t.y + 1;
3671              Inc(TfrStretcheable(t).ActualHeight, t.dy);
3672              if t.dy > TfrStretcheable(t).MinHeight then
3673              begin
3674                TfrStretcheable(t).DrawMode := drPart;
3675                DrawObject(t);
3676              end;
3677              t.dy := olddy;
3678            end
3679            else
3680              t.y := dy
3681          end
3682        else if t is TfrStretcheable then
3683          if (t.y < 0) and (t.y + t.dy >= 0) then
3684            if t.y + t.dy < dy then
3685            begin
3686              oldy := t.y; olddy := t.dy;
3687              t.dy := t.y + t.dy;
3688              t.y := 0;
3689              if t.dy > TfrStretcheable(t).MinHeight div 2 then
3690              begin
3691                t.dy := TfrStretcheable(t).RemainHeight + t.gapy * 2 + 1;
3692                Inc(TfrStretcheable(t).ActualHeight, t.dy - 1);
3693                if maxy < t.y + t.dy then
3694                  maxy := t.y + t.dy;
3695                TfrStretcheable(t).DrawMode := drPart;
3696                DrawObject(t);
3697              end;
3698              t.y := oldy; t.dy := olddy;
3699              CorrY(t, TfrStretcheable(t).ActualHeight - t.dy);
3700              t.Selected := False;
3701            end
3702            else
3703            begin
3704              oldy := t.y; olddy := t.dy;
3705              t.y := 0; t.dy := dy;
3706              Inc(TfrStretcheable(t).ActualHeight, t.dy);
3707              TfrStretcheable(t).DrawMode := drPart;
3708              DrawObject(t);
3709              t.y := oldy; t.dy := olddy;
3710            end;
3711      end;
3712      Flag := False;
3713      for i := 0 to Objects.Count - 1 do
3714      begin
3715        t := Objects[i];
3716        if t.Selected then Flag := True;
3717        Dec(t.y, dy);
3718      end;
3719      if Flag then CheckPageBreak(y, 10000, False);
3720      y := Parent.CurY;
3721      if MasterReport.Terminated then break;
3722    until not Flag;
3723    maxdy := maxy;
3724  end;
3725  for i := 0 to Objects.Count - 1 do
3726  begin
3727    t := Objects[i];
3728    t.y := t.OriginalRect.Top;
3729    t.dy := t.OriginalRect.Bottom;
3730  end;
3731  Inc(Parent.CurY, maxdy);
3732end;
3733
3734function TfrBand.HasCross: Boolean;
3735var
3736  i: Integer;
3737  t: TfrView;
3738begin
3739  Result := False;
3740  for i := 0 to Objects.Count - 1 do
3741  begin
3742    t := Objects[i];
3743    if t.Parent <> Self then
3744    begin
3745      Result := True;
3746      break;
3747    end;
3748  end;
3749end;
3750
3751procedure TfrBand.DoDraw;
3752var
3753  sfy, sh: Integer;
3754  UseY, WasSub: Boolean;
3755
3756begin
3757  if Objects.Count = 0 then Exit;
3758  sfy := y;
3759  UseY := not (Typ in [btPageFooter, btOverlay, btNone]);
3760  if UseY then y := Parent.CurY;
3761  if Stretched then
3762  begin
3763    sh := CalculatedHeight;
3764//    sh := CalcHeight;
3765    if sh > dy then StretchObjects(sh);
3766    maxdy := sh;
3767    if not PageBreak then CheckPageBreak(y, sh, False);
3768    y := Parent.CurY;
3769    WasSub := False;
3770    if PageBreak then
3771    begin
3772      DrawPageBreak;
3773      sh := 0;
3774    end
3775    else
3776    begin
3777      WasSub := DrawObjects;
3778      if HasCross then DrawCross;
3779    end;
3780    UnStretchObjects;
3781    if not WasSub then Inc(Parent.CurY, sh);
3782  end
3783  else
3784  begin
3785    if UseY then
3786    begin
3787      if not PageBreak then CheckPageBreak(y, dy, False);
3788      y := Parent.CurY;
3789    end;
3790    if PageBreak then
3791    begin
3792      maxdy := CalculatedHeight;
3793//      maxdy := CalcHeight;
3794      DrawPageBreak;
3795    end
3796    else
3797    begin
3798      WasSub := DrawObjects;
3799      if HasCross then DrawCross;
3800      if UseY and not WasSub then Inc(Parent.CurY, dy);
3801    end;
3802  end;
3803  y := sfy;
3804  if Typ in [btMasterData, btDetailData, btSubDetailData] then
3805    Parent.DoAggregate([btPageFooter, btMasterFooter, btDetailFooter,
3806                 btSubDetailFooter, btGroupFooter, btReportSummary]);
3807end;
3808
3809function TfrBand.DoCalcHeight: Integer;
3810var
3811  b: TfrBand;
3812begin
3813  if (Typ in [btMasterData, btDetailData, btSubDetailData]) and
3814    (Next <> nil) and (Next.Dataset = nil) then
3815  begin
3816    b := Self;
3817    Result := 0;
3818    repeat
3819      Result := Result + b.CalcHeight;
3820      b := b.Next;
3821    until b = nil;
3822  end
3823  else
3824  begin
3825    Result := dy;
3826    CalculatedHeight := dy;
3827    if Stretched then Result := CalcHeight;
3828  end;
3829end;
3830
3831function TfrBand.Draw: Boolean;
3832var
3833  b: TfrBand;
3834begin
3835  Result := False;
3836  CurView := View;
3837  CurBand := Self;
3838  AggrBand := Self;
3839  CalculatedHeight := -1;
3840
3841  ForceNewPage := False;
3842  ForceNewColumn := False;
3843  if Assigned(CurReport.FOnBeginBand) then
3844    CurReport.FOnBeginBand(Self);
3845  frInterpretator.DoScript(Script);
3846// new page was requested in script
3847  if ForceNewPage then
3848  begin
3849    Parent.CurColumn := Parent.ColCount - 1;
3850    Parent.NewColumn(Self);
3851  end;
3852  if ForceNewColumn then
3853    Parent.NewColumn(Self);
3854
3855  if Visible then
3856  begin
3857    if Typ = btColumnHeader then
3858      Parent.LastStaticColumnY := Parent.CurY;
3859    if Typ = btPageFooter then
3860      y := Parent.CurBottomY;
3861    if Objects.Count > 0 then
3862    begin
3863      if not (Typ in [btPageFooter, btOverlay, btNone]) then
3864        if (Parent.CurY + DoCalcHeight > Parent.CurBottomY) and not PageBreak then
3865        begin
3866          Result := True;
3867          if Parent.Skip then
3868            Exit else
3869            CheckPageBreak(0, 10000, False);
3870        end;
3871      EOFReached := True;
3872
3873// dealing with multiple bands
3874      if (Typ in [btMasterData, btDetailData, btSubDetailData]) and
3875        (Next <> nil) and (Next.Dataset = nil) and (DataSet <> nil) then
3876      begin
3877        b := Self;
3878        repeat
3879          b.DoDraw;
3880          b := b.Next;
3881        until b = nil;
3882      end
3883      else
3884      begin
3885        DoDraw;
3886        if not (Typ in [btMasterData, btDetailData, btSubDetailData, btGroupHeader]) and
3887          NewPageAfter then
3888          Parent.NewPage;
3889      end;
3890      if not EOFReached then Result := True;
3891    end;
3892  end
3893// if band is not visible, just performing aggregate calculations
3894// relative to it
3895  else if Typ in [btMasterData, btDetailData, btSubDetailData] then
3896    Parent.DoAggregate([btPageFooter, btMasterFooter, btDetailFooter,
3897                        btSubDetailFooter, btGroupFooter, btReportSummary]);
3898
3899// check if multiple pagefooters (in cross-tab report) - resets last of them
3900  if not DisableInit then
3901    if (Typ <> btPageFooter) or (PageNo = MasterReport.EMFPages.Count - 1) then
3902      InitValues;
3903  if Assigned(CurReport.FOnEndBand) then
3904    CurReport.FOnEndBand(Self);
3905end;
3906
3907procedure TfrBand.InitValues;
3908var
3909  b: TfrBand;
3910begin
3911  if Typ = btGroupHeader then
3912  begin
3913    b := Self;
3914    while b <> nil do
3915    begin
3916      if b.FooterBand <> nil then
3917      begin
3918        b.FooterBand.Values.Clear;
3919        b.FooterBand.Count := 0;
3920      end;
3921      b.LastGroupValue := frParser.Calc(b.GroupCondition);
3922      b := b.Next;
3923    end;
3924  end
3925  else
3926  begin
3927    Values.Clear;
3928    Count := 0;
3929  end
3930end;
3931
3932procedure TfrBand.DoAggregate;
3933var
3934  i: Integer;
3935  t: TfrView;
3936  s: String;
3937  v: Boolean;
3938begin
3939  for i := 0 to Values.Count - 1 do
3940  begin
3941    s := Values[i];
3942    Values[i] := Copy(s, 1, Pos('=', s) - 1) + '=0' + Copy(s, Pos('=', s) + 2, 255);
3943  end;
3944
3945  v := Visible;
3946  Visible := False;
3947  AggrBand := Self;
3948  for i := 0 to Objects.Count - 1 do
3949  begin
3950    t := Objects[i];
3951    CurView := t;
3952    if t is TfrMemoView then
3953      TfrMemoView(t).ExpandVariables;
3954  end;
3955  Visible := v;
3956  Inc(Count);
3957end;
3958
3959{----------------------------------------------------------------------------}
3960type
3961  TfrBandParts = (bpHeader, bpData, bpFooter);
3962const
3963  MAXBNDS = 3;
3964  Bnds: Array[1..MAXBNDS, TfrBandParts] of TfrBandType =
3965   ((btMasterHeader, btMasterData, btMasterFooter),
3966    (btDetailHeader, btDetailData, btDetailFooter),
3967    (btSubDetailHeader, btSubDetailData, btSubDetailFooter));
3968
3969
3970constructor TfrPage.Create(ASize, AWidth, AHeight: Integer;
3971  AOr: TPrinterOrientation);
3972begin
3973  inherited Create;
3974  List := TList.Create;
3975  Objects := TList.Create;
3976  RTObjects := TList.Create;
3977  ChangePaper(ASize, AWidth, AHeight, AOr);
3978  PrintToPrevPage := False;
3979  UseMargins := True;
3980end;
3981
3982destructor TfrPage.Destroy;
3983begin
3984  Clear;
3985  Objects.Free;
3986  RTObjects.Free;
3987  List.Free;
3988  inherited Destroy;
3989end;
3990
3991procedure TfrPage.ChangePaper(ASize, AWidth, AHeight: Integer;
3992  AOr: TPrinterOrientation);
3993begin
3994  try
3995    Prn.SetPrinterInfo(ASize, AWidth, AHeight, AOr);
3996    Prn.FillPrnInfo(PrnInfo);
3997  except
3998    on exception do
3999    begin
4000      Prn.SetPrinterInfo($100, AWidth, AHeight, AOr);
4001      Prn.FillPrnInfo(PrnInfo);
4002    end;
4003  end;
4004  pgSize := Prn.PaperSize;
4005  pgWidth := Prn.PaperWidth;
4006  pgHeight := Prn.PaperHeight;
4007  pgOr := Prn.Orientation;
4008end;
4009
4010procedure TfrPage.Clear;
4011begin
4012  while Objects.Count > 0 do
4013    Delete(0);
4014end;
4015
4016procedure TfrPage.Delete(Index: Integer);
4017begin
4018  TfrView(Objects[Index]).Free;
4019  Objects.Delete(Index);
4020end;
4021
4022function TfrPage.FindObjectByID(ID: Integer): Integer;
4023var
4024  i: Integer;
4025begin
4026  Result := -1;
4027  for i := 0 to Objects.Count - 1 do
4028    if TfrView(Objects[i]).ID = ID then
4029    begin
4030      Result := i;
4031      break;
4032    end;
4033end;
4034
4035function TfrPage.FindObject(Name: String): TfrView;
4036var
4037  i: Integer;
4038begin
4039  Result := nil;
4040  for i := 0 to Objects.Count - 1 do
4041    if AnsiCompareText(TfrView(Objects[i]).Name, Name) = 0 then
4042    begin
4043      Result := Objects[i];
4044      Exit;
4045    end;
4046end;
4047
4048function TfrPage.FindRTObject(Name: String): TfrView;
4049var
4050  i: Integer;
4051begin
4052  Result := nil;
4053  for i := 0 to RTObjects.Count - 1 do
4054    if AnsiCompareText(TfrView(RTObjects[i]).Name, Name) = 0 then
4055    begin
4056      Result := RTObjects[i];
4057      Exit;
4058    end;
4059end;
4060
4061procedure TfrPage.InitReport;
4062var
4063  b: TfrBandType;
4064begin
4065  for b := btReportTitle to btNone do
4066    Bands[b] := TfrBand.Create(b, Self);
4067  while RTObjects.Count > 0 do
4068  begin
4069    TfrView(RTObjects[0]).Free;
4070    RTObjects.Delete(0);
4071  end;
4072  TossObjects;
4073  InitFlag := True;
4074  CurPos := 1; ColPos := 1;
4075end;
4076
4077procedure TfrPage.DoneReport;
4078var
4079  b: TfrBandType;
4080begin
4081  if InitFlag then
4082  begin
4083    for b := btReportTitle to btNone do
4084      Bands[b].Free;
4085    while RTObjects.Count > 0 do
4086    begin
4087      TfrView(RTObjects[0]).Free;
4088      RTObjects.Delete(0);
4089    end;
4090  end;
4091  InitFlag := False;
4092end;
4093
4094function TfrPage.TopMargin: Integer;
4095begin
4096  if UseMargins then
4097    if pgMargins.Top = 0 then
4098      Result := PrnInfo.Ofy else
4099      Result := pgMargins.Top
4100  else
4101    Result := 0;
4102end;
4103
4104function TfrPage.BottomMargin: Integer;
4105begin
4106  with PrnInfo do
4107    if UseMargins then
4108      if pgMargins.Bottom = 0 then
4109        Result := Ofy + Ph else
4110        Result := Pgh - pgMargins.Bottom
4111    else
4112      Result := Pgh;
4113  if (DocMode <> dmDesigning) and BandExists(Bands[btPageFooter]) then
4114    Result := Result - Bands[btPageFooter].dy;
4115end;
4116
4117function TfrPage.LeftMargin: Integer;
4118begin
4119  if UseMargins then
4120    if pgMargins.Left = 0 then
4121      Result := PrnInfo.Ofx else
4122      Result := pgMargins.Left
4123  else
4124    Result := 0;
4125end;
4126
4127function TfrPage.RightMargin: Integer;
4128begin
4129  with PrnInfo do
4130    if UseMargins then
4131      if pgMargins.Right = 0 then
4132        Result := Ofx + Pw else
4133        Result := Pgw - pgMargins.Right
4134    else
4135      Result := Pgw;
4136end;
4137
4138procedure TfrPage.TossObjects;
4139var
4140  i, j, n, last, miny: Integer;
4141  b: TfrBandType;
4142  bt, t: TfrView;
4143  Bnd, Bnd1: TfrBand;
4144  FirstBand, Flag: Boolean;
4145  BArr: Array[0..31] of TfrBand;
4146  s: String;
4147begin
4148  for i := 0 to Objects.Count - 1 do
4149  begin
4150    bt := Objects[i];
4151    t := frCreateObject(bt.Typ, bt.ClassName);
4152    t.Assign(bt);
4153    t.StreamMode := smPrinting;
4154    RTObjects.Add(t);
4155    if (t.Flags and flWantHook) <> 0 then
4156      HookList.Add(t);
4157  end;
4158
4159  for i := 0 to RTObjects.Count - 1 do // select all objects exclude bands
4160  begin
4161    t := RTObjects[i];
4162    t.Selected := t.Typ <> gtBand;
4163    t.Parent := nil;
4164    frInterpretator.PrepareScript(t.Script, t.Script, SMemo);
4165    if t.Typ = gtSubReport then
4166      CurReport.Pages[(t as TfrSubReportView).SubPage].Skip := True;
4167  end;
4168  Flag := False;
4169  for i := 0 to RTObjects.Count - 1 do // search for btCrossXXX bands
4170  begin
4171    bt := RTObjects[i];
4172    if (bt.Typ = gtBand) and
4173       (TfrBandType(bt.FrameTyp) in [btCrossHeader..btCrossFooter]) then
4174    with Bands[TfrBandType(bt.FrameTyp)] do
4175    begin
4176      Memo.Assign(bt.Memo);
4177      Script.Assign(bt.Script);
4178      x := bt.x; dx := bt.dx;
4179      InitDataSet(bt.FormatStr);
4180      View := bt;
4181      Flags := bt.Flags;
4182      Visible := bt.Visible;
4183      bt.Parent := Bands[TfrBandType(bt.FrameTyp)];
4184      Flag := True;
4185    end;
4186  end;
4187
4188  if Flag then // fill a ColumnXXX bands at first
4189    for b := btCrossHeader to btCrossFooter do
4190    begin
4191      Bnd := Bands[b];
4192      for i := 0 to RTObjects.Count - 1 do
4193      begin
4194        t := RTObjects[i];
4195        if t.Selected then
4196         if (t.x >= Bnd.x) and (t.x + t.dx <= Bnd.x + Bnd.dx) then
4197         begin
4198           t.x := t.x - Bnd.x;
4199           t.Parent := Bnd;
4200           Bnd.Objects.Add(t);
4201         end;
4202      end;
4203    end;
4204
4205  for b := btReportTitle to btGroupFooter do // fill other bands
4206  begin
4207    FirstBand := True;
4208    Bnd := Bands[b];
4209    BArr[0] := Bnd;
4210    Last := 1;
4211    for i := 0 to RTObjects.Count - 1 do // search for specified band
4212    begin
4213      bt := RTObjects[i];
4214      if (bt.Typ = gtBand) and (bt.FrameTyp = Integer(b)) then
4215      begin
4216        if not FirstBand then
4217        begin
4218          Bnd.Next := TfrBand.Create(b,Self);
4219          Bnd := Bnd.Next;
4220          BArr[Last] := Bnd;
4221          Inc(Last);
4222        end;
4223        FirstBand := False;
4224        Bnd.Memo.Assign(bt.Memo);
4225        Bnd.Script.Assign(bt.Script);
4226        Bnd.y := bt.y;
4227        Bnd.dy := bt.dy;
4228        Bnd.View := bt;
4229        Bnd.Flags := bt.Flags;
4230        Bnd.Visible := bt.Visible;
4231        bt.Parent := Bnd;
4232        with bt as TfrBandView, Bnd do
4233        begin
4234          InitDataSet(FormatStr);
4235          Stretched := (Flags and flStretched) <> 0;
4236          PrintIfSubsetEmpty := (Flags and flBandPrintIfSubsetEmpty) <> 0;
4237          if Skip then
4238          begin
4239            NewPageAfter := False;
4240            PageBreak := False;
4241          end
4242          else
4243          begin
4244            NewPageAfter := (Flags and flBandNewPageAfter) <> 0;
4245            PageBreak := (Flags and flBandPageBreak) <> 0;
4246          end;
4247        end;
4248        for j := 0 to RTObjects.Count - 1 do // placing objects over band
4249        begin
4250          t := RTObjects[j];
4251          if (t.Parent = nil) and (t.Typ <> gtSubReport) then
4252           if t.Selected then
4253            if (t.y >= Bnd.y) and (t.y <= Bnd.y + Bnd.dy) then
4254            begin
4255              t.Parent := Bnd;
4256              t.y := t.y - Bnd.y;
4257              t.Selected := False;
4258              Bnd.Objects.Add(t);
4259            end;
4260        end;
4261        for j := 0 to RTObjects.Count - 1 do // placing ColumnXXX objects over band
4262        begin
4263          t := RTObjects[j];
4264          if t.Parent <> nil then
4265           if t.Selected then
4266            if (t.y >= Bnd.y) and (t.y <= Bnd.y + Bnd.dy) then
4267            begin
4268              t.y := t.y - Bnd.y;
4269              t.Selected := False;
4270              Bnd.Objects.Add(t);
4271            end;
4272        end;
4273        for j := 0 to RTObjects.Count - 1 do // placing subreports over band
4274        begin
4275          t := RTObjects[j];
4276          if (t.Parent = nil) and (t.Typ = gtSubReport) then
4277           if t.Selected then
4278            if (t.y >= Bnd.y) and (t.y <= Bnd.y + Bnd.dy) then
4279            begin
4280              t.Parent := Bnd;
4281              t.y := t.y - Bnd.y;
4282              t.Selected := False;
4283              Bnd.Objects.Add(t);
4284            end;
4285        end;
4286      end;
4287    end;
4288    for i := 0 to Last - 1 do // sorting bands
4289    begin
4290      miny := BArr[i].y; n := i;
4291      for j := i + 1 to Last - 1 do
4292        if BArr[j].y < miny then
4293        begin
4294          miny := BArr[j].y;
4295          n := j;
4296        end;
4297      Bnd := BArr[i]; BArr[i] := BArr[n]; BArr[n] := Bnd;
4298    end;
4299    Bnd := BArr[0]; Bands[b] := Bnd;
4300    Bnd.Prev := nil;
4301    for i := 1 to Last - 1 do  // finally ordering
4302    begin
4303      Bnd.Next := BArr[i];
4304      Bnd := Bnd.Next;
4305      Bnd.Prev := BArr[i - 1];
4306    end;
4307    Bnd.Next := nil;
4308    Bands[b].LastBand := Bnd;
4309  end;
4310
4311  for i := 0 to RTObjects.Count - 1 do // place other objects on btNone band
4312  begin
4313    t := RTObjects[i];
4314    if t.Selected then
4315    begin
4316      t.Parent := Bands[btNone];
4317      Bands[btNone].y := 0;
4318      Bands[btNone].Objects.Add(t);
4319    end;
4320  end;
4321
4322  for i := 1 to MAXBNDS do  // connect header & footer to each data-band
4323  begin
4324    Bnd := Bands[Bnds[i, bpHeader]];
4325    while Bnd <> nil do
4326    begin
4327      Bnd1 := Bands[Bnds[i, bpData]];
4328      while Bnd1 <> nil do
4329      begin
4330        if Bnd1.y > Bnd.y + Bnd.dy then break;
4331        Bnd1 := Bnd1.Next;
4332      end;
4333      if (Bnd1 <> nil) and (Bnd1.HeaderBand = nil) then
4334        Bnd1.HeaderBand := Bnd;
4335
4336      Bnd := Bnd.Next;
4337    end;
4338
4339    Bnd := Bands[Bnds[i, bpFooter]];
4340    while Bnd <> nil do
4341    begin
4342      Bnd1 := Bands[Bnds[i, bpData]];
4343      while Bnd1 <> nil do
4344      begin
4345        if Bnd1.y + Bnd1.dy > Bnd.y then
4346        begin
4347          Bnd1 := Bnd1.Prev;
4348          break;
4349        end;
4350        if Bnd1.Next = nil then break;
4351        Bnd1 := Bnd1.Next;
4352      end;
4353      if (Bnd1 <> nil) and (Bnd1.FooterBand = nil) then
4354        Bnd1.FooterBand := Bnd;
4355
4356      Bnd := Bnd.Next;
4357    end;
4358  end;
4359
4360  Bnd := Bands[btGroupHeader].LastBand;
4361  Bnd1 := Bands[btGroupFooter];
4362  repeat
4363    Bnd.FooterBand := Bnd1;
4364    Bnd := Bnd.Prev;
4365    Bnd1 := Bnd1.Next;
4366  until (Bnd = nil) or (Bnd1 = nil);
4367
4368  if BandExists(Bands[btCrossData]) and (Pos(';', Bands[btCrossData].View.FormatStr) <> 0) then
4369  begin
4370    s := Bands[btCrossData].View.FormatStr;
4371    i := 1;
4372    while i < Length(s) do
4373    begin
4374      j := i;
4375      while s[j] <> '=' do Inc(j);
4376      n := j;
4377      while s[n] <> ';' do Inc(n);
4378      for b := btMasterHeader to btGroupFooter do
4379      begin
4380        Bnd := Bands[b];
4381        while Bnd <> nil do
4382        begin
4383          if Bnd.View <> nil then
4384            if AnsiCompareText(Bnd.View.Name, Copy(s, i, j - i)) = 0 then
4385              CreateDS(Copy(s, j + 1, n - j - 1), Bnd.VCDataSet, Bnd.IsVirtualVCDS);
4386          Bnd := Bnd.Next;
4387        end;
4388      end;
4389      i := n + 1;
4390    end;
4391  end;
4392
4393  if ColCount = 0 then ColCount := 1;
4394  ColWidth := (RightMargin - LeftMargin) div ColCount;
4395end;
4396
4397procedure TfrPage.PrepareObjects;
4398var
4399  i, j: Integer;
4400  t: TfrView;
4401  Value: TfrValue;
4402  s: String;
4403  DSet: TfrTDataSet;
4404  Field: TfrTField;
4405begin
4406  CurPage := Self;
4407  for i := 0 to RTObjects.Count - 1 do
4408  begin
4409    t := RTObjects[i];
4410    t.FField := '';
4411    if t.Memo.Count > 0 then
4412      s := t.Memo[0];
4413    j := Length(s);
4414    if (j > 2) and (s[1] = '[') then
4415    begin
4416      while (j > 0) and (s[j] <> ']') do Dec(j);
4417      s := Copy(s, 2, j - 2);
4418      t.FDataSet := nil;
4419      t.FField := '';
4420      Value := CurReport.Values.FindVariable(s);
4421      if Value = nil then
4422      begin
4423        CurBand := t.Parent;
4424        DSet := GetDefaultDataset;
4425        frGetDatasetAndField(s, DSet, Field);
4426        if Field <> nil then
4427        begin
4428          t.FDataSet := DSet;
4429          t.FField := Field.FieldName;
4430        end;
4431      end
4432      else if Value.Typ = vtDBField then
4433        if Value.DSet <> nil then
4434        begin
4435          t.FDataSet := Value.DSet;
4436          t.FField := Value.Field;
4437        end;
4438    end;
4439  end;
4440end;
4441
4442procedure TfrPage.ShowBand(b: TfrBand);
4443begin
4444  if b <> nil then
4445    if Mode = pmBuildList then
4446      AddRecord(b, rtShowBand) else
4447      b.Draw;
4448end;
4449
4450procedure TfrPage.ShowBandByName(s: String);
4451var
4452  bt: TfrBandType;
4453  b: TfrBand;
4454begin
4455  for bt := btReportTitle to btNone do
4456  begin
4457    b := Bands[bt];
4458    while b <> nil do
4459    begin
4460      if b.View <> nil then
4461        if AnsiCompareText(b.View.Name, s) = 0 then
4462        begin
4463          b.Draw;
4464          Exit;
4465        end;
4466      b := b.Next;
4467    end;
4468  end;
4469end;
4470
4471procedure TfrPage.ShowBandByType(bt: TfrBandType);
4472var
4473  b: TfrBand;
4474begin
4475  b := Bands[bt];
4476  if b <> nil then
4477    b.Draw;
4478end;
4479
4480procedure TfrPage.AddRecord(b: TfrBand; rt: TfrBandRecType);
4481var
4482  p: PfrBandRec;
4483begin
4484  GetMem(p, SizeOf(TfrBandRec));
4485  p^.Band := b;
4486  p^.Action := rt;
4487  List.Add(p);
4488end;
4489
4490procedure TfrPage.ClearRecList;
4491var
4492  i: Integer;
4493begin
4494  for i := 0 to List.Count - 1 do
4495    FreeMem(PfrBandRec(List[i]), SizeOf(TfrBandRec));
4496  List.Clear;
4497end;
4498
4499function TfrPage.PlayRecList: Boolean;
4500var
4501  p: PfrBandRec;
4502  b: TfrBand;
4503begin
4504  Result := False;
4505  while PlayFrom < List.Count do
4506  begin
4507    p := List[PlayFrom];
4508    b := p^.Band;
4509    case p^.Action of
4510      rtShowBand:
4511        begin
4512          if LastBand <> nil then
4513          begin
4514            LastBand.DoSubReports;
4515            if LastBand <> nil then
4516            begin
4517              Result := True;
4518              Exit;
4519            end;
4520          end
4521          else
4522            if b.Draw then
4523            begin
4524              Result := True;
4525              Exit;
4526            end;
4527        end;
4528      rtFirst:
4529        begin
4530          b.DataSet.First;
4531          b.Positions[psLocal] := 1;
4532        end;
4533      rtNext:
4534        begin
4535          b.DataSet.Next;
4536          Inc(CurPos);
4537          Inc(b.Positions[psGlobal]);
4538          Inc(b.Positions[psLocal]);
4539        end;
4540    end;
4541    Inc(PlayFrom);
4542  end;
4543end;
4544
4545procedure TfrPage.DrawPageFooters;
4546begin
4547  CurColumn := 0;
4548  XAdjust := LeftMargin;
4549  if (PageNo <> 0) or ((Bands[btPageFooter].Flags and flBandOnFirstPage) <> 0) then
4550    while PageNo < MasterReport.EMFPages.Count do
4551    begin
4552      if not (Append and WasPF) then
4553      begin
4554        if (CurReport <> nil) and Assigned(CurReport.FOnEndPage) then
4555          CurReport.FOnEndPage(PageNo);
4556        if (MasterReport <> CurReport) and (MasterReport <> nil) and
4557          Assigned(MasterReport.FOnEndPage) then
4558          MasterReport.FOnEndPage(PageNo);
4559        ShowBand(Bands[btPageFooter]);
4560      end;
4561      Inc(PageNo);
4562    end;
4563  PageNo := MasterReport.EMFPages.Count;
4564end;
4565
4566procedure TfrPage.NewPage;
4567begin
4568  CurReport.InternalOnProgress(PageNo + 1);
4569  ShowBand(Bands[btColumnFooter]);
4570  DrawPageFooters;
4571  CurBottomY := BottomMargin;
4572  MasterReport.EMFPages.Add(Self);
4573  Append := False;
4574  ShowBand(Bands[btOverlay]);
4575  CurY := TopMargin;
4576  ShowBand(Bands[btPageHeader]);
4577  ShowBand(Bands[btColumnHeader]);
4578end;
4579
4580procedure TfrPage.NewColumn(Band: TfrBand);
4581var
4582  b: TfrBand;
4583begin
4584  if CurColumn < ColCount - 1 then
4585  begin
4586    ShowBand(Bands[btColumnFooter]);
4587    Inc(CurColumn);
4588    Inc(XAdjust, ColWidth + ColGap);
4589    CurY := LastStaticColumnY;
4590    ShowBand(Bands[btColumnHeader]);
4591  end
4592  else
4593    NewPage;
4594  b := Bands[btGroupHeader];
4595  if b <> nil then
4596    while (b <> nil) and (b <> Band) do
4597    begin
4598      b.DisableInit := True;
4599      if (b.Flags and flBandRepeatHeader) <> 0 then
4600        ShowBand(b);
4601      b.DisableInit := False;
4602      b := b.Next;
4603    end;
4604  if Band.Typ in [btMasterData, btDetailData, btSubDetailData] then
4605    if (Band.HeaderBand <> nil) and
4606      ((Band.HeaderBand.Flags and flBandRepeatHeader) <> 0) then
4607      ShowBand(Band.HeaderBand);
4608end;
4609
4610procedure TfrPage.DoAggregate(a: Array of TfrBandType);
4611var
4612  i: Integer;
4613  procedure DoAggregate1(bt: TfrBandType);
4614  var
4615    b: TfrBand;
4616  begin
4617    b := Bands[bt];
4618    while b <> nil do
4619    begin
4620      b.DoAggregate;
4621      b := b.Next;
4622    end;
4623  end;
4624begin
4625  for i := Low(a) to High(a) do
4626    DoAggregate1(a[i]);
4627end;
4628
4629procedure TfrPage.FormPage;
4630var
4631  BndStack: Array[1..MAXBNDS * 3] of TfrBand;
4632  MaxLevel, BndStackTop: Integer;
4633  i, sfPage: Integer;
4634  HasGroups: Boolean;
4635
4636  procedure AddToStack(b: TfrBand);
4637  begin
4638    if b <> nil then
4639    begin
4640      Inc(BndStackTop);
4641      BndStack[BndStackTop] := b;
4642    end;
4643  end;
4644
4645  procedure ShowStack;
4646  var
4647    i: Integer;
4648  begin
4649    for i := 1 to BndStackTop do
4650      if BandExists(BndStack[i]) then
4651        ShowBand(BndStack[i]);
4652    BndStackTop := 0;
4653  end;
4654
4655  procedure DoLoop(Level: Integer);
4656  var
4657    WasPrinted: Boolean;
4658    b, b1, b2: TfrBand;
4659
4660    procedure InitGroups(b: TfrBand);
4661    begin
4662      while b <> nil do
4663      begin
4664        Inc(b.Positions[psLocal]);
4665        Inc(b.Positions[psGlobal]);
4666        ShowBand(b);
4667        b := b.Next;
4668      end;
4669    end;
4670
4671  begin
4672    b := Bands[Bnds[Level, bpData]];
4673    while (b <> nil) and (b.Dataset <> nil) do
4674    begin
4675      b.DataSet.First;
4676      if Mode = pmBuildList then
4677        AddRecord(b, rtFirst) else
4678        b.Positions[psLocal] := 1;
4679
4680      b1 := Bands[btGroupHeader];
4681      while b1 <> nil do
4682      begin
4683        b1.Positions[psLocal] := 0;
4684        b1.Positions[psGlobal] := 0;
4685        b1 := b1.Next;
4686      end;
4687
4688      if not b.DataSet.Eof then
4689      begin
4690        if (Level = 1) and HasGroups then
4691          InitGroups(Bands[btGroupHeader]);
4692        if b.HeaderBand <> nil then
4693          AddToStack(b.HeaderBand);
4694        if b.FooterBand <> nil then
4695          b.FooterBand.InitValues;
4696
4697        while not b.DataSet.Eof do
4698        begin
4699          Application.ProcessMessages;
4700          if MasterReport.Terminated then break;
4701          AddToStack(b);
4702          WasPrinted := True;
4703          if Level < MaxLevel then
4704          begin
4705            DoLoop(Level + 1);
4706            if BndStackTop > 0 then
4707              if b.PrintIfSubsetEmpty then
4708                ShowStack
4709              else
4710              begin
4711                Dec(BndStackTop);
4712                WasPrinted := False;
4713              end;
4714          end
4715          else ShowStack;
4716
4717          b.DataSet.Next;
4718
4719          if (Level = 1) and HasGroups then
4720          begin
4721            b1 := Bands[btGroupHeader];
4722            while b1 <> nil do
4723            begin
4724              if (frParser.Calc(b1.GroupCondition) <> b1.LastGroupValue) or
4725                b.Dataset.Eof then
4726              begin
4727                ShowBand(b.FooterBand);
4728                b2 := Bands[btGroupHeader].LastBand;
4729                while b2 <> b1 do
4730                begin
4731                  ShowBand(b2.FooterBand);
4732                  b2.Positions[psLocal] := 0;
4733                  b2 := b2.Prev;
4734                end;
4735                ShowBand(b1.FooterBand);
4736                if not b.DataSet.Eof then
4737                begin
4738                  if b1.NewPageAfter then NewPage;
4739                  InitGroups(b1);
4740                  ShowBand(b.HeaderBand);
4741                  b.Positions[psLocal] := 0;
4742                end;
4743                break;
4744              end;
4745              b1 := b1.Next;
4746            end;
4747          end;
4748
4749          if Mode = pmBuildList then
4750            AddRecord(b, rtNext)
4751          else if WasPrinted then
4752          begin
4753            Inc(CurPos);
4754            Inc(b.Positions[psGlobal]);
4755            Inc(b.Positions[psLocal]);
4756            if not b.DataSet.Eof and b.NewPageAfter then NewPage;
4757          end;
4758          if MasterReport.Terminated then break;
4759        end;
4760        if BndStackTop = 0 then
4761          ShowBand(b.FooterBand) else
4762          Dec(BndStackTop);
4763      end;
4764      b := b.Next;
4765    end;
4766  end;
4767
4768begin
4769  if Mode = pmNormal then
4770  begin
4771    if Append then
4772      if PrevY = PrevBottomY then
4773      begin
4774        Append := False;
4775        WasPF := False;
4776        PageNo := MasterReport.EMFPages.Count;
4777      end;
4778    if Append and WasPF then
4779      CurBottomY := PrevBottomY else
4780      CurBottomY := BottomMargin;
4781    CurColumn := 0;
4782    XAdjust := LeftMargin;
4783    if not Append then
4784    begin
4785      MasterReport.EMFPages.Add(Self);
4786      CurY := TopMargin;
4787      ShowBand(Bands[btOverlay]);
4788      ShowBand(Bands[btNone]);
4789    end
4790    else
4791      CurY := PrevY;
4792    sfPage := PageNo;
4793    ShowBand(Bands[btReportTitle]);
4794    if PageNo = sfPage then // check if new page was formed
4795    begin
4796      if BandExists(Bands[btPageHeader]) and
4797        ((Bands[btPageHeader].Flags and flBandOnFirstPage) <> 0) then
4798        ShowBand(Bands[btPageHeader]);
4799      ShowBand(Bands[btColumnHeader]);
4800    end;
4801  end;
4802
4803  BndStackTop := 0;
4804  for i := 1 to MAXBNDS do
4805    if BandExists(Bands[Bnds[i, bpData]]) then
4806      MaxLevel := i;
4807  HasGroups := Bands[btGroupHeader].Objects.Count > 0;
4808  DoLoop(1);
4809  if Mode = pmNormal then
4810  begin
4811    ShowBand(Bands[btColumnFooter]);
4812    ShowBand(Bands[btReportSummary]);
4813    PrevY := CurY;
4814    PrevBottomY := CurBottomY;
4815    if CurColumn > 0 then
4816      PrevY := BottomMargin;
4817    CurColumn := 0;
4818    XAdjust := LeftMargin;
4819    sfPage := PageNo;
4820    WasPF := False;
4821    if (Bands[btPageFooter].Flags and flBandOnLastPage) <> 0 then
4822    begin
4823      WasPF := BandExists(Bands[btPageFooter]);
4824      if WasPF then DrawPageFooters;
4825    end;
4826    PageNo := sfPage + 1;
4827  end;
4828end;
4829
4830function TfrPage.BandExists(b: TfrBand): Boolean;
4831begin
4832  Result := b.Objects.Count > 0;
4833end;
4834
4835procedure TfrPage.AfterPrint;
4836var
4837  i: Integer;
4838begin
4839  for i := 0 to HookList.Count - 1 do
4840    TfrView(HookList[i]).OnHook(CurView);
4841end;
4842
4843procedure TfrPage.LoadFromStream(Stream: TStream);
4844var
4845  b: Byte;
4846  s: String[6];
4847begin
4848  with Stream do
4849  begin
4850    Read(pgSize, 4);
4851    Read(pgWidth, 4);
4852    Read(pgHeight, 4);
4853    Read(pgMargins, Sizeof(pgMargins));
4854    Read(b, 1);
4855    pgOr := TPrinterOrientation(b);
4856    if frVersion < 23 then
4857      Read(s[1], 6);
4858    Read(PrintToPrevPage, 2);
4859    Read(UseMargins, 2);
4860    Read(ColCount, 4);
4861    Read(ColGap, 4);
4862  end;
4863  ChangePaper(pgSize, pgWidth, pgHeight, pgOr);
4864end;
4865
4866procedure TfrPage.SaveToStream(Stream: TStream);
4867var
4868  b: Byte;
4869begin
4870  with Stream do
4871  begin
4872    Write(pgSize, 4);
4873    Write(pgWidth, 4);
4874    Write(pgHeight, 4);
4875    Write(pgMargins, Sizeof(pgMargins));
4876    b := Byte(pgOr);
4877    Write(b, 1);
4878    Write(PrintToPrevPage, 2);
4879    Write(UseMargins, 2);
4880    Write(ColCount, 4);
4881    Write(ColGap, 4);
4882  end;
4883end;
4884
4885{-----------------------------------------------------------------------}
4886constructor TfrPages.Create(AParent: TfrReport);
4887begin
4888  inherited Create;
4889  Parent := AParent;
4890  FPages := TList.Create;
4891end;
4892
4893destructor TfrPages.Destroy;
4894begin
4895  Clear;
4896  FPages.Free;
4897  inherited Destroy;
4898end;
4899
4900function TfrPages.GetCount: Integer;
4901begin
4902  Result := FPages.Count;
4903end;
4904
4905function TfrPages.GetPages(Index: Integer): TfrPage;
4906begin
4907  Result := FPages[Index];
4908end;
4909
4910procedure TfrPages.Clear;
4911var
4912  i: Integer;
4913begin
4914  for i := 0 to FPages.Count - 1 do
4915    Pages[i].Free;
4916  FPages.Clear;
4917end;
4918
4919procedure TfrPages.Add;
4920begin
4921  FPages.Add(TfrPage.Create(9, 0, 0, poPortrait));
4922end;
4923
4924procedure TfrPages.Delete(Index: Integer);
4925begin
4926  Pages[Index].Free;
4927  FPages.Delete(Index);
4928end;
4929
4930procedure TfrPages.LoadFromStream(Stream: TStream);
4931var
4932  b: Byte;
4933  t: TfrView;
4934  s: String;
4935  buf: String[8];
4936
4937  procedure AddObject(ot: Byte; clname: String);
4938  begin
4939    Stream.Read(b, 1);
4940    Pages[b].Objects.Add(frCreateObject(ot, clname));
4941    t := Pages[b].Objects.Items[Pages[b].Objects.Count - 1];
4942  end;
4943
4944begin
4945  Clear;
4946  Stream.Read(Parent.PrintToDefault, 2);
4947  Stream.Read(Parent.DoublePass, 2);
4948  Parent.SetPrinterTo(ReadString(Stream));
4949  while Stream.Position < Stream.Size do
4950  begin
4951    Stream.Read(b, 1);
4952    if b = $FF then  // page info
4953    begin
4954      Add;
4955      Pages[Count - 1].LoadFromStream(Stream);
4956    end
4957    else if b = $FE then // values
4958    begin
4959      Parent.FVal.ReadBinaryData(Stream);
4960      ReadMemo(Stream, SMemo);
4961      Parent.Variables.Assign(SMemo);
4962    end
4963    else if b = $FD then // datasets
4964    begin
4965      if frDataManager <> nil then
4966        frDataManager.LoadFromStream(Stream);
4967      break;
4968    end
4969    else
4970    begin
4971      if b > Integer(gtAddIn) then
4972      begin
4973        raise Exception.Create('');
4974        break;
4975      end;
4976      s := '';
4977      if b = gtAddIn then
4978      begin
4979        s := ReadString(Stream);
4980        if AnsiUpperCase(s) = 'TFRFRAMEDMEMOVIEW' then
4981          AddObject(gtMemo, '') else
4982          AddObject(gtAddIn, s);
4983      end
4984      else
4985        AddObject(b, '');
4986      t.LoadFromStream(Stream);
4987      if AnsiUpperCase(s) = 'TFRFRAMEDMEMOVIEW' then
4988        Stream.Read(buf[1], 8);
4989    end;
4990  end;
4991end;
4992
4993procedure TfrPages.SaveToStream(Stream: TStream);
4994var
4995  b: Byte;
4996  i, j: Integer;
4997  t: TfrView;
4998begin
4999  if CurReport.FR3Stream then
5000  begin
5001    SaveToFR3Stream(CurReport, Stream);
5002    Exit;
5003  end;
5004  Stream.Write(Parent.PrintToDefault, 2);
5005  Stream.Write(Parent.DoublePass, 2);
5006  frWriteString(Stream, Prn.Printers[Prn.PrinterIndex]);
5007  for i := 0 to Count - 1 do // adding pages at first
5008  begin
5009    b := $FF;
5010    Stream.Write(b, 1);      // page info
5011    Pages[i].SaveToStream(Stream);
5012  end;
5013  for i := 0 to Count - 1 do
5014  begin
5015    for j := 0 to Pages[i].Objects.Count - 1 do // then adding objects
5016    begin
5017      t := Pages[i].Objects[j];
5018      b := Byte(t.Typ);
5019      Stream.Write(b, 1);
5020      if t.Typ = gtAddIn then
5021        frWriteString(Stream, t.ClassName);
5022      Stream.Write(i, 1);
5023      t.SaveToStream(Stream);
5024    end;
5025  end;
5026  b := $FE;
5027  Stream.Write(b, 1);
5028  Parent.FVal.WriteBinaryData(Stream);
5029  SMemo.Assign(Parent.Variables);
5030  frWriteMemo(Stream, SMemo);
5031  if frDataManager <> nil then
5032  begin
5033    b := $FD;
5034    Stream.Write(b, 1);
5035    frDataManager.SaveToStream(Stream);
5036  end;
5037end;
5038
5039{-----------------------------------------------------------------------}
5040constructor TfrEMFPages.Create(AParent: TfrReport);
5041begin
5042  inherited Create;
5043  Parent := AParent;
5044  FPages := TList.Create;
5045end;
5046
5047destructor TfrEMFPages.Destroy;
5048begin
5049  Clear;
5050  FPages.Free;
5051  inherited Destroy;
5052end;
5053
5054function TfrEMFPages.GetCount: Integer;
5055begin
5056  Result := FPages.Count;
5057end;
5058
5059function TfrEMFPages.GetPages(Index: Integer): PfrPageInfo;
5060begin
5061  Result := FPages[Index];
5062end;
5063
5064procedure TfrEMFPages.Clear;
5065begin
5066  while FPages.Count > 0 do
5067    Delete(0);
5068end;
5069
5070procedure TfrEMFPages.Draw(Index: Integer; Canvas: TCanvas; DrawRect: TRect);
5071var
5072  p: PfrPageInfo;
5073  t: TfrView;
5074  i: Integer;
5075  sx, sy: Double;
5076  v, IsPrinting: Boolean;
5077  h: THandle;
5078begin
5079  IsPrinting := Printer.Printing and (Canvas.Handle = Printer.Canvas.Handle);
5080  DocMode := dmPrinting;
5081  p := FPages[Index];
5082  with p^ do
5083  if Visible then
5084  begin
5085    if Page = nil then
5086      ObjectsToPage(Index);
5087    sx := (DrawRect.Right - DrawRect.Left) / PrnInfo.PgW;
5088    sy := (DrawRect.Bottom - DrawRect.Top) / PrnInfo.PgH;
5089    h := Canvas.Handle;
5090    for i := 0 to Page.Objects.Count - 1 do
5091    begin
5092      t := Page.Objects[i];
5093      v := True;
5094      if not IsPrinting then
5095        with t, DrawRect do
5096          v := RectVisible(h, Rect(Round(x * sx) + Left - 10,
5097                                   Round(y * sy) + Top - 10,
5098                                   Round((x + dx) * sx) + Left + 10,
5099                                   Round((y + dy) * sy) + Top + 10));
5100      if v then
5101      begin
5102        t.ScaleX := sx; t.ScaleY := sy;
5103        t.OffsX := DrawRect.Left; t.OffsY := DrawRect.Top;
5104        t.IsPrinting := IsPrinting;
5105        t.Draw(Canvas);
5106      end;
5107    end;
5108  end
5109  else
5110  begin
5111    Page.Free;
5112    Page := nil;
5113  end;
5114end;
5115
5116procedure TfrEMFPages.ExportData(Index: Integer);
5117var
5118  p: PfrPageInfo;
5119  b: Byte;
5120  t: TfrView;
5121  s: String;
5122begin
5123  p := FPages[Index];
5124  with p^ do
5125  begin
5126    Stream.Position := 0;
5127    Stream.Read(frVersion, 1);
5128    while Stream.Position < Stream.Size do
5129    begin
5130      Stream.Read(b, 1);
5131      if b = gtAddIn then
5132        s := ReadString(Stream) else
5133        s := '';
5134      t := frCreateObject(b, s);
5135      t.StreamMode := smPrinting;
5136      t.LoadFromStream(Stream);
5137      t.ExportData;
5138      t.Free;
5139    end;
5140  end;
5141end;
5142
5143procedure TfrEMFPages.ObjectsToPage(Index: Integer);
5144var
5145  p: PfrPageInfo;
5146  b: Byte;
5147  t: TfrView;
5148  s: String;
5149begin
5150  p := FPages[Index];
5151  with p^ do
5152  begin
5153    if Page <> nil then
5154      Page.Free;
5155    Page := TfrPage.Create(pgSize, pgWidth, pgHeight, pgOr);
5156    Stream.Position := 0;
5157    Stream.Read(frVersion, 1);
5158    while Stream.Position < Stream.Size do
5159    begin
5160      Stream.Read(b, 1);
5161      if b = gtAddIn then
5162        s := ReadString(Stream) else
5163        s := '';
5164      t := frCreateObject(b, s);
5165      t.StreamMode := smPrinting;
5166      t.LoadFromStream(Stream);
5167      t.StreamMode := smDesigning;
5168      Page.Objects.Add(t);
5169    end;
5170  end;
5171end;
5172
5173procedure TfrEMFPages.PageToObjects(Index: Integer);
5174var
5175  i: Integer;
5176  p: PfrPageInfo;
5177  t: TfrView;
5178begin
5179  p := FPages[Index];
5180  with p^ do
5181  begin
5182    Stream.Clear;
5183    frVersion := frCurrentVersion;
5184    Stream.Write(frVersion, 1);
5185    for i := 0 to Page.Objects.Count - 1 do
5186    begin
5187      t := Page.Objects[i];
5188      t.StreamMode := smPrinting;
5189      Stream.Write(t.Typ, 1);
5190      if t.Typ = gtAddIn then
5191        frWriteString(Stream, t.ClassName);
5192      t.Memo1.Assign(t.Memo);
5193      t.SaveToStream(Stream);
5194    end;
5195  end;
5196end;
5197
5198procedure TfrEMFPages.Insert(Index: Integer; APage: TfrPage);
5199var
5200  p: PfrPageInfo;
5201begin
5202  GetMem(p, SizeOf(TfrPageInfo));
5203  FillChar(p^, SizeOf(TfrPageInfo), 0);
5204  if Index >= FPages.Count then
5205    FPages.Add(p) else
5206    FPages.Insert(Index, p);
5207  with p^ do
5208  begin
5209    Stream := TMemoryStream.Create;
5210    frVersion := frCurrentVersion;
5211    Stream.Write(frVersion, 1);
5212    pgSize := APage.pgSize;
5213    pgWidth := APage.pgWidth;
5214    pgHeight := APage.pgHeight;
5215    pgOr := APage.pgOr;
5216    pgMargins := APage.UseMargins;
5217    PrnInfo := APage.PrnInfo;
5218  end;
5219end;
5220
5221procedure TfrEMFPages.Add(APage: TfrPage);
5222begin
5223  Insert(FPages.Count, APage);
5224  if (CurReport <> nil) and Assigned(CurReport.FOnBeginPage) then
5225    CurReport.FOnBeginPage(PageNo);
5226  if (MasterReport <> CurReport) and (MasterReport <> nil) and
5227    Assigned(MasterReport.FOnBeginPage) then
5228    MasterReport.FOnBeginPage(PageNo);
5229end;
5230
5231procedure TfrEMFPages.Delete(Index: Integer);
5232begin
5233  if Pages[Index]^.Page <> nil then Pages[Index]^.Page.Free;
5234  if Pages[Index]^.Stream <> nil then Pages[Index]^.Stream.Free;
5235  FreeMem(Pages[Index], SizeOf(TfrPageInfo));
5236  FPages.Delete(Index);
5237end;
5238
5239procedure TfrEMFPages.LoadFromStream(AStream: TStream);
5240var
5241  i, o, c: Integer;
5242  b, compr: Byte;
5243  p: PfrPageInfo;
5244  s: TMemoryStream;
5245
5246  procedure ReadVersion22;
5247  var
5248    Pict: TfrPictureView;
5249  begin
5250    frReadMemo22(AStream, SMemo);
5251    if SMemo.Count > 0 then
5252      Parent.SetPrinterTo(SMemo[0]);
5253    AStream.Read(c, 4);
5254    i := 0;
5255    repeat
5256      AStream.Read(o, 4);
5257      GetMem(p, SizeOf(TfrPageInfo));
5258      FillChar(p^, SizeOf(TfrPageInfo), 0);
5259      FPages.Add(p);
5260      with p^ do
5261      begin
5262        AStream.Read(pgSize, 2);
5263        AStream.Read(pgWidth, 4);
5264        AStream.Read(pgHeight, 4);
5265        AStream.Read(b, 1);
5266        pgOr := TPrinterOrientation(b);
5267        AStream.Read(b, 1);
5268        pgMargins := Boolean(b);
5269        Prn.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgOr);
5270        Prn.FillPrnInfo(PrnInfo);
5271
5272        Pict := TfrPictureView.Create;
5273        Pict.SetBounds(0, 0, PrnInfo.PgW, PrnInfo.PgH);
5274        Pict.Picture.Metafile.LoadFromStream(AStream);
5275
5276        Stream := TMemoryStream.Create;
5277        b := frCurrentVersion;
5278        Stream.Write(b, 1);
5279        Pict.StreamMode := smPrinting;
5280        Stream.Write(Pict.Typ, 1);
5281        Pict.SaveToStream(Stream);
5282        Pict.Free;
5283      end;
5284      AStream.Seek(o, soFromBeginning);
5285      Inc(i);
5286    until i >= c;
5287  end;
5288
5289begin
5290  Clear;
5291  AStream.Read(compr, 1);
5292  if not (compr in [0, 1, 255]) then
5293  begin
5294    AStream.Seek(0, soFromBeginning);
5295    ReadVersion22;
5296    Exit;
5297  end;
5298  Parent.SetPrinterTo(frReadString(AStream));
5299  AStream.Read(c, 4);
5300  i := 0;
5301  repeat
5302    AStream.Read(o, 4);
5303    GetMem(p, SizeOf(TfrPageInfo));
5304    FillChar(p^, SizeOf(TfrPageInfo), #0);
5305    FPages.Add(p);
5306    with p^ do
5307    begin
5308      AStream.Read(pgSize, 2);
5309      AStream.Read(pgWidth, 4);
5310      AStream.Read(pgHeight, 4);
5311      AStream.Read(b, 1);
5312      pgOr := TPrinterOrientation(b);
5313      AStream.Read(b, 1);
5314      pgMargins := Boolean(b);
5315      if compr <> 0 then
5316      begin
5317        s := TMemoryStream.Create;
5318        s.CopyFrom(AStream, o - AStream.Position);
5319        Stream := TMemoryStream.Create;
5320        frCompressor.DeCompress(s, Stream);
5321        s.Free;
5322      end
5323      else
5324      begin
5325        Stream := TMemoryStream.Create;
5326        Stream.CopyFrom(AStream, o - AStream.Position);
5327      end;
5328      Prn.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgOr);
5329      Prn.FillPrnInfo(PrnInfo);
5330    end;
5331    AStream.Seek(o, soFromBeginning);
5332    Inc(i);
5333  until i >= c;
5334end;
5335
5336procedure TfrEMFPages.SaveToStream(AStream: TStream);
5337var
5338  i, o, n: Integer;
5339  b: Byte;
5340  s: TMemoryStream;
5341begin
5342  b := Byte(frCompressor.Enabled);
5343  AStream.Write(b, 1);
5344  frWriteString(AStream, Prn.Printers[Prn.PrinterIndex]);
5345  n := Count;
5346  AStream.Write(n, 4);
5347  i := 0;
5348  repeat
5349    o := AStream.Position;
5350    AStream.Write(o, 4); // dummy write
5351    with Pages[i]^ do
5352    begin
5353      AStream.Write(pgSize, 2);
5354      AStream.Write(pgWidth, 4);
5355      AStream.Write(pgHeight, 4);
5356      b := Byte(pgOr);
5357      AStream.Write(b, 1);
5358      b := Byte(pgMargins);
5359      AStream.Write(b, 1);
5360      Stream.Position := 0;
5361      if frCompressor.Enabled then
5362      begin
5363        s := TMemoryStream.Create;
5364        frCompressor.Compress(Stream, s);
5365        AStream.CopyFrom(s, s.Size);
5366        s.Free;
5367      end
5368      else
5369        AStream.CopyFrom(Stream, Stream.Size);
5370    end;
5371    n := AStream.Position;
5372    AStream.Seek(o, soFromBeginning);
5373    AStream.Write(n, 4);
5374    AStream.Seek(0, soFromEnd);
5375    Inc(i);
5376  until i >= Count;
5377end;
5378
5379{-----------------------------------------------------------------------}
5380constructor TfrValues.Create;
5381begin
5382  inherited Create;
5383  FItems := TStringList.Create;
5384end;
5385
5386destructor TfrValues.Destroy;
5387begin
5388  Clear;
5389  FItems.Free;
5390  inherited Destroy;
5391end;
5392
5393procedure TfrValues.WriteBinaryData(Stream: TStream);
5394var
5395  i, n: Integer;
5396
5397  procedure WriteStr(s: String);
5398  var
5399    n: Byte;
5400  begin
5401    n := Length(s);
5402    Stream.Write(n, 1);
5403    Stream.Write(s[1], n);
5404  end;
5405
5406begin
5407  with Stream do
5408  begin
5409    n := FItems.Count;
5410    WriteBuffer(n, SizeOf(n));
5411    for i := 0 to n - 1 do
5412    with Objects[i] do
5413    begin
5414      WriteBuffer(Typ, SizeOf(Typ));
5415      WriteBuffer(OtherKind, SizeOf(OtherKind));
5416      WriteStr(DataSet);
5417      WriteStr(Field);
5418      WriteStr(FItems[i]);
5419    end;
5420  end;
5421end;
5422
5423procedure TfrValues.ReadBinaryData(Stream: TStream);
5424var
5425  i, j, n: Integer;
5426
5427  function ReadStr: String;
5428  var
5429    n: Byte;
5430  begin
5431    Stream.Read(n, 1);
5432    SetLength(Result, n);
5433    Stream.Read(Result[1], n);
5434  end;
5435
5436begin
5437  Clear;
5438  FItems.Sorted := False;
5439  with Stream do
5440  begin
5441    ReadBuffer(n, SizeOf(n));
5442    for i := 0 to n - 1 do
5443    begin
5444      j := AddValue;
5445      with Objects[j] do
5446      begin
5447        ReadBuffer(Typ, SizeOf(Typ));
5448        ReadBuffer(OtherKind, SizeOf(OtherKind));
5449        DataSet := ReadStr;
5450        Field := ReadStr;
5451        FItems[j] := ReadStr;
5452      end;
5453    end;
5454  end;
5455end;
5456
5457function TfrValues.GetValue(Index: Integer): TfrValue;
5458begin
5459  Result := TfrValue(FItems.Objects[Index]);
5460end;
5461
5462function TfrValues.AddValue: Integer;
5463begin
5464  Result := FItems.AddObject('', TfrValue.Create);
5465end;
5466
5467procedure TfrValues.Clear;
5468var
5469  i: Integer;
5470begin
5471  for i := 0 to FItems.Count - 1 do
5472    TfrValue(FItems.Objects[i]).Free;
5473  FItems.Clear;
5474end;
5475
5476function TfrValues.FindVariable(const s: String): TfrValue;
5477var
5478  i: Integer;
5479begin
5480  Result := nil;
5481  i := FItems.IndexOf(s);
5482  if i <> -1 then
5483    Result := Objects[i];
5484end;
5485
5486{----------------------------------------------------------------------------}
5487constructor TfrReport.Create(AOwner: TComponent);
5488begin
5489  inherited Create(AOwner);
5490  FPages := TfrPages.Create(Self);
5491  FEMFPages := TfrEMFPages.Create(Self);
5492  FVars := TStringList.Create;
5493  FVal := TfrValues.Create;
5494  FShowProgress := True;
5495  FModalPreview := True;
5496  FModifyPrepared := True;
5497  FPreviewButtons := [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbHelp, pbExit];
5498  FInitialZoom := pzDefault;
5499  FileName := LoadStr(SUntitled);
5500end;
5501
5502destructor TfrReport.Destroy;
5503begin
5504  FVal.Free;
5505  FVars.Free;
5506  FEMFPages.Free;
5507  FEMFPages := nil;
5508  FPages.Free;
5509  inherited Destroy;
5510end;
5511
5512procedure TfrReport.DefineProperties(Filer: TFiler);
5513begin
5514  inherited DefineProperties(Filer);
5515  Filer.DefineBinaryProperty('ReportForm', ReadBinaryData, WriteBinaryData, True);
5516end;
5517
5518procedure TfrReport.WriteBinaryData(Stream: TStream);
5519var
5520  n: Integer;
5521  Stream1: TMemoryStream;
5522begin
5523  n := frCurrentVersion;
5524  Stream.Write(n, 4);
5525  if FStoreInDFM then
5526  begin
5527    Stream1 := TMemoryStream.Create;
5528    SaveToStream(Stream1);
5529    Stream1.Position := 0;
5530    n := Stream1.Size;
5531    Stream.Write(n, 4);
5532    Stream.CopyFrom(Stream1, n);
5533    Stream1.Free;
5534  end;
5535end;
5536
5537procedure TfrReport.ReadBinaryData(Stream: TStream);
5538var
5539  n: Integer;
5540  Stream1: TMemoryStream;
5541begin
5542  Stream.Read(n, 4); // version
5543  if FStoreInDFM then
5544  begin
5545    Stream.Read(n, 4);
5546    Stream1 := TMemoryStream.Create;
5547    Stream1.CopyFrom(Stream, n);
5548    Stream1.Position := 0;
5549    LoadFromStream(Stream1);
5550    Stream1.Free;
5551  end;
5552end;
5553
5554procedure TfrReport.Notification(AComponent: TComponent; Operation: TOperation);
5555begin
5556  inherited Notification(AComponent, Operation);
5557  if (Operation = opRemove) and (AComponent = Dataset) then
5558    Dataset := nil;
5559  if (Operation = opRemove) and (AComponent = Preview) then
5560    Preview := nil;
5561end;
5562
5563// report building events
5564procedure TfrReport.InternalOnProgress(Percent: Integer);
5565begin
5566  if Assigned(FOnProgress) then
5567    FOnProgress(Percent)
5568  else if FShowProgress then
5569  with frProgressForm do
5570  begin
5571    if (MasterReport.DoublePass and MasterReport.FinalPass) or
5572       (FCurrentFilter <> nil) then
5573      Label1.Caption := FirstCaption + '  ' + IntToStr(Percent) + ' ' +
5574        LoadStr(SFrom) + ' ' + IntToStr(SavedAllPages)
5575    else
5576      Label1.Caption := FirstCaption + '  ' + IntToStr(Percent);
5577    Application.ProcessMessages;
5578  end;
5579end;
5580
5581procedure TfrReport.InternalOnGetValue(ParName: String; var ParValue: String);
5582var
5583  i, j, Format: Integer;
5584  FormatStr: String;
5585begin
5586  SubValue := '';
5587  Format := CurView.Format;
5588  FormatStr := CurView.FormatStr;
5589  i := Pos(' #', ParName);
5590  if i <> 0 then
5591  begin
5592    FormatStr := Copy(ParName, i + 2, Length(ParName) - i - 1);
5593    ParName := Copy(ParName, 1, i - 1);
5594
5595    if FormatStr[1] in ['0'..'9', 'N', 'n'] then
5596    begin
5597      if FormatStr[1] in ['0'..'9'] then
5598        FormatStr := 'N' + FormatStr;
5599      Format := $01000000;
5600      if FormatStr[2] in ['0'..'9'] then
5601        Format := Format + $00010000;
5602      i := Length(FormatStr);
5603      while i > 1 do
5604      begin
5605        if FormatStr[i] in ['.', ',', '-'] then
5606        begin
5607          Format := Format + Ord(FormatStr[i]);
5608          FormatStr[i] := '.';
5609          if FormatStr[2] in ['0'..'9'] then
5610          begin
5611            Inc(i);
5612            j := i;
5613            while (i <= Length(FormatStr)) and (FormatStr[i] in ['0'..'9']) do
5614              Inc(i);
5615            Format := Format + 256 * StrToInt(Copy(FormatStr, j, i - j));
5616          end;
5617          break;
5618        end;
5619        Dec(i);
5620      end;
5621      if not (FormatStr[2] in ['0'..'9']) then
5622      begin
5623        FormatStr := Copy(FormatStr, 2, 255);
5624        Format := Format + $00040000;
5625      end;
5626    end
5627    else if FormatStr[1] in ['D', 'T', 'd', 't'] then
5628    begin
5629      Format := $02040000;
5630      FormatStr := Copy(FormatStr, 2, 255);
5631    end
5632    else if FormatStr[1] in ['B', 'b'] then
5633    begin
5634      Format := $04040000;
5635      FormatStr := Copy(FormatStr, 2, 255);
5636    end;
5637  end;
5638
5639  CurVariable := ParName;
5640  CurValue := 0;
5641  GetVariableValue(ParName, CurValue);
5642  ParValue := FormatValue(CurValue, Format, FormatStr);
5643end;
5644
5645procedure TfrReport.InternalOnEnterRect(Memo: TStringList; View: TfrView);
5646begin
5647  with View do
5648    if (FDataSet <> nil) and frIsBlob(TfrTField(FDataSet.FindField(FField))) then
5649      GetBlob(TfrTField(FDataSet.FindField(FField)));
5650  if Assigned(FOnEnterRect) then FOnEnterRect(Memo, View);
5651end;
5652
5653procedure TfrReport.InternalOnExportData(View: TfrView);
5654begin
5655  FCurrentFilter.OnData(View.x, View.y, View);
5656end;
5657
5658procedure TfrReport.InternalOnExportText(x, y: Integer; const text: String;
5659  View: TfrView);
5660begin
5661  FCurrentFilter.OnText(x, y, text, View);
5662end;
5663
5664procedure TfrReport.InternalOnBeginColumn(Band: TfrBand);
5665begin
5666  if Assigned(FOnBeginColumn) then FOnBeginColumn(Band);
5667end;
5668
5669procedure TfrReport.InternalOnPrintColumn(ColNo: Integer; var ColWidth: Integer);
5670begin
5671  if Assigned(FOnPrintColumn) then FOnPrintColumn(ColNo, ColWidth);
5672end;
5673
5674function TfrReport.FormatValue(V: Variant; Format: Integer;
5675  const FormatStr: String): String;
5676var
5677  f1, f2: Integer;
5678  c: Char;
5679  s: String;
5680begin
5681  if (TVarData(v).VType = varEmpty) or (v = Null) then
5682  begin
5683    Result := ' ';
5684    Exit;
5685  end;
5686  c := DecimalSeparator;
5687  f1 := (Format div $01000000) and $0F;
5688  f2 := (Format div $00010000) and $FF;
5689  try
5690    case f1 of
5691      0: Result := v;
5692      1:
5693        begin
5694          DecimalSeparator := Chr(Format and $FF);
5695          case f2 of
5696            0: Result := FormatFloat('###.##', v);
5697            1: Result := FloatToStrF(v, ffFixed, 15, (Format div $0100) and $FF);
5698            2: Result := FormatFloat('#,###.##', v);
5699            3: Result := FloatToStrF(v, ffNumber, 15, (Format div $0100) and $FF);
5700            4: Result := FormatFloat(FormatStr, v);
5701          end;
5702        end;
5703      2: if f2 = 4 then
5704           Result := FormatDateTime(FormatStr, v) else
5705           Result := FormatDateTime(frDateFormats[f2], v);
5706      3: if f2 = 4 then
5707           Result := FormatDateTime(FormatStr, v) else
5708           Result := FormatDateTime(frTimeFormats[f2], v);
5709      4:
5710         begin
5711           if f2 = 4 then
5712             s := FormatStr else
5713             s := BoolStr[f2];
5714           if Integer(v) = 0 then
5715             Result := Copy(s, 1, Pos(';', s) - 1) else
5716             Result := Copy(s, Pos(';', s) + 1, 255);
5717         end;
5718    end;
5719  except
5720    on exception do Result := v;
5721  end;
5722  DecimalSeparator := c;
5723end;
5724
5725procedure TfrReport.GetVariableValue(const s: String; var v: Variant);
5726var
5727  Value: TfrValue;
5728  D: TfrTDataSet;
5729  F: TfrTField;
5730
5731  function MasterBand: TfrBand;
5732  begin
5733    Result := CurBand;
5734    if Result.DataSet = nil then
5735      while Result.Prev <> nil do
5736        Result := Result.Prev;
5737  end;
5738
5739begin
5740  TVarData(v).VType := varEmpty;
5741  if Assigned(FOnGetValue) then FOnGetValue(s, v);
5742  if TVarData(v).VType = varEmpty then
5743  begin
5744    Value := Values.FindVariable(s);
5745    if Value <> nil then
5746      with Value do
5747      case Typ of
5748        vtNotAssigned:
5749          v := '';
5750        vtDBField:
5751          begin
5752            F := TfrTField(DSet.FindField(Field));
5753            if not F.DataSet.Active then
5754              F.DataSet.Open;
5755            if Assigned(F.OnGetText) then
5756              v := F.DisplayText else
5757              v := F.AsVariant;
5758          end;
5759        vtFRVar:
5760          v := frParser.Calc(Field);
5761        vtOther:
5762          if OtherKind = 1 then
5763            v := frParser.Calc(Field) else
5764            v := frParser.Calc(frSpecFuncs[OtherKind]);
5765      end
5766    else
5767    begin
5768      D := GetDefaultDataSet;
5769      frGetDataSetAndField(s, D, F);
5770      if F <> nil then
5771      begin
5772        if not F.DataSet.Active then
5773          F.DataSet.Open;
5774        if Assigned(F.OnGetText) then
5775           v := F.DisplayText else
5776           v := F.AsVariant
5777      end
5778      else if s = 'VALUE' then
5779        v := CurValue
5780      else if s = frSpecFuncs[0] then
5781        v := PageNo + 1
5782      else if s = frSpecFuncs[2] then
5783        v := CurDate
5784      else if s = frSpecFuncs[3] then
5785        v := CurTime
5786      else if s = frSpecFuncs[4] then
5787        v := MasterBand.Positions[psLocal]
5788      else if s = frSpecFuncs[5] then
5789        v := MasterBand.Positions[psGlobal]
5790      else if s = frSpecFuncs[6] then
5791        v := CurPage.ColPos
5792      else if s = frSpecFuncs[7] then
5793        v := CurPage.CurPos
5794      else if s = frSpecFuncs[8] then
5795        v := SavedAllPages
5796      else
5797      begin
5798        if frVariables.IndexOf(s) <> -1 then
5799        begin
5800          v := frVariables[s];
5801          Exit;
5802        end;
5803        if s <> SubValue then
5804        begin
5805          SubValue := s;
5806          v := frParser.Calc(s);
5807          SubValue := '';
5808        end
5809        else raise(EParserError.Create('Undefined symbol "' + SubValue + '"'));
5810      end;
5811    end;
5812  end;
5813end;
5814
5815procedure TfrReport.OnGetParsFunction(const name: String; p1, p2, p3: Variant;
5816   var val: String);
5817var
5818  i: Integer;
5819begin
5820  val := '0';
5821  for i := 0 to frFunctionsCount - 1 do
5822    if frFunctions[i].FunctionLibrary.OnFunction(name, p1, p2, p3, val) then
5823      exit;
5824  if AggrBand.Visible then
5825    if Assigned(FOnFunction) then FOnFunction(name, p1, p2, p3, val);
5826end;
5827
5828// load/save methods
5829procedure TfrReport.LoadFromStream(Stream: TStream);
5830begin
5831  CurReport := Self;
5832  Stream.Read(frVersion, 1);
5833  if frVersion < 21 then
5834  begin
5835    frVersion := 21;
5836    Stream.Position := 0;
5837  end;
5838  if frVersion <= frCurrentVersion then
5839  try
5840{$IFDEF FREEREP2217READ}
5841    if FRE_COMPATIBLE_READ and (frVersion = 23) then
5842      frVersion := 22;
5843{$ENDIF}
5844    Pages.LoadFromStream(Stream);
5845  except
5846    Pages.Clear;
5847    Pages.Add;
5848    MessageBox(0, PChar(LoadStr(SFRFError)), PChar(LoadStr(SError)),
5849      mb_Ok + mb_IconError);
5850  end
5851  else
5852    MessageBox(0, PChar(SFRFError), PChar(LoadStr(SError)),
5853      mb_Ok + mb_IconError);
5854end;
5855
5856procedure TfrReport.SaveToStream(Stream: TStream);
5857begin
5858  CurReport := Self;
5859  if FR3Stream then
5860  begin
5861    Pages.SaveToStream(Stream);
5862    Exit;
5863  end;
5864  frVersion := frCurrentVersion;
5865  Stream.Write(frVersion, 1);
5866  Pages.SaveToStream(Stream);
5867end;
5868
5869procedure TfrReport.LoadFromFile(FName: String);
5870var
5871  Stream: TFileStream;
5872begin
5873  Stream := TFileStream.Create(FName, fmOpenRead);
5874  LoadFromStream(Stream);
5875  Stream.Free;
5876  FileName := FName;
5877end;
5878
5879procedure TfrReport.SaveToFile(FName: String);
5880var
5881  Stream: TFileStream;
5882begin
5883  Stream := TFileStream.Create(FName, fmCreate);
5884  SaveToStream(Stream);
5885  Stream.Free;
5886end;
5887
5888procedure TfrReport.SaveToFR3File(FName: String);
5889var
5890  Stream: TFileStream;
5891begin
5892  Stream := TFileStream.Create(ChangeFileExt(FName, '.fr3'), fmCreate);
5893  try
5894    FR3Stream := True;
5895    SaveToStream(Stream);
5896  finally
5897    FR3Stream := False;
5898    Stream.Free;
5899  end;
5900end;
5901
5902{$IFDEF IBO}
5903procedure TfrReport.LoadFromDB(Table: TIB_DataSet; DocN: Integer);
5904{$ELSE}
5905procedure TfrReport.LoadFromDB(Table: TDataSet; DocN: Integer);
5906{$ENDIF}
5907var
5908  Stream: TMemoryStream;
5909begin
5910  Table.First;
5911  while not Table.Eof do
5912  begin
5913    if Table.Fields[0].AsInteger = DocN then
5914    begin
5915      Stream := TMemoryStream.Create;
5916{$IFDEF IBO}
5917      TfrTBlobField(Table.Fields[1]).AssignTo(Stream);
5918{$ELSE}
5919      TfrTBlobField(Table.Fields[1]).SaveToStream(Stream);
5920{$ENDIF}
5921      Stream.Position := 0;
5922      LoadFromStream(Stream);
5923      Stream.Free;
5924      Exit;
5925    end;
5926    Table.Next;
5927  end;
5928end;
5929
5930{$IFDEF IBO}
5931procedure TfrReport.SaveToDB(Table: TIB_DataSet; DocN: Integer);
5932{$ELSE}
5933procedure TfrReport.SaveToDB(Table: TDataSet; DocN: Integer);
5934{$ENDIF}
5935var
5936  Stream: TMemoryStream;
5937  Found: Boolean;
5938begin
5939  Found := False;
5940  Table.First;
5941  while not Table.Eof do
5942  begin
5943    if Table.Fields[0].AsInteger = DocN then
5944    begin
5945      Found := True;
5946      break;
5947    end;
5948    Table.Next;
5949  end;
5950
5951  if Found then
5952    Table.Edit else
5953    Table.Append;
5954  Table.Fields[0].AsInteger := DocN;
5955  Stream := TMemoryStream.Create;
5956  SaveToStream(Stream);
5957  Stream.Position := 0;
5958{$IFDEF IBO}
5959  TfrTBlobField(Table.Fields[1]).Assign(Stream);
5960{$ELSE}
5961  TfrTBlobField(Table.Fields[1]).LoadFromStream(Stream);
5962{$ENDIF}
5963  Stream.Free;
5964  Table.Post;
5965end;
5966
5967procedure TfrReport.LoadPreparedReport(FName: String);
5968var
5969  Stream: TFileStream;
5970begin
5971  Stream := TFileStream.Create(FName, fmOpenRead);
5972  EMFPages.LoadFromStream(Stream);
5973  Stream.Free;
5974  CanRebuild := False;
5975end;
5976
5977procedure TfrReport.SavePreparedReport(FName: String);
5978var
5979  Stream: TFileStream;
5980begin
5981  Stream := TFileStream.Create(FName, fmCreate);
5982  EMFPages.SaveToStream(Stream);
5983  Stream.Free;
5984end;
5985
5986procedure TfrReport.LoadTemplate(FName: String; comm: TStrings;
5987  Bmp: TBitmap; Load: Boolean);
5988var
5989  Stream: TFileStream;
5990  b: Byte;
5991  fb: TBitmap;
5992  fm: TStringList;
5993  pos: Integer;
5994begin
5995  fb := TBitmap.Create;
5996  fm := TStringList.Create;
5997  Stream := TFileStream.Create(FName, fmOpenRead);
5998  if Load then
5999  begin
6000    ReadMemo(Stream, fm);
6001    Stream.Read(pos, 4);
6002    Stream.Read(b, 1);
6003    if b <> 0 then
6004      fb.LoadFromStream(Stream);
6005    Stream.Position := pos;
6006    Pages.LoadFromStream(Stream);
6007  end
6008  else
6009  begin
6010    ReadMemo(Stream, Comm);
6011    Stream.Read(pos, 4);
6012    Bmp.Assign(nil);
6013    Stream.Read(b, 1);
6014    if b <> 0 then
6015      Bmp.LoadFromStream(Stream);
6016  end;
6017  fm.Free; fb.Free;
6018  Stream.Free;
6019end;
6020
6021procedure TfrReport.SaveTemplate(FName: String; Comm: TStrings; Bmp: TBitmap);
6022var
6023  Stream: TFileStream;
6024  b: Byte;
6025  pos, lpos: Integer;
6026begin
6027  Stream := TFileStream.Create(FName, fmCreate);
6028  frWriteMemo(Stream, Comm);
6029  b := 0;
6030  pos := Stream.Position;
6031  lpos := 0;
6032  Stream.Write(lpos, 4);
6033  if Bmp.Empty then
6034    Stream.Write(b, 1)
6035  else
6036  begin
6037    b := 1;
6038    Stream.Write(b, 1);
6039    Bmp.SaveToStream(Stream);
6040  end;
6041  lpos := Stream.Position;
6042  Stream.Position := pos;
6043  Stream.Write(lpos, 4);
6044  Stream.Position := lpos;
6045  Pages.SaveToStream(Stream);
6046  Stream.Free;
6047end;
6048
6049// report manipulation methods
6050procedure TfrReport.DesignReport;
6051var
6052  HF: String;
6053begin
6054  if Pages.Count = 0 then Pages.Add;
6055  CurReport := Self;
6056  HF := Application.HelpFile;
6057  Application.HelpFile := 'FRuser.hlp';
6058  if frDesigner <> nil then
6059    frDesigner.ShowModal;
6060  Application.HelpFile := HF;
6061end;
6062
6063var
6064  FirstPassTerminated, FirstTime: Boolean;
6065
6066procedure TfrReport.BuildBeforeModal(Sender: TObject);
6067begin
6068  DoBuildReport;
6069  if FinalPass then
6070    if Terminated then
6071      frProgressForm.ModalResult := mrCancel else
6072      frProgressForm.ModalResult := mrOk
6073  else
6074  begin
6075    FirstPassTerminated := Terminated;
6076    SavedAllPages := EMFPages.Count;
6077    DoublePass := False;
6078    FirstTime := False;
6079    DoPrepareReport; // do final pass
6080    DoublePass := True;
6081  end;
6082end;
6083
6084function TfrReport.PrepareReport: Boolean;
6085var
6086  ParamOk: Boolean;
6087begin
6088  DocMode := dmPrinting;
6089  CurDate := Date; CurTime := Time;
6090  MasterReport := Self;
6091  CurReport := Self;
6092  Values.Items.Sorted := True;
6093  frParser.OnGetValue := GetVariableValue;
6094  frParser.OnFunction := OnGetParsFunction;
6095  if Assigned(FOnBeginDoc) then FOnBeginDoc;
6096
6097  Result := False;
6098  ParamOk := True;
6099  if frDataManager <> nil then
6100  begin
6101    FillQueryParams;
6102    ParamOk := frDataManager.ShowParamsDialog;
6103  end;
6104  if ParamOk then
6105    Result := DoPrepareReport;
6106  FinalPass := False;
6107  if frDataManager <> nil then
6108    frDataManager.AfterParamsDialog;
6109  if Assigned(FOnEndDoc) then FOnEndDoc;
6110end;
6111
6112function TfrReport.DoPrepareReport: Boolean;
6113var
6114  s: String;
6115begin
6116  Result := True;
6117  Terminated := False;
6118  Append := False;
6119  DisableDrawing := False;
6120  FinalPass := True;
6121  FirstTime := True;
6122  PageNo := 0;
6123  EMFPages.Clear;
6124
6125  s := LoadStr(SReportPreparing);
6126  if DoublePass then
6127  begin
6128    DisableDrawing := True;
6129    FinalPass := False;
6130    if not Assigned(FOnProgress) and FShowProgress then
6131      with frProgressForm do
6132      begin
6133        if Title = '' then
6134          Caption := s else
6135          Caption := s + ' - ' + Title;
6136        FirstCaption := LoadStr(SFirstPass);
6137        Label1.Caption := FirstCaption + '  1';
6138        OnBeforeModal := BuildBeforeModal;
6139        Show_Modal(Self);
6140      end
6141    else
6142      BuildBeforeModal(nil);
6143    Exit;
6144  end;
6145  if not Assigned(FOnProgress) and FShowProgress then
6146    with frProgressForm do
6147    begin
6148      if Title = '' then
6149        Caption := s else
6150        Caption := s + ' - ' + Title;
6151      FirstCaption := LoadStr(SPagePreparing);
6152      Label1.Caption := FirstCaption + '  1';
6153      OnBeforeModal := BuildBeforeModal;
6154      if Visible then
6155      begin
6156        if not FirstPassTerminated then DoublePass := True;
6157        BuildBeforeModal(nil);
6158      end
6159      else
6160      begin
6161        SavedAllPages := 0;
6162        if Show_Modal(Self) = mrCancel then
6163          Result := False;
6164      end;
6165    end
6166  else
6167    BuildBeforeModal(nil);
6168  Terminated := False;
6169end;
6170
6171var
6172  ExportStream: TFileStream;
6173
6174procedure TfrReport.ExportBeforeModal(Sender: TObject);
6175var
6176  i: Integer;
6177begin
6178  Application.ProcessMessages;
6179  for i := 0 to EMFPages.Count - 1 do
6180  begin
6181    FCurrentFilter.OnBeginPage;
6182    EMFPages.ExportData(i);
6183    InternalOnProgress(i + 1);
6184    Application.ProcessMessages;
6185    FCurrentFilter.OnEndPage;
6186  end;
6187  FCurrentFilter.OnEndDoc;
6188  frProgressForm.ModalResult := mrOk;
6189end;
6190
6191procedure TfrReport.ExportTo(Filter: TClass; FileName: String);
6192var
6193  s: String;
6194begin
6195  ExportStream := TFileStream.Create(FileName, fmCreate);
6196  FCurrentFilter := TfrExportFilter(Filter.NewInstance);
6197  FCurrentFilter.Create(ExportStream);
6198  FCurrentFilter.OnBeginDoc;
6199
6200  CurReport := Self;
6201  MasterReport := Self;
6202  SavedAllPages := EMFPages.Count;
6203  with frProgressForm do
6204  begin
6205    s := LoadStr(SReportPreparing);
6206    if Title = '' then
6207      Caption := s else
6208      Caption := s + ' - ' + Title;
6209    FirstCaption := LoadStr(SPagePreparing);
6210    Label1.Caption := FirstCaption + '  1';
6211    OnBeforeModal := ExportBeforeModal;
6212    Show_Modal(Self);
6213  end;
6214
6215  FCurrentFilter.Free;
6216  FCurrentFilter := nil;
6217  ExportStream.Free;
6218end;
6219
6220procedure TfrReport.FillQueryParams;
6221var
6222  i, j: Integer;
6223  t: TfrView;
6224  procedure PrepareDS(ds: TfrDataSet);
6225  begin
6226    if (ds <> nil) and (ds is TfrDBDataSet) then
6227      frDataManager.PrepareDataSet(TfrTDataSet((ds as TfrDBDataSet).GetDataSet));
6228  end;
6229begin
6230  if frDataManager = nil then Exit;
6231  frDataManager.BeforePreparing;
6232  if Dataset <> nil then
6233    PrepareDS(DataSet);
6234  for i := 0 to Pages.Count - 1 do
6235    for j := 0 to Pages[i].Objects.Count-1 do
6236    begin
6237      t := Pages[i].Objects[j];
6238      if t is TfrBandView then
6239        PrepareDS(frFindComponent(CurReport.Owner, t.FormatStr) as TfrDataSet);
6240    end;
6241  frDataManager.AfterPreparing;
6242end;
6243
6244procedure TfrReport.DoBuildReport;
6245var
6246  i: Integer;
6247  b: Boolean;
6248begin
6249  HookList.Clear;
6250  CanRebuild := True;
6251  DocMode := dmPrinting;
6252  CurReport := Self;
6253  Values.Items.Sorted := True;
6254  frParser.OnGetValue := GetVariableValue;
6255  frParser.OnFunction := OnGetParsFunction;
6256  ErrorFlag := False;
6257  b := (Dataset <> nil) and (ReportType = rtMultiple);
6258  if b then
6259  begin
6260    Dataset.Init;
6261    Dataset.First;
6262  end;
6263  for i := 0 to Pages.Count - 1 do
6264    Pages[i].Skip := False;
6265  for i := 0 to Pages.Count - 1 do
6266    Pages[i].InitReport;
6267  PrepareDataSets;
6268  for i := 0 to Pages.Count - 1 do
6269    Pages[i].PrepareObjects;
6270
6271  repeat
6272    InternalOnProgress(PageNo + 1);
6273    for i := 0 to Pages.Count - 1 do
6274    begin
6275      FCurPage := Pages[i];
6276      if FCurPage.Skip then continue;
6277      FCurPage.Mode := pmNormal;
6278      if Assigned(FOnManualBuild) then
6279        FOnManualBuild(FCurPage) else
6280        FCurPage.FormPage;
6281
6282      Append := False;
6283      if ((i = Pages.Count - 1) and CompositeMode and (not b or Dataset.Eof)) or
6284         ((i <> Pages.Count - 1) and Pages[i + 1].PrintToPrevPage) then
6285      begin
6286        Dec(PageNo);
6287        Append := True;
6288      end;
6289      if not Append then
6290      begin
6291        PageNo := MasterReport.EMFPages.Count;
6292        InternalOnProgress(PageNo);
6293      end;
6294      if MasterReport.Terminated then break;
6295    end;
6296    InternalOnProgress(PageNo);
6297    if b then Dataset.Next;
6298  until MasterReport.Terminated or not b or Dataset.Eof;
6299
6300  for i := 0 to Pages.Count - 1 do
6301    Pages[i].DoneReport;
6302  if b then
6303    Dataset.Exit;
6304  if (frDataManager <> nil) and FinalPass then
6305    frDataManager.AfterPreparing;
6306  Values.Items.Sorted := False;
6307end;
6308
6309procedure TfrReport.ShowReport;
6310begin
6311  PrepareReport;
6312  if ErrorFlag then
6313  begin
6314    MessageBox(0, PChar(ErrorStr), PChar(LoadStr(SError)),
6315      mb_Ok + mb_IconError);
6316    EMFPages.Clear;
6317  end
6318  else
6319    ShowPreparedReport;
6320end;
6321
6322procedure TfrReport.ShowPreparedReport;
6323var
6324  s: String;
6325  p: TfrPreviewForm;
6326begin
6327  CurReport := Self;
6328  MasterReport := Self;
6329  DocMode := dmPrinting;
6330  if EMFPages.Count = 0 then Exit;
6331  s := LoadStr(SPreview);
6332  if Title <> '' then s := s + ' - ' + Title;
6333  if not (csDesigning in ComponentState) and Assigned(Preview) then
6334    Preview.Connect(Self)
6335  else
6336  begin
6337    p := TfrPreviewForm.Create(nil);
6338    p.Caption := s;
6339    p.Show_Modal(Self);
6340  end;
6341end;
6342
6343procedure TfrReport.PrintBeforeModal(Sender: TObject);
6344begin
6345  DoPrintReport(FPageNumbers, FCopies);
6346  frProgressForm.ModalResult := mrOk;
6347end;
6348
6349procedure TfrReport.PrintPreparedReport(PageNumbers: String; Copies: Integer);
6350var
6351  s: String;
6352begin
6353  CurReport := Self;
6354  MasterReport := Self;
6355  s := LoadStr(SReportPreparing);
6356  Terminated := False;
6357  FPageNumbers := PageNumbers;
6358  FCopies := Copies;
6359  if not Assigned(FOnProgress) and FShowProgress then
6360    with frProgressForm do
6361    begin
6362      if Title = '' then
6363        Caption := s else
6364        Caption := s + ' - ' + Title;
6365      FirstCaption := LoadStr(SPagePrinting);
6366      Label1.Caption := FirstCaption;
6367      OnBeforeModal := PrintBeforeModal;
6368      Show_Modal(Self);
6369    end
6370  else
6371    PrintBeforeModal(nil);
6372  Terminated := False;
6373end;
6374
6375{$IFDEF Trial}
6376{$HINTS OFF}
6377procedure TfrReport.DoPrintReport(PageNumbers: String; Copies: Integer);
6378var
6379  i, j: Integer;
6380  f: Boolean;
6381  pgList: TStringList;
6382
6383  procedure ParsePageNumbers;
6384  var
6385    i, j, n1, n2: Integer;
6386    s: String;
6387    IsRange: Boolean;
6388  begin
6389    s := PageNumbers;
6390    while Pos(' ', s) <> 0 do
6391      Delete(s, Pos(' ', s), 1);
6392    if s = '' then Exit;
6393
6394    s := s + ',';
6395    i := 1; j := 1; n1 := 1;
6396    IsRange := False;
6397    while i <= Length(s) do
6398    begin
6399      if s[i] = ',' then
6400      begin
6401        n2 := StrToInt(Copy(s, j, i - j));
6402        j := i + 1;
6403        if IsRange then
6404          while n1 <= n2 do
6405          begin
6406            pgList.Add(IntToStr(n1));
6407            Inc(n1);
6408          end
6409        else
6410          pgList.Add(IntToStr(n2));
6411        IsRange := False;
6412      end
6413      else if s[i] = '-' then
6414      begin
6415        IsRange := True;
6416        n1 := StrToInt(Copy(s, j, i - j));
6417        j := i + 1;
6418      end;
6419      Inc(i);
6420    end;
6421  end;
6422
6423  procedure PrintPage(n: Integer);
6424  var
6425    s: String[40];
6426  begin
6427    with Printer, EMFPages[n]^ do
6428    begin
6429      if not Prn.IsEqual(pgSize, pgWidth, pgHeight, pgOr) then
6430      begin
6431        EndDoc;
6432        Prn.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgOr);
6433        BeginDoc;
6434      end
6435      else if not f then NewPage;
6436      Prn.FillPrnInfo(PrnInfo);
6437      Visible := True;
6438
6439      with PrnInfo do
6440        if pgMargins then
6441          EMFPages.Draw(n, Printer.Canvas, Rect(-POfx, -POfy, PPgw - POfx, PPgh - POfy))
6442        else
6443          EMFPages.Draw(n, Printer.Canvas, Rect(0, 0, PPw, PPh));
6444
6445      Visible := False;
6446      EMFPages.Draw(n, Printer.Canvas, Rect(0, 0, 0, 0));
6447
6448      s[0] := #25;
6449      s[1] := 'F';
6450      s[2] := 'a';
6451      s[3] := 's';
6452      s[4] := 't';
6453      s[5] := 'R';
6454      s[6] := 'e';
6455      s[7] := 'p';
6456      s[8] := 'o';
6457      s[9] := LowerCase(s[5])[1];
6458      s[10] := s[4];
6459      s[11] := ' ';
6460      s[12] := '-';
6461      s[13] := s[11];
6462      s[14] := 'u';
6463      s[15] := 'n';
6464      s[16] := s[9];
6465      s[17] := s[6];
6466      s[18] := 'g';
6467      s[19] := 'i';
6468      s[20] := s[3];
6469      s[21] := s[4];
6470      s[22] := s[6];
6471      s[23] := s[9];
6472      s[24] := s[6];
6473      s[25] := 'd';
6474      Canvas.TextOut(10, 10, s);
6475    end;
6476    InternalOnProgress(n + 1);
6477    Application.ProcessMessages;
6478    f := False;
6479    Printer.EndDoc;
6480    pgList.Free;
6481  end;
6482
6483begin
6484  Prn.Printer := Printer;
6485  pgList := TStringList.Create;
6486
6487  ParsePageNumbers;
6488  if Copies <= 0 then
6489    Copies := 1;
6490
6491  with EMFPages[0]^ do
6492  begin
6493    Prn.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgOr);
6494    Prn.FillPrnInfo(PrnInfo);
6495  end;
6496  if Title <> '' then
6497    Printer.Title := 'FastReport: ' + Title else
6498    Printer.Title := 'FastReport: ' + LoadStr(SUntitled);
6499
6500  Printer.BeginDoc;
6501  f := True;
6502  for i := 0 to EMFPages.Count - 1 do
6503    if (pgList.Count = 0) or (pgList.IndexOf(IntToStr(i + 1)) <> -1) then
6504    begin
6505      PrintPage(i);
6506      Exit;
6507    end;
6508end;
6509{$HINTS ON}
6510{$ELSE}
6511procedure TfrReport.DoPrintReport(PageNumbers: String; Copies: Integer);
6512var
6513  i, j: Integer;
6514  f: Boolean;
6515  pgList: TStringList;
6516
6517  procedure ParsePageNumbers;
6518  var
6519    i, j, n1, n2: Integer;
6520    s: String;
6521    IsRange: Boolean;
6522  begin
6523    s := PageNumbers;
6524    while Pos(' ', s) <> 0 do
6525      Delete(s, Pos(' ', s), 1);
6526    if s = '' then Exit;
6527
6528    s := s + ',';
6529    i := 1; j := 1; n1 := 1;
6530    IsRange := False;
6531    while i <= Length(s) do
6532    begin
6533      if s[i] = ',' then
6534      begin
6535        n2 := StrToInt(Copy(s, j, i - j));
6536        j := i + 1;
6537        if IsRange then
6538          while n1 <= n2 do
6539          begin
6540            pgList.Add(IntToStr(n1));
6541            Inc(n1);
6542          end
6543        else
6544          pgList.Add(IntToStr(n2));
6545        IsRange := False;
6546      end
6547      else if s[i] = '-' then
6548      begin
6549        IsRange := True;
6550        n1 := StrToInt(Copy(s, j, i - j));
6551        j := i + 1;
6552      end;
6553      Inc(i);
6554    end;
6555  end;
6556
6557  procedure PrintPage(n: Integer);
6558  begin
6559    with Printer, EMFPages[n]^ do
6560    begin
6561      if not Prn.IsEqual(pgSize, pgWidth, pgHeight, pgOr) then
6562      begin
6563        EndDoc;
6564        Prn.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgOr);
6565        BeginDoc;
6566      end
6567      else if not f then NewPage;
6568      Prn.FillPrnInfo(PrnInfo);
6569      Visible := True;
6570
6571      with PrnInfo do
6572        if pgMargins then
6573          EMFPages.Draw(n, Printer.Canvas, Rect(-POfx, -POfy, PPgw - POfx, PPgh - POfy))
6574        else
6575          EMFPages.Draw(n, Printer.Canvas, Rect(0, 0, PPw, PPh));
6576
6577      Visible := False;
6578      EMFPages.Draw(n, Printer.Canvas, Rect(0, 0, 0, 0));
6579    end;
6580    InternalOnProgress(n + 1);
6581    Application.ProcessMessages;
6582    f := False;
6583  end;
6584
6585begin
6586  Prn.Printer := Printer;
6587  pgList := TStringList.Create;
6588
6589  ParsePageNumbers;
6590  if Copies <= 0 then
6591    Copies := 1;
6592
6593  with EMFPages[0]^ do
6594  begin
6595    Prn.SetPrinterInfo(pgSize, pgWidth, pgHeight, pgOr);
6596    Prn.FillPrnInfo(PrnInfo);
6597  end;
6598  if Title <> '' then
6599    Printer.Title := 'FastReport: ' + Title else
6600    Printer.Title := 'FastReport: ' + LoadStr(SUntitled);
6601
6602  Printer.BeginDoc;
6603  f := True;
6604  for i := 0 to EMFPages.Count - 1 do
6605    if (pgList.Count = 0) or (pgList.IndexOf(IntToStr(i + 1)) <> -1) then
6606      for j := 0 to Copies - 1 do
6607      begin
6608        PrintPage(i);
6609        if Terminated then
6610        begin
6611          Printer.Abort;
6612          pgList.Free;
6613          Exit;
6614        end;
6615      end;
6616  Printer.EndDoc;
6617  pgList.Free;
6618end;
6619{$ENDIF}
6620
6621// printer manipulation methods
6622
6623procedure TfrReport.SetPrinterTo(PrnName: String);
6624begin
6625  if not PrintToDefault then
6626    if Prn.Printers.IndexOf(PrnName) <> -1 then
6627      Prn.PrinterIndex := Prn.Printers.IndexOf(PrnName);
6628end;
6629
6630function TfrReport.ChangePrinter(OldIndex, NewIndex: Integer): Boolean;
6631  procedure ChangePages;
6632  var
6633    i: Integer;
6634  begin
6635    for i := 0 to Pages.Count - 1 do
6636      with Pages[i] do
6637        ChangePaper(pgSize, pgWidth, pgHeight, pgOr);
6638  end;
6639begin
6640  Result := True;
6641  try
6642    Prn.PrinterIndex := NewIndex;
6643    Prn.PaperSize := -1;
6644    ChangePages;
6645  except
6646    on Exception do
6647    begin
6648      MessageBox(0, PChar(LoadStr(SPrinterError)),
6649        PChar(LoadStr(SError)), mb_IconError + mb_Ok);
6650      Prn.PrinterIndex := OldIndex;
6651      ChangePages;
6652      Result := False;
6653    end;
6654  end;
6655end;
6656
6657procedure TfrReport.EditPreparedReport(PageIndex: Integer);
6658var
6659  p: PfrPageInfo;
6660  Stream: TMemoryStream;
6661  Designer: TfrReportDesigner;
6662  DesName: String;
6663begin
6664  if frDesigner = nil then Exit;
6665  Screen.Cursor := crHourGlass;
6666  Designer := frDesigner;
6667  DesName := Designer.Name;
6668  Designer.Name := DesName + '__';
6669  Designer.Page := nil;
6670  frDesigner := TfrReportDesigner(frDesigner.ClassType.NewInstance);
6671  frDesigner.Create(nil);
6672  Stream := TMemoryStream.Create;
6673  SaveToStream(Stream);
6674  Pages.Clear;
6675  EMFPages.ObjectsToPage(PageIndex);
6676  p := EMFPages[PageIndex];
6677  Pages.FPages.Add(p^.Page);
6678  CurReport := Self;
6679  Screen.Cursor := crDefault;
6680  try
6681    frDesigner.ShowModal;
6682    if frDesigner.Modified then
6683      if MessageBox(0, PChar(LoadStr(SSaveChanges) + '?'),
6684        PChar(LoadStr(SConfirm)), mb_YesNo + mb_IconQuestion) = mrYes then
6685        EMFPages.PageToObjects(PageIndex);
6686  finally
6687    Pages.FPages.Clear;
6688    Stream.Position := 0;
6689    LoadFromStream(Stream);
6690    Stream.Free;
6691    frDesigner.Free;
6692    frDesigner := Designer;
6693    frDesigner.Name := DesName;
6694    frDesigner.Page := Pages[0];
6695    frDesigner.RedrawPage;
6696  end;
6697end;
6698
6699
6700// miscellaneous methods
6701procedure TfrReport.PrepareDataSets;
6702var
6703  i: Integer;
6704begin
6705  with Values do
6706  for i := 0 to Items.Count - 1 do
6707    with Objects[i] do
6708    if Typ = vtDBField then
6709      DSet := frGetDataSet(DataSet);
6710end;
6711
6712procedure TfrReport.SetVars(Value: TStrings);
6713begin
6714  FVars.Assign(Value);
6715end;
6716
6717procedure TfrReport.GetVarList(CatNo: Integer; List: TStrings);
6718var
6719  i, n: Integer;
6720  s: String;
6721begin
6722  List.Clear;
6723  i := 0; n := 0;
6724  if FVars.Count > 0 then
6725    repeat
6726      s := FVars[i];
6727      if Length(s) > 0 then
6728        if s[1] <> ' ' then Inc(n);
6729      Inc(i);
6730    until n > CatNo;
6731  while i < FVars.Count do
6732  begin
6733    s := FVars[i];
6734    if (s <> '') and (s[1] = ' ') then
6735      List.Add(Copy(s, 2, Length(s) - 1)) else
6736      break;
6737    Inc(i);
6738  end;
6739end;
6740
6741procedure TfrReport.GetCategoryList(List: TStrings);
6742var
6743  i: Integer;
6744  s: String;
6745begin
6746  List.Clear;
6747  for i := 0 to FVars.Count - 1 do
6748  begin
6749    s := FVars[i];
6750    if (s <> '') and (s[1] <> ' ') then List.Add(s);
6751  end;
6752end;
6753
6754function TfrReport.FindVariable(Variable: String): Integer;
6755var
6756  i: Integer;
6757begin
6758  Result := -1;
6759  Variable := ' ' + Variable;
6760  for i := 0 to FVars.Count - 1 do
6761    if Variable = FVars[i] then
6762    begin
6763      Result := i;
6764      break;
6765    end;
6766end;
6767
6768function TfrReport.FindObject(Name: String): TfrView;
6769var
6770  i, j: Integer;
6771begin
6772  Result := nil;
6773  for i := 0 to Pages.Count - 1 do
6774    for j := 0 to Pages[i].Objects.Count - 1 do
6775      if AnsiCompareText(TfrView(Pages[i].Objects[j]).Name, Name) = 0 then
6776      begin
6777        Result := Pages[i].Objects[j];
6778        Exit;
6779      end;
6780end;
6781
6782
6783{----------------------------------------------------------------------------}
6784constructor TfrCompositeReport.Create(AOwner: TComponent);
6785begin
6786  inherited Create(AOwner);
6787  Reports := TList.Create;
6788end;
6789
6790destructor TfrCompositeReport.Destroy;
6791begin
6792  Reports.Free;
6793  inherited Destroy;
6794end;
6795
6796procedure TfrCompositeReport.DoBuildReport;
6797var
6798  i: Integer;
6799  Doc: TfrReport;
6800  ParamOk: Boolean;
6801begin
6802  CanRebuild := True;
6803  PageNo := 0;
6804  for i := 0 to Reports.Count - 1 do
6805  begin
6806    Doc := TfrReport(Reports[i]);
6807    CompositeMode := False;
6808    if i <> Reports.Count - 1 then
6809      if (TfrReport(Reports[i + 1]).Pages.Count > 0) and
6810        TfrReport(Reports[i + 1]).Pages[0].PrintToPrevPage then
6811        CompositeMode := True;
6812    if Assigned(Doc.FOnBeginDoc) and FirstTime then
6813      Doc.FOnBeginDoc;
6814    ParamOk := True;
6815    if (frDataManager <> nil) and FirstTime then
6816    begin
6817      Doc.FillQueryParams;
6818      ParamOk := frDataManager.ShowParamsDialog;
6819    end;
6820    if ParamOk then
6821      Doc.DoBuildReport;
6822    if (frDataManager <> nil) and FinalPass then
6823      frDataManager.AfterParamsDialog;
6824    if Assigned(Doc.FOnEndDoc) and FinalPass then
6825      Doc.FOnEndDoc;
6826    Append := CompositeMode;
6827    CompositeMode := False;
6828    if Terminated then break;
6829  end;
6830end;
6831
6832
6833{----------------------------------------------------------------------------}
6834procedure TfrObjEditorForm.ShowEditor(t: TfrView);
6835begin
6836// abstract method
6837end;
6838
6839
6840{----------------------------------------------------------------------------}
6841constructor TfrExportFilter.Create(AStream: TStream);
6842begin
6843  inherited Create;
6844  Stream := AStream;
6845  Lines := TList.Create;
6846end;
6847
6848destructor TfrExportFilter.Destroy;
6849begin
6850  ClearLines;
6851  Lines.Free;
6852  inherited Destroy;
6853end;
6854
6855procedure TfrExportFilter.ClearLines;
6856var
6857  i: Integer;
6858  p, p1: PfrTextRec;
6859begin
6860  for i := 0 to Lines.Count - 1 do
6861  begin
6862    p := PfrTextRec(Lines[i]);
6863    while p <> nil do
6864    begin
6865      p1 := p;
6866      p := p^.Next;
6867      FreeMem(p1, SizeOf(TfrTextRec));
6868    end;
6869  end;
6870  Lines.Clear;
6871end;
6872
6873procedure TfrExportFilter.OnBeginDoc;
6874begin
6875// abstract method
6876end;
6877
6878procedure TfrExportFilter.OnEndDoc;
6879begin
6880// abstract method
6881end;
6882
6883procedure TfrExportFilter.OnBeginPage;
6884begin
6885// abstract method
6886end;
6887
6888procedure TfrExportFilter.OnEndPage;
6889begin
6890// abstract method
6891end;
6892
6893procedure TfrExportFilter.OnData(x, y: Integer; View: TfrView);
6894begin
6895// abstract method
6896end;
6897
6898procedure TfrExportFilter.OnText(x, y: Integer; const text: String; View: TfrView);
6899begin
6900// abstract method
6901end;
6902
6903
6904{----------------------------------------------------------------------------}
6905constructor TfrFunctionLibrary.Create;
6906begin
6907  inherited Create;
6908  List := TStringList.Create;
6909  List.Sorted := True;
6910end;
6911
6912destructor TfrFunctionLibrary.Destroy;
6913begin
6914  List.Free;
6915  inherited Destroy;
6916end;
6917
6918function TfrFunctionLibrary.OnFunction(const FName: String; p1, p2, p3: Variant;
6919  var val: String): Boolean;
6920var
6921  i: Integer;
6922begin
6923  Result := False;
6924  if List.Find(FName, i) then
6925  begin
6926    DoFunction(i, p1, p2, p3, val);
6927    Result := True;
6928  end;
6929end;
6930
6931
6932{----------------------------------------------------------------------------}
6933constructor TfrStdFunctionLibrary.Create;
6934begin
6935  inherited Create;
6936  with List do
6937  begin
6938    Add('AVG');
6939    Add('COUNT');
6940    Add('FORMATDATETIME');
6941    Add('FORMATFLOAT');
6942    Add('INPUT');
6943    Add('LOWERCASE');
6944    Add('MAX');
6945    Add('MIN');
6946    Add('NAMECASE');
6947    Add('STRTODATE');
6948    Add('STRTOTIME');
6949    Add('SUM');
6950    Add('UPPERCASE');
6951  end;
6952end;
6953
6954procedure TfrStdFunctionLibrary.DoFunction(FNo: Integer; p1, p2, p3: Variant;
6955  var val: String);
6956var
6957  DataSet: TfrTDataSet;
6958  Field: TfrTField;
6959  s1, s2, VarName: String;
6960  min, max, avg, sum, count, d, v: Double;
6961  dk: (dkNone, dkSum, dkMin, dkMax, dkAvg, dkCount);
6962  vv: Variant;
6963begin
6964  dk := dkNone;
6965  val := '0';
6966  case FNo of
6967    0: dk := dkAvg;
6968    1: dk := dkCount;
6969    2: val := '''' + FormatDateTime(frParser.Calc(p1), frParser.Calc(p2)) + '''';
6970    3: val := '''' + FormatFloat(frParser.Calc(p1), frParser.Calc(p2)) + '''';
6971    4:
6972      begin
6973        s1 := InputBox('', frParser.Calc(p1), frParser.Calc(p2));
6974        val := '''' + s1 + '''';
6975      end;
6976    5: val := '''' + AnsiLowerCase(frParser.Calc(p1)) + '''';
6977    6: dk := dkMax;
6978    7: dk := dkMin;
6979    8:
6980      begin
6981        s1 := AnsiLowerCase(frParser.Calc(p1));
6982        if Length(s1) > 0 then
6983          val := '''' + AnsiUpperCase(s1[1]) + Copy(s1, 2, Length(s1) - 1) + ''''
6984        else
6985          val := '''' + '''';
6986      end;
6987    9: val := '%d''' + frParser.Calc(p1) + '''';
6988    10: val := '%t''' + frParser.Calc(p1) + '''';
6989    11: dk := dkSum;
6990    12: val := '''' + AnsiUpperCase(frParser.Calc(p1)) + '''';
6991  end;
6992  if dk <> dkNone then
6993  begin
6994    if dk = dkCount then
6995      DataSet := frGetDataSet(p1) else
6996      frGetDataSetAndField(p1, DataSet, Field);
6997    if (DataSet <> nil) and AggrBand.Visible then
6998    begin
6999      min := 1e200; max := -1e200; sum := 0; count := 0; avg := 0;
7000      DataSet.First;
7001      while not DataSet.Eof do
7002      begin
7003        v := 0;
7004        if dk <> dkCount then
7005          if Field.Value <> Null then
7006            v := Field.AsFloat else
7007            v := 0;
7008        if v > max then max := v;
7009        if v < min then min := v;
7010        sum := sum + v;
7011        count := count + 1;
7012        DataSet.Next;
7013      end;
7014      if count > 0 then
7015        avg := sum / count;
7016      d := 0;
7017      case dk of
7018        dkSum: d := sum;
7019        dkMin: d := min;
7020        dkMax: d := max;
7021        dkAvg: d := avg;
7022        dkCount: d := count;
7023      end;
7024      val := FloatToStr(d);
7025    end
7026    else if DataSet = nil then
7027    begin
7028      s1 := Trim(p2);
7029      if s1 = '' then
7030        s1 := CurBand.View.Name;
7031      if dk <> dkCount then
7032        s2 := Trim(p3) else
7033        s2 := Trim(p2);
7034      if (AggrBand.Typ in [btPageFooter, btMasterFooter, btDetailFooter,
7035        btSubDetailFooter, btGroupFooter, btCrossFooter, btReportSummary]) and
7036         ((s2 = '1') or ((s2 <> '1') and CurBand.Visible)) then
7037      begin
7038        VarName := List[FNo] + p1;
7039        if IsColumns then
7040          if AggrBand.Typ = btCrossFooter then
7041            VarName := VarName + '00' else
7042            VarName := VarName + IntToStr(CurPage.ColPos);
7043        if not AggrBand.Visible and (AnsiCompareText(CurBand.View.Name, s1) = 0) then
7044        begin
7045          s1 := AggrBand.Values.Values[VarName];
7046          if s1 <> '' then
7047            if s1[1] = '1' then
7048              Exit else
7049              s1 := Copy(s1, 2, 255);
7050          vv := 0;
7051          if dk <> dkCount then
7052            vv := frParser.Calc(p1);
7053          if vv = Null then
7054            vv := 0;
7055          d := vv;
7056          if s1 = '' then
7057            if dk = dkMin then s1 := '1e200'
7058            else if dk = dkMax then s1 := '-1e200'
7059            else s1 := '0';
7060          v := StrToFloat(s1);
7061          case dk of
7062            dkAvg: v := v + d;
7063            dkCount: v := v + 1;
7064            dkMax: if v < d then v := d;
7065            dkMin: if v > d then v := d;
7066            dkSum: v := v + d;
7067          end;
7068          AggrBand.Values.Values[VarName] := '1' + FloatToStr(v);
7069          Exit;
7070        end
7071        else if AggrBand.Visible then
7072        begin
7073          val := Copy(AggrBand.Values.Values[VarName], 2, 255);
7074          if dk = dkAvg then
7075            val := FloatToStr(StrToFloat(val) / AggrBand.Count);
7076          Exit;
7077        end;
7078      end;
7079    end;
7080  end;
7081end;
7082
7083
7084{-----------------------------------------------------------------------------}
7085const
7086  PropCount = 16;
7087  PropNames: Array[0..PropCount - 1] of String =
7088    ('Left', 'Top', 'Width', 'Height', 'Flags', 'Visible', 'FrameTyp',
7089     'FrameWidth', 'FrameColor', 'FillColor', 'Text',
7090     'FontName', 'FontSize', 'FontStyle', 'FontColor', 'Adjust');
7091  ColNames: Array[0..16] of String =
7092    ('clWhite', 'clBlack', 'clMaroon', 'clGreen', 'clOlive', 'clNavy',
7093     'clPurple', 'clTeal', 'clGray', 'clSilver', 'clRed', 'clLime',
7094     'clYellow', 'clBlue', 'clFuchsia', 'clAqua', 'clTransparent');
7095
7096{$WARNINGS OFF}
7097procedure TInterpretator.GetValue(const Name: String; var Value: Variant);
7098var
7099  i: Integer;
7100  t: TfrView;
7101  b: TfrBand;
7102  Prop: String;
7103  Flag: Boolean;
7104begin
7105  Value := 0;
7106  t := CurView;
7107  Prop := Name;
7108  if frVariables.IndexOf(Name) <> -1 then
7109  begin
7110    Value := frVariables[Name];
7111    Exit;
7112  end;
7113  if Name = 'FREESPACE' then
7114  begin
7115    Value := IntToStr(CurPage.CurBottomY - CurPage.CurY);
7116    Exit;
7117  end;
7118  if Pos('.', Name) <> 0 then
7119  begin
7120    t := CurPage.FindRTObject(Copy(Name, 1, Pos('.', Name) - 1));
7121    Prop := Copy(Name, Pos('.', Name) + 1, 255);
7122  end;
7123  if t = nil then
7124  begin
7125    frParser.OnGetValue(Name, Value);
7126    Exit;
7127  end;
7128  Flag := False;
7129  for i := 0 to PropCount - 1 do
7130    if AnsiCompareText(PropNames[i], Prop) = 0 then
7131    begin
7132      Flag := True;
7133      break;
7134    end;
7135  if not Flag then
7136    for i := 0 to 16 do
7137      if AnsiCompareText(ColNames[i], Prop) = 0 then
7138      begin
7139        if i <> 16 then
7140          Value := frColors[i] else
7141          Value := clNone;
7142        Exit;
7143      end;
7144
7145  if not Flag or ((i >= 11) and not (t is TfrMemoView)) then
7146  begin
7147    frParser.OnGetValue(Name, Value);
7148    Exit;
7149  end;
7150  if t is TfrBandView then
7151  begin
7152    b := t.Parent;
7153    case i of
7154       0: Value := b.x;
7155       1: Value := b.y;
7156       2: Value := b.dx;
7157       3: Value := b.dy;
7158       5: Value := b.Visible;
7159    end;
7160  end
7161  else
7162    case i of
7163       0: Value := t.x;
7164       1: Value := t.y;
7165       2: Value := t.dx;
7166       3: Value := t.dy;
7167       4: Value := t.Flags;
7168       5: Value := t.Visible;
7169       6: Value := t.FrameTyp;
7170       7: Value := t.FrameWidth;
7171       8: Value := t.FrameColor;
7172       9: Value := t.FillColor;
7173      10: Value := t.Memo.Text;
7174      11: Value := TfrMemoView(t).Font.Name;
7175      12: Value := TfrMemoView(t).Font.Size;
7176      13: Value := frGetFontStyle(TfrMemoView(t).Font.Style);
7177      14: Value := TfrMemoView(t).Font.Color;
7178      15: Value := TfrMemoView(t).Adjust;
7179    end;
7180end;
7181{$WARNINGS ON}
7182
7183procedure TInterpretator.SetValue(const Name: String; Value: Variant);
7184var
7185  i: Integer;
7186  t: TfrView;
7187  b: TfrBand;
7188  Prop: String;
7189  Flag: Boolean;
7190begin
7191  t := CurView;
7192  Prop := Name;
7193  if Pos('.', Name) <> 0 then
7194  begin
7195    t := CurPage.FindRTObject(Copy(Name, 1, Pos('.', Name) - 1));
7196    Prop := Copy(Name, Pos('.', Name) + 1, 255);
7197  end;
7198//  if t = nil then Exit;
7199  Flag := False;
7200  for i := 0 to PropCount - 1 do
7201    if AnsiCompareText(PropNames[i], Prop) = 0 then
7202    begin
7203      Flag := True;
7204      break;
7205    end;
7206  if not Flag then
7207  begin
7208    frVariables[Name] := Value;
7209    Exit;
7210  end;
7211  if (i >= 11) and not (t is TfrMemoView) then Exit;
7212  if t is TfrBandView then
7213  begin
7214    b := t.Parent;
7215    case i of
7216       0: b.x := Value;
7217       1: b.y := Value;
7218       2: b.dx := Value;
7219       3: b.dy := Value;
7220       5: b.Visible := Value;
7221    end;
7222  end
7223  else
7224    case i of
7225       0: t.x := Value;
7226       1: t.y := Value;
7227       2: t.dx := Value;
7228       3: t.dy := Value;
7229       4: t.Flags := Value;
7230       5: t.Visible := Value;
7231       6: t.FrameTyp := Value;
7232       7: t.FrameWidth := Value;
7233       8: t.FrameColor := Value;
7234       9: t.FillColor := Value;
7235      10: t.Memo.Text := Value;
7236      11: TfrMemoView(t).Font.Name := Value;
7237      12: TfrMemoView(t).Font.Size := Value;
7238      13: TfrMemoView(t).Font.Style := frSetFontStyle(Value);
7239      14: TfrMemoView(t).Font.Color := Value;
7240      15: TfrMemoView(t).Adjust := Value;
7241    end;
7242end;
7243
7244procedure TInterpretator.DoFunction(const Name: String; p1, p2, p3: Variant;
7245  var val: String);
7246begin
7247  if Name = 'NEWPAGE' then
7248  begin
7249    CurBand.ForceNewPage := True;
7250    Val := '0';
7251  end
7252  else if Name = 'NEWCOLUMN' then
7253  begin
7254    CurBand.ForceNewColumn := True;
7255    Val := '0';
7256  end
7257  else
7258    frParser.OnFunction(Name, p1, p2, p3, val);
7259end;
7260
7261
7262{----------------------------------------------------------------------------}
7263procedure TfrCompressor.Compress(StreamIn, StreamOut: TStream);
7264begin
7265// abstract method
7266end;
7267
7268procedure TfrCompressor.DeCompress(StreamIn, StreamOut: TStream);
7269begin
7270// abstract method
7271end;
7272
7273{----------------------------------------------------------------------------}
7274procedure DoInit;
7275const
7276  Clr: Array[0..1] of TColor = (clWhite, clSilver);
7277var
7278  i, j: Integer;
7279begin
7280  SMemo := TStringList.Create;
7281  SBmp := TBitmap.Create;
7282  TempBmp := TBitmap.Create;
7283  SBmp.Width := 8; SBmp.Height := 8;
7284  TempBmp.Width := 8; TempBmp.Height := 8;
7285  for j := 0 to 7 do
7286    for i := 0 to 7 do
7287      SBmp.Canvas.Pixels[i, j] := Clr[(j + i) mod 2];
7288  frRegisterFunctionLibrary(TfrStdFunctionLibrary);
7289  frProgressForm := TfrProgressForm.Create(nil);
7290  frCharset := StrToInt(LoadStr(SCharset));
7291
7292  for i := 0 to 21 do
7293    frBandNames[i] := LoadStr(SBand1 + i);
7294  for i := 0 to frSpecCount - 1 do
7295    frSpecArr[i] := LoadStr(SVar1 + i);
7296  for i := 0 to 3 do
7297    BoolStr[i] := LoadStr(SFormat51 + i);
7298  for i := 0 to 3 do
7299  begin
7300    frDateFormats[i] := LoadStr(SDateFormat1 + i);
7301    frTimeFormats[i] := LoadStr(STimeFormat1 + i);
7302  end;
7303  frParser := TfrParser.Create;
7304  frInterpretator := TInterpretator.Create;
7305  frVariables := TfrVariables.Create;
7306  frCompressor := TfrCompressor.Create;
7307  HookList := TList.Create;
7308end;
7309
7310procedure DoExit;
7311var
7312  i: Integer;
7313begin
7314  SBmp.Free;
7315  TempBmp.Free;
7316  SMemo.Free;
7317  frProgressForm.Free;
7318  for i := 0 to frFunctionsCount - 1 do
7319    frFunctions[i].FunctionLibrary.Free;
7320  frParser.Free;
7321  frInterpretator.Free;
7322  frVariables.Free;
7323  frCompressor.Free;
7324  HookList.Free;
7325end;
7326
7327
7328initialization
7329  DoInit;
7330
7331finalization
7332  DoExit;
7333
7334end.
7335