{*****************************************}

{                                         }

{             FastReport v2.3             }

{             Report classes              }

{                                         }

{  Copyright (c) 1998-99 by Tzyganenko A. }

{                                         }

{*****************************************}



unit FR_Class;



interface



{$I FR.inc}



uses

  SysUtils, Windows, Messages, Classes, Graphics, Printers, Controls,

  Forms, StdCtrls, ComCtrls, Dialogs, Menus, Buttons,

  FR_View, FR_Pars, FR_Intrp, FR_DSet, FR_DBSet, FR_DBRel

{$IFDEF Delphi6}

  , Variants

{$ENDIF}

{$IFDEF IBO}

 , IB_Components

{$ELSE}

 , DB

{$ENDIF};





const

// object flags

  flStretched = 1;

  flWordWrap = 2;

  flWordBreak = 4;

  flAutoSize = 8;

  flBandNewPageAfter = 2;

  flBandPrintifSubsetEmpty = 4;

  flBandPageBreak = 8;

  flBandOnFirstPage = $10;

  flBandOnLastPage = $20;

  flBandRepeatHeader = $40;

  flPictCenter = 2;

  flPictRatio = 4;

  flWantHook = $8000;



// object types

  gtMemo = 0;

  gtPicture = 1;

  gtBand = 2;

  gtSubReport = 3;

  gtLine = 4;

  gtAddIn = 10;



// frame types

  frftNone = 0;

  frftRight = 1;

  frftDown = 2;

  frftLeft = 4;

  frftUp = 8;



// text align

  frtaLeft = 0;

  frtaRight = 1;

  frtaCenter = 2;

  frtaVertical = 4;

  frtaMiddle = 8;

  frtaDown = 16;



