1187 lines
33 KiB
ObjectPascal
1187 lines
33 KiB
ObjectPascal
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ RB -> FR importer }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit ConverterRB2FR ;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, ComCtrls, Printers, TypInfo, Jpeg, DB,
|
|
frxClass, frxVariables, frxPrinter, frxDCtrl, frxBarcode, frxBarcod,frxMap,
|
|
{$IFDEF DELPHI16}
|
|
VCLTee.TeeProcs, VCLTee.TeEngine, VCLTee.Chart, VCLTee.Series, VCLTee.TeCanvas
|
|
{$ELSE}
|
|
TeeProcs, TeEngine, Chart, Series, TeCanvas
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI16}
|
|
{$IFDEF TeeChartPro}, VCLTEE.TeeEdit{$IFNDEF TeeChart4}, VCLTEE.TeeEditCha{$ENDIF} {$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF TeeChartPro}, TeeEdit{$IFNDEF TeeChart4}, TeeEditCha{$ENDIF} {$ENDIF}
|
|
{$ENDIF}
|
|
, frxChart, frxChBox, frxOLE, frxRich,
|
|
frxCross, frxDBSet, frxUnicodeUtils, frxUtils, fs_ipascal,
|
|
frxCustomDB, {frxBDEComponents,} frxADOComponents, frxIBXComponents,
|
|
frxBarcode2D,frxTableObject
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
TfrxFR2EventsNew = class(TObject)
|
|
private
|
|
function DoLoad(Sender: TfrxReport; Stream: TStream): Boolean;
|
|
procedure OnFindComponentClass(Reader: TReader; const ClassName: string;
|
|
var ComponentClass: TComponentClass);
|
|
|
|
end;
|
|
|
|
TppDuplex = (dpNone, dpHorizontal, dpVertical);
|
|
TppFrame = (bpLeft, bpRight, bpTop, bpBottom);
|
|
TShapeType = (stRectangle, stRoundRect, stEllipse, stSquare, stRoundSquare ,stCircle);
|
|
TRBVarType =(vtDate, vtDateTime, vtDocumentName, vtPrintDateTime, vtPageCount ,vtPageSet,vtPageSetDesc,vtPageNo, vtPageNoDesc, vtTime);
|
|
TppBarTypes = (bcUPC_A, bcUPC_E, bcEAN_13, bcEAN_8, bcInt2of5, bcCode128, bcCode39, bcPostnet, bcFIM, bcCodabar, bcMSI,bcIntelligentMail);
|
|
Tpp2DBarTypes = (bcPDF417, bcMaxicode, bcQRCode, bcDataMatrix, bcAztecCode);
|
|
|
|
TAssignProp = procedure ();
|
|
|
|
var
|
|
frxFR2EventsNew: TfrxFR2EventsNew;
|
|
|
|
|
|
const RBVarsCat = ' RBVariables';
|
|
function LoadFromRB(AReport: TfrxReport; AStream: TStream; MyEvent: TfrxFR2EventsNew): Boolean;
|
|
Var
|
|
Reader: TReader;
|
|
SaveSeparator: Char;
|
|
ClassName,ObjectName,PropName: string;
|
|
Flags: TFilerFlags;
|
|
Position: Integer;
|
|
Val:Variant;
|
|
LastObj: TfrxComponent;
|
|
Parent: TfrxComponent;
|
|
isBin: Boolean;
|
|
Sig: AnsiString;
|
|
CurY: Extended;
|
|
DataBand: TfrxBand;
|
|
DSName: String;
|
|
Table : TfrxTableObject;
|
|
IndexCol : Integer ;
|
|
ICol : Integer ;
|
|
IRow : Integer ;
|
|
TabLeft : Double;
|
|
TabTop : Double;
|
|
Chart : TfrxChartView;
|
|
CrossTab : TfrxDBCrossView;
|
|
|
|
function GetBoolValue(Str: String): Boolean;
|
|
begin
|
|
Result := False;
|
|
If CompareStr(Str,'True') = 0 then
|
|
Result := True;
|
|
end;
|
|
|
|
procedure AssignReport();
|
|
var
|
|
Page: TfrxReportPage;
|
|
i: Integer;
|
|
begin
|
|
Page := LastObj as TfrxReportPage;
|
|
{Page property}
|
|
if PropName = 'PrinterSetup.mmPaperHeight' then
|
|
Page.PaperHeight := Val/1000
|
|
else if PropName = 'PrinterSetup.mmPaperWidth' then
|
|
Page.PaperWidth := Val/1000
|
|
else if PropName = 'PrinterSetup.mmMarginTop' then
|
|
Page.TopMargin := Val/1000
|
|
else if PropName = 'PrinterSetup.mmMarginBottom' then
|
|
Page.BottomMargin := Val/1000
|
|
else if PropName = 'PrinterSetup.mmMarginLeft' then
|
|
begin
|
|
Page.LeftMargin := Val/1000;
|
|
for i := 0 to Page.ColumnPositions.Count - 1 do
|
|
Page.ColumnPositions[i] := FloatToStr(StrToFloat(Page.ColumnPositions[i]) - Page.LeftMargin);
|
|
end
|
|
else if PropName = 'PrinterSetup.mmMarginRight' then
|
|
Page.RightMargin := Val/1000
|
|
else if PropName = 'PrinterSetup.PaperSize' then
|
|
Page.PaperSize := Val
|
|
else if PropName = 'PrinterSetup.BinName' then
|
|
Page.Bin := frxPrinters.Printer.BinNameToNumber(Val)
|
|
else if PropName = 'Columns' then
|
|
begin
|
|
Page.Columns := Val;
|
|
Page.ColumnPositions.Clear;
|
|
end
|
|
else if PropName = 'ColumnPositions.Strings' then
|
|
Page.ColumnPositions.Add(FloatToStr((StrToFloat(Val))/10000 * fr01in))
|
|
else if PropName = 'mmColumnWidth' then
|
|
Page.ColumnWidth := Val/10000 * fr01in
|
|
else if PropName = 'PrinterSetup.Orientation' then
|
|
Page.Orientation := TPrinterOrientation(GetEnumValue(TypeInfo(TPrinterOrientation), Val))
|
|
else if PropName = 'PrinterSetup.Duplex' then
|
|
Page.Duplex := TfrxDuplexMode(GetEnumValue(TypeInfo(TppDuplex),Val))
|
|
else if PropName = 'PrinterSetup.Copies' then
|
|
AReport.PrintOptions.Copies := Val
|
|
else if PropName = 'PrinterSetup.PrinterName' then
|
|
AReport.PrintOptions.Printer := Val
|
|
else if PropName = 'PrinterSetup.DocumentName' then
|
|
AReport.ReportOptions.Name := Val
|
|
else if PropName = 'DataPipeline' then
|
|
begin
|
|
i := pos('.', Val) + 1;
|
|
DSName := Val;
|
|
if i > 0 then
|
|
DSName := copy(Val, i, length(DSName) - i)
|
|
else DSName := '';
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure AssignHeader();
|
|
var
|
|
Header: TfrxHeader;
|
|
begin
|
|
Header := LastObj as TfrxHeader;
|
|
if PropName = 'mmHeight' then
|
|
Header.Height := Val / 10000 * fr1cm
|
|
end;
|
|
|
|
procedure AssignDBProp;
|
|
var
|
|
View: TfrxView;
|
|
i: Integer;
|
|
begin
|
|
View := LastObj as TfrxView;
|
|
|
|
if PropName = 'DataPipeline' then
|
|
begin
|
|
i := pos('.', Val) + 1;
|
|
View.DataSetName := Val;
|
|
if i <> - 1 then
|
|
View.DataSetName := copy(Val, i, length(View.DataSetName) - i)
|
|
else View.DataSetName := '';
|
|
end
|
|
else
|
|
if PropName = 'DataField' then
|
|
View.DataField := Val
|
|
else if PropName = 'DataPipelineName' then
|
|
View.DataSetName := Val
|
|
end;
|
|
|
|
function GetCharsetByName(cName: String):TFontCharset;
|
|
begin
|
|
if cName = 'ANSI_CHARSET' then
|
|
Result := ANSI_CHARSET
|
|
else if cName = 'DEFAULT_CHARSET' then
|
|
Result := DEFAULT_CHARSET
|
|
else if cName = 'SYMBOL_CHARSET' then
|
|
Result := SYMBOL_CHARSET
|
|
else if cName = 'MAC_CHARSET' then
|
|
Result := MAC_CHARSET
|
|
else if cName = 'SHIFTJIS_CHARSET' then
|
|
Result := SHIFTJIS_CHARSET
|
|
else if cName = 'HANGEUL_CHARSET' then
|
|
Result := HANGEUL_CHARSET
|
|
else if cName = 'JOHAB_CHARSET' then
|
|
Result := JOHAB_CHARSET
|
|
else if cName = 'GB2312_CHARSET' then
|
|
Result := GB2312_CHARSET
|
|
else if cName = 'CHINESEBIG5_CHARSET' then
|
|
Result := CHINESEBIG5_CHARSET
|
|
else if cName = 'GREEK_CHARSET' then
|
|
Result := GREEK_CHARSET
|
|
else if cName = 'TURKISH_CHARSET' then
|
|
Result := TURKISH_CHARSET
|
|
else if cName = 'HEBREW_CHARSET' then
|
|
Result := HEBREW_CHARSET
|
|
else if cName = 'ARABIC_CHARSET' then
|
|
Result := ARABIC_CHARSET
|
|
else if cName = 'BALTIC_CHARSET' then
|
|
Result := BALTIC_CHARSET
|
|
else if cName = 'RUSSIAN_CHARSET' then
|
|
Result := RUSSIAN_CHARSET
|
|
else if cName = 'THAI_CHARSETT' then
|
|
Result := THAI_CHARSET
|
|
else if cName = 'EASTEUROPE_CHARSET' then
|
|
Result := EASTEUROPE_CHARSET
|
|
else if cName = 'OEM_CHARSET' then
|
|
Result := OEM_CHARSET
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
procedure AssignFont;
|
|
var
|
|
View: TfrxView;
|
|
begin
|
|
View := LastObj as TfrxView;
|
|
if View = nil then exit;
|
|
if PropName = 'Font.Charset' then
|
|
View.Font.Charset := GetCharsetByName(Val)
|
|
else if PropName = 'Font.Color' then
|
|
View.Font.Color := StringToColor(Val)
|
|
else if PropName = 'Font.Name' then
|
|
View.Font.Name := Val
|
|
else if PropName = 'Font.Size' then
|
|
View.Font.Size := Val
|
|
else if PropName = 'Font.Style' then
|
|
View.Font.Style := View.Font.Style + [TFontStyle(GetEnumValue(TypeInfo(TFontStyle), Val))]
|
|
end;
|
|
|
|
|
|
procedure AssignBandData;
|
|
var
|
|
B: TfrxDataBand;
|
|
begin
|
|
B := LastObj as TfrxDataBand;
|
|
if B = nil then exit;
|
|
B.DataSetName := DSName;
|
|
end;
|
|
|
|
procedure AssignBorder;
|
|
var
|
|
frxView: TfrxView;
|
|
begin
|
|
frxView := lastObj as TfrxView;
|
|
if frxView = nil then exit;
|
|
if PropName = 'Border.BorderPositions' then
|
|
frxView.Frame.Typ := frxView.Frame.Typ + [TfrxFrameType(GetEnumValue(TypeInfo(TppFrame),Val))]
|
|
else if PropName = 'Border.Color' then
|
|
frxView.Frame.Color := StringToColor(Val)
|
|
else if PropName = 'Border.Style' then
|
|
frxView.Frame.Style := TfrxFrameStyle(GetEnumValue(TypeInfo(TPenStyle),Val))
|
|
end;
|
|
|
|
procedure AssignMemo();
|
|
var
|
|
Memo: TfrxMemoView;
|
|
begin
|
|
Memo := LastObj as TfrxMemoView;
|
|
|
|
if (PropName = 'Caption') and (Memo.Text = '') then
|
|
Memo.Text := Val
|
|
else if PropName = 'UserName' then
|
|
Memo.Name := Val
|
|
else if PropName = 'Angle' then
|
|
Memo.Rotation := Val
|
|
else if PropName= 'Color' then
|
|
Memo.Color := StringToColor(Val)
|
|
else if PropName = 'CharWrap' then
|
|
Memo.WordWrap := Val
|
|
else if Pos('Border', PropName) = 1 then
|
|
AssignBorder
|
|
else if Pos('Font', PropName) = 1 then
|
|
AssignFont
|
|
else if PropName = 'BlankWhenZero' then
|
|
Memo.HideZeros := Val
|
|
else if PropName = 'SuppressRepeatedValues' then
|
|
Memo.SuppressRepeated := Val
|
|
else if PropName = 'TextAlignment' then
|
|
begin
|
|
if Val = 'taLeftJustified' then
|
|
Memo.HAlign := haLeft
|
|
else if Val = 'taRightJustified' then
|
|
Memo.HAlign := haRight
|
|
else if Val = 'taCentered' then
|
|
Memo.HAlign := haCenter
|
|
else if Val = 'taFullJustified' then
|
|
Memo.HAlign := haBlock;
|
|
end
|
|
else if PropName = 'WordWrap' then
|
|
Memo.WordWrap := Val
|
|
else if PropName = 'Stretch' then
|
|
begin
|
|
if Val then
|
|
Memo.StretchMode := smActualHeight
|
|
else
|
|
Memo.StretchMode := smDontStretch;
|
|
end
|
|
else if PropName = 'AutoSize' then
|
|
begin
|
|
Memo.AutoWidth := Val
|
|
end
|
|
else if PropName = 'Anchors' then
|
|
begin
|
|
if Val = 'atLeft' then
|
|
Memo.Anchors := Memo.Anchors + [fraLeft]
|
|
else if Val = 'atRight' then
|
|
Memo.Anchors := Memo.Anchors + [fraRight]
|
|
else if Val = 'atBottom' then
|
|
Memo.Anchors := Memo.Anchors + [fraBottom]
|
|
else if Val = 'atTop' then
|
|
Memo.Anchors := Memo.Anchors + [fraTop];
|
|
end
|
|
else if PropName = 'HyperLink' then
|
|
begin
|
|
Memo.Hyperlink.Value := Val
|
|
end
|
|
else if PropName = 'RTLReading' then
|
|
begin
|
|
Memo.RTLReading := Val
|
|
end
|
|
else if PropName = 'Caption' then
|
|
begin
|
|
Memo.Text := Val
|
|
end
|
|
else if PropName = 'Lines.Strings' then
|
|
Memo.Lines.Add(Val);
|
|
if (Pos('DB', ClassName) = 4) and (Memo.DataSetName <> '') and (Memo.DataField <> '') then
|
|
Memo.Text := '['+ Memo.DataSetName + '."' + Memo.DataField + '"]'
|
|
|
|
{DBCalcType}
|
|
end;
|
|
|
|
procedure AssignBarCode;
|
|
var
|
|
Bar: TfrxBarCodeView;
|
|
begin
|
|
Bar := LastObj as TfrxBarCodeView;
|
|
if Bar = nil then exit;
|
|
if PropName = 'BarCodeType' then
|
|
case GetEnumValue(TypeInfo(TppBarTypes),Val) of
|
|
0: Bar.BarType := bcCodeUPC_A;
|
|
1: Bar.BarType := bcCodeUPC_E0;
|
|
2: Bar.BarType := bcCodeEAN13;
|
|
3: Bar.BarType := bcCodeEAN8;
|
|
4: Bar.BarType := bcCode_2_5_interleaved;
|
|
5: Bar.BarType := TfrxBarcodeType(5);
|
|
6: Bar.BarType := TfrxBarcodeType(3);
|
|
7: Bar.BarType := bcCodePostNet;
|
|
8: Bar.BarType := bcCode_2_5_industrial;
|
|
9: Bar.BarType := bcCodeCodabar;
|
|
10: Bar.BarType := bcCodeMSI;
|
|
11: Bar.BarType := bcCodeUSPSIntelligentMail;
|
|
end
|
|
else if PropName = 'Data' then
|
|
Bar.Text := Val
|
|
//else if PropName = 'mmBarWidth' then
|
|
// Bar.Width := Val
|
|
else if PropName = 'mmWideBarRatio' then
|
|
Bar.WideBarRatio := round(Val/1000000 * fr1cm)
|
|
else if PropName = 'PrintHumanReadable' then
|
|
Bar.ShowText := Val
|
|
else if PropName = 'BarColorCalcCheckDigit' then
|
|
Bar.CalcCheckSum := Val
|
|
end;
|
|
|
|
procedure Assign2DBarcodeView();
|
|
var
|
|
BarCode: TfrxBarcode2DView;
|
|
begin
|
|
BarCode := LastObj as TfrxBarcode2DView;
|
|
|
|
if PropName = 'BarCodeType' then
|
|
case GetEnumValue(TypeInfo(Tpp2DBarTypes),Val) of
|
|
0: BarCode.BarType := bcCodePDF417;
|
|
1: BarCode.BarType := bcCodeMaxiCode;
|
|
2: BarCode.BarType := bcCodeQR;
|
|
3: BarCode.BarType := bcCodeDataMatrix;
|
|
4: BarCode.BarType := bcCodeAztec;
|
|
end
|
|
else if PropName = 'Data' then
|
|
BarCode.Text := Val
|
|
|
|
end;
|
|
|
|
procedure AssignTableView();
|
|
var
|
|
Table: TfrxTableObject;
|
|
begin
|
|
Table := LastObj as TfrxTableObject;
|
|
|
|
if PropName = 'ColCount' then
|
|
Table.ColumnCount := Val
|
|
else if PropName = 'RowCount' then
|
|
Table.RowCount := Val
|
|
|
|
end;
|
|
|
|
procedure ObjectCreator(Name:String);
|
|
begin
|
|
if Name = 'TppReport' then
|
|
begin
|
|
LastObj := TfrxReportPage.Create(AReport);
|
|
Parent := LastObj;
|
|
TfrxReportPage(LastObj).CreateUniqueName;
|
|
TfrxReportPage(LastObj).SetDefaults;
|
|
end
|
|
else if Name = 'TppHeaderBand' then
|
|
begin
|
|
LastObj := TfrxHeader.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if Name = 'TppTitleBand' then
|
|
begin
|
|
LastObj := TfrxReportTitle.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if Name = 'TppColumnHeaderBand' then
|
|
begin
|
|
LastObj := TfrxColumnHeader.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppLabel') or (Name = 'TppSystemVariable')
|
|
or (Name = 'TppVariable') or (Name = 'TppMemo')
|
|
or (Name = 'TppDBText') or (Name = 'TppDBMemo') or (Name = 'TppDBCalc') then
|
|
begin
|
|
LastObj := TfrxMemoView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
TfrxMemoView(LastObj).AutoWidth := true;
|
|
if (Name = 'TppSystemVariable') then
|
|
TfrxCustomMemoView(LastObj).Text := '[Date]';
|
|
end
|
|
else if (Name = 'TppImage') or (Name = 'TppDBImage') then
|
|
begin
|
|
LastObj := TfrxPictureView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppShape') then
|
|
begin
|
|
LastObj := TfrxShapeView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppDetailBand') then
|
|
begin
|
|
LastObj := TfrxMasterData.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppColumnHeaderBand') then
|
|
begin
|
|
LastObj := TfrxColumnHeader.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppColumnFooterBand') then
|
|
begin
|
|
LastObj := TfrxColumnFooter.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppFooterBand') then
|
|
begin
|
|
LastObj := TfrxFooter.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppSummaryBand') then
|
|
begin
|
|
LastObj := TfrxReportSummary.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppBarCode') or (Name = 'TppDBBarCode') then
|
|
begin
|
|
LastObj := TfrxBarCodeView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppRichText') or (Name = 'TppDBRichText') then
|
|
begin
|
|
LastObj := TfrxRichView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TmyCheckBox') or (Name = 'TmyDBCheckBox') then
|
|
begin
|
|
LastObj := TfrxCheckBoxView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppLine') then
|
|
begin
|
|
LastObj := TfrxLineView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppGroupHeaderBand') then
|
|
begin
|
|
LastObj := TfrxGroupHeader.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppGroupFooterBand') then
|
|
begin
|
|
LastObj := TfrxGroupFooter.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TdaSQL') then
|
|
begin
|
|
LastObj := TfrxADOQuery.Create(AReport.Pages[0]);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppGMap') then
|
|
begin
|
|
LastObj := TfrxMapView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'Tpp2DBarCode') or (Name = 'TppDB2DBarCode') then
|
|
begin
|
|
LastObj := TfrxBarcode2DView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppTableGrid') then
|
|
begin
|
|
LastObj := TfrxTableObject.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
Table := TfrxTableObject(LastObj);
|
|
IndexCol := 0; ICol := 0; IRow := 0;
|
|
end
|
|
else if (Name = 'TppPaintBox') then
|
|
begin
|
|
LastObj := TfrxPictureView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
end
|
|
else if (Name = 'TppTeeChart') or (ClassName = 'TppDPTeeChart') then
|
|
begin
|
|
LastObj := TfrxChartView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
Chart := TfrxChartView(LastObj);
|
|
end
|
|
else if (Name = 'TppTableRow') then
|
|
begin
|
|
Table.RowCount := Table.RowCount + 1;
|
|
IndexCol := 0;
|
|
end
|
|
else if (Name = 'TppTableCell') then
|
|
begin
|
|
if Table.RowCount = 1 then
|
|
Table.ColumnCount := Table.ColumnCount + 1;
|
|
|
|
if (Table.RowCount > 0) and (Table.ColumnCount > 0) then
|
|
begin
|
|
LastObj := Table.Cells[IndexCol, Table.RowCount-1];
|
|
IndexCol := IndexCol +1;
|
|
end;
|
|
|
|
end
|
|
else if (ClassName = 'TppCrossTab') then
|
|
begin
|
|
LastObj := TfrxDBCrossView.Create(Parent);
|
|
LastObj.CreateUniqueName;
|
|
CrossTab := TfrxDBCrossView(LastObj);
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
procedure AssignView;
|
|
begin
|
|
if PropName = 'mmHeight' then
|
|
LastObj.Height := Val/10000 * fr1cm
|
|
else if PropName = 'mmWidth' then
|
|
LastObj.Width := Val/10000 * fr1cm
|
|
else if PropName = 'mmLeft' then
|
|
LastObj.Left := Val/10000 * fr1cm
|
|
else if PropName = 'mmTop' then
|
|
LastObj.Top := Val/10000 * fr1cm
|
|
else if PropName = 'Visible' then
|
|
LastObj.Visible := Val;
|
|
|
|
if LastObj.Parent is TfrxTableCell then
|
|
|
|
|
|
|
|
end;
|
|
|
|
procedure AssignADOQuery;
|
|
var
|
|
Query: TfrxADOQuery;
|
|
begin
|
|
Query := LastObj as TfrxADOQuery;
|
|
if Query = nil then exit;
|
|
if PropName = 'DataPipelineName' then
|
|
begin
|
|
Query.UserName := Val;
|
|
Query.Name := Val;
|
|
end
|
|
else if PropName = 'SQLText.Strings' then
|
|
Query.SQL.Add(Val)
|
|
end;
|
|
|
|
procedure AssignPicture;
|
|
var
|
|
Stream: TMemoryStream;
|
|
Cn: Integer;
|
|
begin
|
|
|
|
if PropName = 'Picture.Data' then
|
|
begin
|
|
Stream := TMemoryStream.Create;
|
|
Cn := 0;
|
|
TMemoryStream(frxInteger(Val)).Position := 0;
|
|
TMemoryStream(frxInteger(Val)).Read(Cn, 1);
|
|
TMemoryStream(frxInteger(Val)).Position := Cn + 1;
|
|
Stream.SetSize(TMemoryStream(frxInteger(Val)).Size - (Cn + 1));
|
|
Stream.CopyFrom(TMemoryStream(frxInteger(Val)), Stream.Size);
|
|
TfrxPictureView(LastObj).LoadPictureFromStream(Stream);
|
|
Stream.Free;
|
|
end
|
|
|
|
else if PropName = 'AutoSize' then
|
|
TfrxPictureView(LastObj).AutoSize := Val
|
|
else if PropName = 'Stretch' then
|
|
TfrxPictureView(LastObj).Stretched := Val
|
|
|
|
else if PropName = 'Anchors' then
|
|
begin
|
|
if Val = 'atLeft' then
|
|
TfrxPictureView(LastObj).Anchors := TfrxPictureView(LastObj).Anchors + [fraLeft]
|
|
else if Val = 'atRight' then
|
|
TfrxPictureView(LastObj).Anchors := TfrxPictureView(LastObj).Anchors + [fraRight]
|
|
else if Val = 'atBottom' then
|
|
TfrxPictureView(LastObj).Anchors := TfrxPictureView(LastObj).Anchors + [fraBottom]
|
|
else if Val = 'atTop' then
|
|
TfrxPictureView(LastObj).Anchors := TfrxPictureView(LastObj).Anchors + [fraTop];
|
|
end
|
|
else if PropName = 'HyperLink' then
|
|
begin
|
|
TfrxPictureView(LastObj).Hyperlink.Value := Val
|
|
end
|
|
end;
|
|
|
|
procedure AssignProp;
|
|
var Item : TfrxComponent;
|
|
begin
|
|
if Pos('DB', ClassName) = 4 then
|
|
AssignDBProp;
|
|
if (PropName = 'UserName') and not (LastObj is TfrxPage)
|
|
and not (ClassName = 'TppTableRow') and not (ClassName = 'TppTableCell')
|
|
and not (ClassName = 'TppTableColumn')then
|
|
LastObj.Name := Val
|
|
else if ClassName = 'TppReport' then
|
|
AssignReport
|
|
{ else if ClassName = 'TppHeaderBand' then
|
|
AssignHeader }
|
|
else if (ClassName = 'TppTitleBand') or (ClassName = 'TppColumnHeaderBand') or (ClassName = 'TppDetailBand')
|
|
or (ClassName = 'TppColumnHeaderBand') or ( ClassName = 'TppColumnFooterBand') or (ClassName = 'TppFooterBand')
|
|
or (ClassName = 'TppSummaryBand') or (ClassName = 'TppHeaderBand') or (ClassName = 'TppGroupHeaderBand')
|
|
or (ClassName = 'TppGroupFooterBand') then
|
|
begin
|
|
if ClassName = 'TppDetailBand' then
|
|
AssignBandData;
|
|
if PropName = 'mmHeight' then
|
|
begin
|
|
TfrxBand(LastObj).Top := CurY;
|
|
TfrxBand(LastObj).Height := Val / 10000 * fr1cm;
|
|
CurY := CurY + TfrxBand(LastObj).Height + 1;
|
|
end
|
|
else if PropName = 'Visible' then
|
|
LastObj.Visible := Val
|
|
else if PropName = 'Tag' then
|
|
LastObj.Tag := Val
|
|
else if (ClassName = 'TppGroupHeaderBand') then
|
|
begin
|
|
if DataBand <> nil then
|
|
begin
|
|
DataBand.FGroup := TfrxGroupHeader(LastObj);
|
|
LastObj.Top := DataBand.Top ;
|
|
end
|
|
end
|
|
else if (ClassName = 'TppGroupFooterBand') then
|
|
begin
|
|
if DataBand <> nil then
|
|
begin
|
|
LastObj.Top := DataBand.Top + DataBand.Height;
|
|
end
|
|
end
|
|
else if (ClassName = 'TppDetailBand') then
|
|
DataBand := LastObj as TfrxBand
|
|
else if(ClassName = 'TppSummaryBand') then
|
|
if PropName = 'NewPage' then
|
|
TfrxReportSummary(LastObj).StartNewPage := Val;
|
|
end
|
|
else if (ClassName = 'TppLabel')
|
|
or (ClassName = 'TppMemo') or (ClassName = 'TppDBText') or (ClassName = 'TppDBCalc')
|
|
or (ClassName = 'TppDBMemo') then
|
|
begin
|
|
AssignView;
|
|
AssignMemo;
|
|
|
|
end
|
|
|
|
else if (ClassName = 'TppSystemVariable') then
|
|
begin
|
|
AssignView;
|
|
AssignMemo;
|
|
if PropName = 'VarType' then
|
|
case TRBVarType(GetEnumValue(TypeInfo(TRBVarType),Val)) of
|
|
vtDate : TfrxCustomMemoView(LastObj).Text := '[Date]';
|
|
vtDateTime : TfrxCustomMemoView(LastObj).Text := '[Now]';
|
|
vtDocumentName : TfrxCustomMemoView(LastObj).Text := '[Report.ReportOptions.Name]';
|
|
vtPrintDateTime : TfrxCustomMemoView(LastObj).Text := 'PrintDateTime does not exist in Fast Report';
|
|
vtPageCount : TfrxCustomMemoView(LastObj).Text := '[TotalPages#]';
|
|
vtPageSet : TfrxCustomMemoView(LastObj).Text := '[Page#] of [TotalPages#]';
|
|
vtPageSetDesc : TfrxCustomMemoView(LastObj).Text := 'Page [Page#] of [TotalPages#]';
|
|
vtPageNo : TfrxCustomMemoView(LastObj).Text := '[Page#]';
|
|
vtPageNoDesc : TfrxCustomMemoView(LastObj).Text := 'Page [Page#]';
|
|
vtTime : TfrxCustomMemoView(LastObj).Text := '[Time]';
|
|
else TfrxCustomMemoView(LastObj).Text := 'Unknown Variable';
|
|
end;
|
|
end
|
|
else if (ClassName = 'TppVariable') then
|
|
begin
|
|
AssignView;
|
|
AssignMemo;
|
|
if AReport.Variables.IndexOf(RBVarsCat) = -1 then
|
|
with AReport.Variables.Add do
|
|
begin
|
|
Name := RBVarsCat;
|
|
Value := Null;
|
|
end;
|
|
AReport.Variables.AddVariable('RBVariables', 'Report' + LastObj.Name, '''' + '''');
|
|
TfrxCustomMemoView(LastObj).Text := '[Report' + LastObj.Name + ']';
|
|
end
|
|
else if (ClassName = 'TppImage') or (ClassName = 'TppDBImage') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
AssignPicture;
|
|
end
|
|
else if (ClassName = 'TppShape') then
|
|
begin
|
|
AssignView;
|
|
if PropName = 'Shape' then
|
|
begin
|
|
TfrxShapeView(LastObj).Shape := TfrxShapeKind(GetEnumValue(TypeInfo(TShapeType),Val));
|
|
if (Val = 'stRoundRect') or (Val = 'stRoundSquare') then
|
|
TfrxShapeView(LastObj).Curve := 2;
|
|
end;
|
|
if PropName= 'Brush.Color' then
|
|
TfrxShapeView(LastObj).Color := StringToColor(Val)
|
|
end
|
|
else if (ClassName = 'TppBarCode') or (ClassName = 'TppDBBarCode') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
AssignBarCode;
|
|
end
|
|
else if (ClassName = 'TppRichText') or (ClassName = 'TppDBRichText') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
if PropName = 'RichText' then
|
|
TfrxRichView(LastObj).RichEdit.Text := String(Val)
|
|
else if PropName = 'Stretch' then
|
|
begin
|
|
if Val then
|
|
TfrxRichView(LastObj).StretchMode := smActualHeight
|
|
else
|
|
TfrxRichView(LastObj).StretchMode := smDontStretch;
|
|
end
|
|
end
|
|
else if (ClassName = 'TmyCheckBox') or (ClassName = 'TmyDBCheckBox') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
end
|
|
else if (ClassName ='TppLine') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
end
|
|
else if (ClassName = 'TdaSQL') then
|
|
begin
|
|
AssignView;
|
|
AssignADOQuery;
|
|
end
|
|
else if (ClassName = 'TppGMap') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder
|
|
end
|
|
else if (ClassName = 'Tpp2DBarCode') or (ClassName = 'TppDB2DBarCode') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
Assign2DBarcodeView;
|
|
end
|
|
else if (ClassName = 'TppTableGrid') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
AssignTableView;
|
|
end
|
|
else if (ClassName = 'TppPaintBox') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
end
|
|
else if ((ClassName = 'TppTeeChart') or (ClassName = 'TppDPTeeChart')) then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
end
|
|
else if (ClassName = 'TppTableRow') then
|
|
begin
|
|
if PropName = 'mmHeight' then
|
|
Table.Rows[Table.RowCount - 1].Height := Val/10000 * fr1cm;
|
|
end
|
|
else if (ClassName = 'TppTableColumn') then
|
|
begin
|
|
if PropName = 'mmWidth' then
|
|
begin
|
|
Table.Columns[ICol].Width := Val/10000 * fr1cm ;
|
|
if ICol = 0 then
|
|
TabLeft := Table.Left
|
|
else
|
|
TabLeft := TabLeft + Table.Columns[ICol-1].Width;
|
|
|
|
if IRow = 0 then
|
|
TabTop := Table.Top;
|
|
|
|
while IRow < Table.RowCount do
|
|
begin
|
|
for Item in Table.Cells[ICol,IRow].Objects do
|
|
begin
|
|
Item.Left := Item.Left - TabLeft;
|
|
Item.Top := Item.Top - TabTop;
|
|
end;
|
|
TabTop := TabTop + Table.Rows[IRow].Height;
|
|
IRow := IRow + 1;
|
|
end;
|
|
ICol := ICol + 1;
|
|
IRow := 0;
|
|
end;
|
|
|
|
end
|
|
else if (ClassName = 'TppCrossTab') then
|
|
begin
|
|
AssignView;
|
|
AssignBorder;
|
|
end
|
|
else if (ClassName = 'TppValueDef') then
|
|
begin
|
|
if PropName = 'FieldName' then
|
|
begin
|
|
CrossTab.CellFields.Add(Val);
|
|
CrossTab.CellLevels := CrossTab.CellLevels + 1;
|
|
end;
|
|
end
|
|
else if (ClassName = 'TppColumnDef') then
|
|
begin
|
|
if PropName = 'FieldName' then
|
|
begin
|
|
CrossTab.ColumnFields.Add(Val);
|
|
CrossTab.ColumnLevels := CrossTab.ColumnLevels + 1;
|
|
end;
|
|
end
|
|
else if (ClassName = 'TppRowDef') then
|
|
begin
|
|
if PropName = 'FieldName' then
|
|
begin
|
|
CrossTab.RowFields.Add(Val);
|
|
CrossTab.RowLevels := CrossTab.ColumnLevels + 1;
|
|
end;
|
|
end
|
|
|
|
end;
|
|
|
|
procedure ConvertBinary;
|
|
var
|
|
Count: Longint;
|
|
Stream: TMemoryStream;
|
|
begin
|
|
Reader.ReadValue;
|
|
Reader.Read(Count, SizeOf(Count));
|
|
Stream := TMemoryStream.Create;
|
|
Stream.SetSize(Count);
|
|
Reader.Read(Stream.Memory^, Count);
|
|
Val := frxInteger(Stream);
|
|
end;
|
|
|
|
procedure ReadProperty; forward;
|
|
procedure ConvertValue;
|
|
var
|
|
L: Integer;
|
|
S: string;
|
|
W: WideString;
|
|
begin
|
|
case Reader.NextValue of
|
|
vaList:
|
|
begin
|
|
Reader.ReadValue;
|
|
while not Reader.EndOfList do
|
|
begin
|
|
ConvertValue;
|
|
end;
|
|
Reader.ReadListEnd;
|
|
exit;
|
|
end;
|
|
vaInt8, vaInt16, vaInt32:
|
|
Val := IntToStr(Reader.ReadInteger);
|
|
vaExtended:
|
|
Val := FloatToStrF(Reader.ReadFloat, ffFixed, 16, 18);
|
|
vaSingle:
|
|
Val := FloatToStr(Reader.ReadSingle) + 's';
|
|
vaCurrency:
|
|
Val := FloatToStr(Reader.ReadCurrency * 10000) + 'c';
|
|
vaDate:
|
|
Val := FloatToStr(Reader.ReadDate) + 'd';
|
|
vaWString, vaUTF8String:
|
|
begin
|
|
W := Reader.ReadWideString;
|
|
L := Length(W);
|
|
if L = 0 then W := '';
|
|
Val := W;
|
|
end;
|
|
vaString, vaLString:
|
|
begin
|
|
S := Reader.ReadString;
|
|
L := Length(S);
|
|
if L = 0 then S := '';
|
|
Val := S;
|
|
end;
|
|
vaIdent, vaFalse, vaTrue, vaNil, vaNull:
|
|
Val := Reader.ReadIdent;
|
|
vaBinary:
|
|
begin
|
|
isBin := True;
|
|
ConvertBinary;
|
|
end;
|
|
vaSet:
|
|
begin
|
|
Reader.ReadValue;
|
|
|
|
while True do
|
|
begin
|
|
S := Reader.ReadStr;
|
|
if S = '' then exit;
|
|
Val := S;
|
|
AssignProp;
|
|
end;
|
|
end;
|
|
vaCollection:
|
|
begin
|
|
Reader.ReadValue;
|
|
while not Reader.EndOfList do
|
|
begin
|
|
if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then
|
|
begin
|
|
ConvertValue;
|
|
end;
|
|
Reader.CheckValue(vaList);
|
|
while not Reader.EndOfList do ReadProperty;
|
|
Reader.ReadListEnd;
|
|
|
|
end;
|
|
Reader.ReadListEnd;
|
|
end;
|
|
vaInt64:
|
|
Val := IntToStr(Reader.ReadInt64);
|
|
end;
|
|
AssignProp;
|
|
end;
|
|
|
|
|
|
procedure ReadProperty;
|
|
begin
|
|
PropName := Reader.ReadStr;
|
|
ConvertValue;
|
|
end;
|
|
|
|
|
|
|
|
procedure ReadObject;
|
|
var
|
|
LastParent: TfrxComponent;
|
|
Ch : TChart;
|
|
ReaderChart: TReader;
|
|
Series : TChartSeries;
|
|
st: string;
|
|
indSeriesVal : Integer;
|
|
SeriesItem : TfrxSeriesItem;
|
|
OldAStreamPosition : Integer;
|
|
begin
|
|
|
|
if ((ClassName = 'TppTeeChart') or (ClassName = 'TppDPTeeChart'))
|
|
and (PropName = 'LayerName') then
|
|
begin
|
|
OldAStreamPosition := AStream.Position;
|
|
AStream.Position := Reader.Position;
|
|
ReaderChart := TReader.Create(AStream, 4096);
|
|
|
|
ReaderChart.OnFindComponentClass := Reader.OnFindComponentClass;
|
|
Ch := TChart.Create(nil);
|
|
ReaderChart.Root := Chart.Chart;
|
|
ReaderChart.Parent := nil;
|
|
FreeAndNil(Ch);
|
|
|
|
ReaderChart.BeginReferences;
|
|
try
|
|
Ch := ReaderChart.ReadComponent(Chart.Chart) as TChart;
|
|
for Series in Ch.SeriesList do
|
|
begin
|
|
Chart.SeriesData.Add;
|
|
if (ClassName = 'TppDPTeeChart') then
|
|
begin
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].DataType := dtDBData;
|
|
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source1:=
|
|
'."' + Series.XLabelsSource + '"';
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source2:=
|
|
'."' + Series.YValues.ValueSource + '"';
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source3:=
|
|
'."' + Series.XValues.ValueSource + '"';
|
|
end
|
|
|
|
else
|
|
for indSeriesVal := 0 to Series.XValues.Count-1 do
|
|
begin
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].DataType := dtFixedData;
|
|
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source1:=
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source1 +';'+
|
|
Series.XValues.Value[indSeriesVal].ToString;
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source2:=
|
|
Chart.SeriesData.Items[Chart.SeriesData.Count-1].Source2 +';'+
|
|
Series.YValues.Value[indSeriesVal].ToString;
|
|
end;
|
|
indSeriesVal :=0;
|
|
end;
|
|
finally
|
|
ReaderChart.FixupReferences;
|
|
ReaderChart.EndReferences;
|
|
FreeAndNil(ReaderChart);
|
|
end;
|
|
AStream.Position := OldAStreamPosition;
|
|
|
|
end;
|
|
|
|
Reader.ReadPrefix(Flags, Position);
|
|
if (ffInherited in Flags) or (ffInline in Flags) then exit;
|
|
ClassName := Reader.ReadStr;
|
|
ObjectName := Reader.ReadStr;
|
|
ObjectCreator(ClassName);
|
|
|
|
|
|
LastParent := LastObj;
|
|
while not Reader.EndOfList do
|
|
begin
|
|
|
|
ReadProperty;
|
|
if PropName = 'DataSource' then
|
|
begin
|
|
for indSeriesVal := 0 to Chart.SeriesData.Count-1 do
|
|
begin
|
|
if Chart.Chart.Series[indSeriesVal].Name = ObjectName then
|
|
begin
|
|
SeriesItem := Chart.SeriesData.Items[indSeriesVal];
|
|
SeriesItem.Source1 := Val + SeriesItem.Source1;
|
|
SeriesItem.Source2 := Val + SeriesItem.Source2;
|
|
SeriesItem.Source3 := Val + SeriesItem.Source3;
|
|
end;
|
|
end;
|
|
end;
|
|
if isBin then
|
|
begin
|
|
TMemoryStream(frxInteger(Val)).Free;
|
|
isBin := False;
|
|
end;
|
|
end;
|
|
if (LastObj <> nil) and (LastObj.Parent <> nil) and not (LastObj.Parent is TfrxReport)
|
|
and not (LastObj.Parent is TfrxChartView) then
|
|
LastObj := LastObj.Parent;
|
|
Reader.ReadListEnd;
|
|
while not Reader.EndOfList do
|
|
begin
|
|
Parent := LastParent;
|
|
ReadObject;
|
|
end;
|
|
Reader.ReadListEnd;
|
|
end;
|
|
|
|
|
|
begin
|
|
Result := False;
|
|
SetLength(Sig, 3);
|
|
AStream.Position := 0;
|
|
AStream.Read(Sig[1], 3);
|
|
AStream.Position := 0;
|
|
if Sig <> 'TPF' then exit;
|
|
AReport.Clear;
|
|
with TfrxDataPage.Create(AReport) do
|
|
begin
|
|
CreateUniqueName;
|
|
end;
|
|
Reader := TReader.Create(AStream, 4096);
|
|
|
|
Reader.OnFindComponentClass := MyEvent.OnFindComponentClass;
|
|
|
|
{$IFDEF Delphi16}
|
|
SaveSeparator := FormatSettings.DecimalSeparator;
|
|
{$ELSE}
|
|
SaveSeparator := DecimalSeparator;
|
|
{$ENDIF}
|
|
|
|
isBin := False;
|
|
CurY := 0;
|
|
{$IFDEF Delphi16}
|
|
FormatSettings.DecimalSeparator := '.';
|
|
{$ELSE}
|
|
DecimalSeparator := '.';
|
|
{$ENDIF}
|
|
|
|
try
|
|
Reader.ReadSignature;
|
|
Reader.ReadPrefix(Flags, Position);
|
|
LastObj := nil;
|
|
ReadObject;
|
|
Result := True;
|
|
finally
|
|
Reader.Free;
|
|
end;
|
|
{$IFDEF Delphi16}
|
|
FormatSettings.DecimalSeparator := SaveSeparator;
|
|
{$ELSE}
|
|
DecimalSeparator := SaveSeparator;
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
function TfrxFR2EventsNew.DoLoad(Sender: TfrxReport; Stream: TStream): Boolean;
|
|
var
|
|
Sig: AnsiString;
|
|
TmpStream: TMemoryStream;
|
|
begin
|
|
SetLength(Sig, 6);
|
|
Stream.Position := 0;
|
|
Stream.Read(Sig[1], 6);
|
|
Stream.Position := 0;
|
|
if Sig = 'object' then
|
|
begin
|
|
TmpStream := TMemoryStream.Create;
|
|
try
|
|
ObjectTextToBinary(Stream, TmpStream);
|
|
Result := LoadFromRB(Sender, TmpStream, Self);
|
|
finally
|
|
TmpStream.Free;
|
|
end;
|
|
end
|
|
else
|
|
Result := LoadFromRB(Sender, Stream, Self);
|
|
end;
|
|
|
|
|
|
|
|
procedure TfrxFR2EventsNew.OnFindComponentClass(Reader: TReader;
|
|
const ClassName: string; var ComponentClass: TComponentClass);
|
|
|
|
begin
|
|
if (ClassName = 'TppTeeChartControl') or (ClassName = 'TppDPTeeChartControl') then
|
|
ComponentClass := TChart;
|
|
end;
|
|
|
|
initialization
|
|
frxFR2EventsNew := TfrxFR2EventsNew.Create;
|
|
frxFR2Events.OnLoad := frxFR2EventsNew.DoLoad;
|
|
frxFR2Events.Filter := '*.rtm';
|
|
|
|
finalization
|
|
frxFR2EventsNew.Free;
|
|
|
|
|
|
end.
|