2924 lines
71 KiB
ObjectPascal
2924 lines
71 KiB
ObjectPascal
|
|
|||
|
{******************************************}
|
|||
|
{ }
|
|||
|
{ FastReport VCL }
|
|||
|
{ FR2.x importer }
|
|||
|
{ }
|
|||
|
{ Copyright (c) 1998-2021 }
|
|||
|
{ by Fast Reports Inc. }
|
|||
|
{ }
|
|||
|
{******************************************}
|
|||
|
|
|||
|
unit frx2xto30;
|
|||
|
|
|||
|
interface
|
|||
|
|
|||
|
{$I frx.inc}
|
|||
|
|
|||
|
implementation
|
|||
|
|
|||
|
uses
|
|||
|
SysUtils, {$IFNDEF FPC}Windows, Messages, {$ENDIF}
|
|||
|
Classes, Graphics, Controls, Forms, Dialogs,
|
|||
|
StdCtrls, ComCtrls, Printers, TypInfo, {$IFNDEF FPC}Jpeg,{$ENDIF} DB,
|
|||
|
frxClass, frxVariables, frxPrinter, frxDCtrl, frxBarcode, frxBarcod,
|
|||
|
{$IFNDEF FPC}TeeProcs, TeEngine, Chart, Series, frxChart, frxChBox, frxOLE, frxRich,{$ENDIF}
|
|||
|
frxCross, frxDBSet, frxUnicodeUtils, frxUtils, fs_ipascal,
|
|||
|
frxCustomDB, {$IFNDEF FPC}frxBDEComponents, frxADOComponents, frxIBXComponents{$ENDIF}
|
|||
|
{$IFDEF FPC}
|
|||
|
LCLType, LCLProc, LazHelper
|
|||
|
{$ENDIF}
|
|||
|
{$IFDEF Delphi6}
|
|||
|
, Variants
|
|||
|
{$ENDIF};
|
|||
|
|
|||
|
type
|
|||
|
TfrxFR2EventsNew = class(TObject)
|
|||
|
private
|
|||
|
FReport: TfrxReport;
|
|||
|
procedure DoGetValue(const Expr: String; var Value: Variant);
|
|||
|
procedure DoPrepareScript(Sender: TObject);
|
|||
|
function GetScriptValue(Instance: TObject; ClassType: TClass;
|
|||
|
const MethodName: String; var Params: Variant): Variant;
|
|||
|
function DoLoad(Sender: TfrxReport; Stream: TStream): Boolean;
|
|||
|
function DoGetScriptValue(var Params: Variant): Variant;
|
|||
|
end;
|
|||
|
|
|||
|
TfrPageType = (ptReport, ptDialog);
|
|||
|
TfrBandType = (btReportTitle, btReportSummary,
|
|||
|
btPageHeader, btPageFooter,
|
|||
|
btMasterHeader, btMasterData, btMasterFooter,
|
|||
|
btDetailHeader, btDetailData, btDetailFooter,
|
|||
|
btSubDetailHeader, btSubDetailData, btSubDetailFooter,
|
|||
|
btOverlay, btColumnHeader, btColumnFooter,
|
|||
|
btGroupHeader, btGroupFooter,
|
|||
|
btCrossHeader, btCrossData, btCrossFooter,
|
|||
|
btChild, btNone);
|
|||
|
|
|||
|
TfrxFixupItem = class(TObject)
|
|||
|
public
|
|||
|
Obj: TPersistent;
|
|||
|
PropInfo: PPropInfo;
|
|||
|
Value: String;
|
|||
|
end;
|
|||
|
|
|||
|
TfrHighlightAttr = packed record
|
|||
|
FontStyle: Word;
|
|||
|
FontColor, FillColor: TColor;
|
|||
|
end;
|
|||
|
|
|||
|
TfrBarCodeRec = packed record
|
|||
|
cCheckSum : Boolean;
|
|||
|
cShowText : Boolean;
|
|||
|
cCadr : Boolean;
|
|||
|
cBarType : TfrxBarcodeType;
|
|||
|
cModul : Integer;
|
|||
|
cRatio : Double;
|
|||
|
cAngle : Double;
|
|||
|
end;
|
|||
|
|
|||
|
TChartOptions = packed record
|
|||
|
ChartType: Byte;
|
|||
|
Dim3D, IsSingle, ShowLegend, ShowAxis, ShowMarks, Colored: Boolean;
|
|||
|
MarksStyle: Byte;
|
|||
|
Top10Num: Integer;
|
|||
|
Reserved: array[0..35] of Byte;
|
|||
|
end;
|
|||
|
|
|||
|
TfrRoundRect = packed record
|
|||
|
SdColor: TColor; // Color of Shadow
|
|||
|
wShadow: Integer; // Width of shadow
|
|||
|
Cadre : Boolean; // Frame On/Off - not used /TZ/
|
|||
|
sCurve : Boolean; // RoundRect On/Off
|
|||
|
wCurve : Integer; // Curve size
|
|||
|
end;
|
|||
|
|
|||
|
THackControl = class(TControl)
|
|||
|
end;
|
|||
|
|
|||
|
{$IFNDEF FPC}
|
|||
|
TSeriesClass = class of TChartSeries;
|
|||
|
{$ENDIF}
|
|||
|
|
|||
|
const
|
|||
|
gtMemo = 0;
|
|||
|
gtPicture = 1;
|
|||
|
gtBand = 2;
|
|||
|
gtSubReport = 3;
|
|||
|
gtLine = 4;
|
|||
|
gtCross = 5;
|
|||
|
gtAddIn = 10;
|
|||
|
|
|||
|
frftNone = 0;
|
|||
|
frftRight = 1;
|
|||
|
frftBottom = 2;
|
|||
|
frftLeft = 4;
|
|||
|
frftTop = 8;
|
|||
|
|
|||
|
frtaLeft = 0;
|
|||
|
frtaRight = 1;
|
|||
|
frtaCenter = 2;
|
|||
|
frtaVertical = 4;
|
|||
|
frtaMiddle = 8;
|
|||
|
frtaDown = 16;
|
|||
|
|
|||
|
flStretched = 1;
|
|||
|
flWordWrap = 2;
|
|||
|
flWordBreak = 4;
|
|||
|
flAutoSize = 8;
|
|||
|
flTextOnly = $10;
|
|||
|
flSuppressRepeated = $20;
|
|||
|
flHideZeros = $40;
|
|||
|
flUnderlines = $80;
|
|||
|
flRTLReading = $100;
|
|||
|
flBandNewPageAfter = 2;
|
|||
|
flBandPrintifSubsetEmpty = 4;
|
|||
|
flBandBreaked = 8;
|
|||
|
flBandOnFirstPage = $10;
|
|||
|
flBandOnLastPage = $20;
|
|||
|
flBandRepeatHeader = $40;
|
|||
|
flBandPrintChildIfInvisible = $80;
|
|||
|
flPictCenter = 2;
|
|||
|
flPictRatio = 4;
|
|||
|
flWantHook = $8000;
|
|||
|
flDontUndo = $4000;
|
|||
|
flOnePerPage = $2000;
|
|||
|
|
|||
|
pkNone = 0;
|
|||
|
pkBitmap = 1;
|
|||
|
pkMetafile = 2;
|
|||
|
pkIcon = 3;
|
|||
|
pkJPEG = 4;
|
|||
|
|
|||
|
var
|
|||
|
frVersion: Byte;
|
|||
|
Report: TfrxReport;
|
|||
|
Stream: TStream;
|
|||
|
Page: TfrxPage;
|
|||
|
Fixups: TList;
|
|||
|
offsx, offsy: Integer;
|
|||
|
frxFR2EventsNew: TfrxFR2EventsNew;
|
|||
|
|
|||
|
const
|
|||
|
frSpecCount = 9;
|
|||
|
frSpecFuncs: array[0..frSpecCount - 1] of String =
|
|||
|
('PAGE#', '', 'DATE', 'TIME', 'LINE#', 'LINETHROUGH#', 'COLUMN#',
|
|||
|
'CURRENT#', 'TOTALPAGES');
|
|||
|
Bands: array[TfrBandType] of TfrxBandClass =
|
|||
|
(TfrxReportTitle, TfrxReportSummary,
|
|||
|
TfrxPageHeader, TfrxPageFooter,
|
|||
|
TfrxHeader, TfrxMasterData, TfrxFooter,
|
|||
|
TfrxHeader, TfrxDetailData, TfrxFooter,
|
|||
|
TfrxHeader, TfrxSubDetailData, TfrxFooter,
|
|||
|
TfrxOverlay, TfrxColumnHeader, TfrxColumnFooter,
|
|||
|
TfrxGroupHeader, TfrxGroupFooter,
|
|||
|
TfrxHeader, TfrxMasterData, TfrxFooter,
|
|||
|
TfrxChild, nil);
|
|||
|
cbDefaultText = '12345678';
|
|||
|
{$IFNDEF FPC}
|
|||
|
ChartTypes: array[0..5] of TSeriesClass =
|
|||
|
(TLineSeries, TAreaSeries, TPointSeries,
|
|||
|
TBarSeries, THorizBarSeries, TPieSeries);
|
|||
|
{$ENDIF}
|
|||
|
frRepInfoCount = 9;
|
|||
|
frRepInfo: array[0..frRepInfoCount-1] of String =
|
|||
|
('REPORTCOMMENT', 'REPORTNAME', 'REPORTAUTOR',
|
|||
|
'VMAJOR', 'VMINOR', 'VRELEASE', 'VBUILD', 'REPORTDATE', 'REPORTLASTCHANGE');
|
|||
|
ParamTypes: array[0..10] of TFieldType =
|
|||
|
(ftBCD, ftBoolean, ftCurrency, ftDate, ftDateTime, ftInteger,
|
|||
|
ftFloat, ftSmallint, ftString, ftTime, ftWord);
|
|||
|
|
|||
|
|
|||
|
procedure frGetDataSetAndField(ComplexName: String; var DataSet: TDataSet;
|
|||
|
var Field: String); forward;
|
|||
|
function frGetFieldValue(F: TField): Variant; forward;
|
|||
|
procedure LoadFromFR2Stream(AReport: TfrxReport; AStream: TStream); forward;
|
|||
|
function ConvertDatasetAndField(s: String): String; forward;
|
|||
|
|
|||
|
{ ------------------ hack FR events --------------------------------------- }
|
|||
|
{ TfrxFR2EventsNew }
|
|||
|
|
|||
|
procedure TfrxFR2EventsNew.DoGetValue(const Expr: String; var Value: Variant);
|
|||
|
var
|
|||
|
Dataset: TDataset;
|
|||
|
s, Field: String;
|
|||
|
tf: TField;
|
|||
|
ds: TfrxDataSet;
|
|||
|
fld: String;
|
|||
|
begin
|
|||
|
Dataset := nil;
|
|||
|
Field := '';
|
|||
|
|
|||
|
if CompareText(Expr, 'COLUMN#') = 0 then
|
|||
|
Value := Report.Engine.CurLine
|
|||
|
else
|
|||
|
begin
|
|||
|
s := Expr;
|
|||
|
if Pos('DialogForm.', s) = 1 then
|
|||
|
begin
|
|||
|
Delete(s, 1, Length('DialogForm.'));
|
|||
|
Report.GetDataSetAndField(s, ds, fld);
|
|||
|
if (ds <> nil) and (fld <> '') then
|
|||
|
begin
|
|||
|
Value := ds.Value[fld];
|
|||
|
if Report.EngineOptions.ConvertNulls and (Value = Null) then
|
|||
|
case ds.FieldType[fld] of
|
|||
|
fftNumeric:
|
|||
|
Value := 0;
|
|||
|
fftString:
|
|||
|
Value := '';
|
|||
|
fftBoolean:
|
|||
|
Value := False;
|
|||
|
end;
|
|||
|
Exit;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
frGetDataSetAndField(s, Dataset, Field);
|
|||
|
if (Dataset <> nil) and (Field <> '') then
|
|||
|
begin
|
|||
|
tf := Dataset.FieldByName(Field);
|
|||
|
Value := frGetFieldValue(tf);
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrxFR2EventsNew.DoPrepareScript(Sender: TObject);
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
begin
|
|||
|
FReport := TfrxReport(Sender);
|
|||
|
Report := FReport;
|
|||
|
for i := 0 to FReport.Variables.Count - 1 do
|
|||
|
if IsValidIdent(FReport.Variables.Items[i].Name) then
|
|||
|
FReport.Script.AddMethod('function ' + FReport.Variables.Items[i].Name + ': Variant', GetScriptValue);
|
|||
|
end;
|
|||
|
|
|||
|
function TfrxFR2EventsNew.GetScriptValue(Instance: TObject;
|
|||
|
ClassType: TClass; const MethodName: String;
|
|||
|
var Params: Variant): Variant;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
val: Variant;
|
|||
|
begin
|
|||
|
i := FReport.Variables.IndexOf(MethodName);
|
|||
|
if i <> -1 then
|
|||
|
begin
|
|||
|
val := FReport.Variables.Items[i].Value;
|
|||
|
if (TVarData(val).VType = varString) or (TVarData(val).VType = varOleStr) then
|
|||
|
begin
|
|||
|
if Pos(#13#10, val) <> 0 then
|
|||
|
Result := val
|
|||
|
else
|
|||
|
Result := FReport.Calc(val);
|
|||
|
end
|
|||
|
else
|
|||
|
Result := val;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
function TfrxFR2EventsNew.DoLoad(Sender: TfrxReport; Stream: TStream): Boolean;
|
|||
|
begin
|
|||
|
Result := False;
|
|||
|
Stream.Read(frVersion, 1);
|
|||
|
Stream.Seek(-1, soFromCurrent);
|
|||
|
if frVersion < 30 then
|
|||
|
begin
|
|||
|
LoadFromFR2Stream(Sender, Stream);
|
|||
|
Result := True;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
function TfrxFR2EventsNew.DoGetScriptValue(var Params: Variant): Variant;
|
|||
|
begin
|
|||
|
Result := FReport.Calc('`' + Params[0] + '`', FReport.Script.ProgRunning);
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
{ ------------------ fixups ----------------------------------------------- }
|
|||
|
procedure ClearFixups;
|
|||
|
begin
|
|||
|
while Fixups.Count > 0 do
|
|||
|
begin
|
|||
|
TfrxFixupItem(Fixups[0]).Free;
|
|||
|
Fixups.Delete(0);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure FixupReferences;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
Item: TfrxFixupItem;
|
|||
|
Ref: TObject;
|
|||
|
begin
|
|||
|
for i := 0 to Fixups.Count - 1 do
|
|||
|
begin
|
|||
|
Item := Fixups[i];
|
|||
|
Ref := Report.FindObject(Item.Value);
|
|||
|
if Ref <> nil then
|
|||
|
SetOrdProp(Item.Obj, Item.PropInfo, frxInteger(Ref));
|
|||
|
end;
|
|||
|
|
|||
|
ClearFixups;
|
|||
|
end;
|
|||
|
|
|||
|
procedure AddFixup(Obj: TPersistent; Name, Value: String);
|
|||
|
var
|
|||
|
Item: TfrxFixupItem;
|
|||
|
begin
|
|||
|
Item := TfrxFixupItem.Create;
|
|||
|
Item.Obj := Obj;
|
|||
|
Item.PropInfo := GetPropInfo(Obj.ClassInfo, Name);
|
|||
|
Item.Value := Value;
|
|||
|
Fixups.Add(Item);
|
|||
|
end;
|
|||
|
|
|||
|
{ ------------------ stream readers -------------------------------------- }
|
|||
|
function frSetFontStyle(Style: Integer): TFontStyles;
|
|||
|
begin
|
|||
|
Result := [];
|
|||
|
if (Style and $1) <> 0 then Result := Result + [fsItalic];
|
|||
|
if (Style and $2) <> 0 then Result := Result + [fsBold];
|
|||
|
if (Style and $4) <> 0 then Result := Result + [fsUnderLine];
|
|||
|
if (Style and $8) <> 0 then Result := Result + [fsStrikeOut];
|
|||
|
end;
|
|||
|
|
|||
|
procedure frReadMemo(Stream: TStream; l: TStrings);
|
|||
|
var
|
|||
|
s: AnsiString;
|
|||
|
b: Byte;
|
|||
|
n: Word;
|
|||
|
begin
|
|||
|
l.Clear;
|
|||
|
Stream.Read(n, 2);
|
|||
|
if n > 0 then
|
|||
|
repeat
|
|||
|
Stream.Read(n, 2);
|
|||
|
SetLength(s, n);
|
|||
|
if n > 0 then
|
|||
|
Stream.Read(s[1], n);
|
|||
|
{$IFDEF Delphi12}
|
|||
|
l.Add(String(s));
|
|||
|
{$ELSE}
|
|||
|
l.Add(s);
|
|||
|
{$ENDIF}
|
|||
|
Stream.Read(b, 1);
|
|||
|
until b = 0
|
|||
|
else
|
|||
|
Stream.Read(b, 1);
|
|||
|
end;
|
|||
|
|
|||
|
function frReadString(Stream: TStream): String;
|
|||
|
var
|
|||
|
s: AnsiString;
|
|||
|
n: Word;
|
|||
|
b: Byte;
|
|||
|
begin
|
|||
|
Stream.Read(n, 2);
|
|||
|
SetLength(s, n);
|
|||
|
if n > 0 then
|
|||
|
Stream.Read(s[1], n);
|
|||
|
Stream.Read(b, 1);
|
|||
|
{$IFDEF Delphi12}
|
|||
|
Result := String(s);
|
|||
|
{$ELSE}
|
|||
|
Result := s;
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure frReadMemo22(Stream: TStream; l: TStrings);
|
|||
|
var
|
|||
|
s: AnsiString;
|
|||
|
i: Integer;
|
|||
|
b: Byte;
|
|||
|
begin
|
|||
|
SetLength(s, 4096);
|
|||
|
l.Clear;
|
|||
|
i := 1;
|
|||
|
repeat
|
|||
|
Stream.Read(b,1);
|
|||
|
if (b = 13) or (b = 0) then
|
|||
|
begin
|
|||
|
SetLength(s, i - 1);
|
|||
|
if not ((b = 0) and (i = 1)) then
|
|||
|
{$IFDEF Delphi12}
|
|||
|
l.Add(String(s));
|
|||
|
{$ELSE}
|
|||
|
l.Add(s);
|
|||
|
{$ENDIF}
|
|||
|
SetLength(s, 4096);
|
|||
|
i := 1;
|
|||
|
end
|
|||
|
else if b <> 0 then
|
|||
|
begin
|
|||
|
{$IFDEF Delphi12}
|
|||
|
s[i] := AnsiChar(Chr(b));
|
|||
|
{$ELSE}
|
|||
|
s[i] := Chr(b);
|
|||
|
{$ENDIF}
|
|||
|
Inc(i);
|
|||
|
if i > 4096 then
|
|||
|
SetLength(s, Length(s) + 4096);
|
|||
|
end;
|
|||
|
until b = 0;
|
|||
|
end;
|
|||
|
|
|||
|
function frReadString22(Stream: TStream): String;
|
|||
|
var
|
|||
|
s: AnsiString;
|
|||
|
i: Integer;
|
|||
|
b: Byte;
|
|||
|
begin
|
|||
|
SetLength(s, 4096);
|
|||
|
i := 1;
|
|||
|
repeat
|
|||
|
Stream.Read(b, 1);
|
|||
|
if b = 0 then
|
|||
|
SetLength(s, i - 1)
|
|||
|
else
|
|||
|
begin
|
|||
|
{$IFDEF Delphi12}
|
|||
|
s[i] := AnsiChar(Chr(b));
|
|||
|
{$ELSE}
|
|||
|
s[i] := Chr(b);
|
|||
|
{$ENDIF}
|
|||
|
Inc(i);
|
|||
|
if i > 4096 then
|
|||
|
SetLength(s, Length(s) + 4096);
|
|||
|
end;
|
|||
|
until b = 0;
|
|||
|
{$IFDEF Delphi12}
|
|||
|
Result := String(s);
|
|||
|
{$ELSE}
|
|||
|
Result := s;
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
function frReadBoolean(Stream: TStream): Boolean;
|
|||
|
begin
|
|||
|
Stream.Read(Result, 1);
|
|||
|
end;
|
|||
|
|
|||
|
function frReadByte(Stream: TStream): Byte;
|
|||
|
begin
|
|||
|
Stream.Read(Result, 1);
|
|||
|
end;
|
|||
|
|
|||
|
function frReadWord(Stream: TStream): Word;
|
|||
|
begin
|
|||
|
Stream.Read(Result, 2);
|
|||
|
end;
|
|||
|
|
|||
|
function frReadInteger(Stream: TStream): Integer;
|
|||
|
begin
|
|||
|
Stream.Read(Result, 4);
|
|||
|
end;
|
|||
|
|
|||
|
procedure frReadFont(Stream: TStream; Font: TFont);
|
|||
|
var
|
|||
|
w: Word;
|
|||
|
begin
|
|||
|
Font.Name := frReadString(Stream);
|
|||
|
Font.Size := frReadInteger(Stream);
|
|||
|
Font.Style := frSetFontStyle(frReadWord(Stream));
|
|||
|
Font.Color := frReadInteger(Stream);
|
|||
|
w := frReadWord(Stream);
|
|||
|
Font.Charset := w;
|
|||
|
end;
|
|||
|
|
|||
|
function ReadString(Stream: TStream): String;
|
|||
|
begin
|
|||
|
if frVersion >= 23 then
|
|||
|
Result := frReadString(Stream) else
|
|||
|
Result := frReadString22(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadMemo(Stream: TStream; Memo: TStrings);
|
|||
|
begin
|
|||
|
if frVersion >= 23 then
|
|||
|
frReadMemo(Stream, Memo) else
|
|||
|
frReadMemo22(Stream, Memo);
|
|||
|
end;
|
|||
|
|
|||
|
{ --------------------------- utils -------------------------------- }
|
|||
|
function frFindComponent(Owner: TComponent; Name: String): TComponent;
|
|||
|
var
|
|||
|
n: Integer;
|
|||
|
s1, s2: String;
|
|||
|
begin
|
|||
|
Result := nil;
|
|||
|
n := Pos('.', Name);
|
|||
|
try
|
|||
|
if n = 0 then
|
|||
|
Result := Owner.FindComponent(Name)
|
|||
|
else
|
|||
|
begin
|
|||
|
s1 := Copy(Name, 1, n - 1); // module name
|
|||
|
s2 := Copy(Name, n + 1, 255); // component name
|
|||
|
Owner := FindGlobalComponent(s1);
|
|||
|
if Owner <> nil then
|
|||
|
begin
|
|||
|
n := Pos('.', s2);
|
|||
|
if n <> 0 then // frame name - Delphi5
|
|||
|
begin
|
|||
|
s1 := Copy(s2, 1, n - 1);
|
|||
|
s2 := Copy(s2, n + 1, 255);
|
|||
|
Owner := Owner.FindComponent(s1);
|
|||
|
if Owner <> nil then
|
|||
|
Result := Owner.FindComponent(s2);
|
|||
|
end
|
|||
|
else
|
|||
|
Result := Owner.FindComponent(s2);
|
|||
|
end;
|
|||
|
end;
|
|||
|
except
|
|||
|
on Exception do
|
|||
|
raise EClassNotFound.Create('Missing ' + Name);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
function frRemoveQuotes(const s: String): String;
|
|||
|
begin
|
|||
|
if (Length(s) > 2) and (s[1] = '"') and (s[Length(s)] = '"') then
|
|||
|
Result := Copy(s, 2, Length(s) - 2) else
|
|||
|
Result := s;
|
|||
|
end;
|
|||
|
|
|||
|
function frRemoveQuotes1(const s: String): String;
|
|||
|
begin
|
|||
|
if (Length(s) > 2) and (s[1] = '''') and (s[Length(s)] = '''') then
|
|||
|
Result := Copy(s, 2, Length(s) - 2) else
|
|||
|
Result := s;
|
|||
|
end;
|
|||
|
|
|||
|
procedure frGetFieldNames(DataSet: TDataSet; List: TStrings);
|
|||
|
begin
|
|||
|
try
|
|||
|
DataSet.GetFieldNames(List);
|
|||
|
except;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure frGetDataSetAndField(ComplexName: String; var DataSet: TDataSet;
|
|||
|
var Field: String);
|
|||
|
var
|
|||
|
i, j, n: Integer;
|
|||
|
f: TComponent;
|
|||
|
sl: TStringList;
|
|||
|
s: String;
|
|||
|
c: Char;
|
|||
|
cn: TControl;
|
|||
|
|
|||
|
function FindField(ds: TDataSet; FName: String): String;
|
|||
|
var
|
|||
|
sl: TStringList;
|
|||
|
begin
|
|||
|
Result := '';
|
|||
|
if ds <> nil then
|
|||
|
begin
|
|||
|
sl := TStringList.Create;
|
|||
|
frGetFieldNames(ds, sl);
|
|||
|
if sl.IndexOf(FName) <> -1 then
|
|||
|
Result := FName;
|
|||
|
sl.Free;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
Field := '';
|
|||
|
f := Report.Owner;
|
|||
|
sl := TStringList.Create;
|
|||
|
|
|||
|
n := 0; j := 1;
|
|||
|
for i := 1 to Length(ComplexName) do
|
|||
|
begin
|
|||
|
c := ComplexName[i];
|
|||
|
if c = '"' then
|
|||
|
begin
|
|||
|
sl.Add(Copy(ComplexName, i, 255));
|
|||
|
j := i;
|
|||
|
break;
|
|||
|
end
|
|||
|
else if c = '.' then
|
|||
|
begin
|
|||
|
sl.Add(Copy(ComplexName, j, i - j));
|
|||
|
j := i + 1;
|
|||
|
Inc(n);
|
|||
|
end;
|
|||
|
end;
|
|||
|
if j <> i then
|
|||
|
sl.Add(Copy(ComplexName, j, 255));
|
|||
|
|
|||
|
case n of
|
|||
|
0: // field name only
|
|||
|
begin
|
|||
|
if DataSet <> nil then
|
|||
|
begin
|
|||
|
s := frRemoveQuotes(ComplexName);
|
|||
|
Field := FindField(DataSet, s);
|
|||
|
end;
|
|||
|
end;
|
|||
|
1: // DatasetName.FieldName
|
|||
|
begin
|
|||
|
if sl.Count > 1 then
|
|||
|
begin
|
|||
|
DataSet := TDataSet(frFindComponent(f, sl[0]));
|
|||
|
s := frRemoveQuotes(sl[1]);
|
|||
|
Field := FindField(DataSet, s);
|
|||
|
end;
|
|||
|
end;
|
|||
|
2: // FormName.DatasetName.FieldName
|
|||
|
begin
|
|||
|
f := FindGlobalComponent(sl[0]);
|
|||
|
if f <> nil then
|
|||
|
begin
|
|||
|
DataSet := TDataSet(f.FindComponent(sl[1]));
|
|||
|
s := frRemoveQuotes(sl[2]);
|
|||
|
Field := FindField(DataSet, s);
|
|||
|
end;
|
|||
|
end;
|
|||
|
3: // FormName.FrameName.DatasetName.FieldName - Delphi5
|
|||
|
begin
|
|||
|
f := FindGlobalComponent(sl[0]);
|
|||
|
if f <> nil then
|
|||
|
begin
|
|||
|
cn := TControl(f.FindComponent(sl[1]));
|
|||
|
DataSet := TDataSet(cn.FindComponent(sl[2]));
|
|||
|
s := frRemoveQuotes(sl[3]);
|
|||
|
Field := FindField(DataSet, s);
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
sl.Free;
|
|||
|
end;
|
|||
|
|
|||
|
function frGetFieldValue(F: TField): Variant;
|
|||
|
begin
|
|||
|
if not F.DataSet.Active then
|
|||
|
F.DataSet.Open;
|
|||
|
if Assigned(F.OnGetText) then
|
|||
|
Result := F.DisplayText
|
|||
|
else if F.DataType in [ftLargeint] then
|
|||
|
Result := F.DisplayText
|
|||
|
else
|
|||
|
Result := F.AsVariant;
|
|||
|
|
|||
|
if Result = Null then
|
|||
|
if F.DataType = ftString then
|
|||
|
Result := ''
|
|||
|
else if F.DataType = ftWideString then
|
|||
|
Result := ''
|
|||
|
else if F.DataType = ftBoolean then
|
|||
|
Result := False
|
|||
|
else
|
|||
|
Result := 0;
|
|||
|
end;
|
|||
|
|
|||
|
function FindTfrxDataset(ds: TDataset): TfrxDataset;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
sl: TStringList;
|
|||
|
ds1: TfrxDataset;
|
|||
|
begin
|
|||
|
Result := nil;
|
|||
|
sl := TStringList.Create;
|
|||
|
frxGetDatasetList(sl);
|
|||
|
for i := 0 to sl.Count - 1 do
|
|||
|
begin
|
|||
|
ds1 := TfrxDataset(sl.Objects[i]);
|
|||
|
if (ds1 is TfrxDBDataset) and (TfrxDBDataset(ds1).GetDataSet = ds) then
|
|||
|
begin
|
|||
|
Result := ds1;
|
|||
|
break;
|
|||
|
end;
|
|||
|
end;
|
|||
|
sl.Free;
|
|||
|
end;
|
|||
|
|
|||
|
function GetBrackedVariable(const s: String; var i, j: Integer): String;
|
|||
|
var
|
|||
|
c: Integer;
|
|||
|
fl1, fl2: Boolean;
|
|||
|
begin
|
|||
|
j := i; fl1 := True; fl2 := True; c := 0;
|
|||
|
Result := '';
|
|||
|
if (s = '') or (j > Length(s)) then Exit;
|
|||
|
Dec(j);
|
|||
|
repeat
|
|||
|
Inc(j);
|
|||
|
if fl1 and fl2 then
|
|||
|
if s[j] = '[' then
|
|||
|
begin
|
|||
|
if c = 0 then i := j;
|
|||
|
Inc(c);
|
|||
|
end
|
|||
|
else if s[j] = ']' then Dec(c);
|
|||
|
if fl1 then
|
|||
|
if s[j] = '"' then fl2 := not fl2;
|
|||
|
if fl2 then
|
|||
|
if s[j] = '''' then fl1 := not fl1;
|
|||
|
until (c = 0) or (j >= Length(s));
|
|||
|
Result := Copy(s, i + 1, j - i - 1);
|
|||
|
end;
|
|||
|
|
|||
|
function Substitute(const ParName: String): String;
|
|||
|
begin
|
|||
|
Result := ParName;
|
|||
|
if CompareText(ParName, frRepInfo[0]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.Description'
|
|||
|
else if CompareText(ParName, frRepInfo[1]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.Name'
|
|||
|
else if CompareText(ParName, frRepInfo[2]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.Author'
|
|||
|
else if CompareText(ParName, frRepInfo[3]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.VersionMajor'
|
|||
|
else if CompareText(ParName, frRepInfo[4]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.VersionMinor'
|
|||
|
else if CompareText(ParName, frRepInfo[5]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.VersionRelease'
|
|||
|
else if CompareText(ParName, frRepInfo[6]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.VersionBuild'
|
|||
|
else if CompareText(ParName, frRepInfo[7]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.CreateDate'
|
|||
|
else if CompareText(ParName, frRepInfo[8]) = 0 then
|
|||
|
Result := 'Report.ReportOptions.LastChange'
|
|||
|
|
|||
|
else if CompareText(ParName, 'CURY') = 0 then
|
|||
|
Result := 'Engine.CurY'
|
|||
|
else if CompareText(ParName, 'FREESPACE') = 0 then
|
|||
|
Result := 'Engine.FreeSpace'
|
|||
|
else if CompareText(ParName, 'FINALPASS') = 0 then
|
|||
|
Result := 'Engine.FinalPass'
|
|||
|
else if CompareText(ParName, 'PAGEHEIGHT') = 0 then
|
|||
|
Result := 'Engine.PageHeight'
|
|||
|
else if CompareText(ParName, 'PAGEWIDTH') = 0 then
|
|||
|
Result := 'Engine.PageWidth'
|
|||
|
end;
|
|||
|
|
|||
|
procedure DoExpression(const Expr: String; var Value: String);
|
|||
|
begin
|
|||
|
Value := Substitute(Expr);
|
|||
|
if ConvertDatasetAndField(Expr) <> Expr then
|
|||
|
Value := ConvertDatasetAndField(Expr);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ExpandVariables(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 := s1;
|
|||
|
DoExpression(s1, s2);
|
|||
|
s2 := '[' + s2 + ']';
|
|||
|
Insert(s2, s, i);
|
|||
|
Inc(i, Length(s2));
|
|||
|
j := 0;
|
|||
|
end;
|
|||
|
until i = j;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ExpandVariables1(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 := s1;
|
|||
|
DoExpression(s1, s2);
|
|||
|
Insert(s2, s, i);
|
|||
|
Inc(i, Length(s2));
|
|||
|
j := 0;
|
|||
|
end;
|
|||
|
until i = j;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ConvertMemoExpressions(m: TfrxCustomMemoView; s: String);
|
|||
|
begin
|
|||
|
ExpandVariables(s);
|
|||
|
{$IFDEF Delphi12}
|
|||
|
m.Memo.Text := AnsiToUnicode(AnsiString(s), m.Font.Charset);
|
|||
|
{$ELSE}
|
|||
|
m.Memo.Text := AnsiToUnicode(s, m.Font.Charset);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
{ --------------------------- report items -------------------------------- }
|
|||
|
var
|
|||
|
Name: String;
|
|||
|
HVersion, LVersion: Byte;
|
|||
|
x, y, dx, dy: Integer;
|
|||
|
Flags: Word;
|
|||
|
FrameTyp: Word;
|
|||
|
FrameWidth: Single;
|
|||
|
FrameColor: TColor;
|
|||
|
FrameStyle: Word;
|
|||
|
FillColor: TColor;
|
|||
|
Format: Integer;
|
|||
|
FormatStr: String;
|
|||
|
Visible: WordBool;
|
|||
|
gapx, gapy: Integer;
|
|||
|
Restrictions: Word;
|
|||
|
Tag: String;
|
|||
|
Memo, Script: TStringList;
|
|||
|
BandAlign: Byte;
|
|||
|
NeedCreateName: Boolean;
|
|||
|
|
|||
|
procedure AddScript(c: TfrxComponent; const ScriptName: String);
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
vName: String;
|
|||
|
begin
|
|||
|
vName := c.Name;
|
|||
|
if Script.Count <> 0 then
|
|||
|
begin
|
|||
|
Report.ScriptText.Add('procedure ' + vName + scriptName);
|
|||
|
Report.ScriptText.Add('begin');
|
|||
|
Report.ScriptText.Add(' with ' + vName + ', Engine do');
|
|||
|
Report.ScriptText.Add(' begin');
|
|||
|
if Script[0] <> 'begin' then
|
|||
|
Report.ScriptText.Add(Script[0]);
|
|||
|
|
|||
|
for i := 1 to Script.Count - 2 do
|
|||
|
Report.ScriptText.Add(Script[i]);
|
|||
|
|
|||
|
if Script[0] <> 'begin' then
|
|||
|
begin
|
|||
|
if Script.Count <> 1 then
|
|||
|
Report.ScriptText.Add(Script[Script.Count - 1]);
|
|||
|
Report.ScriptText.Add(' end');
|
|||
|
Report.ScriptText.Add('end;');
|
|||
|
end
|
|||
|
else
|
|||
|
begin
|
|||
|
Report.ScriptText.Add(' end');
|
|||
|
Report.ScriptText.Add(Script[Script.Count - 1] + ';');
|
|||
|
end;
|
|||
|
Report.ScriptText.Add('');
|
|||
|
|
|||
|
if c is TfrxDialogPage then
|
|||
|
TfrxDialogPage(c).OnShow := vName + 'OnShow'
|
|||
|
else if c is TfrxDialogControl then
|
|||
|
TfrxDialogControl(c).OnClick := vName + 'OnClick'
|
|||
|
else if c is TfrxReportComponent then
|
|||
|
TfrxReportComponent(c).OnBeforePrint := vName + 'OnBeforePrint';
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure SetfrxComponent(c: TfrxComponent);
|
|||
|
|
|||
|
procedure SetValidIdent(var Ident: string);
|
|||
|
const
|
|||
|
Alpha = ['A'..'Z', 'a'..'z', '_'];
|
|||
|
AlphaNumeric = Alpha + ['0'..'9'];
|
|||
|
var
|
|||
|
I: Integer;
|
|||
|
begin
|
|||
|
{$IFDEF Delphi12}
|
|||
|
if (Length(Ident) > 0) and not CharInSet(Ident[1], Alpha) then
|
|||
|
Ident[1] := '_';
|
|||
|
for I := 2 to Length(Ident) do
|
|||
|
if not CharInSet(Ident[I], AlphaNumeric) then
|
|||
|
Ident[I] := '_';
|
|||
|
{$ELSE}
|
|||
|
if (Length(Ident) > 0) and not (Ident[1] in Alpha) then
|
|||
|
Ident[1] := '_';
|
|||
|
for I := 2 to Length(Ident) do
|
|||
|
if not (Ident[I] in AlphaNumeric) then
|
|||
|
Ident[I] := '_';
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
SetValidIdent(Name);
|
|||
|
c.Name := Name;
|
|||
|
if NeedCreateName then
|
|||
|
c.CreateUniqueName;
|
|||
|
|
|||
|
c.Left := x + offsx;
|
|||
|
c.Top := y + offsy;
|
|||
|
c.Width := dx;
|
|||
|
c.Height := dy;
|
|||
|
c.Visible := Visible;
|
|||
|
end;
|
|||
|
|
|||
|
procedure SetfrxView(c: TfrxView);
|
|||
|
begin
|
|||
|
if (FrameTyp and frftRight) <> 0 then
|
|||
|
c.Frame.Typ := c.Frame.Typ + [ftRight];
|
|||
|
if (FrameTyp and frftBottom) <> 0 then
|
|||
|
c.Frame.Typ := c.Frame.Typ + [ftBottom];
|
|||
|
if (FrameTyp and frftLeft) <> 0 then
|
|||
|
c.Frame.Typ := c.Frame.Typ + [ftLeft];
|
|||
|
if (FrameTyp and frftTop) <> 0 then
|
|||
|
c.Frame.Typ := c.Frame.Typ + [ftTop];
|
|||
|
c.Frame.Width := FrameWidth;
|
|||
|
c.Frame.Color := FrameColor;
|
|||
|
c.Frame.Style := TfrxFrameStyle(FrameStyle);
|
|||
|
c.Color := FillColor;
|
|||
|
if BandAlign = 6 then
|
|||
|
BandAlign := 0;
|
|||
|
if BandAlign = 7 then
|
|||
|
BandAlign := 6;
|
|||
|
c.Align := TfrxAlign(BandAlign);
|
|||
|
c.TagStr := Tag;
|
|||
|
AddScript(c, 'OnBeforePrint(Sender: TfrxComponent);');
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrViewLoadFromStream;
|
|||
|
var
|
|||
|
w: Integer;
|
|||
|
begin
|
|||
|
with Stream do
|
|||
|
begin
|
|||
|
NeedCreateName := False;
|
|||
|
if frVersion >= 23 then
|
|||
|
Name := ReadString(Stream) else
|
|||
|
NeedCreateName := True;
|
|||
|
if frVersion > 23 then
|
|||
|
begin
|
|||
|
Read(HVersion, 1);
|
|||
|
Read(LVersion, 1);
|
|||
|
end;
|
|||
|
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);
|
|||
|
Read(Format, 4);
|
|||
|
FormatStr := ReadString(Stream);
|
|||
|
ReadMemo(Stream, Memo);
|
|||
|
if frVersion >= 23 then
|
|||
|
begin
|
|||
|
ReadMemo(Stream, Script);
|
|||
|
Read(Visible, 2);
|
|||
|
end;
|
|||
|
if frVersion >= 24 then
|
|||
|
begin
|
|||
|
Read(Restrictions, 2);
|
|||
|
Tag := ReadString(Stream);
|
|||
|
Read(gapx, 4);
|
|||
|
Read(gapy, 4);
|
|||
|
end;
|
|||
|
w := PInteger(@FrameWidth)^;
|
|||
|
if w <= 10 then
|
|||
|
w := w * 1000;
|
|||
|
if HVersion > 1 then
|
|||
|
Read(BandAlign, 1);
|
|||
|
FrameWidth := w / 1000;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrMemoViewLoadFromStream;
|
|||
|
var
|
|||
|
w: Word;
|
|||
|
i: Integer;
|
|||
|
Alignment: Integer;
|
|||
|
Highlight: TfrHighlightAttr;
|
|||
|
HighlightStr: String;
|
|||
|
LineSpacing, CharacterSpacing: Integer;
|
|||
|
m: TfrxMemoView;
|
|||
|
|
|||
|
procedure DecodeDisplayFormat;
|
|||
|
var
|
|||
|
LCategory: Byte;
|
|||
|
LType: Byte;
|
|||
|
LNoOfDecimals: Byte;
|
|||
|
LSeparator: Char;
|
|||
|
begin
|
|||
|
LCategory := (Format and $0F000000) shr 24;
|
|||
|
LType := (Format and $00FF0000) shr 16;
|
|||
|
LNoOfDecimals := (Format and $0000FF00) shr 8;
|
|||
|
LSeparator := Chr(Format and $000000FF);
|
|||
|
|
|||
|
case LCategory of
|
|||
|
0: { text }
|
|||
|
m.DisplayFormat.Kind := fkText;
|
|||
|
|
|||
|
1: { number }
|
|||
|
begin
|
|||
|
m.DisplayFormat.Kind := fkNumeric;
|
|||
|
m.DisplayFormat.DecimalSeparator := LSeparator;
|
|||
|
case LType of
|
|||
|
0: m.DisplayFormat.FormatStr := '%2.' + IntToStr(LNoOfDecimals) + 'g';
|
|||
|
1: m.DisplayFormat.FormatStr := '%g';
|
|||
|
2: m.DisplayFormat.FormatStr := '%2.' + IntToStr(LNoOfDecimals) + 'f';
|
|||
|
3: m.DisplayFormat.FormatStr := '%2.' + IntToStr(LNoOfDecimals) + 'n';
|
|||
|
else
|
|||
|
m.DisplayFormat.FormatStr := '%g' { can't convert custom format string };
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
2: { date }
|
|||
|
begin
|
|||
|
m.DisplayFormat.Kind := fkDateTime;
|
|||
|
case LType of
|
|||
|
0: m.DisplayFormat.FormatStr := 'dd.mm.yy';
|
|||
|
1: m.DisplayFormat.FormatStr := 'dd.mm.yyyy';
|
|||
|
2: m.DisplayFormat.FormatStr := 'd mmm yyyy';
|
|||
|
3: m.DisplayFormat.FormatStr := LongDateFormat;
|
|||
|
4: m.DisplayFormat.FormatStr := FormatStr;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
3: { time }
|
|||
|
begin
|
|||
|
m.DisplayFormat.Kind := fkDateTime;
|
|||
|
case LType of
|
|||
|
0: m.DisplayFormat.FormatStr := 'hh:nn:ss';
|
|||
|
1: m.DisplayFormat.FormatStr := 'h:nn:ss';
|
|||
|
2: m.DisplayFormat.FormatStr := 'hh:nn';
|
|||
|
3: m.DisplayFormat.FormatStr := 'h:nn';
|
|||
|
4: m.DisplayFormat.FormatStr := FormatStr;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
4: { boolean }
|
|||
|
begin
|
|||
|
m.DisplayFormat.Kind := fkBoolean;
|
|||
|
case LType of
|
|||
|
0: m.DisplayFormat.FormatStr := '0,1';
|
|||
|
1: m.DisplayFormat.FormatStr := '<27><><EFBFBD>,<2C><>';
|
|||
|
2: m.DisplayFormat.FormatStr := '_,X';
|
|||
|
3: m.DisplayFormat.FormatStr := 'False,True';
|
|||
|
4: m.DisplayFormat.FormatStr := FormatStr;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
TfrViewLoadFromStream;
|
|||
|
m := TfrxMemoView.Create(Page);
|
|||
|
SetfrxComponent(m);
|
|||
|
SetfrxView(m);
|
|||
|
|
|||
|
with Stream do
|
|||
|
begin
|
|||
|
{ font info }
|
|||
|
m.Font.Name := ReadString(Stream);
|
|||
|
Read(i, 4);
|
|||
|
m.Font.Size := i;
|
|||
|
Read(w, 2);
|
|||
|
m.Font.Style := frSetFontStyle(w);
|
|||
|
Read(i, 4);
|
|||
|
m.Font.Color := i;
|
|||
|
|
|||
|
{ text align, rotation }
|
|||
|
Read(Alignment, 4);
|
|||
|
if (Alignment and frtaRight) <> 0 then
|
|||
|
m.HAlign := haRight;
|
|||
|
if (Alignment and frtaCenter) <> 0 then
|
|||
|
m.HAlign := haCenter;
|
|||
|
if (Alignment and 3) = 3 then
|
|||
|
m.HAlign := haBlock;
|
|||
|
if (Alignment and frtaVertical) <> 0 then
|
|||
|
m.Rotation := 90;
|
|||
|
if (Alignment and frtaMiddle) <> 0 then
|
|||
|
m.VAlign := vaCenter;
|
|||
|
if (Alignment and frtaDown) <> 0 then
|
|||
|
m.VAlign := vaBottom;
|
|||
|
|
|||
|
{ charset }
|
|||
|
Read(w, 2);
|
|||
|
if frVersion < 23 then
|
|||
|
w := DEFAULT_CHARSET;
|
|||
|
m.Font.Charset := w;
|
|||
|
|
|||
|
Read(Highlight, 10);
|
|||
|
HighlightStr := ReadString(Stream);
|
|||
|
|
|||
|
m.Highlight.Condition := HighlightStr;
|
|||
|
m.Highlight.Color := Highlight.FillColor;
|
|||
|
m.Highlight.Font.Color := Highlight.FontColor;
|
|||
|
m.Highlight.Font.Style := frSetFontStyle(Highlight.FontStyle);
|
|||
|
|
|||
|
if frVersion >= 24 then
|
|||
|
begin
|
|||
|
Read(LineSpacing, 4);
|
|||
|
m.LineSpacing := LineSpacing;
|
|||
|
Read(CharacterSpacing, 4);
|
|||
|
m.CharSpacing := CharacterSpacing;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
if frVersion = 21 then
|
|||
|
Flags := Flags or flWordWrap;
|
|||
|
|
|||
|
if (Flags and flStretched) <> 0 then
|
|||
|
m.StretchMode := smMaxHeight;
|
|||
|
m.WordWrap := (Flags and flWordWrap) <> 0;
|
|||
|
m.WordBreak := (Flags and flWordBreak) <> 0;
|
|||
|
m.AutoWidth := (Flags and flAutoSize) <> 0;
|
|||
|
m.AllowExpressions := (Flags and flTextOnly) = 0;
|
|||
|
m.SuppressRepeated := (Flags and flSuppressRepeated) <> 0;
|
|||
|
m.HideZeros := (Flags and flHideZeros) <> 0;
|
|||
|
m.Underlines := (Flags and flUnderlines) <> 0;
|
|||
|
m.RTLReading := (Flags and flRTLReading) <> 0;
|
|||
|
|
|||
|
DecodeDisplayFormat;
|
|||
|
|
|||
|
ConvertMemoExpressions(m, Memo.Text);
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrPictureViewLoadFromStream;
|
|||
|
var
|
|||
|
b, BlobType: Byte;
|
|||
|
n: Integer;
|
|||
|
Graphic: TGraphic;
|
|||
|
TempStream: TMemoryStream;
|
|||
|
p: TfrxPictureView;
|
|||
|
begin
|
|||
|
TfrViewLoadFromStream;
|
|||
|
p := TfrxPictureView.Create(Page);
|
|||
|
SetfrxComponent(p);
|
|||
|
SetfrxView(p);
|
|||
|
|
|||
|
Stream.Read(b, 1);
|
|||
|
if HVersion * 10 + LVersion > 10 then
|
|||
|
Stream.Read(BlobType, 1);
|
|||
|
Stream.Read(n, 4);
|
|||
|
Graphic := nil;
|
|||
|
case b of
|
|||
|
pkBitmap: Graphic := TBitmap.Create;
|
|||
|
pkMetafile: Graphic := TMetafile.Create;
|
|||
|
pkIcon: Graphic := TIcon.Create;
|
|||
|
pkJPEG: Graphic := TJPEGImage.Create;
|
|||
|
end;
|
|||
|
p.Picture.Graphic := Graphic;
|
|||
|
if Graphic <> nil then
|
|||
|
begin
|
|||
|
Graphic.Free;
|
|||
|
TempStream := TMemoryStream.Create;
|
|||
|
TempStream.CopyFrom(Stream, n - Stream.Position);
|
|||
|
TempStream.Position := 0;
|
|||
|
p.Picture.Graphic.LoadFromStream(TempStream);
|
|||
|
TempStream.Free;
|
|||
|
end;
|
|||
|
Stream.Seek(n, soFromBeginning);
|
|||
|
|
|||
|
p.Stretched := (Flags and flStretched) <> 0;
|
|||
|
p.Center := (Flags and flPictCenter) <> 0;
|
|||
|
p.KeepAspectRatio := (Flags and flPictRatio) <> 0;
|
|||
|
if Memo.Count > 0 then
|
|||
|
p.DataField := Memo[0];
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrBandViewLoadFromStream;
|
|||
|
var
|
|||
|
ChildBand, Master: String;
|
|||
|
Columns: Integer;
|
|||
|
ColumnWidth: Integer;
|
|||
|
ColumnGap: Integer;
|
|||
|
NewColumnAfter: Integer;
|
|||
|
BandType: TfrBandType;
|
|||
|
Band: TfrxBand;
|
|||
|
begin
|
|||
|
TfrViewLoadFromStream;
|
|||
|
|
|||
|
BandType := TfrBandType(FrameTyp);
|
|||
|
Band := TfrxBand(Bands[BandType].NewInstance);
|
|||
|
Band.Create(Page);
|
|||
|
if BandType in [btCrossHeader..btCrossFooter] then
|
|||
|
Band.Vertical := True;
|
|||
|
SetfrxComponent(Band);
|
|||
|
AddScript(Band, 'OnBeforePrint(Sender: TfrxComponent);');
|
|||
|
|
|||
|
if frVersion > 23 then
|
|||
|
begin
|
|||
|
ChildBand := frReadString(Stream);
|
|||
|
if ChildBand <> '' then
|
|||
|
AddFixup(Band, 'Child', ChildBand);
|
|||
|
Stream.Read(Columns, 4);
|
|||
|
Stream.Read(ColumnWidth, 4);
|
|||
|
Stream.Read(ColumnGap, 4);
|
|||
|
{ not implemented }
|
|||
|
Stream.Read(NewColumnAfter, 4);
|
|||
|
{ not implemented }
|
|||
|
if HVersion * 10 + LVersion > 20 then
|
|||
|
Master := frReadString(Stream);
|
|||
|
if Band is TfrxDataBand then
|
|||
|
begin
|
|||
|
TfrxDataBand(Band).Columns := Columns;
|
|||
|
TfrxDataBand(Band).ColumnWidth := ColumnWidth;
|
|||
|
TfrxDataBand(Band).ColumnGap := ColumnGap;
|
|||
|
{$IFDEF Delphi12}
|
|||
|
if (FormatStr <> '') and CharInSet(FormatStr[1], ['1'..'9']) then
|
|||
|
{$ELSE}
|
|||
|
if (FormatStr <> '') and (FormatStr[1] in ['1'..'9']) then
|
|||
|
{$ENDIF}
|
|||
|
TfrxDataBand(Band).RowCount := StrToInt(FormatStr)
|
|||
|
else
|
|||
|
TfrxDataBand(Band).DatasetName := FormatStr;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
Band.Stretched := (Flags and flStretched) <> 0;
|
|||
|
Band.StartNewPage := (Flags and flBandNewPageAfter) <> 0;
|
|||
|
Band.PrintChildIfInvisible := (Flags and flBandPrintChildIfInvisible) <> 0;
|
|||
|
Band.AllowSplit := (Flags and flBandBreaked) <> 0;
|
|||
|
if Band is TfrxDataBand then
|
|||
|
TfrxDataBand(Band).PrintifDetailEmpty := (Flags and flBandPrintifSubsetEmpty) <> 0;
|
|||
|
if Band is TfrxPageHeader then
|
|||
|
TfrxPageHeader(Band).PrintOnFirstPage := (Flags and flBandOnFirstPage) <> 0;
|
|||
|
if Band is TfrxPageFooter then
|
|||
|
begin
|
|||
|
TfrxPageFooter(Band).PrintOnFirstPage := (Flags and flBandOnFirstPage) <> 0;
|
|||
|
TfrxPageFooter(Band).PrintOnLastPage := (Flags and flBandOnLastPage) <> 0;
|
|||
|
end;
|
|||
|
if Band is TfrxHeader then
|
|||
|
TfrxHeader(Band).ReprintOnNewPage := (Flags and flBandRepeatHeader) <> 0;
|
|||
|
if Band is TfrxGroupHeader then
|
|||
|
begin
|
|||
|
TfrxGroupHeader(Band).ReprintOnNewPage := (Flags and flBandRepeatHeader) <> 0;
|
|||
|
DoExpression(FormatStr, FormatStr);
|
|||
|
TfrxGroupHeader(Band).Condition := FormatStr;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrSubreportLoadFromStream;
|
|||
|
var
|
|||
|
s: TfrxSubreport;
|
|||
|
SubPage: Integer;
|
|||
|
begin
|
|||
|
TfrViewLoadFromStream;
|
|||
|
s := TfrxSubreport.Create(Page);
|
|||
|
SetfrxComponent(s);
|
|||
|
Stream.Read(SubPage, 4);
|
|||
|
s.Page := TfrxReportPage(Report.Pages[SubPage]);
|
|||
|
with s.Page do
|
|||
|
begin
|
|||
|
if Name = '' then
|
|||
|
CreateUniqueName;
|
|||
|
LeftMargin := 0;
|
|||
|
RightMargin := 0;
|
|||
|
TopMargin := 0;
|
|||
|
BottomMargin := 0;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrLineViewLoadFromStream;
|
|||
|
var
|
|||
|
Line: TfrxLineView;
|
|||
|
begin
|
|||
|
TfrViewLoadFromStream;
|
|||
|
Line := TfrxLineView.Create(Page);
|
|||
|
SetfrxComponent(Line);
|
|||
|
SetfrxView(Line);
|
|||
|
if (Flags and flStretched) <> 0 then
|
|||
|
Line.StretchMode := smMaxHeight;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadStdCtrl(c: TfrxDialogControl);
|
|||
|
begin
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(c);
|
|||
|
THackControl(c.Control).Color := frReadInteger(Stream);
|
|||
|
c.Control.Enabled := frReadBoolean(Stream);
|
|||
|
frReadFont(Stream, c.Font);
|
|||
|
AddScript(c, 'OnClick(Sender: TfrxComponent);');
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrLabelControl;
|
|||
|
var
|
|||
|
l: TfrxLabelControl;
|
|||
|
begin
|
|||
|
l := TfrxLabelControl.Create(Page);
|
|||
|
ReadStdCtrl(l);
|
|||
|
l.Alignment := TAlignment(frReadByte(Stream));
|
|||
|
l.AutoSize := frReadBoolean(Stream);
|
|||
|
l.Caption := frReadString(Stream);
|
|||
|
l.WordWrap := frReadBoolean(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrEditControl;
|
|||
|
var
|
|||
|
e: TfrxEditControl;
|
|||
|
begin
|
|||
|
e := TfrxEditControl.Create(Page);
|
|||
|
ReadStdCtrl(e);
|
|||
|
e.Text := frReadString(Stream);
|
|||
|
e.ReadOnly := frReadBoolean(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrMemoControl;
|
|||
|
var
|
|||
|
m: TfrxMemoControl;
|
|||
|
begin
|
|||
|
m := TfrxMemoControl.Create(Page);
|
|||
|
ReadStdCtrl(m);
|
|||
|
m.Text := frReadString(Stream);
|
|||
|
m.ReadOnly := frReadBoolean(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrButtonControl;
|
|||
|
var
|
|||
|
b: TfrxButtonControl;
|
|||
|
begin
|
|||
|
b := TfrxButtonControl.Create(Page);
|
|||
|
ReadStdCtrl(b);
|
|||
|
b.Caption := frReadString(Stream);
|
|||
|
b.ModalResult := frReadWord(Stream);
|
|||
|
b.Cancel := b.ModalResult = mrCancel;
|
|||
|
b.Default := b.ModalResult = mrOk;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrCheckBoxControl;
|
|||
|
var
|
|||
|
b: TfrxCheckBoxControl;
|
|||
|
begin
|
|||
|
b := TfrxCheckBoxControl.Create(Page);
|
|||
|
ReadStdCtrl(b);
|
|||
|
b.Alignment := TAlignment(frReadByte(Stream));
|
|||
|
b.Checked := frReadBoolean(Stream);
|
|||
|
b.Caption := frReadString(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrRadioButtonControl;
|
|||
|
var
|
|||
|
b: TfrxRadioButtonControl;
|
|||
|
begin
|
|||
|
b := TfrxRadioButtonControl.Create(Page);
|
|||
|
ReadStdCtrl(b);
|
|||
|
b.Alignment := TAlignment(frReadByte(Stream));
|
|||
|
b.Checked := frReadBoolean(Stream);
|
|||
|
b.Caption := frReadString(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrListBoxControl;
|
|||
|
var
|
|||
|
b: TfrxListBoxControl;
|
|||
|
begin
|
|||
|
b := TfrxListBoxControl.Create(Page);
|
|||
|
ReadStdCtrl(b);
|
|||
|
frReadMemo(Stream, b.Items);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrComboBoxControl;
|
|||
|
var
|
|||
|
c: TfrxComboBoxControl;
|
|||
|
b: Byte;
|
|||
|
begin
|
|||
|
c := TfrxComboBoxControl.Create(Page);
|
|||
|
ReadStdCtrl(c);
|
|||
|
frReadMemo(Stream, c.Items);
|
|||
|
if HVersion * 10 + LVersion > 10 then
|
|||
|
begin
|
|||
|
b := frReadByte(Stream);
|
|||
|
if (HVersion * 10 + LVersion <= 20) and (b > 0) then
|
|||
|
Inc(b);
|
|||
|
c.Style := TComboBoxStyle(b);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrDateEditControl;
|
|||
|
var
|
|||
|
b: TfrxDateEditControl;
|
|||
|
begin
|
|||
|
b := TfrxDateEditControl.Create(Page);
|
|||
|
ReadStdCtrl(b);
|
|||
|
b.DateFormat := TDTDateFormat(frReadByte(Stream));
|
|||
|
b.Time := 0;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrDBLookupControl;
|
|||
|
var
|
|||
|
c: TfrxDBLookupComboBox;
|
|||
|
begin
|
|||
|
c := TfrxDBLookupComboBox.Create(Page);
|
|||
|
ReadStdCtrl(c);
|
|||
|
c.DataSetName := frReadString(Stream);
|
|||
|
c.KeyField := frReadString(Stream);
|
|||
|
c.ListField := frReadString(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrBarcodeView;
|
|||
|
var
|
|||
|
v: TfrxBarcodeView;
|
|||
|
Param: TfrBarcodeRec;
|
|||
|
begin
|
|||
|
v := TfrxBarcodeView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
Stream.Read(Param, SizeOf(Param));
|
|||
|
if Param.cModul = 1 then
|
|||
|
begin
|
|||
|
Param.cRatio := Param.cRatio / 2;
|
|||
|
Param.cModul := 2;
|
|||
|
end;
|
|||
|
|
|||
|
if (Memo.Count > 0) and (Memo[0][1] <> '[') then
|
|||
|
v.Text := Memo[0] else
|
|||
|
v.Expression := Memo[0];
|
|||
|
|
|||
|
v.Rotation := Round(Param.cAngle);
|
|||
|
v.CalcChecksum := Param.cCheckSum;
|
|||
|
v.BarType := Param.cBarType;
|
|||
|
v.Zoom := Param.cRatio;
|
|||
|
v.ShowText := Param.cShowText;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrChartView;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxChartView;
|
|||
|
b: Byte;
|
|||
|
ChartOptions: TChartOptions;
|
|||
|
LegendObj, ValueObj, Top10Label: String;
|
|||
|
Ser: TChartSeries;
|
|||
|
dser: TfrxSeriesItem;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxChartView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
Stream.Read(b, 1);
|
|||
|
if b <> 1 then
|
|||
|
with Stream do
|
|||
|
begin
|
|||
|
Read(ChartOptions, SizeOf(ChartOptions));
|
|||
|
LegendObj := frReadString(Stream);
|
|||
|
ValueObj := frReadString(Stream);
|
|||
|
Top10Label := frReadString(Stream);
|
|||
|
end;
|
|||
|
|
|||
|
v.Chart.Frame.Visible := False;
|
|||
|
v.Chart.LeftWall.Brush.Style := bsClear;
|
|||
|
v.Chart.BottomWall.Brush.Style := bsClear;
|
|||
|
|
|||
|
v.Chart.View3D := ChartOptions.Dim3D;
|
|||
|
v.Chart.Legend.Visible := ChartOptions.ShowLegend;
|
|||
|
v.Chart.AxisVisible := ChartOptions.ShowAxis;
|
|||
|
v.Chart.View3DWalls := ChartOptions.ChartType <> 5;
|
|||
|
v.Chart.BackWall.Brush.Style := bsClear;
|
|||
|
v.Chart.View3DOptions.Elevation := 315;
|
|||
|
v.Chart.View3DOptions.Rotation := 360;
|
|||
|
v.Chart.View3DOptions.Orthogonal := ChartOptions.ChartType <> 5;
|
|||
|
|
|||
|
Ser := ChartTypes[ChartOptions.ChartType].Create(v.Chart);
|
|||
|
v.Chart.AddSeries(Ser);
|
|||
|
if ChartOptions.Colored then
|
|||
|
Ser.ColorEachPoint := True;
|
|||
|
Ser.Marks.Visible := ChartOptions.ShowMarks;
|
|||
|
Ser.Marks.Style := TSeriesMarksStyle(ChartOptions.MarksStyle);
|
|||
|
|
|||
|
dser := v.SeriesData.Add;
|
|||
|
dser.DataType := dtBandData;
|
|||
|
dser.XSource := LegendObj;
|
|||
|
dser.YSource := ValueObj;
|
|||
|
dser.TopN := ChartOptions.Top10Num;
|
|||
|
dser.TopNCaption := Top10Label;
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrCheckBoxView;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxCheckBoxView;
|
|||
|
CheckStyle: Byte;
|
|||
|
CheckColor: TColor;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxCheckBoxView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
if frVersion > 23 then
|
|||
|
begin
|
|||
|
Stream.Read(CheckStyle, 1);
|
|||
|
v.CheckStyle := TfrxCheckStyle(CheckStyle);
|
|||
|
Stream.Read(CheckColor, 4);
|
|||
|
v.CheckColor := CheckColor;
|
|||
|
end;
|
|||
|
if Memo.Count > 0 then
|
|||
|
v.Expression := Memo[0];
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrOLEView;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxOLEView;
|
|||
|
b: Byte;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxOLEView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
Stream.Read(b, 1);
|
|||
|
if b <> 0 then
|
|||
|
v.OleContainer.LoadFromStream(Stream);
|
|||
|
if Memo.Count > 0 then
|
|||
|
v.DataField := Memo[0];
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrRichView;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxRichView;
|
|||
|
b: Byte;
|
|||
|
n: Integer;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxRichView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
if (Flags and flStretched) <> 0 then
|
|||
|
v.StretchMode := smMaxHeight;
|
|||
|
Stream.Read(b, 1);
|
|||
|
Stream.Read(n, 4);
|
|||
|
if b <> 0 then
|
|||
|
v.RichEdit.Lines.LoadFromStream(Stream);
|
|||
|
Stream.Seek(n, soFromBeginning);
|
|||
|
if Memo.Count > 0 then
|
|||
|
v.DataField := Memo[0];
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrShapeView;
|
|||
|
var
|
|||
|
v: TfrxShapeView;
|
|||
|
ShapeType: Byte;
|
|||
|
begin
|
|||
|
v := TfrxShapeView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
Stream.Read(ShapeType, 1);
|
|||
|
v.Shape := TfrxShapeKind(ShapeType);
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrRoundRectView;
|
|||
|
var
|
|||
|
v: TfrxShapeView;
|
|||
|
Cadre: TfrRoundRect;
|
|||
|
begin
|
|||
|
v := TfrxShapeView.Create(Page);
|
|||
|
v.Shape := skRoundRectangle;
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
Stream.Read(Cadre, SizeOf(Cadre));
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrCrossView;
|
|||
|
var
|
|||
|
v: TfrxDBCrossView;
|
|||
|
sl: TStringList;
|
|||
|
s: String;
|
|||
|
i: Integer;
|
|||
|
|
|||
|
function PureName1(const s: String): String;
|
|||
|
begin
|
|||
|
if Pos('+', s) <> 0 then
|
|||
|
Result := Copy(s, 1, Pos('+', s) - 1) else
|
|||
|
Result := s;
|
|||
|
end;
|
|||
|
|
|||
|
function HasTotal(s: String): Boolean;
|
|||
|
begin
|
|||
|
Result := Pos('+', s) <> 0;
|
|||
|
end;
|
|||
|
|
|||
|
function FuncName(s: String): String;
|
|||
|
begin
|
|||
|
if HasTotal(s) then
|
|||
|
begin
|
|||
|
Result := LowerCase(Copy(s, Pos('+', s) + 1, 255));
|
|||
|
if Result = '' then
|
|||
|
Result := 'sum';
|
|||
|
end
|
|||
|
else
|
|||
|
Result := '';
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
v := TfrxDBCrossView.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
SetfrxView(v);
|
|||
|
|
|||
|
v.Border := frReadBoolean(Stream);
|
|||
|
v.RepeatHeaders := frReadBoolean(Stream);
|
|||
|
v.GapY := 1;
|
|||
|
v.Visible := True;
|
|||
|
{ show header, not used }
|
|||
|
frReadBoolean(Stream);
|
|||
|
if LVersion > 0 then
|
|||
|
begin
|
|||
|
v.ShowColumnTotal := frReadBoolean(Stream);
|
|||
|
v.ShowRowTotal := v.ShowColumnTotal;
|
|||
|
v.MaxWidth := frReadInteger(Stream);
|
|||
|
{FHeaderWidth := }frReadInteger(Stream);
|
|||
|
end;
|
|||
|
if LVersion > 1 then
|
|||
|
begin
|
|||
|
{FDictionary.Text := }frReadString(Stream);
|
|||
|
{FMaxNameLen := }frReadInteger(Stream);
|
|||
|
end;
|
|||
|
if LVersion > 2 then
|
|||
|
{FDataCaption := }frReadString(Stream);
|
|||
|
|
|||
|
sl := TStringList.Create;
|
|||
|
|
|||
|
if Memo.Count >= 4 then
|
|||
|
begin
|
|||
|
v.DataSetName := Memo[0];
|
|||
|
|
|||
|
frxSetCommaText(Memo[1], sl);
|
|||
|
v.RowLevels := sl.Count;
|
|||
|
v.RowFields.Clear;
|
|||
|
for i := 0 to sl.Count - 1 do
|
|||
|
begin
|
|||
|
s := PureName1(sl[i]); {row field name }
|
|||
|
v.RowFields.Add(s);
|
|||
|
v.RowTotalMemos[i + 1].Visible := s <> sl[i];
|
|||
|
end;
|
|||
|
|
|||
|
frxSetCommaText(Memo[2], sl);
|
|||
|
v.ColumnLevels := sl.Count;
|
|||
|
v.ColumnFields.Clear;
|
|||
|
for i := 0 to sl.Count - 1 do
|
|||
|
begin
|
|||
|
s := PureName1(sl[i]); {column field name }
|
|||
|
v.ColumnFields.Add(s);
|
|||
|
v.ColumnTotalMemos[i + 1].Visible := s <> sl[i];
|
|||
|
end;
|
|||
|
|
|||
|
frxSetCommaText(Memo[3], sl);
|
|||
|
v.CellLevels := sl.Count;
|
|||
|
v.CellFields.Clear;
|
|||
|
for i := 0 to sl.Count - 1 do
|
|||
|
begin
|
|||
|
s := PureName1(sl[i]); {column field name }
|
|||
|
v.CellFields.Add(s);
|
|||
|
s := FuncName(sl[i]);
|
|||
|
if s = 'sum' then
|
|||
|
v.CellFunctions[i] := cfSum
|
|||
|
else if s = 'avg' then
|
|||
|
v.CellFunctions[i] := cfAvg
|
|||
|
else if s = 'min' then
|
|||
|
v.CellFunctions[i] := cfMin
|
|||
|
else if s = 'max' then
|
|||
|
v.CellFunctions[i] := cfMax
|
|||
|
else if s = 'count' then
|
|||
|
v.CellFunctions[i] := cfCount
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
sl.Free;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
{------------------------- datacontrols --------------------------------------}
|
|||
|
procedure ReadTfrBDEDatabase;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxBDEDatabase;
|
|||
|
s: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxBDEDatabase.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
|
|||
|
v.DatabaseName := frReadString(Stream);
|
|||
|
s := frReadString(Stream);
|
|||
|
if s <> '' then
|
|||
|
v.AliasName := s;
|
|||
|
s := frReadString(Stream);
|
|||
|
if s <> '' then
|
|||
|
v.DriverName := s;
|
|||
|
v.LoginPrompt := frReadBoolean(Stream);
|
|||
|
frReadMemo(Stream, v.Params);
|
|||
|
v.Connected := frReadBoolean(Stream);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
{ field list is not stored in FR3, just skip }
|
|||
|
procedure TfrXXXDataSetReadFields;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
n: Word;
|
|||
|
fLookup: Boolean;
|
|||
|
b: Byte;
|
|||
|
begin
|
|||
|
Stream.Read(n, 2); // FieldCount
|
|||
|
for i := 0 to n - 1 do
|
|||
|
begin
|
|||
|
|
|||
|
// Old version of BDEComponents stores fieldlist wrongfully
|
|||
|
if HVersion * 10 + LVersion <= 10 then
|
|||
|
begin
|
|||
|
b := frReadByte(Stream); // islookup
|
|||
|
frReadString(Stream); // fieldname
|
|||
|
if b = 1 then
|
|||
|
begin
|
|||
|
frReadByte(Stream); // datatype
|
|||
|
frReadWord(Stream); // size
|
|||
|
frReadString(Stream); // KeyFields
|
|||
|
frReadString(Stream); // LookupDataset
|
|||
|
frReadString(Stream); // LookupKeyFields
|
|||
|
frReadString(Stream); // LookupResultField
|
|||
|
end;
|
|||
|
continue;
|
|||
|
end;
|
|||
|
|
|||
|
frReadByte(Stream); // DataType
|
|||
|
frReadString(Stream); // FieldName
|
|||
|
fLookup := frReadBoolean(Stream); // Lookup
|
|||
|
frReadWord(Stream); // Size
|
|||
|
|
|||
|
if fLookup then
|
|||
|
begin
|
|||
|
frReadString(Stream); // KeyFields
|
|||
|
frReadString(Stream); // LookupDataset
|
|||
|
frReadString(Stream); // LookupKeyFields
|
|||
|
frReadString(Stream); // LookupResultField
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrBDETable;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxBDETable;
|
|||
|
master: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxBDETable.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
v.SetBounds(-1000, -1000, 0, 0);
|
|||
|
|
|||
|
v.DatabaseName := frReadString(Stream);
|
|||
|
v.Filter := frReadString(Stream);
|
|||
|
v.Filtered := Trim(v.Filter) <> '';
|
|||
|
v.IndexName := frReadString(Stream);
|
|||
|
v.MasterFields := frReadString(Stream);
|
|||
|
master := frReadString(Stream);
|
|||
|
if master <> '' then
|
|||
|
AddFixup(v, 'Master', master);
|
|||
|
v.TableName := frReadString(Stream);
|
|||
|
frReadBoolean(Stream); // active
|
|||
|
TfrXXXDataSetReadFields;
|
|||
|
Report.Datasets.Add(v);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrXXXQueryReadParams(Query: TfrxCustomQuery);
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
w, n: Word;
|
|||
|
Ln: Integer;
|
|||
|
Exp: String;
|
|||
|
begin
|
|||
|
Stream.Read(n, 2);
|
|||
|
for i := 0 to n - 1 do
|
|||
|
with Query.Params[i] do
|
|||
|
begin
|
|||
|
Stream.Read(w, 2);
|
|||
|
DataType := ParamTypes[w];
|
|||
|
Stream.Read(w, 2);
|
|||
|
Exp := frReadString(Stream);
|
|||
|
Ln := Length(Exp);
|
|||
|
Exp := LowerCase(Exp);
|
|||
|
if (Pos('.date',Exp) = Ln - 5) then
|
|||
|
begin
|
|||
|
if Exp[1] = '[' then Delete(Exp, 1, 1);
|
|||
|
if Exp[Length(Exp)] = ']' then Delete(Exp, Length(Exp), 1);
|
|||
|
end
|
|||
|
else
|
|||
|
begin
|
|||
|
if Exp[1] = '[' then Exp[1] := '<';
|
|||
|
if Exp[Ln] = ']' then Exp[Ln] := '>';
|
|||
|
end;
|
|||
|
Expression := Exp;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrBDEQuery;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxBDEQuery;
|
|||
|
master: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxBDEQuery.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
v.SetBounds(-1000, -1000, 0, 0);
|
|||
|
|
|||
|
v.DatabaseName := frReadString(Stream);
|
|||
|
v.Filter := frReadString(Stream);
|
|||
|
v.Filtered := Trim(v.Filter) <> '';
|
|||
|
master := frReadString(Stream);
|
|||
|
if master <> '' then
|
|||
|
AddFixup(v, 'Master', master);
|
|||
|
frReadMemo(Stream, v.SQL);
|
|||
|
|
|||
|
frReadBoolean(Stream);
|
|||
|
TfrXXXDataSetReadFields;
|
|||
|
TfrXXXQueryReadParams(v);
|
|||
|
v.IsLoading := True;
|
|||
|
v.UpdateParams;
|
|||
|
v.IsLoading := False;
|
|||
|
Report.Datasets.Add(v);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrADODatabase;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxADODatabase;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxADODatabase.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
|
|||
|
v.DatabaseName := frReadString(Stream);
|
|||
|
v.LoginPrompt := frReadBoolean(Stream);
|
|||
|
v.Connected := frReadBoolean(Stream);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrADOTable;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxADOTable;
|
|||
|
master: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxADOTable.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
v.SetBounds(-1000, -1000, 0, 0);
|
|||
|
|
|||
|
AddFixup(v, 'Database', frReadString(Stream));
|
|||
|
v.Filter := frReadString(Stream);
|
|||
|
v.Filtered := Trim(v.Filter) <> '';
|
|||
|
v.IndexName := frReadString(Stream);
|
|||
|
v.MasterFields := frReadString(Stream);
|
|||
|
master := frReadString(Stream);
|
|||
|
if master <> '' then
|
|||
|
AddFixup(v, 'Master', master);
|
|||
|
v.TableName := frReadString(Stream);
|
|||
|
frReadBoolean(Stream); // active
|
|||
|
if LVersion >= 2 then
|
|||
|
frReadBoolean(Stream); // enableBCD
|
|||
|
TfrXXXDataSetReadFields;
|
|||
|
Report.Datasets.Add(v);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrADOQuery;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxADOQuery;
|
|||
|
master: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxADOQuery.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
v.SetBounds(-1000, -1000, 0, 0);
|
|||
|
|
|||
|
AddFixup(v, 'Database', frReadString(Stream));
|
|||
|
v.Filter := frReadString(Stream);
|
|||
|
v.Filtered := Trim(v.Filter) <> '';
|
|||
|
master := frReadString(Stream);
|
|||
|
if master <> '' then
|
|||
|
AddFixup(v, 'Master', master);
|
|||
|
frReadMemo(Stream, v.SQL);
|
|||
|
|
|||
|
frReadBoolean(Stream); // active
|
|||
|
if LVersion >= 2 then
|
|||
|
frReadBoolean(Stream); // enableBCD
|
|||
|
|
|||
|
TfrXXXDataSetReadFields;
|
|||
|
TfrXXXQueryReadParams(v);
|
|||
|
v.IsLoading := True;
|
|||
|
v.UpdateParams;
|
|||
|
v.IsLoading := False;
|
|||
|
Report.Datasets.Add(v);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrIBXDatabase;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxIBXDatabase;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxIBXDatabase.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
|
|||
|
v.DatabaseName := frReadString(Stream);
|
|||
|
v.LoginPrompt := frReadBoolean(Stream);
|
|||
|
if HVersion * 10 + LVersion > 20 then
|
|||
|
v.SQLDialect := frReadInteger(Stream);
|
|||
|
frReadMemo(Stream, v.Params);
|
|||
|
v.Connected := frReadBoolean(Stream);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrIBXTable;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxIBXTable;
|
|||
|
master: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxIBXTable.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
v.SetBounds(-1000, -1000, 0, 0);
|
|||
|
|
|||
|
AddFixup(v, 'Database', frReadString(Stream));
|
|||
|
v.TableName := frReadString(Stream);
|
|||
|
v.Filter := frReadString(Stream);
|
|||
|
v.Filtered := Trim(v.Filter) <> '';
|
|||
|
v.IndexName := frReadString(Stream);
|
|||
|
v.IndexFieldNames := frReadString(Stream);
|
|||
|
v.MasterFields := frReadString(Stream);
|
|||
|
master := frReadString(Stream);
|
|||
|
if master <> '' then
|
|||
|
AddFixup(v, 'Master', master);
|
|||
|
frReadBoolean(Stream); // active
|
|||
|
TfrXXXDataSetReadFields;
|
|||
|
Report.Datasets.Add(v);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadTfrIBXQuery;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
v: TfrxIBXQuery;
|
|||
|
master: String;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
v := TfrxIBXQuery.Create(Page);
|
|||
|
TfrViewLoadFromStream;
|
|||
|
SetfrxComponent(v);
|
|||
|
v.SetBounds(-1000, -1000, 0, 0);
|
|||
|
|
|||
|
AddFixup(v, 'Database', frReadString(Stream));
|
|||
|
v.Filter := frReadString(Stream);
|
|||
|
v.Filtered := Trim(v.Filter) <> '';
|
|||
|
master := frReadString(Stream);
|
|||
|
if master <> '' then
|
|||
|
AddFixup(v, 'Master', master);
|
|||
|
frReadMemo(Stream, v.SQL);
|
|||
|
frReadBoolean(Stream); // active
|
|||
|
|
|||
|
TfrXXXDataSetReadFields;
|
|||
|
TfrXXXQueryReadParams(v);
|
|||
|
v.IsLoading := True;
|
|||
|
v.UpdateParams;
|
|||
|
v.IsLoading := False;
|
|||
|
Report.Datasets.Add(v);
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
|
|||
|
{----------------------------------------------------------------------------}
|
|||
|
procedure TfrDictionaryLoadFromStream;
|
|||
|
var
|
|||
|
w: Word;
|
|||
|
NewVersion: Boolean;
|
|||
|
Variables, FieldAliases, BandDatasources: TfrxVariables;
|
|||
|
SMemo: TStringList;
|
|||
|
|
|||
|
procedure LoadFRVariables(Value: TfrxVariables);
|
|||
|
var
|
|||
|
i, n: Integer;
|
|||
|
s: String;
|
|||
|
begin
|
|||
|
Stream.Read(n, 4);
|
|||
|
for i := 0 to n - 1 do
|
|||
|
begin
|
|||
|
s := frReadString(Stream);
|
|||
|
Value[s] := frReadString(Stream);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure LoadOldVariables;
|
|||
|
var
|
|||
|
i, n, d: Integer;
|
|||
|
b: Byte;
|
|||
|
s, s1, s2: String;
|
|||
|
|
|||
|
function ReadStr: String;
|
|||
|
var
|
|||
|
n: Byte;
|
|||
|
begin
|
|||
|
Stream.Read(n, 1);
|
|||
|
SetLength(Result, n);
|
|||
|
Stream.Read(Result[1], n);
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
with Stream do
|
|||
|
begin
|
|||
|
ReadBuffer(n, SizeOf(n));
|
|||
|
for i := 0 to n - 1 do
|
|||
|
begin
|
|||
|
Read(b, 1); // typ
|
|||
|
Read(d, 4); // otherkind
|
|||
|
s1 := ReadStr; // dataset
|
|||
|
s2 := ReadStr; // field
|
|||
|
s := ReadStr; // var name
|
|||
|
if b = 2 then // it's system variable or expression
|
|||
|
if d = 1 then
|
|||
|
s1 := s2 else
|
|||
|
s1 := frSpecFuncs[d]
|
|||
|
else if b = 1 then // it's data field
|
|||
|
s1 := s1 + '."' + s2 + '"'
|
|||
|
else
|
|||
|
s1 := '';
|
|||
|
FieldAliases[' ' + s] := s1;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
ReadMemo(Stream, SMemo);
|
|||
|
for i := 0 to SMemo.Count - 1 do
|
|||
|
begin
|
|||
|
s := SMemo[i];
|
|||
|
if (s <> '') and (s[1] <> ' ') then
|
|||
|
Variables[s] := '' else
|
|||
|
Variables[s] := FieldAliases[s];
|
|||
|
end;
|
|||
|
FieldAliases.Clear;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ConvertToNewFormat;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
s: String;
|
|||
|
begin
|
|||
|
for i := 0 to Variables.Count - 1 do
|
|||
|
begin
|
|||
|
s := Variables.Items[i].Name;
|
|||
|
if s <> '' then
|
|||
|
if s[1] = ' ' then
|
|||
|
s := Copy(s, 2, 255) else
|
|||
|
s := ' ' + s;
|
|||
|
Variables.Items[i].Name := s;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
Variables := TfrxVariables.Create;
|
|||
|
FieldAliases := TfrxVariables.Create;
|
|||
|
BandDatasources := TfrxVariables.Create;
|
|||
|
SMemo := TStringList.Create;
|
|||
|
|
|||
|
w := frReadWord(Stream);
|
|||
|
NewVersion := (w = $FFFF) or (w = $FFFE);
|
|||
|
if NewVersion then
|
|||
|
begin
|
|||
|
LoadFRVariables(Variables);
|
|||
|
LoadFRVariables(FieldAliases);
|
|||
|
LoadFRVariables(BandDatasources);
|
|||
|
end
|
|||
|
else
|
|||
|
begin
|
|||
|
Stream.Seek(-2, soFromCurrent);
|
|||
|
LoadOldVariables;
|
|||
|
end;
|
|||
|
if (Variables.Count > 0) and (Variables.Items[0].Name <> '') and (Variables.Items[0].Name[1] <> ' ') then
|
|||
|
ConvertToNewFormat;
|
|||
|
{ if w = $FFFF then
|
|||
|
ConvertAliases;}
|
|||
|
|
|||
|
Report.Variables.Assign(Variables);
|
|||
|
Variables.Free;
|
|||
|
FieldAliases.Free;
|
|||
|
BandDatasources.Free;
|
|||
|
SMemo.Free;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrPageLoadFromStream;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
b: Byte;
|
|||
|
s: String[6];
|
|||
|
|
|||
|
pgSize, pgWidth, pgHeight: Integer;
|
|||
|
pgMargins: TRect;
|
|||
|
pgOr: TPrinterOrientation;
|
|||
|
pgBin: Integer;
|
|||
|
PrintToPrevPage, UseMargins: WordBool;
|
|||
|
ColCount, ColGap: Integer;
|
|||
|
PageType: TfrPageType;
|
|||
|
// dialog properties
|
|||
|
BorderStyle: Byte;
|
|||
|
Color: TColor;
|
|||
|
Left, Top, Width, Height: Integer;
|
|||
|
|
|||
|
ReportPage: TfrxReportPage;
|
|||
|
DialogPage: TfrxDialogPage;
|
|||
|
ColWidth: Extended;
|
|||
|
begin
|
|||
|
ReportPage := TfrxReportPage.Create(nil);
|
|||
|
DialogPage := TfrxDialogPage.Create(nil);
|
|||
|
PageType := ptReport;
|
|||
|
|
|||
|
with Stream do
|
|||
|
begin
|
|||
|
{ paper size }
|
|||
|
Read(i, 4);
|
|||
|
if i = -1 then
|
|||
|
Read(pgSize, 4) else
|
|||
|
pgSize := i;
|
|||
|
ReportPage.PaperSize := pgSize;
|
|||
|
|
|||
|
{ width }
|
|||
|
Read(pgWidth, 4);
|
|||
|
|
|||
|
{ height }
|
|||
|
Read(pgHeight, 4);
|
|||
|
|
|||
|
{ margins }
|
|||
|
Read(pgMargins, Sizeof(pgMargins));
|
|||
|
pgMargins.Left := pgMargins.Left * 5 div 18;
|
|||
|
pgMargins.Top := pgMargins.Top * 5 div 18;
|
|||
|
pgMargins.Right := pgMargins.Right * 5 div 18;
|
|||
|
pgMargins.Bottom := pgMargins.Bottom * 5 div 18;
|
|||
|
if (pgMargins.Left = 0) and (pgMargins.Top = 0) and
|
|||
|
(pgMargins.Right = 0) and (pgMargins.Bottom = 0) then
|
|||
|
begin
|
|||
|
pgMargins.Left := Round(frxPrinters.Printer.LeftMargin);
|
|||
|
pgMargins.Top := Round(frxPrinters.Printer.TopMargin);
|
|||
|
pgMargins.Right := Round(frxPrinters.Printer.RightMargin);
|
|||
|
pgMargins.Bottom := Round(frxPrinters.Printer.BottomMargin);
|
|||
|
end;
|
|||
|
ReportPage.LeftMargin := pgMargins.Left;
|
|||
|
ReportPage.TopMargin := pgMargins.Top;
|
|||
|
ReportPage.RightMargin := pgMargins.Right;
|
|||
|
ReportPage.BottomMargin := pgMargins.Bottom;
|
|||
|
|
|||
|
{ orientation }
|
|||
|
Read(b, 1);
|
|||
|
pgOr := TPrinterOrientation(b);
|
|||
|
ReportPage.Orientation := pgOr;
|
|||
|
|
|||
|
ReportPage.PaperWidth := pgWidth / 10;
|
|||
|
ReportPage.PaperHeight := pgHeight / 10;
|
|||
|
|
|||
|
if frVersion < 23 then
|
|||
|
Read(s[1], 6);
|
|||
|
|
|||
|
{ bin }
|
|||
|
pgBin := -1;
|
|||
|
if frVersion > 23 then
|
|||
|
Read(pgBin, 4);
|
|||
|
ReportPage.Bin := pgBin;
|
|||
|
ReportPage.BinOtherPages := pgBin;
|
|||
|
|
|||
|
{ print to prevpage }
|
|||
|
Read(PrintToPrevPage, 2);
|
|||
|
ReportPage.PrintOnPreviousPage := PrintToPrevPage;
|
|||
|
|
|||
|
{ not used }
|
|||
|
Read(UseMargins, 2);
|
|||
|
|
|||
|
{ columns }
|
|||
|
Read(ColCount, 4);
|
|||
|
ReportPage.Columns := ColCount;
|
|||
|
|
|||
|
{ not used }
|
|||
|
Read(ColGap, 4);
|
|||
|
|
|||
|
if ColGap <> 0 then
|
|||
|
begin
|
|||
|
ColGap := Round(ColGap / 18 * 5);
|
|||
|
ReportPage.ColumnPositions.Clear;
|
|||
|
if ColCount > 0 then
|
|||
|
begin
|
|||
|
ColWidth := (ReportPage.PaperWidth - ReportPage.LeftMargin - ReportPage.RightMargin + ColGap) / ColCount;
|
|||
|
ReportPage.ColumnWidth := ColWidth - ColGap;
|
|||
|
while ReportPage.ColumnPositions.Count < ColCount do
|
|||
|
ReportPage.ColumnPositions.Add(FloatToStr(ReportPage.ColumnPositions.Count * ColWidth));
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
if frVersion > 23 then
|
|||
|
begin
|
|||
|
{ page type }
|
|||
|
Read(PageType, 1);
|
|||
|
|
|||
|
{ name }
|
|||
|
ReportPage.Name := frReadString(Stream);
|
|||
|
//DialogPage.Name := ReportPage.Name;
|
|||
|
|
|||
|
{ border style }
|
|||
|
Read(BorderStyle, 1);
|
|||
|
if BorderStyle = 0 then
|
|||
|
BorderStyle := Byte(bsDialog)
|
|||
|
else if BorderStyle = 1 then
|
|||
|
BorderStyle := Byte(bsSizeable);
|
|||
|
DialogPage.BorderStyle := TFormBorderStyle(BorderStyle);
|
|||
|
|
|||
|
{ caption }
|
|||
|
DialogPage.Caption := frReadString(Stream);
|
|||
|
|
|||
|
{ color }
|
|||
|
Read(Color, 4);
|
|||
|
DialogPage.Color := Color;
|
|||
|
|
|||
|
{ left-top-width-height }
|
|||
|
Read(Left, 4);
|
|||
|
Read(Top, 4);
|
|||
|
Read(Width, 4);
|
|||
|
Read(Height, 4);
|
|||
|
DialogPage.Left := Left;
|
|||
|
DialogPage.Top := Top;
|
|||
|
DialogPage.Width := Width;
|
|||
|
DialogPage.Height := Height;
|
|||
|
|
|||
|
{ position }
|
|||
|
Read(b, 1);
|
|||
|
if b <> 0 then
|
|||
|
b := Byte(poScreenCenter);
|
|||
|
DialogPage.Position := TPosition(b);
|
|||
|
|
|||
|
if i = -1 then
|
|||
|
begin
|
|||
|
Script := TStringList.Create;
|
|||
|
frReadMemo(Stream, Script);
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
if PageType = ptReport then
|
|||
|
begin
|
|||
|
ReportPage.Parent := Report;
|
|||
|
if ReportPage.Name = '' then
|
|||
|
ReportPage.CreateUniqueName;
|
|||
|
DialogPage.Free;
|
|||
|
AddScript(ReportPage, 'OnBeforePrint(Sender: TfrxComponent);');
|
|||
|
end
|
|||
|
else
|
|||
|
begin
|
|||
|
DialogPage.Parent := Report;
|
|||
|
if DialogPage.Name = '' then
|
|||
|
DialogPage.CreateUniqueName;
|
|||
|
ReportPage.Free;
|
|||
|
AddScript(DialogPage, 'OnShow(Sender: TfrxComponent);');
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ReadReportOptions;
|
|||
|
var
|
|||
|
l: Word;
|
|||
|
buf: String;
|
|||
|
|
|||
|
ReportComment, ReportName, ReportAuthor : String;
|
|||
|
ReportCreateDate, ReportLastChange : TDateTime;
|
|||
|
ReportVersionMajor : String;
|
|||
|
ReportVersionMinor : String;
|
|||
|
ReportVersionRelease : String;
|
|||
|
ReportVersionBuild : String;
|
|||
|
ReportPasswordProtected : Boolean;
|
|||
|
ReportPassword : String;
|
|||
|
ReportGeneratorVersion : Byte;
|
|||
|
|
|||
|
function HexChar1(Ch : Char) : Byte;
|
|||
|
begin
|
|||
|
Ch := UpCase(Ch);
|
|||
|
if (Ch <= '9') then
|
|||
|
Result := Ord(Ch) - Ord('0')
|
|||
|
else
|
|||
|
Result := Ord(Ch) - Ord('A') + 10;
|
|||
|
end;
|
|||
|
|
|||
|
function HexToStr(const s : String) : String;
|
|||
|
var
|
|||
|
Len, i : Integer;
|
|||
|
Ch : Byte;
|
|||
|
NibbleH, NibbleL : Byte;
|
|||
|
begin
|
|||
|
Len := Length(s);
|
|||
|
SetLength(Result, Len shr 1);
|
|||
|
for i := 1 to Len shr 1 do begin
|
|||
|
NibbleH := HexChar1(s[i shl 1 - 1]);
|
|||
|
NibbleL := HexChar1(s[i shl 1]);
|
|||
|
Ch := NibbleH shl 4 or NibbleL;
|
|||
|
Result[i] := Chr(Ch);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportComment, l);
|
|||
|
Stream.Read(ReportComment[1], l);
|
|||
|
Report.ReportOptions.Description.Text := ReportComment;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportName, l);
|
|||
|
Stream.Read(ReportName[1], l);
|
|||
|
Report.ReportOptions.Name := ReportName;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportAuthor, l);
|
|||
|
Stream.Read(ReportAuthor[1], l);
|
|||
|
Report.ReportOptions.Author := ReportAuthor;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportVersionMajor, l);
|
|||
|
Stream.Read(ReportVersionMajor[1], l);
|
|||
|
Report.ReportOptions.VersionMajor := ReportVersionMajor;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportVersionMinor, l);
|
|||
|
Stream.Read(ReportVersionMinor[1], l);
|
|||
|
Report.ReportOptions.VersionMinor := ReportVersionMinor;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportVersionRelease, l);
|
|||
|
Stream.Read(ReportVersionRelease[1], l);
|
|||
|
Report.ReportOptions.VersionRelease := ReportVersionRelease;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(ReportVersionBuild, l);
|
|||
|
Stream.Read(ReportVersionBuild[1], l);
|
|||
|
Report.ReportOptions.VersionBuild := ReportVersionBuild;
|
|||
|
end;
|
|||
|
Stream.Read(l, 2);
|
|||
|
if l>0 then
|
|||
|
begin
|
|||
|
SetLength(Buf, l);
|
|||
|
Stream.Read(Buf[1], l);
|
|||
|
ReportPassword := HexToStr(buf);
|
|||
|
Report.ReportOptions.Password := ReportPassword;
|
|||
|
end;
|
|||
|
Stream.Read(ReportGeneratorVersion, 1);
|
|||
|
Stream.Read(ReportPasswordProtected, SizeOf(Boolean));
|
|||
|
Stream.Read(ReportCreateDate, SizeOf(TDateTime));
|
|||
|
Report.ReportOptions.CreateDate := ReportCreateDate;
|
|||
|
Stream.Read(ReportLastChange, SizeOf(TDateTime));
|
|||
|
Report.ReportOptions.LastChange := ReportLastChange;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrPagesLoadFromStream;
|
|||
|
var
|
|||
|
b, b1: Byte;
|
|||
|
w: Word;
|
|||
|
n: Integer;
|
|||
|
s: String;
|
|||
|
buf: String[8];
|
|||
|
PrintToDefault: Boolean;
|
|||
|
begin
|
|||
|
Stream.Read(w{Parent.PrintToDefault}, 2);
|
|||
|
PrintToDefault := w <> 0;
|
|||
|
Stream.Read(w{Parent.DoublePass}, 2);
|
|||
|
Report.EngineOptions.DoublePass := w <> 0;
|
|||
|
s := ReadString(Stream);
|
|||
|
if (s = #1) or PrintToDefault then
|
|||
|
s := 'Default';
|
|||
|
Report.PrintOptions.Printer := s;
|
|||
|
|
|||
|
while Stream.Position < Stream.Size do
|
|||
|
begin
|
|||
|
Stream.Read(b, 1);
|
|||
|
if b = $FF then // page info
|
|||
|
TfrPageLoadFromStream
|
|||
|
else if b = $FE then // data dictionary
|
|||
|
TfrDictionaryLoadFromStream
|
|||
|
else if b = $FD then // data manager, not supported
|
|||
|
begin
|
|||
|
break;
|
|||
|
end
|
|||
|
else if b = $FC then // extra report data
|
|||
|
begin
|
|||
|
ReadReportOptions;
|
|||
|
break;
|
|||
|
end
|
|||
|
else
|
|||
|
begin
|
|||
|
if b > Integer(gtAddIn) then
|
|||
|
begin
|
|||
|
raise Exception.Create('Error in frf file');
|
|||
|
break;
|
|||
|
end;
|
|||
|
s := ''; n := 0;
|
|||
|
try
|
|||
|
if b = gtAddIn then
|
|||
|
begin
|
|||
|
s := ReadString(Stream);
|
|||
|
if (AnsiUpperCase(s) = 'TFRBDELOOKUPCONTROL') or
|
|||
|
(AnsiUpperCase(s) = 'TFRIBXLOOKUPCONTROL') then
|
|||
|
s := 'TfrDBLookupControl';
|
|||
|
if AnsiUpperCase(s) = 'TFRFRAMEDMEMOVIEW' then
|
|||
|
b := gtMemo;
|
|||
|
end;
|
|||
|
|
|||
|
{ object's page }
|
|||
|
Stream.Read(b1, 1);
|
|||
|
Page := Report.Pages[b1];
|
|||
|
if Page is TfrxReportPage then
|
|||
|
begin
|
|||
|
offsx := Round(-TfrxReportPage(Page).LeftMargin * fr01cm);
|
|||
|
offsy := Round(-TfrxReportPage(Page).TopMargin * fr01cm);
|
|||
|
end
|
|||
|
else
|
|||
|
begin
|
|||
|
offsx := 0;
|
|||
|
offsy := 0;
|
|||
|
end;
|
|||
|
|
|||
|
if frVersion > 23 then
|
|||
|
Stream.Read(n, 4);
|
|||
|
|
|||
|
case b of
|
|||
|
gtMemo: TfrMemoViewLoadFromStream;
|
|||
|
gtPicture: TfrPictureViewLoadFromStream;
|
|||
|
gtBand: TfrBandViewLoadFromStream;
|
|||
|
gtSubReport: TfrSubreportLoadFromStream;
|
|||
|
gtLine: TfrLineViewLoadFromStream;
|
|||
|
gtAddIn:
|
|||
|
begin
|
|||
|
if CompareText(s, 'TfrLabelControl') = 0 then
|
|||
|
ReadTfrLabelControl
|
|||
|
else if CompareText(s, 'TfrEditControl') = 0 then
|
|||
|
ReadTfrEditControl
|
|||
|
else if CompareText(s, 'TfrMemoControl') = 0 then
|
|||
|
ReadTfrMemoControl
|
|||
|
else if CompareText(s, 'TfrButtonControl') = 0 then
|
|||
|
ReadTfrButtonControl
|
|||
|
else if CompareText(s, 'TfrCheckBoxControl') = 0 then
|
|||
|
ReadTfrCheckBoxControl
|
|||
|
else if CompareText(s, 'TfrRadioButtonControl') = 0 then
|
|||
|
ReadTfrRadioButtonControl
|
|||
|
else if CompareText(s, 'TfrListBoxControl') = 0 then
|
|||
|
ReadTfrListBoxControl
|
|||
|
else if CompareText(s, 'TfrComboBoxControl') = 0 then
|
|||
|
ReadTfrComboBoxControl
|
|||
|
else if CompareText(s, 'TfrDateEditControl') = 0 then
|
|||
|
ReadTfrDateEditControl
|
|||
|
else if CompareText(s, 'TfrDBLookupControl') = 0 then
|
|||
|
ReadTfrDBLookupControl
|
|||
|
else if CompareText(s, 'TfrBarCodeView') = 0 then
|
|||
|
ReadTfrBarCodeView
|
|||
|
else if CompareText(s, 'TfrChartView') = 0 then
|
|||
|
ReadTfrChartView
|
|||
|
else if CompareText(s, 'TfrCheckBoxView') = 0 then
|
|||
|
ReadTfrCheckBoxView
|
|||
|
else if CompareText(s, 'TfrCrossView') = 0 then
|
|||
|
ReadTfrCrossView
|
|||
|
else if CompareText(s, 'TfrOLEView') = 0 then
|
|||
|
ReadTfrOLEView
|
|||
|
else if CompareText(s, 'TfrRichView') = 0 then
|
|||
|
ReadTfrRichView
|
|||
|
else if CompareText(s, 'TfrRxRichView') = 0 then
|
|||
|
ReadTfrRichView
|
|||
|
else if CompareText(s, 'TfrRoundRectView') = 0 then
|
|||
|
ReadTfrRoundRectView
|
|||
|
else if CompareText(s, 'TfrShapeView') = 0 then
|
|||
|
ReadTfrShapeView
|
|||
|
|
|||
|
else if CompareText(s, 'TfrBDEDatabase') = 0 then
|
|||
|
ReadTfrBDEDatabase
|
|||
|
else if CompareText(s, 'TfrBDETable') = 0 then
|
|||
|
ReadTfrBDETable
|
|||
|
else if CompareText(s, 'TfrBDEQuery') = 0 then
|
|||
|
ReadTfrBDEQuery
|
|||
|
|
|||
|
else if CompareText(s, 'TfrADODatabase') = 0 then
|
|||
|
ReadTfrADODatabase
|
|||
|
else if CompareText(s, 'TfrADOTable') = 0 then
|
|||
|
ReadTfrADOTable
|
|||
|
else if CompareText(s, 'TfrADOQuery') = 0 then
|
|||
|
ReadTfrADOQuery
|
|||
|
|
|||
|
else if CompareText(s, 'TfrIBXDatabase') = 0 then
|
|||
|
ReadTfrIBXDatabase
|
|||
|
else if CompareText(s, 'TfrIBXTable') = 0 then
|
|||
|
ReadTfrIBXTable
|
|||
|
else if CompareText(s, 'TfrIBXQuery') = 0 then
|
|||
|
ReadTfrIBXQuery
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
if AnsiUpperCase(s) = 'TFRFRAMEDMEMOVIEW' then
|
|||
|
Stream.Read(buf[1], 8);
|
|||
|
if n <> 0 then
|
|||
|
Stream.Position := n;
|
|||
|
except
|
|||
|
if frVersion > 23 then
|
|||
|
begin
|
|||
|
if n = 0 then
|
|||
|
Stream.Read(n, 4);
|
|||
|
Stream.Seek(n, soFromBeginning);
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TfrReportLoadFromStream;
|
|||
|
begin
|
|||
|
Stream.Read(frVersion, 1);
|
|||
|
TfrPagesLoadFromStream;
|
|||
|
end;
|
|||
|
|
|||
|
procedure AdjustBands;
|
|||
|
var
|
|||
|
i, j: Integer;
|
|||
|
FObjects: TList;
|
|||
|
|
|||
|
procedure TossObjects(Bnd: TfrxBand);
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
c: TfrxComponent;
|
|||
|
SaveRestrictions: TfrxRestrictions;
|
|||
|
begin
|
|||
|
if Bnd.Vertical then Exit;
|
|||
|
|
|||
|
while Bnd.Objects.Count > 0 do
|
|||
|
begin
|
|||
|
c := Bnd.Objects[0];
|
|||
|
SaveRestrictions := c.Restrictions;
|
|||
|
c.Restrictions := [];
|
|||
|
c.Top := c.AbsTop;
|
|||
|
c.Restrictions := SaveRestrictions;
|
|||
|
c.Parent := Bnd.Parent;
|
|||
|
end;
|
|||
|
|
|||
|
for i := 0 to FObjects.Count - 1 do
|
|||
|
begin
|
|||
|
c := FObjects[i];
|
|||
|
if (c is TfrxView) and (c.AbsTop >= Bnd.Top - 1e-4) and (c.AbsTop < Bnd.Top + Bnd.Height + 1e-4) then
|
|||
|
begin
|
|||
|
SaveRestrictions := c.Restrictions;
|
|||
|
c.Restrictions := [];
|
|||
|
c.Top := c.AbsTop - Bnd.Top;
|
|||
|
c.Restrictions := SaveRestrictions;
|
|||
|
c.Parent := Bnd;
|
|||
|
if c is TfrxStretcheable then
|
|||
|
if (TfrxStretcheable(c).StretchMode = smMaxHeight) and not Bnd.Stretched then
|
|||
|
TfrxStretcheable(c).StretchMode := smDontStretch;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
FObjects := TList.Create;
|
|||
|
for i := 0 to Report.PagesCount - 1 do
|
|||
|
begin
|
|||
|
Page := Report.Pages[i];
|
|||
|
FObjects.Clear;
|
|||
|
for j := 0 to Page.AllObjects.Count - 1 do
|
|||
|
FObjects.Add(Page.AllObjects[j]);
|
|||
|
for j := 0 to FObjects.Count - 1 do
|
|||
|
if TObject(FObjects[j]) is TfrxBand then
|
|||
|
TossObjects(FObjects[j]);
|
|||
|
end;
|
|||
|
FObjects.Free;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ConnectDatasets;
|
|||
|
var
|
|||
|
l: TList;
|
|||
|
i: Integer;
|
|||
|
c: TfrxComponent;
|
|||
|
d: TfrxDataband;
|
|||
|
ds: TfrxDataset;
|
|||
|
cr: TfrxDBCrossView;
|
|||
|
c1: TComponent;
|
|||
|
s: String;
|
|||
|
begin
|
|||
|
l := Report.AllObjects;
|
|||
|
for i := 0 to l.Count - 1 do
|
|||
|
begin
|
|||
|
c := l[i];
|
|||
|
if c is TfrxDataband then
|
|||
|
begin
|
|||
|
d := l[i];
|
|||
|
|
|||
|
s := d.DatasetName;
|
|||
|
if Pos('DialogForm._', s) = 1 then
|
|||
|
begin
|
|||
|
Delete(s, 1, Length('DialogForm._'));
|
|||
|
d.DatasetName := s;
|
|||
|
ds := d.DataSet;
|
|||
|
end
|
|||
|
else
|
|||
|
ds := frFindComponent(Report.Owner, d.DatasetName) as TfrxDataset;
|
|||
|
|
|||
|
if ds <> nil then
|
|||
|
begin
|
|||
|
d.Dataset := ds;
|
|||
|
if Report.Datasets.Find(ds) = nil then
|
|||
|
Report.Datasets.Add(ds);
|
|||
|
end;
|
|||
|
end;
|
|||
|
if c is TfrxDBCrossView then
|
|||
|
begin
|
|||
|
cr := l[i];
|
|||
|
c1 := frFindComponent(Report.Owner, cr.DatasetName);
|
|||
|
if c1 is TDataSet then
|
|||
|
begin
|
|||
|
ds := FindTfrxDataset(TDataSet(c1));
|
|||
|
if ds <> nil then
|
|||
|
begin
|
|||
|
cr.Dataset := ds;
|
|||
|
if Report.Datasets.Find(ds) = nil then
|
|||
|
Report.Datasets.Add(ds);
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
function ConvertDatasetAndField(s: String): String;
|
|||
|
var
|
|||
|
ds: TDataset;
|
|||
|
ds1: TfrxDataset;
|
|||
|
fld: String;
|
|||
|
begin
|
|||
|
ds := nil;
|
|||
|
fld := '';
|
|||
|
|
|||
|
if Pos(AnsiUppercase('DialogForm.'), AnsiUppercase(s)) = 1 then
|
|||
|
s := Copy(s, Length('DialogForm.') + 1, 255);
|
|||
|
|
|||
|
Result := s;
|
|||
|
frGetDatasetAndField(s, ds, fld);
|
|||
|
if (ds <> nil) and (fld <> '') then
|
|||
|
begin
|
|||
|
ds1 := FindTfrxDataset(ds);
|
|||
|
if ds1 <> nil then
|
|||
|
Result := ds1.UserName + '."' + fld + '"';
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure ConvertVariables;
|
|||
|
var
|
|||
|
i: Integer;
|
|||
|
v: TfrxVariable;
|
|||
|
begin
|
|||
|
for i := 0 to Report.Variables.Count - 1 do
|
|||
|
begin
|
|||
|
v := Report.Variables.Items[i];
|
|||
|
v.Value := ConvertDatasetAndField(v.Value);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure CheckCrosses;
|
|||
|
var
|
|||
|
l, l1: TList;
|
|||
|
i, j: Integer;
|
|||
|
c: TfrxComponent;
|
|||
|
cr: TfrxDBCrossView;
|
|||
|
v: TfrxMemoView;
|
|||
|
|
|||
|
procedure AssignMemo(m, m1: TfrxCustomMemoView);
|
|||
|
var
|
|||
|
s: String;
|
|||
|
begin
|
|||
|
m.Visible := True;
|
|||
|
m.StretchMode := smDontStretch;
|
|||
|
s := m.Highlight.Condition;
|
|||
|
ExpandVariables1(s);
|
|||
|
m.Highlight.Condition := s;
|
|||
|
m1.Assign(m);
|
|||
|
if l1.IndexOf(m) = -1 then
|
|||
|
l1.Add(m);
|
|||
|
end;
|
|||
|
|
|||
|
begin
|
|||
|
l := Report.AllObjects;
|
|||
|
l1 := TList.Create;
|
|||
|
|
|||
|
for i := 0 to l.Count - 1 do
|
|||
|
begin
|
|||
|
c := l[i];
|
|||
|
if c is TfrxDBCrossView then
|
|||
|
begin
|
|||
|
cr := l[i];
|
|||
|
v := TfrxMemoView(Report.FindObject('ColumnHeaderMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
for j := 0 to cr.ColumnLevels - 1 do
|
|||
|
AssignMemo(v, cr.ColumnMemos[j]);
|
|||
|
end;
|
|||
|
v := TfrxMemoView(Report.FindObject('RowHeaderMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
for j := 0 to cr.RowLevels - 1 do
|
|||
|
AssignMemo(v, cr.RowMemos[j]);
|
|||
|
end;
|
|||
|
v := TfrxMemoView(Report.FindObject('ColumnTotalMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
for j := 0 to cr.ColumnLevels - 1 do
|
|||
|
AssignMemo(v, cr.ColumnTotalMemos[j]);
|
|||
|
end;
|
|||
|
v := TfrxMemoView(Report.FindObject('RowTotalMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
for j := 0 to cr.RowLevels - 1 do
|
|||
|
AssignMemo(v, cr.RowTotalMemos[j]);
|
|||
|
end;
|
|||
|
v := TfrxMemoView(Report.FindObject('GrandColumnTotalMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
AssignMemo(v, cr.ColumnTotalMemos[0]);
|
|||
|
end;
|
|||
|
v := TfrxMemoView(Report.FindObject('GrandRowTotalMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
AssignMemo(v, cr.RowTotalMemos[0]);
|
|||
|
end;
|
|||
|
v := TfrxMemoView(Report.FindObject('CellMemo' + cr.Name));
|
|||
|
if v <> nil then
|
|||
|
begin
|
|||
|
if not cr.Border then
|
|||
|
v.Frame.Typ := [ftLeft, ftRight];
|
|||
|
for j := 0 to cr.CellLevels - 1 do
|
|||
|
begin
|
|||
|
AssignMemo(v, cr.CellMemos[j]);
|
|||
|
if j <> 0 then
|
|||
|
cr.CellMemos[j].Frame.Typ := cr.CellMemos[j].Frame.Typ - [ftTop];
|
|||
|
if j <> cr.CellLevels - 1 then
|
|||
|
cr.CellMemos[j].Frame.Typ := cr.CellMemos[j].Frame.Typ - [ftBottom];
|
|||
|
end;
|
|||
|
cr.Border := True;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
for i := 0 to l1.Count - 1 do
|
|||
|
TObject(l1[i]).Free;
|
|||
|
l1.Free;
|
|||
|
end;
|
|||
|
|
|||
|
procedure CheckCharts;
|
|||
|
{$IFNDEF FPC}
|
|||
|
var
|
|||
|
l: TList;
|
|||
|
i: Integer;
|
|||
|
c, c1: TfrxComponent;
|
|||
|
ch: TfrxChartView;
|
|||
|
dser: TfrxSeriesItem;
|
|||
|
{$ENDIF}
|
|||
|
begin
|
|||
|
{$IFNDEF FPC}
|
|||
|
l := Report.AllObjects;
|
|||
|
for i := 0 to l.Count - 1 do
|
|||
|
begin
|
|||
|
c := l[i];
|
|||
|
if c is TfrxChartView then
|
|||
|
begin
|
|||
|
ch := l[i];
|
|||
|
dser := ch.SeriesData[0];
|
|||
|
c1 := Report.FindObject(dser.XSource) as TfrxComponent;
|
|||
|
if (c1 is TfrxMemoView) and (c1.Parent is TfrxDataBand) then
|
|||
|
begin
|
|||
|
dser.Databand := TfrxDataBand(c1.Parent);
|
|||
|
dser.XSource := TfrxMemoView(c1).Text;
|
|||
|
c1 := Report.FindObject(dser.YSource) as TfrxComponent;
|
|||
|
if c1 is TfrxMemoView then
|
|||
|
dser.YSource := TfrxMemoView(c1).Text;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
{$ENDIF}
|
|||
|
end;
|
|||
|
|
|||
|
procedure CheckViews;
|
|||
|
var
|
|||
|
l: TList;
|
|||
|
i: Integer;
|
|||
|
c: TfrxComponent;
|
|||
|
v: TfrxView;
|
|||
|
s: String;
|
|||
|
ds: TfrxDataSet;
|
|||
|
fld: String;
|
|||
|
begin
|
|||
|
l := Report.AllObjects;
|
|||
|
for i := 0 to l.Count - 1 do
|
|||
|
begin
|
|||
|
c := l[i];
|
|||
|
if c is TfrxView then
|
|||
|
begin
|
|||
|
v := l[i];
|
|||
|
if v.DataField <> '' then
|
|||
|
if v.DataField[1] = '[' then
|
|||
|
begin
|
|||
|
s := Copy(v.DataField, 2, Length(v.DataField) - 2);
|
|||
|
if Report.Variables.IndexOf(s) <> -1 then
|
|||
|
s := Report.Variables[s]
|
|||
|
else
|
|||
|
s := ConvertDatasetAndField(s);
|
|||
|
ds := nil;
|
|||
|
fld := '';
|
|||
|
Report.GetDatasetAndField(s, ds, fld);
|
|||
|
if (ds <> nil) and (fld <> '') then
|
|||
|
begin
|
|||
|
v.Dataset := ds;
|
|||
|
v.DataField := fld;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure LoadFromFR2Stream(AReport: TfrxReport; AStream: TStream);
|
|||
|
begin
|
|||
|
Report := AReport;
|
|||
|
Stream := AStream;
|
|||
|
ClearFixups;
|
|||
|
Report.Clear;
|
|||
|
Report.ScriptText.Clear;
|
|||
|
TfrReportLoadFromStream;
|
|||
|
Report.ScriptText.Add('begin');
|
|||
|
Report.ScriptText.Add('');
|
|||
|
Report.ScriptText.Add('end.');
|
|||
|
AdjustBands;
|
|||
|
FixupReferences;
|
|||
|
ConnectDatasets;
|
|||
|
ConvertVariables;
|
|||
|
CheckCrosses;
|
|||
|
CheckCharts;
|
|||
|
CheckViews;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
initialization
|
|||
|
Memo := TStringList.Create;
|
|||
|
Script := TStringList.Create;
|
|||
|
Fixups := TList.Create;
|
|||
|
fsModifyPascalForFR2;
|
|||
|
frxFR2EventsNew := TfrxFR2EventsNew.Create;
|
|||
|
frxFR2Events.OnGetValue := frxFR2EventsNew.DoGetValue;
|
|||
|
frxFR2Events.OnPrepareScript := frxFR2EventsNew.DoPrepareScript;
|
|||
|
frxFR2Events.OnLoad := frxFR2EventsNew.DoLoad;
|
|||
|
frxFR2Events.OnGetScriptValue := frxFR2EventsNew.DoGetScriptValue;
|
|||
|
frxFR2Events.Filter := '*.frf';
|
|||
|
|
|||
|
finalization
|
|||
|
Memo.Free;
|
|||
|
Script.Free;
|
|||
|
Fixups.Free;
|
|||
|
frxFR2EventsNew.Free;
|
|||
|
|
|||
|
|
|||
|
end.
|