type

  TfrDrawMode = (drAll, drCalcHeight, drAfterCalcHeight, drPart);

  TfrBandType = (btReportTitle, btReportSummary,

                 btPageHeader, btPageFooter,

                 btMasterHeader, btMasterData, btMasterFooter,

                 btDetailHeader, btDetailData, btDetailFooter,

                 btSubDetailHeader, btSubDetailData, btSubDetailFooter,

                 btOverlay, btColumnHeader, btColumnFooter,

                 btGroupHeader, btGroupFooter,

                 btCrossHeader, btCrossData, btCrossFooter, btNone);

  TfrDataSetPosition = (psLocal, psGlobal);

  TfrValueType = (vtNotAssigned, vtDBField, vtOther, vtFRVar);

  TfrPageMode = (pmNormal, pmBuildList);

  TfrBandRecType = (rtShowBand, rtFirst, rtNext);

  TfrRgnType = (rtNormal, rtExtended);

  TfrReportType = (rtSimple, rtMultiple);



  TfrView = class;

  TfrBand = class;

  TfrPage = class;

  TfrReport = class;

  TfrExportFilter = class;



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

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

  TBeginDocEvent = procedure of object;

  TEndDocEvent = procedure of object;

  TBeginPageEvent = procedure(pgNo: Integer) of object;

  TEndPageEvent = procedure(pgNo: Integer) of object;

  TBeginBandEvent = procedure(Band: TfrBand) of object;

  TEndBandEvent = procedure(Band: TfrBand) of object;

  TProgressEvent = procedure(n: Integer) of object;

  TBeginColumnEvent = procedure(Band: TfrBand) of object;

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

  TManualBuildEvent = procedure(Page: TfrPage) of object;



  TfrHighlightAttr = packed record

    FontStyle: Word;

    FontColor, FillColor: TColor;

  end;



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

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

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

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

  end;



  PfrPageInfo = ^TfrPageInfo;

  TfrPageInfo = packed record // pages of a preview

    R: TRect;

    pgSize: Word;

    pgWidth, pgHeight: Integer;

    pgOr: TPrinterOrientation;

    pgMargins: Boolean;

    PrnInfo: TfrPrnInfo;

    Visible: Boolean;

    Stream: TMemoryStream;

    Page: TfrPage;

  end;



  PfrBandRec = ^TfrBandRec;

  TfrBandRec = packed record

    Band: TfrBand;

    Action: TfrBandRecType;

  end;



  TfrView = class(TObject)

  private

    procedure P1Click(Sender: TObject);

  protected

    SaveX, SaveY, SaveDX, SaveDY: Integer;

    SaveFW: Single;

    BaseName: String;

    Canvas: TCanvas;

    DRect: TRect;

    gapx, gapy: Integer;

    Memo1: TStringList;

    FDataSet: TfrTDataSet;

    FField: String;

    olddy: Integer;

    StreamMode: (smDesigning, smPrinting);

    procedure ShowBackGround; virtual;

    procedure ShowFrame; virtual;

    procedure BeginDraw(ACanvas: TCanvas);

    procedure GetBlob(b: TfrTField); virtual;

    procedure OnHook(View: TfrView); virtual;

  public

    Parent: TfrBand;

    Name: String;

    ID: Integer;

    Typ: Byte;

    Selected: Boolean;

    OriginalRect: TRect;

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

    OffsX, OffsY: Integer;    //

    IsPrinting: Boolean;

    x, y, dx, dy: Integer;

    Flags: Word;

    FrameTyp: Word;

    FrameWidth: Single;

    FrameColor: TColor;

    FrameStyle: Word;

    FillColor: TColor;

    Format: Integer;

    FormatStr: String;

    Visible: WordBool;

    Memo, Script: TStringList;

    constructor Create; virtual;

    destructor Destroy; override;

    procedure Assign(From: TfrView); virtual;

    procedure CalcGaps; virtual;

    procedure RestoreCoord; virtual;

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

    procedure Print(Stream: TStream); virtual;

    procedure ExportData; virtual;

    procedure LoadFromStream(Stream: TStream); virtual;

    procedure SaveToStream(Stream: TStream); virtual;

    procedure SaveToFR3Stream(Stream: TStream); virtual;

    procedure Resized; virtual;

    procedure DefinePopupMenu(Popup: TPopupMenu); virtual;

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

    procedure CreateUniqueName;

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

  end;



  TfrStretcheable = class(TfrView)

  protected

    ActualHeight: Integer;

    DrawMode: TfrDrawMode;

    function CalcHeight: Integer; virtual; abstract;

    function MinHeight: Integer; virtual; abstract;

    function RemainHeight: Integer; virtual; abstract;

  end;



  TfrMemoView = class(TfrStretcheable)

  private

    FFont: TFont;

    procedure P1Click(Sender: TObject);

    procedure P2Click(Sender: TObject);

    procedure P3Click(Sender: TObject);

    procedure P4Click(Sender: TObject);

    procedure P5Click(Sender: TObject);

    procedure SetFont(Value: TFont);

  protected

    Streaming: Boolean;

    TextHeight: Integer;

    CurStrNo: Integer;

    Exporting: Boolean;

    procedure ExpandVariables;

    procedure AssignFont(Canvas: TCanvas);

    procedure WrapMemo;

    procedure ShowMemo;

    function CalcWidth(Memo: TStringList): Integer;

    function CalcHeight: Integer; override;

    function MinHeight: Integer; override;

    function RemainHeight: Integer; override;

    procedure GetBlob(b: TfrTField); override;

  public

    Adjust: Integer;

    Highlight: TfrHighlightAttr;

    HighlightStr: String;

    LineSpacing, CharacterSpacing: Integer;

    constructor Create; override;

    destructor Destroy; override;

    procedure Assign(From: TfrView); override;

    procedure Draw(Canvas: TCanvas); override;

    procedure Print(Stream: TStream); override;

    procedure ExportData; override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure SaveToStream(Stream: TStream); override;

    procedure SaveToFR3Stream(Stream: TStream); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

    property Font: TFont read FFont write SetFont;

  end;



  TfrBandView = class(TfrView)

  private

    procedure P1Click(Sender: TObject);

    procedure P2Click(Sender: TObject);

    procedure P3Click(Sender: TObject);

    procedure P4Click(Sender: TObject);

    procedure P5Click(Sender: TObject);

    procedure P6Click(Sender: TObject);

    function GetBandType: TfrBandType;

    procedure SetBandType(const Value: TfrBandType);

  public

    constructor Create; override;

    procedure Draw(Canvas: TCanvas); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

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

    procedure SaveToFR3Stream(Stream: TStream); override;

    property BandType: TfrBandType read GetBandType write SetBandType;

    property DataSet: String read FormatStr write FormatStr;

    property GroupCondition: String read FormatStr write FormatStr;

  end;



  TfrSubReportView = class(TfrView)

  public

    SubPage: Integer;

    constructor Create; override;

    procedure Assign(From: TfrView); override;

    procedure Draw(Canvas: TCanvas); override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure SaveToStream(Stream: TStream); override;

    procedure SaveToFR3Stream(Stream: TStream); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

  end;



  TfrPictureView = class(TfrView)

  private

    procedure P1Click(Sender: TObject);

    procedure P2Click(Sender: TObject);

  protected

    procedure GetBlob(b: TfrTField); override;

  public

    Picture: TPicture;

    constructor Create; override;

    destructor Destroy; override;

    procedure Assign(From: TfrView); override;

    procedure Draw(Canvas: TCanvas); override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure SaveToStream(Stream: TStream); override;

    procedure SaveToFR3Stream(Stream: TStream); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

  end;



  TfrLineView = class(TfrView)

  public

    constructor Create; override;

    procedure Draw(Canvas: TCanvas); override;

    procedure DefinePopupMenu(Popup: TPopupMenu); override;

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

    procedure SaveToFR3Stream(Stream: TStream); override;

  end;



  TfrBand = class(TObject)

  private

    Parent: TfrPage;

    View: TfrView;

    Flags: Word;

    Next, Prev: TfrBand;

    SubIndex, MaxY: Integer;

    EOFReached: Boolean;

    EOFArr: Array[0..31] of Boolean;

    Positions: Array[TfrDatasetPosition] of Integer;

    LastGroupValue: Variant;

    HeaderBand, FooterBand, LastBand: TfrBand;

    Values: TStringList;

    Count: Integer;

    DisableInit: Boolean;

    CalculatedHeight: Integer;

    procedure InitDataSet(Desc: String);

    procedure DoError;

    function CalcHeight: Integer;

    procedure StretchObjects(MaxHeight: Integer);

    procedure UnStretchObjects;

    procedure DrawObject(t: TfrView);

    procedure PrepareSubReports;

    procedure DoSubReports;

    function DrawObjects: Boolean;

    procedure DrawCrossCell(Parnt: TfrBand; CurX: Integer);

    procedure DrawCross;

    function CheckPageBreak(y, dy: Integer; PBreak: Boolean): Boolean;

    procedure DrawPageBreak;

    function HasCross: Boolean;

    function DoCalcHeight: Integer;

    procedure DoDraw;

    function Draw: Boolean;

    procedure InitValues;

    procedure DoAggregate;

  public

    x, y, dx, dy, maxdy: Integer;

    Typ: TfrBandType;

    PrintIfSubsetEmpty, NewPageAfter, Stretched, PageBreak, Visible: Boolean;

    Objects: TList;

    Memo, Script: TStringList;

    DataSet: TfrDataSet;

    IsVirtualDS: Boolean;

    VCDataSet: TfrDataSet;

    IsVirtualVCDS: Boolean;

    GroupCondition: String;

    ForceNewPage, ForceNewColumn: Boolean;

    constructor Create(ATyp: TfrBandType; AParent: TfrPage);

    destructor Destroy; override;

  end;



  TfrValue = class

  public

    Typ: TfrValueType;

    OtherKind: Integer;   // for vtOther - typ, for vtDBField - format

    DataSet: String;      // for vtDBField

    Field: String;        // here is an expression for vtOther

    DSet: TfrTDataSet;

  end;



  TfrValues = class(TPersistent)

  private

    FItems: TStringList;

    function GetValue(Index: Integer): TfrValue;

  public

    constructor Create; virtual;

    destructor Destroy; override;

    function AddValue: Integer;

    function FindVariable(const s: String): TfrValue;

    procedure ReadBinaryData(Stream: TStream);

    procedure WriteBinaryData(Stream: TStream);

    procedure Clear;

    property Items: TStringList read FItems write FItems;

    property Objects[Index: Integer]: TfrValue read GetValue;

  end;



  TfrPage = class(TObject)

  private

    Bands: Array[TfrBandType] of TfrBand;

    Skip, InitFlag: Boolean;

    CurColumn, LastStaticColumnY, XAdjust: Integer;

    List: TList;

    Mode: TfrPageMode;

    PlayFrom: Integer;

    LastBand: TfrBand;

    ColPos, CurPos: Integer;

    procedure InitReport;

    procedure DoneReport;

    procedure TossObjects;

    procedure PrepareObjects;

    procedure FormPage;

    procedure DoAggregate(a: Array of TfrBandType);

    procedure AddRecord(b: TfrBand; rt: TfrBandRecType);

    procedure ClearRecList;

    function PlayRecList: Boolean;

    procedure DrawPageFooters;

    function BandExists(b: TfrBand): Boolean;

    procedure AfterPrint;

    procedure LoadFromStream(Stream: TStream);

    procedure SaveToStream(Stream: TStream);

    procedure ShowBand(b: TfrBand);

  public

    pgSize, pgWidth, pgHeight: Integer;

    pgMargins: TRect;

    pgOr: TPrinterOrientation;

    PrintToPrevPage, UseMargins: WordBool;

    PrnInfo: TfrPrnInfo;

    ColCount, ColWidth, ColGap: Integer;

    Objects, RTObjects: TList;

    CurY, CurBottomY: Integer;

    constructor Create(ASize, AWidth, AHeight: Integer; AOr: TPrinterOrientation);

    destructor Destroy; override;

    function TopMargin: Integer;

    function BottomMargin: Integer;

    function LeftMargin: Integer;

    function RightMargin: Integer;

    procedure Clear;

    procedure Delete(Index: Integer);

    function FindObjectByID(ID: Integer): Integer;

    function FindObject(Name: String): TfrView;

    function FindRTObject(Name: String): TfrView;

    procedure ChangePaper(ASize, AWidth, AHeight: Integer; AOr: TPrinterOrientation);

    procedure ShowBandByName(s: String);

    procedure ShowBandByType(bt: TfrBandType);

    procedure NewPage;

    procedure NewColumn(Band: TfrBand);

  end;



  TfrPages = class(TObject)

  private

    FPages: TList;

    Parent: TfrReport;

    function GetCount: Integer;

    function GetPages(Index: Integer): TfrPage;

  public

    constructor Create(AParent: TfrReport);

    destructor Destroy; override;

    procedure Clear;

    procedure Add;

    procedure Delete(Index: Integer);

    procedure LoadFromStream(Stream: TStream);

    procedure SaveToStream(Stream: TStream);

    property Pages[Index: Integer]: TfrPage read GetPages; default;

    property Count: Integer read GetCount;

  end;



  TfrEMFPages = class(TObject)

  private

    FPages: TList;

    Parent: TfrReport;

    function GetCount: Integer;

    function GetPages(Index: Integer): PfrPageInfo;

    procedure ExportData(Index: Integer);

    procedure PageToObjects(Index: Integer);

    procedure ObjectsToPage(Index: Integer);

  public

    constructor Create(AParent: TfrReport);

    destructor Destroy; override;

    procedure Clear;

    procedure Draw(Index: Integer; Canvas: TCanvas; DrawRect: TRect);

    procedure Add(APage: TfrPage);

    procedure Insert(Index: Integer; APage: TfrPage);

    procedure Delete(Index: Integer);

    procedure LoadFromStream(AStream: TStream);

    procedure SaveToStream(AStream: TStream);

    property Pages[Index: Integer]: PfrPageInfo read GetPages; default;

    property Count: Integer read GetCount;

  end;



  TfrReport = class(TComponent)

  private

    FPages: TfrPages;

    FEMFPages: TfrEMFPages;

    FVars: TStrings;

    FVal: TfrValues;

    FDataset: TfrDataset;

    FGrayedButtons: Boolean;

    FReportType: TfrReportType;

    FTitle: String;

    FShowProgress: Boolean;

    FModalPreview: Boolean;

    FModifyPrepared: Boolean;

    FStoreInDFM: Boolean;

    FPreview: TfrPreview;

    FPreviewButtons: TfrPreviewButtons;

    FInitialZoom: TfrPreviewZoom;

    FOnBeginDoc: TBeginDocEvent;

    FOnEndDoc: TEndDocEvent;

    FOnBeginPage: TBeginPageEvent;

    FOnEndPage: TEndPageEvent;

    FOnBeginBand: TBeginBandEvent;

    FOnEndBand: TEndBandEvent;

    FOnGetValue: TDetailEvent;

    FOnEnterRect: TEnterRectEvent;

    FOnProgress: TProgressEvent;

    FOnFunction: TFunctionEvent;

    FOnBeginColumn: TBeginColumnEvent;

    FOnPrintColumn: TPrintColumnEvent;

    FOnManualBuild: TManualBuildEvent;

    FCurrentFilter: TfrExportFilter;

    FPageNumbers: String;

    FCopies: Integer;

    FCurPage: TfrPage;

    function FormatValue(V: Variant; Format: Integer;

      const FormatStr: String): String;

    procedure OnGetParsFunction(const name: String; p1, p2, p3: Variant;

                                var val: String);

    procedure PrepareDataSets;

    procedure BuildBeforeModal(Sender: TObject);

    procedure ExportBeforeModal(Sender: TObject);

    procedure PrintBeforeModal(Sender: TObject);

    function DoPrepareReport: Boolean;

    procedure DoBuildReport; virtual;

    procedure DoPrintReport(PageNumbers: String; Copies: Integer);

    procedure SetPrinterTo(PrnName: String);

    procedure SetVars(Value: TStrings);

  protected

    procedure DefineProperties(Filer: TFiler); override;

    procedure ReadBinaryData(Stream: TStream);

    procedure WriteBinaryData(Stream: TStream);

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public

    CanRebuild: Boolean;            // true, if report can be rebuilded

    Terminated: Boolean;

    PrintToDefault, DoublePass: WordBool;

    FinalPass: Boolean;

    FileName: String;

    FR3Stream: Boolean;

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    // service methods

    function FindVariable(Variable: String): Integer;

    procedure GetVariableValue(const s: String; var v: Variant);

    procedure GetVarList(CatNo: Integer; List: TStrings);

    procedure GetCategoryList(List: TStrings);

    function FindObject(Name: String): TfrView;

    // internal events used through report building

    procedure InternalOnEnterRect(Memo: TStringList; View: TfrView);

    procedure InternalOnExportData(View: TfrView);

    procedure InternalOnExportText(x, y: Integer; const text: String; View: TfrView);

    procedure InternalOnGetValue(ParName: String; var ParValue: String);

    procedure InternalOnProgress(Percent: Integer);

    procedure InternalOnBeginColumn(Band: TfrBand);

    procedure InternalOnPrintColumn(ColNo: Integer; var ColWidth: Integer);

    procedure FillQueryParams;

    // load/save methods

    procedure LoadFromStream(Stream: TStream);

    procedure SaveToStream(Stream: TStream);

    procedure LoadFromFile(FName: String);

    procedure SaveToFile(FName: String);

    procedure SaveToFR3File(FName: String);

{$IFDEF IBO}

    procedure LoadFromDB(Table: TIB_DataSet; DocN: Integer);

    procedure SaveToDB(Table: TIB_DataSet; DocN: Integer);

{$ELSE}

    procedure LoadFromDB(Table: TDataSet; DocN: Integer);

    procedure SaveToDB(Table: TDataSet; DocN: Integer);

{$ENDIF}

    procedure LoadTemplate(fname: String; comm: TStrings;

      Bmp: TBitmap; Load: Boolean);

    procedure SaveTemplate(fname: String; comm: TStrings; Bmp: TBitmap);

    procedure LoadPreparedReport(FName: String);

    procedure SavePreparedReport(FName: String);

    // report manipulation methods

    procedure DesignReport;

    function PrepareReport: Boolean;

    procedure ExportTo(Filter: TClass; FileName: String);

    procedure ShowReport;

    procedure ShowPreparedReport;

    procedure PrintPreparedReport(PageNumbers: String; Copies: Integer);

    function ChangePrinter(OldIndex, NewIndex: Integer): Boolean;

    procedure EditPreparedReport(PageIndex: Integer);

    //

    property Pages: TfrPages read FPages;

    property EMFPages: TfrEMFPages read FEMFPages write FEMFPages;

    property Variables: TStrings read FVars write SetVars;

    property Values: TfrValues read FVal write FVal;

  published

    property Dataset: TfrDataset read FDataset write FDataset;

    property GrayedButtons: Boolean read FGrayedButtons write FGrayedButtons default False;

    property InitialZoom: TfrPreviewZoom read FInitialZoom write FInitialZoom;

    property ModalPreview: Boolean read FModalPreview write FModalPreview default True;

    property ModifyPrepared: Boolean read FModifyPrepared write FModifyPrepared default True;

    property Preview: TfrPreview read FPreview write FPreview;

    property PreviewButtons: TfrPreviewButtons read FPreviewButtons write FPreviewButtons;

    property ReportType: TfrReportType read FReportType write FReportType default rtSimple;

    property ShowProgress: Boolean read FShowProgress write FShowProgress default True;

    property StoreInDFM: Boolean read FStoreInDFM write FStoreInDFM default False;

    property Title: String read FTitle write FTitle;

    property OnBeginDoc: TBeginDocEvent read FOnBeginDoc write FOnBeginDoc;

    property OnEndDoc: TEndDocEvent read FOnEndDoc write FOnEndDoc;

    property OnBeginPage: TBeginPageEvent read FOnBeginPage write FOnBeginPage;

    property OnEndPage: TEndPageEvent read FOnEndPage write FOnEndPage;

    property OnBeginBand: TBeginBandEvent read FOnBeginBand write FOnBeginBand;

    property OnEndBand: TEndBandEvent read FOnEndBand write FOnEndBand;

    property OnGetValue: TDetailEvent read FOnGetValue write FOnGetValue;

    property OnEnterRect: TEnterRectEvent read FOnEnterRect write FOnEnterRect;

    property OnUserFunction: TFunctionEvent read FOnFunction write FOnFunction;

    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;

    property OnBeginColumn: TBeginColumnEvent read FOnBeginColumn write FOnBeginColumn;

    property OnPrintColumn: TPrintColumnEvent read FOnPrintColumn write FOnPrintColumn;

    property OnManualBuild: TManualBuildEvent read FOnManualBuild write FOnManualBuild;

  end;



  TfrCompositeReport = class(TfrReport)

  private

    procedure DoBuildReport; override;

  public

    Reports: TList;

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  end;



  TfrReportDesigner = class(TForm)

  public

    Page: TfrPage;

    Modified: Boolean;

    procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: String;

      ButtonTag: Integer); virtual; abstract;

    procedure RegisterTool(MenuCaption: String; ButtonBmp: TBitmap;

      OnClick: TNotifyEvent); virtual; abstract;

    procedure BeforeChange; virtual; abstract;

    procedure AfterChange; virtual; abstract;

    procedure RedrawPage; virtual; abstract;

  end;



  TfrDataManager = class(TObject)

  public

    procedure LoadFromStream(Stream: TStream); virtual; abstract;

    procedure SaveToStream(Stream: TStream); virtual; abstract;

    procedure BeforePreparing; virtual; abstract;

    procedure AfterPreparing; virtual; abstract;

    procedure PrepareDataSet(ds: TfrTDataSet); virtual; abstract;

    function ShowParamsDialog: Boolean; virtual; abstract;

    procedure AfterParamsDialog; virtual; abstract;

  end;



  TfrObjEditorForm = class(TForm)

  public

    procedure ShowEditor(t: TfrView); virtual;

  end;



  TfrExportFilter = class(TObject)

  protected

    Stream: TStream;

    Lines: TList;

    procedure ClearLines;

  public

    constructor Create(AStream: TStream); virtual;

    destructor Destroy; override;

    procedure OnBeginDoc; virtual;

    procedure OnEndDoc; virtual;

    procedure OnBeginPage; virtual;

    procedure OnEndPage; virtual;

    procedure OnData(x, y: Integer; View: TfrView); virtual;

    procedure OnText(x, y: Integer; const text: String; View: TfrView); virtual;

  end;



  TfrFunctionLibrary = class(TObject)

  public

    List: TStringList;

    constructor Create; virtual;

    destructor Destroy; override;

    function OnFunction(const FName: String; p1, p2, p3: Variant;

      var val: String): Boolean;

    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: String);

      virtual; abstract;

  end;



  TfrCompressor = class(TObject)

  public

    Enabled: Boolean;

    procedure Compress(StreamIn, StreamOut: TStream); virtual;

    procedure DeCompress(StreamIn, StreamOut: TStream); virtual;

  end;





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

procedure frRegisterObject(ClassRef: TClass; ButtonBmp: TBitmap;

  const ButtonHint: String; EditorForm: TfrObjEditorForm);

procedure frRegisterExportFilter(ClassRef: TClass;

  const FilterDesc, FilterExt: String);

procedure frRegisterFunctionLibrary(ClassRef: TClass);

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

function GetDefaultDataSet: TfrTDataSet;





const

  frCurrentVersion = 23; // this is current version (2.3)

  frSpecCount = 9;

  frSpecFuncs: Array[0..frSpecCount - 1] of String = ('PAGE#', '',

    'DATE', 'TIME', 'LINE#', 'LINETHROUGH#', 'COLUMN#', 'CURRENT#', 'TOTALPAGES');

  frColors: Array[0..15] of TColor =

    (clWhite, clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal,

     clGray, clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua);



type

  PfrTextRec = ^TfrTextRec;

  TfrTextRec = record

    Next: PfrTextRec;

    X: Integer;

    Text: String[255];

    FontName: String[32];

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

  end;



  TfrAddInObjectInfo = record

    ClassRef: TClass;

    EditorForm: TfrObjEditorForm;

    ButtonBmp: TBitmap;

    ButtonHint: String;

  end;



  TfrExportFilterInfo = record

    ClassRef: TClass;

    FilterDesc, FilterExt: String;

  end;



  TfrFunctionInfo = record

    FunctionLibrary: TfrFunctionLibrary;

  end;



  TfrToolsInfo = record

    Caption: String;

    ButtonBmp: TBitmap;

    OnClick: TNotifyEvent;

  end;



var

  frDesigner: TfrReportDesigner;                  // designer reference

  frDataManager: TfrDataManager;                  // data manager reference

  frParser: TfrParser;                            // parser reference

  frInterpretator: TfrInterpretator;              // interpretator reference

  frVariables: TfrVariables;                      // report variables reference

  frCompressor: TfrCompressor;                    // compressor reference

  CurReport: TfrReport;                           // currently proceeded report

  MasterReport: TfrReport;               // reference to main composite report

  CurView: TfrView;                               // currently proceeded view

  CurBand: TfrBand;                               // currently proceeded band

  CurPage: TfrPage;                               // currently proceeded page

  DocMode: (dmDesigning, dmPrinting);             // current mode

  DisableDrawing: Boolean;

  frAddIns: Array[0..31] of TfrAddInObjectInfo;   // add-in objects

  frAddInsCount: Integer;

  frFilters: Array[0..31] of TfrExportFilterInfo; // export filters

  frFiltersCount: Integer;

  frFunctions: Array[0..31] of TfrFunctionInfo;   // function libraries

  frFunctionsCount: Integer;

  frTools: Array[0..31] of TfrToolsInfo;          // tools

  frToolsCount: Integer;

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

  frCharset: 0..255;

  frBandNames: Array[0..21] of String;

  frSpecArr: Array[0..frSpecCount - 1] of String;

  frDateFormats, frTimeFormats: Array[0..3] of String;

  frVersion: Byte;                       // version of currently loaded report

  SMemo: TStringList;          // temporary memo used during TfrView drawing

  ShowBandTitles: Boolean = True;

(*

  FRE_COMPATIBLEREAD variable added for migrating from older versions 

  of FreeReport and will be removed in next releases as soon as possible.

*)

{$IFDEF FREEREP2217READ}

  FRE_COMPATIBLE_READ: Boolean = False;

{$ENDIF}



implementation



uses

  FR_Fmted, FR_Prntr, FR_Progr, FR_Utils, FR_Const

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



{$R FR_Lng1.RES}



type

  TfrStdFunctionLibrary = class(TfrFunctionLibrary)

  public

    constructor Create; override;

    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: String); override;

  end;



  TInterpretator = class(TfrInterpretator)

  public

    procedure GetValue(const Name: String; var Value: Variant); override;

    procedure SetValue(const Name: String; Value: Variant); override;

    procedure DoFunction(const name: String; p1, p2, p3: Variant;

                         var val: String); override;

  end;





var

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

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

  TempBmp: TBitmap;            // temporary bitmap used by TfrMemoView

  CurDate, CurTime: TDateTime; // date/time of report starting

  CurValue: Variant;           // used for highlighting

  AggrBand: TfrBand;           // used for aggregate functions

  CurVariable: String;

  IsColumns: Boolean;

  SavedAllPages: Integer;      // number of pages in entire report

  ErrorFlag: Boolean;          // error occured through TfrView drawing

  ErrorStr: String;            // error description

  SubValue: String;            // used in GetValue event handler

  ObjID: Integer = 0;

  BoolStr: Array[0..3] of String;

  HookList: TList;



  // variables used through report building

  PrevY, PrevBottomY, ColumnXAdjust: Integer;

  Append, WasPF: Boolean;

  CompositeMode: Boolean;



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

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

var

  i: Integer;

begin

  Result := nil;

  case Typ of

    gtMemo:      Result := TfrMemoView.Create;

    gtPicture:   Result := TfrPictureView.Create;

    gtBand:      Result := TfrBandView.Create;

    gtSubReport: Result := TfrSubReportView.Create;

    gtLine:      Result := TfrLineView.Create;

    gtAddIn:

      begin

        for i := 0 to frAddInsCount - 1 do

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

          begin

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

            Result.Create;

            Result.Typ := gtAddIn;

            break;

          end;

        if Result = nil then

          raise EClassNotFound.Create('Íå íàéäåí êëàññ ' + ClassName);

      end;

  end;

  if Result <> nil then

  begin

    Result.ID := ObjID;

    Inc(ObjID);

  end;

end;



procedure frRegisterObject(ClassRef: TClass; ButtonBmp: TBitmap;

  const ButtonHint: String; EditorForm: TfrObjEditorForm);

begin

  frAddIns[frAddInsCount].ClassRef := ClassRef;

  frAddIns[frAddInsCount].EditorForm := EditorForm;

  frAddIns[frAddInsCount].ButtonBmp := ButtonBmp;

  frAddIns[frAddInsCount].ButtonHint := ButtonHint;

  if frDesigner <> nil then

    frDesigner.RegisterObject(ButtonBmp, ButtonHint,

      Integer(gtAddIn) + frAddInsCount);

  Inc(frAddInsCount);

end;



procedure frRegisterExportFilter(ClassRef: TClass;

  const FilterDesc, FilterExt: String);

begin

  frFilters[frFiltersCount].ClassRef := ClassRef;

  frFilters[frFiltersCount].FilterDesc := FilterDesc;

  frFilters[frFiltersCount].FilterExt := FilterExt;

  Inc(frFiltersCount);

end;



procedure frRegisterFunctionLibrary(ClassRef: TClass);

begin

  frFunctions[frFunctionsCount].FunctionLibrary :=

    TfrFunctionLibrary(ClassRef.NewInstance);

  frFunctions[frFunctionsCount].FunctionLibrary.Create;

  Inc(frFunctionsCount);

end;



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

begin

  frTools[frToolsCount].Caption := MenuCaption;

  frTools[frToolsCount].ButtonBmp := ButtonBmp;

  frTools[frToolsCount].OnClick := OnClick;

  if frDesigner <> nil then

    frDesigner.RegisterTool(MenuCaption, ButtonBmp, OnClick);

  Inc(frToolsCount);

end;



function Create90Font(Font: TFont): HFont;

var

  F: TLogFont;

begin

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

  F.lfEscapement := 900;

  F.lfOrientation := 900;

  Result := CreateFontIndirect(F);

end;



function GetDefaultDataSet: TfrTDataSet;

var

  Res: TfrDataset;

begin

  Result := nil; Res := nil;

  if CurBand <> nil then

    case CurBand.Typ of

      btMasterData, btReportSummary, btMasterFooter,

      btGroupHeader, btGroupFooter:

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

      btDetailData, btDetailFooter:

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

      btSubDetailData, btSubDetailFooter:

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

      btCrossData, btCrossFooter:

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

    end;

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

    Result := TfrDBDataSet(Res).GetDataSet;

end;



function ReadString(Stream: TStream): String;

begin

  if frVersion >= 23 then

{$IFDEF FREEREP2217READ}

      Result := frReadString(Stream) // load in current format

  else

    if (frVersion = 22) and FRE_COMPATIBLE_READ then

      Result := frReadString2217(Stream) // load in bad format

    else

{$ELSE}

    Result := frReadString(Stream) else

{$ENDIF}

    Result := frReadString22(Stream);

end;



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

begin

  if frVersion >= 23 then

{$IFDEF FREEREP2217READ}

      frReadMemo(Stream, Memo) // load in current format

  else

    if (frVersion = 22) and FRE_COMPATIBLE_READ then

      Memo.Text := frReadString2217(Stream) // load in bad format

    else

{$ELSE}

    frReadMemo(Stream, Memo) else

{$ENDIF}

    frReadMemo22(Stream, Memo);

end;



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

begin

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

  begin

    DataSet := TfrUserDataSet.Create(nil);

    DataSet.RangeEnd := reCount;

    DataSet.RangeEndCount := StrToInt(Desc);

    IsVirtualDS := True;

  end

  else

    DataSet := frFindComponent(CurReport.Owner, Desc) as TfrDataSet;

  if DataSet <> nil then

    DataSet.Init;

end;



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

constructor TfrView.Create;

begin

  inherited Create;

  Parent := nil;

  Memo := TStringList.Create;

  Memo1 := TStringList.Create;

  Script := TStringList.Create;

  FrameWidth := 1;

  FrameColor := clBlack;

  FillColor := clNone;

  Format := 2*256 + Ord(DecimalSeparator);

  BaseName := 'View';

  Visible := True;

  StreamMode := smDesigning;

  ScaleX := 1; ScaleY := 1;

  OffsX := 0; OffsY := 0;

  Flags := flStretched;

end;



destructor TfrView.Destroy;

begin

  Memo.Free;

  Memo1.Free;

  Script.Free;

  inherited Destroy;

end;



procedure TfrView.Assign(From: TfrView);

begin

  Name := From.Name;

  Typ := From.Typ;

  Selected := From.Selected;

  x := From.x; y := From.y; dx := From.dx; dy := From.dy;

  Flags := From.Flags;

  FrameTyp := From.FrameTyp;

  FrameWidth := From.FrameWidth;

  FrameColor := From.FrameColor;

  FrameStyle := From.FrameStyle;

  FillColor := From.FillColor;

  Format := From.Format;

  FormatStr := From.FormatStr;

  Visible := From.Visible;

  Memo.Assign(From.Memo);

  Script.Assign(From.Script);

end;



procedure TfrView.CalcGaps;

var

  bx, by, bx1, by1, wx1, wx2, wy1, wy2: Integer;

begin

  SaveX := x; SaveY := y; SaveDX := dx; SaveDY := dy;

  SaveFW := FrameWidth;

  if DocMode = dmDesigning then

  begin

    ScaleX := 1; ScaleY := 1;

    OffsX := 0; OffsY := 0;

  end;

  x := Round(x * ScaleX) + OffsX;

  y := Round(y * ScaleY) + OffsY;

  dx := Round(dx * ScaleX);

  dy := Round(dy * ScaleY);



  wx1 := Round((FrameWidth * ScaleX - 1) / 2);

  wx2 := Round(FrameWidth * ScaleX / 2);

  wy1 := Round((FrameWidth * ScaleY - 1) / 2);

  wy2 := Round(FrameWidth * ScaleY / 2);

  FrameWidth := FrameWidth * ScaleX;

  gapx := wx2 + 2; gapy := wy2 div 2 + 1;

  bx := x;

  by := y;

  bx1 := Round((SaveX + SaveDX) * ScaleX + OffsX);

  by1 := Round((SaveY + SaveDY) * ScaleY + OffsY);

  if (FrameTyp and $1) <> 0 then Dec(bx1, wx2);

  if (FrameTyp and $2) <> 0 then Dec(by1, wy2);

  if (FrameTyp and $4) <> 0 then Inc(bx, wx1);

  if (FrameTyp and $8) <> 0 then Inc(by, wy1);

  DRect := Rect(bx, by, bx1 + 1, by1 + 1);

end;



procedure TfrView.RestoreCoord;

begin

  x := SaveX;

  y := SaveY;

  dx := SaveDX;

  dy := SaveDY;

  FrameWidth := SaveFW;

end;



procedure TfrView.ShowBackground;

var

  fp: TColor;

begin

  if DisableDrawing then Exit;

  if (DocMode = dmPrinting) and (FillColor = clNone) then Exit;

  fp := FillColor;

  if (DocMode = dmDesigning) and (fp = clNone) then

    fp := clWhite;

  Canvas.Brush.Color := fp;

  if DocMode = dmDesigning then

    Canvas.FillRect(DRect) else

    Canvas.FillRect(Rect(x, y,

// use calculating coords instead of dx, dy - for best view

      Round((SaveX + SaveDX) * ScaleX + OffsX), Round((SaveY + SaveDY) * ScaleY + OffsY)));

end;



procedure TfrView.ShowFrame;

var

  x1, y1: Integer;

  procedure Line(x, y, dx, dy: Integer);

  begin

    Canvas.MoveTo(x, y);

    Canvas.LineTo(x + dx, y + dy);

  end;

  procedure Line1(x, y, x1, y1: Integer);

  var

    i, w: Integer;

  begin

    if Canvas.Pen.Style = psSolid then

    begin

      if FrameStyle <> 5 then

      begin

        Canvas.MoveTo(x, y);

        Canvas.LineTo(x1, y1);

      end

      else

      begin

        if x = x1 then

        begin

          Canvas.MoveTo(x - Round(FrameWidth), y);

          Canvas.LineTo(x1 - Round(FrameWidth), y1);

          Canvas.Pen.Color := FillColor;

          Canvas.MoveTo(x, y);

          Canvas.LineTo(x1, y1);

          Canvas.Pen.Color := FrameColor;

          Canvas.MoveTo(x + Round(FrameWidth), y);

          Canvas.LineTo(x1 + Round(FrameWidth), y1);

        end

        else

        begin

          Canvas.MoveTo(x, y - Round(FrameWidth));

          Canvas.LineTo(x1, y1 - Round(FrameWidth));

          Canvas.Pen.Color := FillColor;

          Canvas.MoveTo(x, y);

          Canvas.LineTo(x1, y1);

          Canvas.Pen.Color := FrameColor;

          Canvas.MoveTo(x, y + Round(FrameWidth));

          Canvas.LineTo(x1, y1 + Round(FrameWidth));

        end;

      end

    end

    else

    begin

      Canvas.Brush.Color := FillColor;

      w := Canvas.Pen.Width;

      Canvas.Pen.Width := 1;

      if x = x1 then

        for i := 0 to w - 1 do

        begin

          Canvas.MoveTo(x - w div 2 + i, y);

          Canvas.LineTo(x - w div 2 + i, y1);

        end

      else

        for i := 0 to w - 1 do

        begin

          Canvas.MoveTo(x, y - w div 2 + i);

          Canvas.LineTo(x1, y - w div 2 + i);

        end;

      Canvas.Pen.Width := w;

    end;

  end;

begin

  if DisableDrawing then Exit;

  if (DocMode = dmPrinting) and ((FrameTyp and $F) = 0) then Exit;

  with Canvas do

  begin

    Brush.Style := bsClear;

    Pen.Style := psSolid;

    if (dx > 0) and (dy > 0) and (DocMode = dmDesigning) then

    begin

      Pen.Color := clBlack;

      Pen.Width := 1;

      Line(x, y + 3, 0, -3); Line(x, y, 4, 0);

      Line(x, y + dy - 3, 0, 3); Line(x, y + dy, 4, 0);

      Line(x + dx - 3, y, 3, 0); Line(x + dx, y, 0, 4);

      Line(x + dx - 3, y + dy, 3, 0); Line(x + dx, y + dy, 0, -4);

    end;

    Pen.Color := FrameColor;

    Pen.Width := Round(FrameWidth);

    if FrameStyle <> 5 then

      Pen.Style := TPenStyle(FrameStyle);

// use calculating coords instead of dx, dy - for best view

    x1 := Round((SaveX + SaveDX) * ScaleX + OffsX);

    y1 := Round((SaveY + SaveDY) * ScaleY + OffsY);

    if ((FrameTyp and $F) = $F) and (FrameStyle = 0) then

      Rectangle(x, y, x1 + 1, y1 + 1)

    else

    begin

      if (FrameTyp and $1) <> 0 then Line1(x1, y, x1, y1);

      if (FrameTyp and $4) <> 0 then Line1(x, y, x, y1);

      if (FrameTyp and $2) <> 0 then Line1(x, y1, x1, y1);

      if (FrameTyp and $8) <> 0 then Line1(x, y, x1, y);

    end;

  end;

end;



procedure TfrView.BeginDraw(ACanvas: TCanvas);

begin

  Canvas := ACanvas;

  CurView := Self;

end;



procedure TfrView.Print(Stream: TStream);

begin

  BeginDraw(Canvas);

  Memo1.Assign(Memo);

  CurReport.InternalOnEnterRect(Memo1, Self);

  frInterpretator.DoScript(Script);

  if not Visible then Exit;



  Stream.Write(Typ, 1);

  if Typ = gtAddIn then

    frWriteString(Stream, ClassName);

  SaveToStream(Stream);

end;



procedure TfrView.ExportData;

begin

  CurReport.InternalOnExportData(Self);

end;



procedure TfrView.LoadFromStream(Stream: TStream);

var

  w: Integer;

begin

  with Stream do

  begin

    if StreamMode = smDesigning then

      if frVersion >= 23 then

        Name := ReadString(Stream) else

        CreateUniqueName;

    Read(x, 30); // this is equal to, but much faster:

{    Read(x, 4); Read(y, 4); Read(dx, 4); Read(dy, 4);

    Read(Flags, 2);

    Read(FrameTyp, 2);

    Read(FrameWidth, 4);

    Read(FrameColor, 4);

    Read(FrameStyle, 2);}

    Read(FillColor, 4);

    if StreamMode = smDesigning then

    begin

      Read(Format, 4);

      FormatStr := ReadString(Stream);

    end;

    ReadMemo(Stream, Memo);

    if (frVersion >= 23) and (StreamMode = smDesigning) then

    begin

      ReadMemo(Stream, Script);

      Read(Visible, 2);

    end;

    w := PInteger(@FrameWidth)^;

    if w <= 10 then

      w := w * 1000;

    FrameWidth := w / 1000;

  end;

end;



procedure TfrView.SaveToStream(Stream: TStream);

var

  w: Integer;

  f: Single;

begin

  f := FrameWidth;

  if f <> Int(f) then

    w := Round(FrameWidth * 1000) else

    w := Round(f);

  PInteger(@FrameWidth)^ := w;

  with Stream do

  begin

    if StreamMode = smDesigning then

      frWriteString(Stream, Name);

    Write(x, 30); // this is equal to, but much faster:

{    Write(x, 4); Write(y, 4); Write(dx, 4); Write(dy, 4);

    Write(Flags, 2);

    Write(FrameTyp, 2);

    Write(FrameWidth, 4);

    Write(FrameColor, 4);

    Write(FrameStyle, 2);}

    Write(FillColor, 4);

    if StreamMode = smDesigning then

    begin

      Write(Format, 4);

      frWriteString(Stream, FormatStr);

      frWriteMemo(Stream, Memo);

    end

    else

      frWriteMemo(Stream, Memo1);

    if StreamMode = smDesigning then

    begin

      frWriteMemo(Stream, Script);

      Write(Visible, 2);

    end;

  end;

  FrameWidth := f;

end;



procedure TfrView.SaveToFR3Stream(Stream: TStream);

var 

  FTyp: Integer;

  s: String;



  procedure WriteStr(const s: String);

  begin

    Stream.Write(s[1], Length(s));

  end;



begin

  s := ClassName;

  if Pos('Tfr', s) = 1 then

  begin

    Delete(s, 1, 3);

    s := 'Tfrx' + s;

    if CompareText(s, 'TfrxSubreportView') = 0 then

      s := 'TfrxSubreport';

  end;

  WriteStr('<' + s + ' ');

  WriteStr('Name="' + Name +

    '" Left="' + IntToStr(x) + '" Top="' + IntToStr(y) +

    '" Width="' + IntToStr(dx) + '" Height="' + IntToStr(dy) +

    '" Color="' + IntToStr(FillColor) + '"');

  if not Visible then

    WriteStr(' Visible="False"');



  FTyp := 0;

  if (FrameTyp and frftLeft) <> 0 then

    FTyp := FTyp or 1;

  if (FrameTyp and frftRight) <> 0 then

    FTyp := FTyp or 2;

  if (FrameTyp and frftUp) <> 0 then

    FTyp := FTyp or 4;

  if (FrameTyp and frftDown) <> 0 then

    FTyp := FTyp or 8;



  WriteStr(' Frame.Typ="' + IntToStr(FTyp) +

    '" Frame.Width="' + FloatToStr(FrameWidth) +

    '" Frame.Color="' + IntToStr(FrameColor) +

    '" Frame.Style="' + IntToStr(FrameStyle) +

    '" GapX="' + IntToStr(gapx) + '" GapY="' + IntToStr(gapy) +

    {'" TagStr="' + StrToXML(Tag) + }'" Memo.text="' + StrToXML(Memo.Text) + '"');



{  ba := BandAlign;

  if ba = baRest then

    ba := baWidth

  else if ba = baTop then

    ba := baNone;

  WriteStr(' Align="' + IntToStr(ba) + '"');}



  if Script.Count > 0 then

    WriteStr(' OnBeforePrint="' + Name + 'OnBeforePrint' +

      '" OnClick="' + Name + 'OnBeforePrint' +

      '" OnActivate="' + Name + 'OnBeforePrint"');



{  RTyp := 0;

  if ((Restrictions and frrfDontEditMemo) <> 0) or

     ((Restrictions and frrfDontEditScript) <> 0) or

     ((Restrictions and frrfDontEditContents) <> 0) or

     ((Restrictions and frrfDontModify) <> 0) then

    RTyp := RTyp or 1;

  if (Restrictions and frrfDontSize) <> 0 then

    RTyp := RTyp or 2;

  if (Restrictions and frrfDontMove) <> 0 then

    RTyp := RTyp or 4;

  if (Restrictions and frrfDontDelete) <> 0 then

    RTyp := RTyp or 8;

  WriteStr(' Restrictions="' + IntToStr(RTyp) + '"');}

end;



procedure TfrView.Resized;

begin

end;



procedure TfrView.GetBlob(b: TfrTField);

begin

end;



procedure TfrView.OnHook(View: TfrView);

begin

end;



function TfrView.GetClipRgn(rt: TfrRgnType): HRGN;

var

  bx, by, bx1, by1, w1, w2: Integer;

begin

  if FrameStyle = 5 then

  begin

    w1 := Round(FrameWidth * 1.5);

    w2 := Round((FrameWidth - 1) / 2 + FrameWidth);

  end

  else

  begin

    w1 := Round(FrameWidth / 2);

    w2 := Round((FrameWidth - 1) / 2);

  end;

  bx := x; by := y; bx1 := x + dx + 1; by1 := y + dy + 1;

  if (FrameTyp and $1) <> 0 then Inc(bx1, w2);

  if (FrameTyp and $2) <> 0 then Inc(by1, w2);

  if (FrameTyp and $4) <> 0 then Dec(bx, w1);

  if (FrameTyp and $8) <> 0 then Dec(by, w1);

  if rt = rtNormal then

    Result := CreateRectRgn(bx, by, bx1, by1) else

    Result := CreateRectRgn(bx - 10, by - 10, bx1 + 10, by1 + 10);

end;



procedure TfrView.CreateUniqueName;

var

  i: Integer;

begin

  Name := '';

  for i := 1 to 10000 do

    if CurReport.FindObject(BaseName + IntToStr(i)) = nil then

    begin

      Name := BaseName + IntToStr(i);

      Exit;

    end;

end;



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

begin

  x := Left;

  y := Top;

  dx := Width;

  dy := Height;

end;



procedure TfrView.DefinePopupMenu(Popup: TPopupMenu);

var

  m: TMenuItem;

begin

  m := TMenuItem.Create(Popup);

  m.Caption := '-';

  Popup.Items.Add(m);



  m := TMenuItem.Create(Popup);

  m.Caption := LoadStr(SStretched);

  m.OnClick := P1Click;

  m.Checked := (Flags and flStretched) <> 0;

  Popup.Items.Add(m);

end;



procedure TfrView.P1Click(Sender: TObject);

var

  i: Integer;

  t: TfrView;

begin

  frDesigner.BeforeChange;

  with Sender as TMenuItem do

  begin

    Checked := not Checked;

    for i := 0 to frDesigner.Page.Objects.Count-1 do

    begin

      t := frDesigner.Page.Objects[i];

      if t.Selected then

        t.Flags := (t.Flags and not flStretched) + Word(Checked);

    end;

  end;

  frDesigner.AfterChange;

end;



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

constructor TfrMemoView.Create;

begin

  inherited Create;

  Typ := gtMemo;

  FFont := TFont.Create;

  FFont.Name := 'Arial';

  FFont.Size := 10;

  FFont.Color := clBlack;

{$IFNDEF Delphi2}

  FFont.Charset := frCharset;

{$ENDIF}

  Highlight.FontColor := clBlack;

  Highlight.FillColor := clWhite;

  Highlight.FontStyle := 2; // fsBold

  BaseName := 'Memo';

  Flags := flStretched + flWordWrap;

  LineSpacing := 2;

  CharacterSpacing := 0;

end;



destructor TfrMemoView.Destroy;

begin

  FFont.Free;

  inherited Destroy;

end;



procedure TfrMemoView.SetFont(Value: TFont);

begin

  FFont.Assign(Value);

end;



procedure TfrMemoView.Assign(From: TfrView);

begin

  inherited Assign(From);

  Font := TfrMemoView(From).Font;

  Adjust := TfrMemoView(From).Adjust;

  Highlight := TfrMemoView(From).Highlight;

  HighlightStr := TfrMemoView(From).HighlightStr;

  LineSpacing := TfrMemoView(From).LineSpacing;

end;



procedure TfrMemoView.ExpandVariables;

var

  i: Integer;

  s: String;

  procedure GetData(var s: String);

  var

    i, j: Integer;

    s1, s2: String;

  begin

    i := 1;

    repeat

      while (i < Length(s)) and (s[i] <> '[') do Inc(i);

      s1 := GetBrackedVariable(s, i, j);

      if i <> j then

      begin

        Delete(s, i, j - i + 1);

        s2 := '';

        CurReport.InternalOnGetValue(s1, s2);

        Insert(s2, s, i);

        Inc(i, Length(s2));

        j := 0;

      end;

    until i = j;

  end;

begin

  Memo1.Clear;

  for i := 0 to Memo.Count - 1 do

  begin

    s := Memo[i];

    if Length(s) > 0 then

    begin

      GetData(s);

      Memo1.Text := Memo1.Text + s;

    end

    else

      Memo1.Add('');

  end;

end;



procedure TfrMemoView.AssignFont(Canvas: TCanvas);

begin

  with Canvas do

  begin

    Brush.Style := bsClear;

    Font := Self.Font;

    if not IsPrinting then

      Font.Height := -Round(Font.Size * 96 / 72 * ScaleY);

  end;

end;





type

  TWordBreaks = string;



const

  gl: set of Char = ['À', 'Å', '¨', 'È', 'Î', 'Ó', 'Û', 'Ý', 'Þ', 'ß'];

  r_sogl: set of Char = ['Ú', 'Ü'];

  spaces: set of Char = [' ', '.', ',', '-'];



function BreakWord(s: String): TWordBreaks;

var

  i: Integer;

  CanBreak: Boolean;

begin

  Result := '';

  s := AnsiUpperCase(s);

  if Length(s) > 4 then

  begin

    i := 2;

    repeat

      CanBreak := False;

      if s[i] in gl then

      begin

        if (s[i + 1] in gl) or (s[i + 2] in gl) then CanBreak := True;

      end

      else

      begin

        if not (s[i + 1] in gl) and not (s[i + 1] in r_sogl) and

           (s[i + 2] in gl) then

          CanBreak := True;

      end;

      if CanBreak then

        Result := Result + Chr(i);

      Inc(i);

    until i > Length(s) - 2;

  end;

end;



procedure TfrMemoView.WrapMemo;

var

  size, size1, maxwidth: Integer;

  b: TWordBreaks;

  WCanvas: TCanvas;



  procedure OutLine(const str: String);

  var

    n, w: Word;

  begin

    n := Length(str);

    if (n > 0) and (str[n] = #1) then

      w := WCanvas.TextWidth(Copy(str, 1, n - 1)) else

      w := WCanvas.TextWidth(str);

    SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));

    Inc(size, size1);

  end;



  procedure WrapLine(const s: String);

  var

    i, cur, beg, last: Integer;

    WasB…