2743 lines
72 KiB
ObjectPascal
2743 lines
72 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ Preview Pages }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxPreviewPages;
|
|
|
|
interface
|
|
|
|
{$I fmx.inc}
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants,
|
|
FMX.Types, System.UIConsts,
|
|
FMX.frxClass, FMX.frxXML, FMX.frxPictureCache, System.Diagnostics, System.TimeSpan, FMX.frxXMLSerializer, FMX.frxFMX
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Printer
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI28}
|
|
, FMX.BaseTypeAliases, FMX.FormTypeAliases
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
THackCanvas = class(TCanvas);
|
|
TfrxOutline = class(TfrxCustomOutline)
|
|
private
|
|
protected
|
|
function GetCount: Integer; override;
|
|
public
|
|
function Root: TfrxXMLItem;
|
|
procedure AddItem(const Text: String; Top: Integer); override;
|
|
procedure LevelDown(Index: Integer); override;
|
|
procedure LevelRoot; override;
|
|
procedure LevelUp; override;
|
|
procedure GetItem(Index: Integer; var Text: String;
|
|
var Page, Top: Integer); override;
|
|
procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); override;
|
|
function GetCurPosition: TfrxXMLItem; override;
|
|
end;
|
|
|
|
TfrxDictionary = class(TObject)
|
|
private
|
|
FNames: TStringList;
|
|
FSourceNames: TStringList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Add(const Name, SourceName: String; Obj: TObject);
|
|
procedure Clear;
|
|
function AddUnique(const Base, SourceName: String; Obj: TObject): String;
|
|
function CreateUniqueName(const Base: String): String;
|
|
function GetSourceName(const Name: String): String;
|
|
function GetObject(const Name: String): TObject;
|
|
property Names: TStringList read FNames;
|
|
property SourceNames: TStringList read FSourceNames;
|
|
end;
|
|
|
|
TfrxPreviewPages = class(TfrxCustomPreviewPages)
|
|
private
|
|
FAllowPartialLoading: Boolean;
|
|
FCopyNo: Integer;
|
|
FDictionary: TfrxDictionary; { list of all objects }
|
|
FFirstObjectIndex: Integer; { used in the ClearFirstPassPages }
|
|
FFirstPageIndex: Integer; { used in the ClearFirstPassPages }
|
|
FFirstOutlineIndex: Integer; { used in the ClearFirstPassPages }
|
|
FLogicalPageN: Integer;
|
|
FPageCache: TStringList; { last 20 TfrxPreviewPage }
|
|
FPageBitmapCache: TStringList; { last 20 TfrxPreviewPage bitmaps }
|
|
FPagesItem: TfrxXMLItem; { shortcut to XMLDoc.Root.FindName('previewpages') }
|
|
FPictureCache: TfrxPictureCache;
|
|
FPrintScale: Extended;
|
|
FSourcePages: TList; { list of source pages }
|
|
FTempStream: TStream;
|
|
FXMLDoc: TfrxXMLDocument; { parsed FP3 document }
|
|
FXMLSize: Integer;
|
|
FLastY: Extended; { last Y for composite report created with AddFrom }
|
|
FLastScale: Extended;
|
|
FSerializer: TfrxXMLSerializer;
|
|
FFastCanvas: TCanvas;
|
|
FFastPrintCanvas: TfrxFastCanvasLayer;
|
|
procedure AfterLoad;
|
|
procedure BeforeSave;
|
|
procedure ClearPageCache;
|
|
procedure ClearPageBitmapCache;
|
|
procedure ClearSourcePages;
|
|
function CurXMLPage: TfrxXMLItem;
|
|
function GetObject(const Name: String): TfrxComponent;
|
|
procedure DoLoadFromStream;
|
|
procedure DoSaveToStream;
|
|
procedure DrawPageInternal(Index: Integer; Canvas: TCanvas;
|
|
ScaleX, ScaleY, OffsetX, OffsetY: Extended; WorkArea: TRectF);
|
|
protected
|
|
function GetCount: Integer; override;
|
|
function GetPage(Index: Integer): TfrxReportPage; override;
|
|
function GetPageSize(Index: Integer): TPoint; override;
|
|
public
|
|
constructor Create(AReport: TfrxReport); override;
|
|
destructor Destroy; override;
|
|
procedure Clear; override;
|
|
procedure Initialize; override;
|
|
|
|
{ engine commands }
|
|
procedure AddAnchor(const Text: String);
|
|
procedure AddObject(Obj: TfrxComponent); override;
|
|
procedure AddPage(Page: TfrxReportPage); override;
|
|
procedure AddPicture(Picture: TfrxPictureView); override;
|
|
procedure AddSourcePage(Page: TfrxReportPage); override;
|
|
procedure AddToSourcePage(Obj: TfrxComponent); override;
|
|
procedure BeginPass; override;
|
|
procedure ClearFirstPassPages; override;
|
|
procedure CutObjects(APosition: Integer); override;
|
|
procedure Finish; override;
|
|
procedure IncLogicalPageNumber; override;
|
|
procedure ResetLogicalPageNumber; override;
|
|
procedure PasteObjects(X, Y: Extended); override;
|
|
procedure ShiftAnchors(From, NewTop: Integer); override;
|
|
procedure UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
|
|
function BandExists(Band: TfrxBand): Boolean; override;
|
|
function FindAnchor(const Text: String): TfrxXMLItem;
|
|
function GetAnchorPage(const Text: String): Integer;
|
|
function GetAnchorCurPosition: Integer; override;
|
|
function GetCurPosition: Integer; override;
|
|
function GetLastY(ColumnPosition: Extended = 0): Extended; override;
|
|
function GetLogicalPageNo: Integer; override;
|
|
function GetLogicalTotalPages: Integer; override;
|
|
|
|
{ preview commands }
|
|
procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY,
|
|
OffsetX, OffsetY: Extended; WorkArea: TRectF); override;
|
|
procedure AddEmptyPage(Index: Integer); override;
|
|
procedure DeletePage(Index: Integer); override;
|
|
procedure ModifyPage(Index: Integer; Page: TfrxReportPage); override;
|
|
procedure AddFrom(Report: TfrxReport); override;
|
|
procedure LoadFromStream(Stream: TStream;
|
|
AllowPartialLoading: Boolean = False); override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
function LoadFromFile(const FileName: String;
|
|
ExceptionIfNotFound: Boolean = False): Boolean; override;
|
|
procedure SaveToFile(const FileName: String); override;
|
|
function Print: Boolean; override;
|
|
function Export(Filter: TfrxCustomExportFilter): Boolean; override;
|
|
procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
|
|
Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
|
|
Click: Boolean; var Cursor: TCursor; DBClick: Boolean = False); override;
|
|
property SourcePages: TList read FSourcePages;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
FMX.frxPreview, FMX.frxPrinter,
|
|
FMX.frxUtils, FMX.frxDMPClass, FMX.frxRes, FMX.frxPrintDialog, FMX.Dialogs,
|
|
FMX.frxBaseModalForm
|
|
{$IFDEF MSWINDOWS}
|
|
, Winapi.ShellAPI
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
,FMUX.Api
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
, Posix.Stdlib
|
|
{$ENDIF}
|
|
{$IFDEF FRVIEWER}
|
|
{$IFDEF MSWINDOWS}
|
|
, FMX.Forms
|
|
{$ENDIF}
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
THackComponent = class(TfrxComponent);
|
|
THackMemoView = class(TfrxCustomMemoView);
|
|
THackThread = class(TThread);
|
|
|
|
|
|
|
|
{ TfrxOutline }
|
|
|
|
procedure TfrxOutline.AddItem(const Text: String; Top: Integer);
|
|
begin
|
|
CurItem := CurItem.Add;
|
|
CurItem.Name := 'item';
|
|
CurItem.Text := 'text="' + frxStrToXML(Text) +
|
|
'" page="' + IntToStr(PreviewPages.CurPage) +
|
|
'" top="' + IntToStr(Top) + '"';
|
|
end;
|
|
|
|
procedure TfrxOutline.GetItem(Index: Integer; var Text: String; var Page,
|
|
Top: Integer);
|
|
var
|
|
Item: TfrxXMLItem;
|
|
s: String;
|
|
begin
|
|
Item := CurItem[Index];
|
|
Text := Item.Prop['text'];
|
|
|
|
s := String(Item.Prop['page']);
|
|
if s <> '' then
|
|
Page := StrToInt(s);
|
|
|
|
s := String(Item.Prop['top']);
|
|
if s <> '' then
|
|
Top := StrToInt(s);
|
|
end;
|
|
|
|
procedure TfrxOutline.LevelDown(Index: Integer);
|
|
begin
|
|
CurItem := CurItem[Index];
|
|
end;
|
|
|
|
procedure TfrxOutline.LevelRoot;
|
|
begin
|
|
CurItem := Root;
|
|
end;
|
|
|
|
procedure TfrxOutline.LevelUp;
|
|
begin
|
|
if CurItem <> Root then
|
|
CurItem := CurItem.Parent;
|
|
end;
|
|
|
|
function TfrxOutline.Root: TfrxXMLItem;
|
|
begin
|
|
Result := TfrxPreviewPages(PreviewPages).FXMLDoc.Root.FindItem('outline');
|
|
end;
|
|
|
|
function TfrxOutline.GetCount: Integer;
|
|
begin
|
|
if CurItem = nil then
|
|
Result := 0
|
|
else
|
|
Result := CurItem.Count;
|
|
end;
|
|
|
|
procedure TfrxOutline.ShiftItems(From: TfrxXMLItem; NewTop: Integer);
|
|
var
|
|
i, TopY, CorrY: Integer;
|
|
|
|
procedure EnumItems(Item: TfrxXMLItem);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
|
|
Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
|
|
for i := 0 to Item.Count - 1 do
|
|
EnumItems(Item[i]);
|
|
end;
|
|
|
|
begin
|
|
if From = nil then Exit;
|
|
i := From.Parent.IndexOf(From);
|
|
if i + 1 >= From.Parent.Count then Exit;
|
|
From := From.Parent[i + 1];
|
|
|
|
TopY := StrToInt(String(From.Prop['top']));
|
|
CorrY := NewTop - TopY;
|
|
EnumItems(From);
|
|
end;
|
|
|
|
function TfrxOutline.GetCurPosition: TfrxXMLItem;
|
|
begin
|
|
if Count = 0 then
|
|
Result := nil else
|
|
Result := CurItem[Count - 1];
|
|
end;
|
|
|
|
|
|
{ TfrxDictionary }
|
|
|
|
constructor TfrxDictionary.Create;
|
|
begin
|
|
FNames := TfrxStringList.Create;
|
|
FNames.Sorted := True;
|
|
FSourceNames := TStringList.Create;
|
|
end;
|
|
|
|
destructor TfrxDictionary.Destroy;
|
|
begin
|
|
FNames.Free;
|
|
FSourceNames.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxDictionary.Clear;
|
|
begin
|
|
FNames.Clear;
|
|
FSourceNames.Clear;
|
|
end;
|
|
|
|
procedure TfrxDictionary.Add(const Name, SourceName: String; Obj: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FSourceNames.AddObject(SourceName, Obj);
|
|
FNames.AddObject(Name, TObject(i));
|
|
end;
|
|
|
|
function TfrxDictionary.AddUnique(const Base, SourceName: String; Obj: TObject): String;
|
|
var
|
|
TempStr: String;
|
|
begin
|
|
TempStr := CreateUniqueName(Base);
|
|
Add(TempStr, SourceName, Obj);
|
|
Result := TempStr;
|
|
end;
|
|
|
|
function TfrxDictionary.CreateUniqueName(const Base: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := 10000;
|
|
while (i > 1) and (FNames.IndexOf(Base + IntToStr(i)) = -1) do
|
|
i := i div 2;
|
|
while FNames.IndexOf(Base + IntToStr(i)) <> -1 do
|
|
Inc(i);
|
|
Result := Base + IntToStr(i);
|
|
end;
|
|
|
|
function TfrxDictionary.GetObject(const Name: String): TObject;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
i := FNames.IndexOf(Name);
|
|
if i <> -1 then
|
|
Result := FSourceNames.Objects[frxInteger(FNames.Objects[i])];
|
|
end;
|
|
|
|
function TfrxDictionary.GetSourceName(const Name: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
i := FNames.IndexOf(Name);
|
|
if i <> -1 then
|
|
Result := FSourceNames[frxInteger(FNames.Objects[i])];
|
|
end;
|
|
|
|
|
|
{ TfrxPreviewPages }
|
|
|
|
constructor TfrxPreviewPages.Create(AReport: TfrxReport);
|
|
begin
|
|
inherited;
|
|
FDictionary := TfrxDictionary.Create;
|
|
FSourcePages := TList.Create;
|
|
FXMLDoc := TfrxXMLDocument.Create;
|
|
FXMLDoc.Root.Name := 'preparedreport';
|
|
FPageCache := TfrxStringList.Create;
|
|
FPageBitmapCache := TStringList.Create;
|
|
FPictureCache := TfrxPictureCache.Create;
|
|
FSerializer := TfrxXMLSerializer.Create(nil);
|
|
FLastY := 0;
|
|
FFastPrintCanvas := nil;
|
|
end;
|
|
|
|
destructor TfrxPreviewPages.Destroy;
|
|
begin
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
FPageCache.Free;
|
|
FPageBitmapCache.Free;
|
|
FDictionary.Free;
|
|
ClearSourcePages;
|
|
FPictureCache.Free;
|
|
FSourcePages.Free;
|
|
FXMLDoc.Free;
|
|
FSerializer.Free;
|
|
if Assigned(FFastPrintCanvas) then
|
|
FFastPrintCanvas.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.Clear;
|
|
begin
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
ClearSourcePages;
|
|
FXMLDoc.Clear;
|
|
FDictionary.Clear;
|
|
FPictureCache.Clear;
|
|
CurPage := -1;
|
|
FXMLSize := 0;
|
|
FLastY := 0;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.Initialize;
|
|
begin
|
|
FPictureCache.UseFileCache := Report.PreviewOptions.PictureCacheInFile;
|
|
FPictureCache.TempDir := Report.EngineOptions.TempDir;
|
|
FXMLDoc.TempDir := Report.EngineOptions.TempDir;
|
|
Report.InternalOnProgressStart(ptRunning);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearPageCache;
|
|
begin
|
|
while FPageCache.Count > 0 do
|
|
begin
|
|
TfrxReportPage(FPageCache.Objects[0]).Free;
|
|
FPageCache.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearPageBitmapCache;
|
|
begin
|
|
while FPageBitmapCache.Count > 0 do
|
|
begin
|
|
TBitmap(FPageBitmapCache.Objects[0]).Free;
|
|
FPageBitmapCache.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearSourcePages;
|
|
begin
|
|
while FSourcePages.Count > 0 do
|
|
begin
|
|
TfrxReportPage(FSourcePages[0]).Free;
|
|
FSourcePages.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.BeginPass;
|
|
begin
|
|
FFirstPageIndex := Count - 1;
|
|
if FFirstPageIndex <> -1 then
|
|
begin
|
|
FFirstObjectIndex := FXMLDoc.Root.FindItem('previewpages')[FFirstPageIndex].Count;
|
|
FFirstOutlineIndex := FXMLDoc.Root.FindItem('outline').Count;
|
|
end;
|
|
ResetLogicalPageNumber;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ClearFirstPassPages;
|
|
var
|
|
PagesRoot, OutlineRoot: TfrxXMLItem;
|
|
p: TfrxXMLItem;
|
|
i: Integer;
|
|
begin
|
|
if FFirstPageIndex = -1 then
|
|
begin
|
|
for i := 0 to FXMLDoc.Root.Count - 1 do
|
|
if (CompareText(FXMLDoc.Root[i].Name, 'anchors') <> 0) and
|
|
(CompareText(FXMLDoc.Root[i].Name, 'logicalpagenumbers') <> 0) then
|
|
FXMLDoc.Root[i].Clear;
|
|
|
|
end
|
|
else
|
|
begin
|
|
PagesRoot := FXMLDoc.Root.FindItem('previewpages');
|
|
OutlineRoot := FXMLDoc.Root.FindItem('outline');
|
|
p := PagesRoot[FFirstPageIndex];
|
|
{ clear some objects on first page }
|
|
while p.Count > FFirstObjectIndex do
|
|
p[FFirstObjectIndex].Free;
|
|
{ clear remained pages }
|
|
while Count > FFirstPageIndex + 1 do
|
|
PagesRoot[FFirstPageIndex + 1].Free;
|
|
{ clear remained outline }
|
|
while OutlineRoot.Count > FFirstOutlineIndex do
|
|
OutlineRoot[FFirstOutlineIndex].Free;
|
|
end;
|
|
|
|
ResetLogicalPageNumber;
|
|
CurPage := FFirstPageIndex;
|
|
FXMLSize := 0;
|
|
end;
|
|
|
|
function TfrxPreviewPages.CurXMLPage: TfrxXMLItem;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('previewpages');
|
|
Result := Result[CurPage];
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetCount: Integer;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('previewpages').Count;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetCurPosition: Integer;
|
|
begin
|
|
Result := CurXMLPage.Count;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddAnchor(const Text: String);
|
|
var
|
|
AnchorRoot, Item: TfrxXMLItem;
|
|
begin
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
Item := AnchorRoot.Add;
|
|
Item.Name := 'item';
|
|
Item.Text := 'text="' + frxStrToXML(Text) +
|
|
'" page="' + IntToStr(CurPage) +
|
|
'" top="' + IntToStr(Round(Engine.CurY)) + '"';
|
|
end;
|
|
|
|
function TfrxPreviewPages.FindAnchor(const Text: String): TfrxXMLItem;
|
|
var
|
|
AnchorRoot, Item: TfrxXMLItem;
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
for i := AnchorRoot.Count - 1 downto 0 do
|
|
begin
|
|
Item := AnchorRoot[i];
|
|
if frxCompareText(Item.Prop['text'], Text) = 0 then
|
|
begin
|
|
Result := Item;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetAnchorPage(const Text: String): Integer;
|
|
var
|
|
Item: TfrxXMLItem;
|
|
begin
|
|
Item := FindAnchor(Text);
|
|
if Item <> nil then
|
|
Result := StrToInt(String(Item.Prop['page'])) + 1 else
|
|
Result := 1;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetAnchorCurPosition: Integer;
|
|
begin
|
|
Result := FXMLDoc.Root.FindItem('anchors').Count - 1;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ShiftAnchors(From, NewTop: Integer);
|
|
var
|
|
i, CorrY: Integer;
|
|
AnchorRoot, Item: TfrxXMLItem;
|
|
begin
|
|
AnchorRoot := FXMLDoc.Root.FindItem('anchors');
|
|
if (From + 1 < 0) or (From + 1 >= AnchorRoot.Count) then Exit;
|
|
|
|
Item := AnchorRoot[From + 1];
|
|
CorrY := NewTop - StrToInt(String(Item.Prop['top']));
|
|
|
|
for i := From + 1 to AnchorRoot.Count - 1 do
|
|
begin
|
|
Item := AnchorRoot[i];
|
|
Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
|
|
Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.IncLogicalPageNumber;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
if Engine.FinalPass and Engine.DoublePass then Exit;
|
|
|
|
Inc(FLogicalPageN);
|
|
xi := FXMLDoc.Root.FindItem('logicalpagenumbers').Add;
|
|
xi.Name := 'page';
|
|
xi.Prop['n'] := IntToStr(FLogicalPageN);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ResetLogicalPageNumber;
|
|
var
|
|
i: Integer;
|
|
xi, pageItem: TfrxXMLItem;
|
|
begin
|
|
if Engine.FinalPass and Engine.DoublePass then Exit;
|
|
|
|
pageItem := FXMLDoc.Root.FindItem('logicalpagenumbers');
|
|
for i := CurPage downto FFirstPageIndex + 1 do
|
|
begin
|
|
if (i < 0) or (i >= pageItem.Count) then continue;
|
|
xi := pageItem[i];
|
|
xi.Prop['t'] := IntToStr(FLogicalPageN);
|
|
if xi.Prop['n'] = '1' then
|
|
break;
|
|
end;
|
|
FLogicalPageN := 0;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetLogicalPageNo: Integer;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
|
|
if (CurPage < 0) or (CurPage >= xi.Count) then
|
|
Result := CurPage - FirstPage + 1
|
|
else
|
|
begin
|
|
xi := xi[CurPage];
|
|
Result := StrToInt(String(xi.Prop['n']));
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetLogicalTotalPages: Integer;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
|
|
if (CurPage < 0) or (CurPage >= xi.Count) then
|
|
Result := Engine.TotalPages - FirstPage
|
|
else
|
|
begin
|
|
xi := xi[CurPage];
|
|
if xi.Prop['t'] <> '' then
|
|
Result := StrToInt(String(xi.Prop['t']))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddObject(Obj: TfrxComponent);
|
|
var
|
|
IsOriginalPage: Boolean;
|
|
CurPageItem: TfrxXMLItem;
|
|
|
|
procedure DoAdd(c: TfrxComponent; Item: TfrxXMLItem);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (not c.Visible) or not (csPreviewVisible in c.frComponentStyle) then Exit;
|
|
|
|
with THackComponent(c) do
|
|
begin
|
|
Item := Item.Add;
|
|
{ the component that was created after report has been started }
|
|
if (FOriginalComponent = nil) or IsOriginalPage then
|
|
begin
|
|
Item.Name := ClassName;
|
|
Item.Text := AllDiff(nil);
|
|
end
|
|
else
|
|
begin
|
|
{ the component that exists in the report template }
|
|
Item.Name := FAliasName;
|
|
if Engine.FinalPass then
|
|
begin
|
|
if csDefaultDiff in frComponentStyle then
|
|
Item.Text := AllDiff(FOriginalComponent) else
|
|
Item.Text := Diff(FOriginalComponent);
|
|
end
|
|
else
|
|
{ we don't need to output all info on the first pass, only coordinates }
|
|
Item.Text := InternalDiff(FOriginalComponent);
|
|
end;
|
|
Inc(FXMLSize, Length(Item.Name) + Length(Item.Text) + Item.InstanceSize + 16);
|
|
end;
|
|
|
|
for i := 0 to c.Objects.Count - 1 do
|
|
DoAdd(c.Objects[i], Item);
|
|
end;
|
|
|
|
begin
|
|
CurPageItem := CurXMLPage;
|
|
{ need for PrintOnPrevPage option when report has pages added by AddFrom method}
|
|
IsOriginalPage := ((CompareText(CurPageItem.Name, 'TfrxReportPage') = 0) or
|
|
(CompareText(CurPageItem.Name, 'TfrxDMPPage') = 0));
|
|
DoAdd(Obj, CurPageItem);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddPage(Page: TfrxReportPage);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
|
|
procedure UnloadPages;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Report.EngineOptions.UseFileCache then
|
|
if FXMLSize > Report.EngineOptions.MaxMemSize * 1024 * 1024 then
|
|
begin
|
|
for i := xi.Count - 2 downto 0 do
|
|
if xi[i].Loaded then
|
|
FXMLDoc.UnloadItem(xi[i]) else
|
|
break;
|
|
FXMLSize := 0;
|
|
end;
|
|
end;
|
|
|
|
function GetSourceNo(Page: TfrxReportPage): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := -1;
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
if THackComponent(FSourcePages[i]).FOriginalComponent = Page then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FPagesItem := FXMLDoc.Root.FindItem('previewpages');
|
|
xi := FPagesItem;
|
|
UnloadPages;
|
|
|
|
CurPage := CurPage + 1;
|
|
if (CurPage >= Count) or (AddPageAction = apAdd) then
|
|
begin
|
|
xi := xi.Add;
|
|
xi.Name := 'page' + IntToStr(GetSourceNo(Page));
|
|
if Count > 2 then
|
|
xi.Unloadable := True;
|
|
Report.InternalOnProgress(ptRunning, CurPage + 1);
|
|
AddPageAction := apWriteOver;
|
|
CurPage := Count - 1;
|
|
IncLogicalPageNumber;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddSourcePage(Page: TfrxReportPage);
|
|
var
|
|
p: TfrxReportPage;
|
|
xs: TfrxXMLSerializer;
|
|
xi: TfrxXMLItem;
|
|
i: Integer;
|
|
originals, copies: TList;
|
|
c1, c2: TfrxComponent;
|
|
s, s1: String;
|
|
|
|
function EnumObjects(Parent, Parent1: TfrxComponent): TfrxComponent;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
Result := nil;
|
|
if not (csPreviewVisible in Parent.frComponentStyle) then
|
|
begin
|
|
originals.Add(Parent);
|
|
copies.Add(nil);
|
|
Exit;
|
|
end;
|
|
|
|
c := TfrxComponent(Parent.NewInstance);
|
|
c.Create(Parent1);
|
|
if Parent is TfrxPictureView then
|
|
TfrxPictureView(Parent).IsPictureStored := False;
|
|
c.Assign(Parent);
|
|
if Parent is TfrxPictureView then
|
|
TfrxPictureView(Parent).IsPictureStored := True;
|
|
c.Name := Parent.Name;
|
|
originals.Add(Parent);
|
|
copies.Add(c);
|
|
|
|
for i := 0 to Parent.Objects.Count - 1 do
|
|
EnumObjects(Parent.Objects[i], c);
|
|
Result := c;
|
|
end;
|
|
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
xi := TfrxXMLItem.Create;
|
|
originals := TList.Create;
|
|
copies := TList.Create;
|
|
|
|
try
|
|
p := TfrxReportPage(EnumObjects(Page, nil));
|
|
THackComponent(p).FOriginalComponent := Page;
|
|
FSourcePages.Add(p);
|
|
|
|
for i := 1 to copies.Count - 1 do
|
|
begin
|
|
c1 := copies[i];
|
|
c2 := originals[i];
|
|
if (c1 = nil) and not (csPreviewVisible in c2.frComponentStyle ) then
|
|
begin
|
|
c2.AddSourceObjects;
|
|
continue;
|
|
end;
|
|
|
|
THackComponent(c2).FOriginalComponent := c1;
|
|
THackComponent(c1).FOriginalComponent := c2;
|
|
|
|
if c1 is TfrxBand then
|
|
s := 'b' else
|
|
s := LowerCase(c1.BaseName[1]);
|
|
s := FDictionary.AddUnique(String(s), 'Page' + IntToStr(FSourcePages.Count - 1) +
|
|
'.' + c1.Name, c1);
|
|
// speed optimization
|
|
if c1 is TfrxCustomMemoView then
|
|
begin
|
|
TfrxCustomMemoView(c1).DataSet := nil;
|
|
TfrxCustomMemoView(c1).DataField := '';
|
|
end;
|
|
if csDefaultDiff in c1.frComponentStyle then
|
|
s1 := c1.ClassName
|
|
else
|
|
s1 := xs.WriteComponentStr(c1);
|
|
THackComponent(c1).FBaseName := s1;
|
|
THackComponent(c1).FAliasName := s;
|
|
THackComponent(c2).FAliasName := s;
|
|
end;
|
|
|
|
finally
|
|
originals.Free;
|
|
copies.Free;
|
|
xs.Free;
|
|
xi.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddPicture(Picture: TfrxPictureView);
|
|
begin
|
|
FPictureCache.AddPicture(Picture);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddToSourcePage(Obj: TfrxComponent);
|
|
var
|
|
NewObj: TfrxComponent;
|
|
Page: TfrxReportPage;
|
|
s: String;
|
|
xs: TfrxXMLSerializer;
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
Page := FSourcePages[FSourcePages.Count - 1];
|
|
NewObj := TfrxComponent(Obj.NewInstance);
|
|
NewObj.Create(Page);
|
|
NewObj.Assign(Obj);
|
|
NewObj.CreateUniqueName;
|
|
|
|
s := FDictionary.AddUnique(LowerCase(String(NewObj.BaseName[1])),
|
|
'Page' + IntToStr(FSourcePages.Count - 1) + '.' + NewObj.Name, NewObj);
|
|
if csDefaultDiff in NewObj.frComponentStyle then
|
|
THackComponent(NewObj).FBaseName := NewObj.ClassName else
|
|
THackComponent(NewObj).FBaseName := xs.WriteComponentStr(NewObj);
|
|
|
|
THackComponent(Obj).FOriginalComponent := NewObj;
|
|
THackComponent(Obj).FAliasName := s;
|
|
THackComponent(NewObj).FAliasName := s;
|
|
xs.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
|
|
var
|
|
SourcePage: TfrxReportPage;
|
|
xi: TfrxXMLItem;
|
|
i: Integer;
|
|
begin
|
|
SourcePage := nil;
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
begin
|
|
SourcePage := FSourcePages[i];
|
|
if THackComponent(SourcePage).FOriginalComponent = Page then
|
|
break;
|
|
end;
|
|
|
|
SourcePage.PaperSize := 256;
|
|
SourcePage.PaperWidth := Width / fr01cm;
|
|
SourcePage.PaperHeight := Height / fr01cm;
|
|
xi := TfrxXMLItem.Create;
|
|
xi.Text := THackComponent(SourcePage).FBaseName;
|
|
xi.Prop['PaperSize'] := '256';
|
|
xi.Prop['PaperWidth'] := frxFloatToStr(SourcePage.PaperWidth);
|
|
xi.Prop['PaperHeight'] := frxFloatToStr(SourcePage.PaperHeight);
|
|
THackComponent(SourcePage).FBaseName := xi.Text;
|
|
xi.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.Finish;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FLastY := 0;
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
{ avoid bug with multiple PrepareReport(False) }
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
THackComponent(FSourcePages[i]).FOriginalComponent := nil;
|
|
Report.InternalOnProgressStop(ptRunning);
|
|
end;
|
|
|
|
function TfrxPreviewPages.BandExists(Band: TfrxBand): Boolean;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to CurXMLPage.Count - 1 do
|
|
begin
|
|
c := GetObject(CurXMLPage[i].Name);
|
|
if c <> nil then
|
|
if (THackComponent(c).FOriginalComponent = Band) or
|
|
((Band is TfrxPageFooter) and (c is TfrxPageFooter)) or
|
|
((Band is TfrxColumnFooter) and (c is TfrxColumnFooter)) then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetLastY(ColumnPosition: Extended): Extended;
|
|
var
|
|
i: Integer;
|
|
c: TfrxComponent;
|
|
s: String;
|
|
y, x: Extended;
|
|
begin
|
|
Result := 0;
|
|
y := 0;
|
|
for i := 0 to CurXMLPage.Count - 1 do
|
|
begin
|
|
c := GetObject(CurXMLPage[i].Name);
|
|
if c is TfrxBand then
|
|
if not (c is TfrxPageFooter) and not (c is TfrxOverlay) then
|
|
begin
|
|
s := String(CurXMLPage[i].Prop['l']);
|
|
if s <> '' then
|
|
x := frxStrToFloat(s) else
|
|
x := c.Left;
|
|
{ check columns }
|
|
if (ColumnPosition = 0) or (ABS(ColumnPosition - x) < 0.001)
|
|
or (c is TfrxPageHeader) or (c is TfrxReportTitle) then
|
|
begin
|
|
s := String(CurXMLPage[i].Prop['t']);
|
|
if s <> '' then
|
|
y := frxStrToFloat(s) else
|
|
y := c.Top;
|
|
|
|
s := String(CurXMLPage[i].Prop['h']);
|
|
if s <> '' then
|
|
y := y + frxStrToFloat(s) else
|
|
y := y + c.Height;
|
|
end;
|
|
if y > Result then
|
|
Result := y;
|
|
end;
|
|
end;
|
|
if (Result = 0) and (FLastY <> 0) then
|
|
Result := FLastY;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.CutObjects(APosition: Integer);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('cutted');
|
|
while APosition < CurXMLPage.Count do
|
|
xi.AddItem(CurXMLPage[APosition]);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.PasteObjects(X, Y: Extended);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
LeftX, TopY, CorrX, CorrY: Extended;
|
|
|
|
procedure CorrectX(xi: TfrxXMLItem);
|
|
var
|
|
X: Extended;
|
|
begin
|
|
if xi.Prop['l'] <> '' then
|
|
X := frxStrToFloat(xi.Prop['l']) else
|
|
X := 0;
|
|
X := X + CorrX;
|
|
xi.Prop['l'] := FloatToStr(X);
|
|
end;
|
|
|
|
procedure CorrectY(xi: TfrxXMLItem);
|
|
var
|
|
Y: Extended;
|
|
begin
|
|
if xi.Prop['t'] <> '' then
|
|
Y := frxStrToFloat(xi.Prop['t']) else
|
|
Y := 0;
|
|
Y := Y + CorrY;
|
|
xi.Prop['t'] := FloatToStr(Y);
|
|
end;
|
|
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('cutted');
|
|
|
|
if xi.Count > 0 then
|
|
begin
|
|
if xi[0].Prop['l'] <> '' then
|
|
LeftX := frxStrToFloat(xi[0].Prop['l']) else
|
|
LeftX := 0;
|
|
CorrX := X - LeftX;
|
|
|
|
if xi[0].Prop['t'] <> '' then
|
|
TopY := frxStrToFloat(xi[0].Prop['t']) else
|
|
TopY := 0;
|
|
CorrY := Y - TopY;
|
|
|
|
while xi.Count > 0 do
|
|
begin
|
|
CorrectX(xi[0]);
|
|
CorrectY(xi[0]);
|
|
CurXMLPage.AddItem(xi[0]);
|
|
end;
|
|
end;
|
|
|
|
xi.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DoLoadFromStream;
|
|
var
|
|
Compressor: TfrxCustomCompressor;
|
|
begin
|
|
Compressor := nil;
|
|
if frxCompressorClass <> nil then
|
|
begin
|
|
FAllowPartialLoading := False;
|
|
Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
|
|
Compressor.Create(nil);
|
|
Compressor.Report := Report;
|
|
Compressor.IsFR3File := False;
|
|
try
|
|
Compressor.CreateStream;
|
|
if Compressor.Decompress(FTempStream) then
|
|
FTempStream := Compressor.Stream;
|
|
except
|
|
Compressor.Free;
|
|
Report.Errors.Add(frxResources.Get('clDecompressError'));
|
|
frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text);
|
|
Exit;
|
|
end;
|
|
end;
|
|
FXMLDoc.LoadFromStream(FTempStream, FAllowPartialLoading);
|
|
AfterLoad;
|
|
if Compressor <> nil then
|
|
Compressor.Free;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DoSaveToStream;
|
|
var
|
|
Compressor: TfrxCustomCompressor;
|
|
StreamTo: TStream;
|
|
begin
|
|
StreamTo := FTempStream;
|
|
Compressor := nil;
|
|
if Report.ReportOptions.Compressed and (frxCompressorClass <> nil) then
|
|
begin
|
|
Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
|
|
Compressor.Create(nil);
|
|
Compressor.Report := Report;
|
|
Compressor.IsFR3File := False;
|
|
Compressor.CreateStream;
|
|
StreamTo := Compressor.Stream;
|
|
end;
|
|
try
|
|
BeforeSave;
|
|
FXMLDoc.SaveToStream(StreamTo);
|
|
finally
|
|
if Compressor <> nil then
|
|
begin
|
|
try
|
|
Compressor.Compress(FTempStream);
|
|
finally
|
|
Compressor.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.LoadFromStream(Stream: TStream;
|
|
AllowPartialLoading: Boolean = False);
|
|
begin
|
|
Clear;
|
|
FTempStream := Stream;
|
|
FAllowPartialLoading := AllowPartialLoading;
|
|
DoLoadFromStream;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.SaveToStream(Stream: TStream);
|
|
begin
|
|
FTempStream := Stream;
|
|
DoSaveToStream;
|
|
end;
|
|
|
|
function TfrxPreviewPages.LoadFromFile(const FileName: String;
|
|
ExceptionIfNotFound: Boolean): Boolean;
|
|
var
|
|
Stream: TFileStream;
|
|
{$IFDEF FRVIEWER}
|
|
{$IFDEF MSWINDOWS}
|
|
RepStream: TStringStream;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
Result := FileExists(FileName);
|
|
if Result or ExceptionIfNotFound then
|
|
begin
|
|
{$IFDEF FRVIEWER}
|
|
{$IFDEF MSWINDOWS}
|
|
RepStream := TStringStream.Create;
|
|
try
|
|
RepStream.LoadFromFile(FileName);
|
|
if Pos('PixelsPerInch' ,RepStream.DataString, 1)= 0 then
|
|
begin
|
|
ShellExecute(0, 'open', PChar(ExtractFilePath(ParamStr(0)) + 'FastReportVCL_Viewer.exe'), PChar(FileName), '', 0);
|
|
Application.Terminate;
|
|
end;
|
|
finally
|
|
RepStream.Free;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Stream := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.SaveToFile(const FileName: String);
|
|
var
|
|
Stream: TFileStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AfterLoad;
|
|
var
|
|
i: Integer;
|
|
xs: TfrxXMLSerializer;
|
|
xi: TfrxXMLItem;
|
|
p: TfrxReportPage;
|
|
|
|
{ store source objects' properties in the FBaseName to get it later in the GetPage }
|
|
procedure DoProps(p: TfrxReportPage);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
c: THackComponent;
|
|
begin
|
|
l := p.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
c := l[i];
|
|
c.FBaseName := xs.WriteComponentStr(c);
|
|
end;
|
|
end;
|
|
|
|
{ fill FDictionary.Objects }
|
|
procedure FillDictionary;
|
|
var
|
|
i: Integer;
|
|
Name, PageName, ObjName: String;
|
|
PageN: Integer;
|
|
begin
|
|
xi := FXMLDoc.Root.FindItem('dictionary');
|
|
FDictionary.Clear;
|
|
for i := 0 to xi.Count - 1 do
|
|
begin
|
|
Name := Copy(xi[i].Text, 7, Length(xi[i].Text) - 7);
|
|
PageName := Copy(Name, 1, Pos('.', Name) - 1);
|
|
ObjName := Copy(Name, Pos('.', Name) + 1, 255);
|
|
|
|
PageN := StrToInt(Copy(PageName, 5, 255));
|
|
FDictionary.Add(xi[i].Name, Name,
|
|
TfrxReportPage(FSourcePages[PageN]).FindObject(ObjName));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FPagesItem := FXMLDoc.Root.FindItem('previewpages');
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
xs.OldFormat := FXMLDoc.OldVersion;
|
|
|
|
{ load the report settings }
|
|
xi := FXMLDoc.Root.FindItem('report');
|
|
if xi.Count > 0 then
|
|
xs.ReadRootComponent(Report, xi[0]);
|
|
|
|
{ build sourcepages }
|
|
try
|
|
xi := FXMLDoc.Root.FindItem('sourcepages');
|
|
ClearSourcePages;
|
|
|
|
for i := 0 to xi.Count - 1 do
|
|
begin
|
|
if CompareText(xi[i].Name, 'TfrxDMPPage') = 0 then
|
|
p := TfrxDMPPage.Create(nil) else
|
|
p := TfrxReportPage.Create(nil);
|
|
xs.Owner := p;
|
|
xs.ReadRootComponent(p, xi[i]);
|
|
DoProps(p);
|
|
FSourcePages.Add(p);
|
|
end;
|
|
xi.Clear;
|
|
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
|
|
{ build the dictionary }
|
|
FillDictionary;
|
|
|
|
{ load the picturecache }
|
|
FPictureCache.LoadFromXML(FXMLDoc.Root.FindItem('picturecache'));
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.BeforeSave;
|
|
var
|
|
i: Integer;
|
|
xs: TfrxXMLSerializer;
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
FPagesItem := FXMLDoc.Root.FindItem('previewpages');
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
|
|
{ upload the report settings }
|
|
xi := FXMLDoc.Root.FindItem('report');
|
|
xi.Clear;
|
|
xi := xi.Add;
|
|
xi.Name := Report.ClassName;
|
|
xi.Text := 'DotMatrixReport="' + frxValueToXML(Report.DotMatrixReport) +
|
|
'" PreviewOptions.OutlineVisible="' + frxValueToXML(Report.PreviewOptions.OutlineVisible) +
|
|
'" PreviewOptions.OutlineWidth="' + frxValueToXML(Report.PreviewOptions.OutlineWidth) +
|
|
'" ReportOptions.Name="' + frxStrToXML(Report.ReportOptions.Name) + '"';
|
|
|
|
{ upload the sourcepages }
|
|
try
|
|
xi := FXMLDoc.Root.FindItem('sourcepages');
|
|
xi.Clear;
|
|
for i := 0 to FSourcePages.Count - 1 do
|
|
xs.WriteRootComponent(FSourcePages[i], True, xi.Add);
|
|
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
|
|
{ upload the dictionary }
|
|
xi := FXMLDoc.Root.FindItem('dictionary');
|
|
xi.Clear;
|
|
for i := 0 to FDictionary.Names.Count - 1 do
|
|
with xi.Add do
|
|
begin
|
|
Name := FDictionary.Names[i];
|
|
Text := 'name="' + FDictionary.GetSourceName(Name) + '"';
|
|
end;
|
|
|
|
{ upload the picturecache }
|
|
xi := FXMLDoc.Root.FindItem('picturecache');
|
|
FPictureCache.SaveToXML(xi);
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetObject(const Name: String): TfrxComponent;
|
|
begin
|
|
Result := TfrxComponent(FDictionary.GetObject(Name));
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetPage(Index: Integer): TfrxReportPage;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
i: Integer;
|
|
Source: TfrxReportPage;
|
|
|
|
procedure DoObjects(Item: TfrxXMLItem; Owner: TfrxComponent);
|
|
var
|
|
i: Integer;
|
|
c, c0: TfrxComponent;
|
|
begin
|
|
for i := 0 to Item.Count - 1 do
|
|
begin
|
|
c0 := GetObject(Item[i].Name);
|
|
{ object not found in the dictionary }
|
|
if c0 = nil then
|
|
c := FSerializer.ReadComponentStr(Owner, Item[i].Name + ' ' + Item[i].Text, True)
|
|
else
|
|
begin
|
|
c := FSerializer.ReadComponentStr(Owner,
|
|
THackComponent(c0).FBaseName + ' ' + Item[i].Text, True);
|
|
c.Name := c0.Name;
|
|
if (c is TfrxPictureView) and (TfrxPictureView(c).Picture.IsEmpty) then
|
|
FPictureCache.GetPicture(TfrxPictureView(c));
|
|
end;
|
|
c.Parent := Owner;
|
|
|
|
DoObjects(Item[i], c);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := nil;
|
|
if Count = 0 then Exit;
|
|
{ check pagecache first }
|
|
if not Engine.Running then
|
|
begin
|
|
i := FPageCache.IndexOf(IntToStr(Index));
|
|
if i <> -1 then
|
|
begin
|
|
Result := TfrxReportPage(FPageCache.Objects[i]);
|
|
FPageCache.Exchange(i, 0);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
FSerializer.OldFormat := FXMLDoc.OldVersion;
|
|
FSerializer.Owner := nil;
|
|
{ load the page item }
|
|
xi := FPagesItem[Index];
|
|
FXMLDoc.LoadItem(xi);
|
|
|
|
if CompareText(xi.Name, 'TfrxReportPage') = 0 then
|
|
begin
|
|
{ page item do not refer to the originalpages }
|
|
Result := TfrxReportPage.Create(nil);
|
|
FSerializer.ReadRootComponent(Result, xi);
|
|
end
|
|
else if CompareText(xi.Name, 'TfrxDMPPage') = 0 then
|
|
begin
|
|
{ page item do not refer to the originalpages }
|
|
Result := TfrxDMPPage.Create(nil);
|
|
FSerializer.ReadRootComponent(Result, xi);
|
|
end
|
|
else
|
|
begin
|
|
Source := FSourcePages[StrToInt(Copy(String(xi.Name), 5, 5))];
|
|
{ create reportpage and assign properties from original page }
|
|
if Source is TfrxDMPPage then
|
|
Result := TfrxDMPPage.Create(nil)
|
|
else
|
|
Result := TfrxReportPage.Create(nil);
|
|
Result.Assign(Source);
|
|
Result.Name := Source.Name;
|
|
{ create objects }
|
|
DoObjects(xi, Result);
|
|
end;
|
|
{ update aligned objects }
|
|
Result.AlignChildren;
|
|
{ add this page to the pagecache }
|
|
FPageCache.InsertObject(0, IntToStr(Index), Result);
|
|
i := FPageCache.Count;
|
|
|
|
{ remove the least used item from the pagecache }
|
|
if (i > 1) and (i > Report.PreviewOptions.PagesInCache) then
|
|
begin
|
|
xi := FPagesItem[StrToInt(FPageCache[i - 1])];
|
|
if Report.EngineOptions.UseFileCache and xi.Unloadable then
|
|
begin
|
|
FXMLDoc.UnloadItem(xi);
|
|
xi.Clear;
|
|
end;
|
|
TfrxReportPage(FPageCache.Objects[i - 1]).Free;
|
|
FPageCache.Delete(i - 1);
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.GetPageSize(Index: Integer): TPoint;
|
|
var
|
|
xi: TfrxXMLItem;
|
|
p: TfrxReportPage;
|
|
begin
|
|
if (Count = 0) or (Index < 0) or (Index >= Count) then
|
|
begin
|
|
Result := Point(0, 0);
|
|
Exit;
|
|
end;
|
|
|
|
xi := FPagesItem[Index];
|
|
if (CompareText(xi.Name, 'TfrxReportPage') = 0) or
|
|
(CompareText(xi.Name, 'TfrxDMPPage') = 0) then
|
|
p := GetPage(Index) else
|
|
p := FSourcePages[StrToInt(Copy(String(xi.Name), 5, 256))];
|
|
Result.X := Round(p.Width);
|
|
Result.Y := Round(p.Height);
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddEmptyPage(Index: Integer);
|
|
var
|
|
xi: TfrxXMLItem;
|
|
begin
|
|
if Count = 0 then Exit;
|
|
|
|
xi := TfrxXMLItem.Create;
|
|
xi.Name := FPagesItem[Index].Name;
|
|
FPagesItem.InsertItem(Index, xi);
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DeletePage(Index: Integer);
|
|
begin
|
|
if Count < 2 then Exit;
|
|
|
|
FPagesItem[Index].Free;
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ModifyPage(Index: Integer; Page: TfrxReportPage);
|
|
var
|
|
xs: TfrxXMLSerializer;
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
try
|
|
FPagesItem[Index].Clear;
|
|
xs.WriteRootComponent(Page, True, FPagesItem[Index]);
|
|
FPagesItem[Index].Unloadable := False;
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
finally
|
|
xs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.AddFrom(Report: TfrxReport);
|
|
var
|
|
i, nPageOffset: Integer;
|
|
Page: TfrxReportPage;
|
|
xi: TfrxXMLItem;
|
|
xs: TfrxXMLSerializer;
|
|
AnchorRootSource, AnchorRootDest: TfrxXMLItem;
|
|
|
|
procedure CopyOutline;
|
|
var
|
|
nPage, nTop, idx: Integer;
|
|
sText: String;
|
|
begin
|
|
for idx := 0 to Report.PreviewPages.Outline.Count - 1 do
|
|
begin
|
|
Report.PreviewPages.Outline.GetItem(idx, sText, nPage, nTop);
|
|
CurPage := nPageOffset + nPage;
|
|
Outline.AddItem(sText, nTop);
|
|
Report.PreviewPages.Outline.LevelDown(idx);
|
|
CopyOutline;
|
|
Report.PreviewPages.Outline.LevelUp;
|
|
Outline.LevelUp;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
xs := TfrxXMLSerializer.Create(nil);
|
|
|
|
nPageOffset := Count;
|
|
|
|
for i := 0 to Report.PreviewPages.Count - 1 do
|
|
begin
|
|
Page := Report.PreviewPages.Page[i];
|
|
xi := TfrxXMLItem.Create;
|
|
xi.Name := FPagesItem[Count - 1].Name;
|
|
xs.WriteRootComponent(Page, True, xi);
|
|
xi.Unloadable := False;
|
|
FPagesItem.AddItem(xi);
|
|
end;
|
|
|
|
{ Copy Anchors items}
|
|
AnchorRootDest := FXMLDoc.Root.FindItem('anchors');
|
|
AnchorRootSource := TfrxPreviewPages(Report.PreviewPages).FXMLDoc.Root.FindItem('anchors');
|
|
|
|
for i := 0 to AnchorRootSource.Count - 1 do
|
|
begin
|
|
xi := AnchorRootSource[i];
|
|
with AnchorRootDest.Add do
|
|
begin
|
|
Name := 'item';
|
|
Text := xi.Text;
|
|
Prop['page'] := IntToStr(StrToInt(Prop['page']) + nPageOffset);
|
|
end;
|
|
end;
|
|
|
|
{copy outline items}
|
|
Report.PreviewPages.Outline.LevelRoot;
|
|
Outline.LevelRoot;
|
|
CopyOutline;
|
|
if Report.PreviewPages.Count <> 0 then
|
|
begin
|
|
Report.PreviewPages.CurPage := Report.PreviewPages.Count - 1;
|
|
FLastY := Report.PreviewPages.GetLastY;
|
|
Report.PreviewPages.CurPage := -1;
|
|
end;
|
|
|
|
xs.Free;
|
|
ClearPageCache;
|
|
ClearPageBitmapCache;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DrawPageInternal(Index: Integer; Canvas: TCanvas;
|
|
ScaleX, ScaleY, OffsetX, OffsetY: Extended; WorkArea: TRectF);
|
|
var
|
|
i, pCount: Integer;
|
|
Page: TfrxReportPage;
|
|
l: TList;
|
|
c: TfrxComponent;
|
|
IsPrinting: Boolean;
|
|
SaveLeftMargin, SaveRightMargin: Extended;
|
|
ObjectRect: TRectF;
|
|
begin
|
|
Page := GetPage(Index);
|
|
if Page = nil then
|
|
Exit;
|
|
|
|
SaveLeftMargin := Page.LeftMargin;
|
|
SaveRightMargin := Page.RightMargin;
|
|
if Page.MirrorMargins and (Index mod 2 = 1) then
|
|
begin
|
|
Page.LeftMargin := SaveRightMargin;
|
|
Page.RightMargin := SaveLeftMargin;
|
|
end;
|
|
|
|
IsPrinting := THackCanvas(Canvas).FPrinter <> nil;
|
|
Page.IsPrinting := IsPrinting;
|
|
Page.Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
|
|
OffsetX := OffsetX + Page.LeftMargin * fr01cm * ScaleX;
|
|
OffsetY := OffsetY + Page.TopMargin * fr01cm * ScaleY;
|
|
|
|
l := Page.AllObjects;
|
|
pCount := Count;
|
|
for i := 0 to l.Count - 1 do
|
|
begin
|
|
c := l[i];
|
|
if (c is TfrxView) then
|
|
if not IsPrinting or TfrxView(c).Printable then
|
|
begin
|
|
c.IsPrinting := IsPrinting;
|
|
TfrxView(c).SetFastCanvas(FFastCanvas);
|
|
{ needed for TOTALPAGES macro }
|
|
if c is TfrxCustomMemoView then
|
|
begin
|
|
c.IsPrinting := IsPrinting;
|
|
THackMemoView(c).FTotalPages := pCount;
|
|
THackMemoView(c).FCopyNo := FCopyNo;
|
|
THackMemoView(c).FPrintScale := FPrintScale;
|
|
end;
|
|
{ draw the object }
|
|
if WorkArea.Width = 1 then
|
|
WorkArea.Right := WorkArea.Right + 1
|
|
|
|
else if WorkArea.Height = 1 then
|
|
WorkArea.Bottom := WorkArea.Bottom + 1;
|
|
|
|
|
|
TfrxView(c).GetVisibleRect(ObjectRect);
|
|
|
|
ObjectRect.Left := ObjectRect.Left * ScaleX + OffsetX;
|
|
ObjectRect.Top := ObjectRect.Top * ScaleY + OffsetY;
|
|
|
|
if ObjectRect.Left < WorkArea.Left then
|
|
ObjectRect.Left := WorkArea.Left;
|
|
if ObjectRect.Top < WorkArea.Top then
|
|
ObjectRect.Top := WorkArea.Top;
|
|
|
|
ObjectRect.Right := ObjectRect.Right * ScaleX + OffsetX;
|
|
ObjectRect.Bottom := ObjectRect.Bottom * ScaleY + OffsetY;
|
|
if ObjectRect.Right > WorkArea.Right then
|
|
ObjectRect.Right := WorkArea.Right - 1;
|
|
if ObjectRect.Bottom > WorkArea.Bottom then
|
|
ObjectRect.Bottom := WorkArea.Bottom - 1;
|
|
|
|
if WorkArea.Contains(PointF(ObjectRect.Left + 1, ObjectRect.Top + 1)) and
|
|
WorkArea.Contains(PointF(ObjectRect.Right - 1, ObjectRect.Top + 1)) and
|
|
WorkArea.Contains(PointF(ObjectRect.Left + 1, ObjectRect.Bottom - 1)) and
|
|
WorkArea.Contains(PointF(ObjectRect.Right - 1, ObjectRect.Bottom - 1))
|
|
{ zero rect means we want to draw everything, print or export }
|
|
or ((WorkArea.Top = 0) and (WorkArea.Left = 0) and
|
|
(WorkArea.Right = 0) and (WorkArea.Bottom = 0)) then
|
|
begin
|
|
TfrxView(c).Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
|
|
c.IsPrinting := False;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
Page.LeftMargin := SaveLeftMargin;
|
|
Page.RightMargin := SaveRightMargin;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.DrawPage(Index: Integer; Canvas: TCanvas;
|
|
ScaleX, ScaleY, OffsetX, OffsetY: Extended; WorkArea: TRectF);
|
|
var
|
|
i: Integer;
|
|
Page: TfrxReportPage;
|
|
IsPrinting: Boolean;
|
|
Bitmap: TBitmap;
|
|
begin
|
|
Bitmap := nil;
|
|
FFastCanvas := nil;
|
|
IsPrinting := THackCanvas(Canvas).FPrinter <> nil;
|
|
{$IFDEF DELPHI25}
|
|
if (Report <> nil) and Assigned(FFastPrintCanvas) then
|
|
begin
|
|
FFastPrintCanvas.Canvas := Canvas;
|
|
FFastCanvas := FFastPrintCanvas;
|
|
end;
|
|
{$ENDIF}
|
|
if IsPrinting or Engine.Running then
|
|
begin
|
|
DrawPageInternal(Index, Canvas, ScaleX, ScaleY, OffsetX, OffsetY, WorkArea);
|
|
Exit;
|
|
end;
|
|
if (Report <> nil) and (Report.Preview <> nil) then
|
|
FFastCanvas := Report.Preview.GetCanvas;
|
|
|
|
if FLastScale <> ScaleX then
|
|
begin
|
|
ClearPageBitmapCache;
|
|
FLastScale := ScaleX;
|
|
end;
|
|
i := FPageBitmapCache.IndexOf(IntToStr(Index));
|
|
if i <> -1 then
|
|
begin
|
|
Bitmap := TBitmap(FPageBitmapCache.Objects[i]);
|
|
FPageBitmapCache.Exchange(i, 0);
|
|
end
|
|
else
|
|
begin
|
|
Page := GetPage(Index);
|
|
if Page = nil then Exit;
|
|
if Report.PreviewOptions.PagesInPictureCache and
|
|
(Round(Page.Width * ScaleX) < Report.PreviewOptions.MaxPagePictureWidth)
|
|
and (Round(Page.Height * ScaleX) <
|
|
Report.PreviewOptions.MaxPagePictureHeight) then
|
|
begin
|
|
Bitmap := TBitmap.Create(Round(Page.Width * ScaleX),
|
|
Round(Page.Height * ScaleY));
|
|
Bitmap.Canvas.BeginScene;
|
|
try
|
|
Bitmap.Canvas.Clear(claWhite);
|
|
DrawPageInternal(Index, Bitmap.Canvas, ScaleX, ScaleY, 0, 0,
|
|
RectF(0, 0, 0, 0));
|
|
finally
|
|
Bitmap.Canvas.EndScene;
|
|
end;
|
|
{ add this page to the pagecache }
|
|
FPageBitmapCache.InsertObject(0, IntToStr(Index), Bitmap);
|
|
i := FPageBitmapCache.Count;
|
|
|
|
{ remove the least used item from the pagecache }
|
|
if (i > 1) and (i > Report.PreviewOptions.PagesInCache) then
|
|
begin
|
|
TBitmap(FPageBitmapCache.Objects[i - 1]).Free;
|
|
FPageBitmapCache.Delete(i - 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if Bitmap <> nil then
|
|
Canvas.DrawBitmap(Bitmap, RectF(0, 0, Bitmap.Width, Bitmap.Height),
|
|
RectF(OffsetX, OffsetY, OffsetX + Bitmap.Width, OffsetY + Bitmap.Height), 1)
|
|
else
|
|
DrawPageInternal(Index, Canvas, ScaleX, ScaleY, OffsetX, OffsetY, WorkArea);
|
|
end;
|
|
|
|
function TfrxPreviewPages.Print: Boolean;
|
|
var
|
|
MaxCount: Integer;
|
|
PagesPrinted, ACopyNo: Integer;
|
|
pgList: TStringList;
|
|
LastDuplexMode: TfrxDuplexMode;
|
|
LastPaperSize, LastPaperWidth, LastPaperHeight, LastBin: Integer;
|
|
LastOrientation: TPrinterOrientation;
|
|
DuplexMode: TfrxDuplexMode;
|
|
SavePrintOptions: TfrxPrintOptions;
|
|
SheetWidth, SheetHeight, SplicingLineSz: Extended;
|
|
NeedFinishDuplex: Boolean;
|
|
|
|
|
|
function GetPageIndex(Index: Integer): Integer;
|
|
var
|
|
pgIdx: Integer;
|
|
begin
|
|
Result := -1;
|
|
if pgList.Count > 0 then
|
|
begin
|
|
pgIdx := StrToInt(pgList[Index]) - 1;
|
|
if (pgIdx < 0) or (pgIdx > Count) then
|
|
Result := -1
|
|
else
|
|
Result := pgIdx;
|
|
end
|
|
else if (Index < Count) and (Index >= 0) then
|
|
Result := Index;
|
|
end;
|
|
|
|
function GetNextPage(var Index: Integer): TfrxReportPage;
|
|
var
|
|
pgIdx: Integer;
|
|
begin
|
|
Result := nil;
|
|
Inc(Index);
|
|
pgIdx := GetPageIndex(Index);
|
|
if (pgIdx <> -1) then
|
|
Result := GetPage(pgIdx);
|
|
end;
|
|
|
|
procedure SplitPage(a, b, c, d: Extended; var x, y: Integer; var NeedRotate: Boolean);
|
|
var
|
|
tempX, tempY: Integer;
|
|
tempC: Extended;
|
|
|
|
procedure TrySplit;
|
|
begin
|
|
if Abs(Trunc(a / c) * c - a) < 11 then
|
|
x := Round(a / c)
|
|
else
|
|
x := Trunc(a / c) + 1;
|
|
|
|
if Abs(Trunc(b / d) * d - b) < 11 then
|
|
y := Round(b / d)
|
|
else
|
|
y := Trunc(b / d) + 1;
|
|
end;
|
|
|
|
begin
|
|
NeedRotate := False;
|
|
|
|
TrySplit;
|
|
|
|
tempX := x;
|
|
tempY := y;
|
|
|
|
tempC := c;
|
|
c := d;
|
|
d := tempC;
|
|
|
|
TrySplit;
|
|
|
|
if x * y >= tempX * tempY then
|
|
begin
|
|
x := tempX;
|
|
y := tempY;
|
|
end
|
|
else
|
|
NeedRotate := True;
|
|
end;
|
|
|
|
procedure DoPrint;
|
|
var
|
|
i: Integer;
|
|
Printer: TfrxCustomPrinter;
|
|
PagePrinted: Boolean;
|
|
Page: TfrxReportPage;
|
|
|
|
function PrintSplittedPage(Index: Integer): Boolean;
|
|
var
|
|
Bin, ACopies, x, y, countX, countY: Integer;
|
|
pieceX, pieceY{, offsX, offsY}, marginX, marginY, printedX, printedY: Extended;
|
|
SplitAddX, SplitAddY: Extended;
|
|
|
|
orient: TPrinterOrientation;
|
|
NeedChangeOrientation: Boolean;
|
|
dup: TfrxDuplexMode;
|
|
|
|
procedure SwapXY(var sX, sY: Extended);
|
|
var
|
|
TempZ: Extended;
|
|
begin
|
|
TempZ := sX;
|
|
sX := sY;
|
|
sY := TempZ;
|
|
end;
|
|
begin
|
|
Result := True;
|
|
Index := GetPageIndex(Index);
|
|
// if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
|
|
if (Index = -1) or (Index >= Count) then Exit;
|
|
if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
|
|
((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
|
|
if Report.Terminated then
|
|
begin
|
|
Printer.Abort;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
Page := GetPage(Index);
|
|
|
|
if Report.PrintOptions.Collate then
|
|
begin
|
|
ACopies := 1;
|
|
FCopyNo := ACopyNo;
|
|
end
|
|
else
|
|
begin
|
|
ACopies := Report.PrintOptions.Copies;
|
|
FCopyNo := 1;
|
|
end;
|
|
|
|
if Assigned(Report.OnPrintPage) then
|
|
Report.OnPrintPage(Page, FCopyNo);
|
|
|
|
if Index = 0 then
|
|
Bin := Page.Bin else
|
|
Bin := Page.BinOtherPages;
|
|
|
|
SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth, SheetHeight,
|
|
countX, countY, NeedChangeOrientation);
|
|
|
|
{ add splicing offset and calculate countX, countY again }
|
|
SplitAddX := 0;
|
|
SplitAddY := 0;
|
|
if countX > 1 then
|
|
SplitAddX := SplicingLineSz + Printer.TopMargin + Printer.BottomMargin;
|
|
if countY > 1 then
|
|
SplitAddY := SplicingLineSz + Printer.LeftMargin + Printer.RightMargin;
|
|
if NeedChangeOrientation then
|
|
SwapXY(SplitAddX, SplitAddY);
|
|
SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth - SplitAddX, SheetHeight - SplitAddY,
|
|
countX, countY, NeedChangeOrientation);
|
|
|
|
|
|
orient := poPortrait;
|
|
if NeedChangeOrientation then
|
|
orient := poLandscape;
|
|
|
|
dup := Page.Duplex;
|
|
if DuplexMode <> dmNone then
|
|
dup := DuplexMode;
|
|
|
|
if not PagePrinted or (orient <> LastOrientation) then
|
|
Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
|
|
SheetWidth, SheetHeight, orient, Bin, Integer(dup) {+ 1}, ACopies);
|
|
if not PagePrinted then
|
|
Printer.BeginDoc;
|
|
|
|
if orient = poPortrait then
|
|
begin
|
|
pieceX := SheetWidth * (Printer.DPI.X / 25.4);
|
|
pieceY := SheetHeight * (Printer.DPI.Y / 25.4);
|
|
end
|
|
else
|
|
begin
|
|
pieceX := SheetHeight * (Printer.DPI.X / 25.4);
|
|
pieceY := SheetWidth * (Printer.DPI.Y / 25.4);
|
|
end;
|
|
|
|
//marginY := 0;
|
|
printedY := 0;
|
|
// offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
|
|
|
|
SplitAddY := 0;
|
|
|
|
for y := 1 to countY do
|
|
begin
|
|
//marginX := 0;
|
|
printedX := 0;
|
|
// offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;
|
|
SplitAddX := 0;
|
|
|
|
for x := 1 to countX do
|
|
begin
|
|
// todo
|
|
(* SavedDCState := SaveDC(Printer.Canvas.Handle);
|
|
OldRgn := CreateRectRgn(0, 0, 10000, 10000);
|
|
GetClipRgn(Printer.Canvas.Handle, OldRgn);
|
|
OutRgn := CreateRectRgn(Round(SplitAddX + Printer.LeftMargin * Printer.DPI.X / 25.4),
|
|
Round(SplitAddY + Printer.TopMargin * Printer.DPI.Y / 25.4),
|
|
Round(Page.PaperWidth * fr01cm * Printer.DPI.X / frxDefPPI - Printer.RightMargin * Printer.DPI.X / 25.4) - 1,
|
|
Round(Page.PaperHeight * fr01cm * Printer.DPI.Y / frxDefPPI - Printer.BottomMargin * Printer.DPI.Y / 25.4) - 1);
|
|
SelectClipRgn(Printer.Canvas.Handle, OutRgn);
|
|
SetMetaRgn(Printer.Canvas.Handle);
|
|
try
|
|
Printer.BeginPage;
|
|
DrawPage(Index, Printer.Canvas, Printer.DPI.X / frxDefPPI, Printer.DPI.Y / frxDefPPI,
|
|
offsX, offsY);
|
|
|
|
|
|
Printer.EndPage;
|
|
finally
|
|
{ restore regions }
|
|
SelectClipRgn(Printer.Canvas.Handle, OldRgn);
|
|
DeleteObject(OutRgn);
|
|
DeleteObject(OldRgn);
|
|
RestoreDC(Printer.Canvas.Handle, SavedDCState);
|
|
end;*)
|
|
SplitAddX := SplicingLineSz * Printer.DPI.X / 25.4;
|
|
marginX := Printer.LeftMargin * Printer.DPI.X / 25.4;
|
|
printedX := printedX + (pieceX - marginX - Printer.RightMargin * Printer.DPI.X / 25.4) -
|
|
SplitAddX;
|
|
// offsX := -printedX;
|
|
end;
|
|
marginY := Printer.TopMargin * Printer.DPI.Y / 25.4;
|
|
SplitAddY := SplicingLineSz * Printer.DPI.Y / 25.4;
|
|
printedY := printedY + (pieceY - marginY - Printer.BottomMargin * Printer.DPI.Y / 25.4) -
|
|
SplitAddY;
|
|
// offsY := -printedY;
|
|
end;
|
|
|
|
Report.InternalOnProgress(ptPrinting, Index + 1);
|
|
|
|
PagePrinted := True;
|
|
Inc(PagesPrinted);
|
|
|
|
LastOrientation := Page.Orientation;
|
|
ClearPageCache;
|
|
end;
|
|
|
|
|
|
function PrintPage(Index: Integer): Boolean;
|
|
var
|
|
Bin, ACopies: Integer;
|
|
dup: TfrxDuplexMode;
|
|
ZoomX, ZoomY: Extended;
|
|
begin
|
|
Result := True;
|
|
//if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
|
|
Index := GetPageIndex(Index);
|
|
if (Index = -1) or (Index >= Count) then Exit;
|
|
if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
|
|
((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
|
|
if Report.Terminated then
|
|
begin
|
|
Printer.Abort;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
Page := GetPage(Index);
|
|
|
|
if Report.PrintOptions.Collate then
|
|
begin
|
|
ACopies := 1;
|
|
FCopyNo := ACopyNo;
|
|
end
|
|
else
|
|
begin
|
|
ACopies := Report.PrintOptions.Copies;
|
|
FCopyNo := 1;
|
|
end;
|
|
|
|
if Assigned(Report.OnPrintPage) then
|
|
Report.OnPrintPage(Page, FCopyNo);
|
|
|
|
if Index = 0 then
|
|
Bin := Page.Bin else
|
|
Bin := Page.BinOtherPages;
|
|
|
|
dup := Page.Duplex;
|
|
if DuplexMode <> dmNone then
|
|
dup := DuplexMode;
|
|
|
|
if LastDuplexMode <> dup then
|
|
NeedFinishDuplex := False;
|
|
if dup in [dmVertical, dmHorizontal] then
|
|
NeedFinishDuplex := not NeedFinishDuplex;
|
|
|
|
if Report.PrintOptions.PrintMode = pmDefault then
|
|
begin
|
|
if (not PagePrinted) or
|
|
(LastPaperSize <> Page.PaperSize) or
|
|
(LastPaperWidth <> Round(Page.PaperWidth)) or
|
|
(LastPaperHeight <> Round(Page.PaperHeight)) or
|
|
(LastBin <> Bin) or
|
|
(LastOrientation <> Page.Orientation) or
|
|
(LastDuplexMode <> dup) then
|
|
Printer.SetPrintParams(Page.PaperSize, Page.PaperWidth, Page.PaperHeight,
|
|
Page.Orientation, Bin, Integer(dup) {+ 1}, ACopies);
|
|
end
|
|
else
|
|
if (not PagePrinted) or
|
|
(LastBin <> Bin) or
|
|
(LastOrientation <> Page.Orientation) or
|
|
(LastDuplexMode <> dup) then
|
|
begin
|
|
Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
|
|
SheetWidth, SheetHeight, Page.Orientation, Bin, Integer(dup) {+ 1}, ACopies);
|
|
SheetWidth := frxPrinters.Printer.PaperWidth;
|
|
SheetHeight := frxPrinters.Printer.PaperHeight;
|
|
end;
|
|
if not PagePrinted then
|
|
Printer.BeginDoc;
|
|
|
|
Printer.BeginPage;
|
|
|
|
if Report.PrintOptions.PrintMode = pmDefault then
|
|
begin
|
|
ZoomX := 1;
|
|
ZoomY := 1;
|
|
end
|
|
else
|
|
begin
|
|
ZoomX := SheetWidth / Page.PaperWidth;
|
|
ZoomY := SheetHeight / Page.PaperHeight;
|
|
if ZoomY < ZoomX then
|
|
FPrintScale := ZoomY
|
|
else
|
|
FPrintScale := ZoomX;
|
|
end;
|
|
|
|
DrawPage(Index, Printer.Canvas, Printer.DPI.X / frxDefPPI * ZoomX, Printer.DPI.Y / frxDefPPI * ZoomY,
|
|
-Printer.LeftMargin * Printer.DPI.X / 25.4,
|
|
-Printer.TopMargin * Printer.DPI.Y / 25.4, RectF(0, 0, 0, 0));
|
|
|
|
Report.InternalOnProgress(ptPrinting, Index + 1);
|
|
|
|
|
|
Printer.EndPage;
|
|
|
|
PagePrinted := True;
|
|
Inc(PagesPrinted);
|
|
|
|
LastPaperSize := Page.PaperSize;
|
|
LastPaperWidth := Round(Page.PaperWidth);
|
|
LastPaperHeight := Round(Page.PaperHeight);
|
|
LastBin := Bin;
|
|
LastOrientation := Page.Orientation;
|
|
LastDuplexMode := dup;
|
|
ClearPageCache;
|
|
end;
|
|
|
|
procedure PrintPages;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
PagesPrinted := 0;
|
|
|
|
if Report.PrintOptions.Reverse then
|
|
begin
|
|
for i := MaxCount - 1 downto 0 do
|
|
if not PrintPage(i) then
|
|
break;
|
|
end
|
|
else
|
|
for i := 0 to MaxCount - 1 do
|
|
if not PrintPage(i) then
|
|
break;
|
|
end;
|
|
|
|
procedure PrintSplittedPages;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
PagesPrinted := 0;
|
|
|
|
if Report.PrintOptions.Reverse then
|
|
begin
|
|
for i := MaxCount - 1 downto 0 do
|
|
if not PrintSplittedPage(i) then
|
|
break;
|
|
end
|
|
else
|
|
for i := 0 to MaxCount - 1 do
|
|
if not PrintSplittedPage(i) then
|
|
break;
|
|
end;
|
|
|
|
procedure PrintJoinedPages;
|
|
var
|
|
Index, cp, x, y, countX, countY: Integer;
|
|
pieceX, pieceY, offsX, offsY: Extended;
|
|
orient: TPrinterOrientation;
|
|
NeedChangeOrientation: Boolean;
|
|
dup: TfrxDuplexMode;
|
|
begin
|
|
PagesPrinted := 0;
|
|
if Count = 0 then Exit;
|
|
|
|
{ get the first page and calculate the join options }
|
|
Index := -1;
|
|
Page := GetNextPage(Index);
|
|
|
|
SplitPage(SheetWidth, SheetHeight, Page.PaperWidth, Page.PaperHeight,
|
|
countX, countY, NeedChangeOrientation);
|
|
orient := poPortrait;
|
|
if NeedChangeOrientation then
|
|
begin
|
|
orient := poLandscape;
|
|
x := countX;
|
|
countX := countY;
|
|
countY := x;
|
|
end;
|
|
|
|
{ setup the printer }
|
|
dup := Page.Duplex;
|
|
if DuplexMode <> dmNone then
|
|
dup := DuplexMode;
|
|
Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
|
|
SheetWidth, SheetHeight, orient, Page.Bin, Integer(dup) {+ 1}, 1);
|
|
PagePrinted := True;
|
|
Printer.BeginDoc;
|
|
|
|
{ start the cycle }
|
|
pieceX := Page.PaperWidth * (Printer.DPI.X / 25.4);
|
|
pieceY := Page.PaperHeight * (Printer.DPI.Y / 25.4);
|
|
|
|
Index := -1;
|
|
while Index < MaxCount - 1 do
|
|
begin
|
|
cp := 1;
|
|
offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
|
|
Printer.BeginPage;
|
|
|
|
for y := 1 to countY do
|
|
begin
|
|
offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;
|
|
|
|
for x := 1 to countX do
|
|
begin
|
|
{ get the next page }
|
|
FCopyNo := cp;
|
|
if cp = 1 then
|
|
Page := GetNextPage(Index)
|
|
else
|
|
begin
|
|
ClearPageCache;
|
|
Page := GetPage(GetPageIndex(Index));
|
|
end;
|
|
Inc(cp);
|
|
if cp > Report.PrintOptions.Copies then
|
|
cp := 1;
|
|
|
|
if Page = nil then break;
|
|
|
|
DrawPage(GetPageIndex(Index), Printer.Canvas, Printer.DPI.X / frxDefPPI, Printer.DPI.Y / frxDefPPI,
|
|
offsX, offsY, RectF(0, 0, 0, 0));
|
|
|
|
offsX := offsX + pieceX;
|
|
end;
|
|
|
|
if Page = nil then break;
|
|
offsY := offsY + pieceY;
|
|
end;
|
|
|
|
|
|
Printer.EndPage;
|
|
|
|
Report.InternalOnProgress(ptPrinting, Index);
|
|
if Report.Terminated then
|
|
begin
|
|
Printer.Abort;
|
|
Exit;
|
|
end;
|
|
|
|
Inc(PagesPrinted);
|
|
ClearPageCache;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Printer := frxPrinters.Printer;
|
|
Report.Terminated := False;
|
|
Report.InternalOnProgressStart(ptPrinting);
|
|
|
|
if Report.ReportOptions.Name <> '' then
|
|
Printer.Title := Report.ReportOptions.Name else
|
|
Printer.Title := Report.FileName;
|
|
if Report.PrintOptions.Copies <= 0 then
|
|
Report.PrintOptions.Copies := 1;
|
|
|
|
if pgList.Count = 0 then
|
|
MaxCount := Count
|
|
else
|
|
MaxCount := pgList.Count;
|
|
|
|
|
|
PagePrinted := False;
|
|
LastDuplexMode := dmNone;
|
|
NeedFinishDuplex := False;
|
|
|
|
if Report.PrintOptions.Collate then
|
|
for i := 0 to Report.PrintOptions.Copies - 1 do
|
|
begin
|
|
ACopyNo := i + 1;
|
|
case Report.PrintOptions.PrintMode of
|
|
pmDefault, pmScale:
|
|
PrintPages;
|
|
pmSplit:
|
|
PrintSplittedPages;
|
|
pmJoin:
|
|
PrintJoinedPages;
|
|
end;
|
|
if NeedFinishDuplex then
|
|
begin
|
|
Printer.BeginPage;
|
|
Printer.EndPage;
|
|
end;
|
|
|
|
if Report.Terminated then break;
|
|
end
|
|
else
|
|
begin
|
|
case Report.PrintOptions.PrintMode of
|
|
pmDefault, pmScale:
|
|
PrintPages;
|
|
pmSplit:
|
|
PrintSplittedPages;
|
|
pmJoin:
|
|
PrintJoinedPages;
|
|
end;
|
|
end;
|
|
|
|
if PagePrinted then
|
|
Printer.EndDoc;
|
|
Report.InternalOnProgressStop(ptPrinting);
|
|
end;
|
|
|
|
begin
|
|
Result := True;
|
|
if not frxPrinters.HasPhysicalPrinters then
|
|
begin
|
|
frxErrorMsg(frxResources.Get('clNoPrinters'));
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
FPrintScale := 1;
|
|
|
|
if Report.DotMatrixReport and (frxDotMatrixExport <> nil) then
|
|
begin
|
|
Report.SelectPrinter;
|
|
frxDotMatrixExport.ShowDialog := Report.PrintOptions.ShowDialog;
|
|
frxDotMatrixExport.PageNumbers := Report.PrintOptions.PageNumbers;
|
|
Result := Export(frxDotMatrixExport);
|
|
Exit;
|
|
end;
|
|
|
|
SavePrintOptions := TfrxPrintOptions.Create;
|
|
SavePrintOptions.Assign(Report.PrintOptions);
|
|
DuplexMode := Report.PrintOptions.Duplex;
|
|
Report.SelectPrinter;
|
|
{$IFDEF MACOS}
|
|
if Report.PrintOptions.ShowDialog then
|
|
with TPrintDialog.Create(nil) do
|
|
begin
|
|
if not Execute then
|
|
begin
|
|
Free;
|
|
FCopyNo := 0;
|
|
Result := False;
|
|
SavePrintOptions.Free;
|
|
if Report.PreviewForm is TfrxForm then
|
|
TfrxForm(Report.PreviewForm).PeekLastModalResult;
|
|
Exit;
|
|
end;
|
|
if PrintRange = TPrintRange.prPageNums then
|
|
Report.PrintOptions.PageNumbers := IntToStr(FromPage) + '-' + IntToStr(ToPage);
|
|
Free;
|
|
end;
|
|
if Report.PreviewForm is TfrxForm then
|
|
TfrxForm(Report.PreviewForm).PeekLastModalResult;
|
|
|
|
|
|
{$ELSE}
|
|
// todo
|
|
if Report.PrintOptions.ShowDialog then
|
|
with TfrxPrintDialog.Create(nil) do
|
|
begin
|
|
AReport := Report;
|
|
ADuplexMode := DuplexMode;
|
|
FormShow(nil);
|
|
ShowModal;
|
|
if ModalResult = mrOk then
|
|
begin
|
|
DuplexMode := ADuplexMode;
|
|
Report.PrintOptions.Duplex := DuplexMode;
|
|
Free;
|
|
end
|
|
else
|
|
begin
|
|
Free;
|
|
FCopyNo := 0;
|
|
Result := False;
|
|
SavePrintOptions.Free;
|
|
Exit;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if Report.PrintOptions.PrnOutFileName <> '' then
|
|
frxPrinters.Printer.FileName := Report.PrintOptions.PrnOutFileName;
|
|
|
|
if Report.PrintOptions.PrintMode <> pmDefault then
|
|
begin
|
|
if Report.PrintOptions.PrintOnSheet <> 256 then
|
|
frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, 0, 0, poPortrait)
|
|
else
|
|
frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, frxPrinters.Printer.PaperWidth,
|
|
frxPrinters.Printer.PaperHeight, poPortrait);
|
|
|
|
SheetWidth := frxPrinters.Printer.PaperWidth;
|
|
SheetHeight := frxPrinters.Printer.PaperHeight;
|
|
SplicingLineSz := Report.PrintOptions.SplicingLine;
|
|
end;
|
|
|
|
if Assigned(Report.OnPrintReport) then
|
|
Report.OnPrintReport(Report);
|
|
Report.DoNotifyEvent(Report, Report.OnReportPrint, not Report.EngineOptions.DestroyForms);
|
|
|
|
if Report.Preview <> nil then
|
|
begin
|
|
// todo?
|
|
// Report.Preview.Lock;
|
|
// Report.Preview.Refresh;
|
|
end;
|
|
pgList := TStringList.Create;
|
|
{$IFDEF MSWINDOWS}
|
|
if frxCanvasClass <> nil then
|
|
FFastPrintCanvas := frxCanvasClass.Create;
|
|
{$ENDIF}
|
|
try
|
|
if frxPrinters.Printer.Initialized then
|
|
begin
|
|
frxParsePageNumbers(Report.PrintOptions.PageNumbers, pgList, Count);
|
|
ClearPageCache;
|
|
DoPrint;
|
|
end
|
|
else frxErrorMsg('Printer selected is not valid');
|
|
finally
|
|
if Assigned(Report.OnAfterPrintReport) then
|
|
Report.OnAfterPrintReport(Report);
|
|
FCopyNo := 0;
|
|
Report.PrintOptions.Assign(SavePrintOptions);
|
|
SavePrintOptions.Free;
|
|
pgList.Free;
|
|
{$IFDEF MSWINDOWS}
|
|
if Assigned(FFastPrintCanvas) then
|
|
FreeAndNil(FFastPrintCanvas);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TfrxPreviewPages.Export(Filter: TfrxCustomExportFilter): Boolean;
|
|
var
|
|
pgList: TStringList;
|
|
tempBMP: TBitmap;
|
|
|
|
procedure ExportPage(Index: Integer);
|
|
var
|
|
i, j: Integer;
|
|
Page: TfrxReportPage;
|
|
c: TfrxComponent;
|
|
p: TfrxPictureView;
|
|
|
|
|
|
procedure ExportObject(c: TfrxComponent);
|
|
begin
|
|
if Filter.DataOnly and not (c.Parent is TfrxDataBand) then
|
|
Exit;
|
|
|
|
if c is TfrxCustomMemoView then
|
|
begin
|
|
{ set up font if Highlight is active }
|
|
if TfrxCustomMemoView(c).Highlight.Active then
|
|
TfrxCustomMemoView(c).Font.Assign(TfrxCustomMemoView(c).Highlight.Font);
|
|
{ needed for TOTALPAGES, COPYNAME macros }
|
|
THackMemoView(c).FTotalPages := Count;
|
|
THackMemoView(c).FCopyNo := 1;
|
|
THackMemoView(c).ExtractMacros;
|
|
{ needed if memo has AutoWidth and Align properties }
|
|
if THackMemoView(c).AutoWidth then
|
|
begin
|
|
tempBMP.Canvas.BeginScene;
|
|
try
|
|
THackMemoView(c).Draw(tempBMP.Canvas, 1, 1, 0, 0);
|
|
finally
|
|
tempBMP.Canvas.EndScene;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if c is TfrxView then
|
|
begin
|
|
if Assigned(FFastPrintCanvas) then
|
|
TfrxView(c).SetFastCanvas(FFastPrintCanvas)
|
|
else
|
|
TfrxView(c).SetFastCanvas(nil);
|
|
end;
|
|
Filter.ExportObject(c);
|
|
if c is TfrxView then
|
|
TfrxView(c).SetFastCanvas(nil);
|
|
if Report.Terminated then
|
|
raise EExportTerminated.Create;
|
|
end;
|
|
|
|
begin
|
|
if Index >= Count then Exit;
|
|
if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
|
|
Page := GetPage(Index);
|
|
if Page = nil then Exit;
|
|
|
|
if Filter.ShowProgress then
|
|
Report.InternalOnProgress(ptExporting, Index + 1);
|
|
|
|
Filter.StartPage(Page, Index);
|
|
try
|
|
{ set the offset of the page objects }
|
|
if Page.MirrorMargins and (Index mod 2 = 1) then
|
|
Page.Left := Page.RightMargin * fr01cm else
|
|
Page.Left := Page.LeftMargin * fr01cm;
|
|
Page.Top := Page.TopMargin * fr01cm;
|
|
|
|
{ export the page background picture and frame }
|
|
p := TfrxPictureView.Create(nil);
|
|
p.Name := '_pagebackground';
|
|
p.Color := Page.Color;
|
|
p.Frame.Assign(Page.Frame);
|
|
p.Picture.Assign(Page.BackPicture);
|
|
p.Stretched := True;
|
|
p.KeepAspectRatio := False;
|
|
try
|
|
p.SetBounds(Page.Left, Page.Top,
|
|
Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm,
|
|
Page.Height - (Page.TopMargin + Page.BottomMargin) * fr01cm);
|
|
ExportObject(p);
|
|
finally
|
|
p.Free;
|
|
end;
|
|
|
|
|
|
for i := 0 to Page.Objects.Count - 1 do
|
|
begin
|
|
c := Page.Objects[i];
|
|
if c is TfrxBand then
|
|
begin
|
|
if c is TfrxPageHeader then
|
|
begin
|
|
{ suppress a header }
|
|
if Filter.SuppressPageHeadersFooters and (Index <> 0) then continue;
|
|
end;
|
|
if c is TfrxPageFooter then
|
|
begin
|
|
{ suppress a footer }
|
|
if Filter.SuppressPageHeadersFooters and (Index <> Count - 1) then continue;
|
|
end;
|
|
end;
|
|
ExportObject(c);
|
|
if c.Objects.Count <> 0 then
|
|
for j := 0 to c.Objects.Count - 1 do
|
|
ExportObject(c.Objects[j]);
|
|
end;
|
|
|
|
finally
|
|
Filter.FinishPage(Page, Index);
|
|
end;
|
|
|
|
if Report.Preview = nil then
|
|
ClearPageCache
|
|
else
|
|
begin
|
|
Page.Left := 0;
|
|
Page.Top := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure DoExport;
|
|
var
|
|
i: Integer;
|
|
{$IFDEF DBGLOG}
|
|
Time: Cardinal;
|
|
{$ENDIF}
|
|
begin
|
|
if Assigned(Filter.OnBeginExport) then
|
|
Filter.OnBeginExport(Filter);
|
|
|
|
{$IFDEF DBGLOG}
|
|
Time := GetTickCount;
|
|
{$ENDIF}
|
|
|
|
if Filter.Start then
|
|
try
|
|
if Report.Preview <> nil then
|
|
begin
|
|
Report.Preview.Lock;
|
|
Report.Preview.Repaint;
|
|
end;
|
|
|
|
if Filter.ShowProgress then
|
|
Report.InternalOnProgressStart(ptExporting);
|
|
|
|
|
|
for i := 0 to Count - 1 do
|
|
|
|
begin
|
|
ExportPage(i);
|
|
end;
|
|
|
|
finally
|
|
if Report.Preview <> nil then
|
|
begin
|
|
// todo
|
|
// TfrxPreview(Report.Preview).HideMessage;
|
|
// Report.Preview.Refresh;
|
|
end;
|
|
|
|
if Filter.ShowProgress then
|
|
Report.InternalOnProgressStop(ptExporting);
|
|
|
|
Filter.Finish;
|
|
end;
|
|
|
|
{$IFDEF DBGLOG}
|
|
Time := GetTickCount - Time;
|
|
|
|
DbgPrintTitle('Exporting Results');
|
|
DbgPrint('Filter: %s'#10, [Filter.ClassName]);
|
|
DbgPrint('Duration: %d ms'#10, [Time]);
|
|
|
|
if (Report <> nil) and (Report.FileName <> '') then
|
|
DbgPrint('Input: %s'#10, [Report.FileName]);
|
|
|
|
with Filter do
|
|
if Stream <> nil then
|
|
begin
|
|
DbgPrint('Output: %s'#10, [Stream.ClassName]);
|
|
DbgPrint('SHA1(Output): %s'#10, [HashStream('SHA1', Stream)]);
|
|
DbgPrint('Output size: %d'#10, [Stream.Size]);
|
|
end
|
|
else
|
|
begin
|
|
DbgPrint('Output: %s'#10, [FileName]);
|
|
DbgPrint('SHA1(Output): %s'#10, [HashFile('SHA1', FileName)]);
|
|
|
|
with TFileStream.Create(FileName, 0) do
|
|
try
|
|
DbgPrint('Output size: %d'#10, [Size]);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
begin
|
|
Result := False;
|
|
FCopyNo := 0;
|
|
|
|
if Filter = nil then
|
|
Exit;
|
|
|
|
{$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
Filter.CreationTime := Now;
|
|
{$ENDIF}
|
|
|
|
Filter.Report := Report;
|
|
if (Filter.ShowDialog and (Filter.ShowModal <> mrOk)) then
|
|
Exit;
|
|
if Filter.CurPage then
|
|
if Report.Preview <> nil then
|
|
Filter.PageNumbers := IntToStr(CurPreviewPage) else
|
|
Filter.PageNumbers := '1';
|
|
|
|
Result := True;
|
|
Report.Terminated := False;
|
|
|
|
pgList := TStringList.Create;
|
|
tempBMP := TBitmap.Create(1, 1);
|
|
{$IFDEF DELPHI25}
|
|
{$IFDEF MSWINDOWS}
|
|
if frxCanvasClass <> nil then
|
|
FFastPrintCanvas := frxCanvasClass.Create;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
try
|
|
frxParsePageNumbers(Filter.PageNumbers, pgList, Count);
|
|
|
|
if Filter = frxDotMatrixExport then
|
|
if Assigned(Report.OnPrintReport) then
|
|
Report.OnPrintReport(Report);
|
|
|
|
try
|
|
DoExport;
|
|
except
|
|
on EExportTerminated do
|
|
{do nothing};
|
|
on e: Exception do
|
|
begin
|
|
Result := False;
|
|
Report.Errors.Text := e.Message;
|
|
frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text);
|
|
end;
|
|
end;
|
|
|
|
if Filter = frxDotMatrixExport then
|
|
if Assigned(Report.OnAfterPrintReport) then
|
|
Report.OnAfterPrintReport(Report);
|
|
finally
|
|
pgList.Free;
|
|
tempBMP.Free;
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF DELPHI25}
|
|
if Assigned(FFastPrintCanvas) then
|
|
FreeAndNil(FFastPrintCanvas);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPreviewPages.ObjectOver(Index: Integer; X, Y: Integer;
|
|
Button: TMouseButton; Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
|
|
Click: Boolean; var Cursor: TCursor; DBClick: Boolean);
|
|
var
|
|
Page: TfrxReportPage;
|
|
c: TfrxComponent;
|
|
l: TList;
|
|
i: Integer;
|
|
Flag: Boolean;
|
|
v: TfrxView;
|
|
drill: TfrxGroupHeader;
|
|
aRect: TRectF;
|
|
|
|
function MouseInView(c: TfrxComponent): Boolean;
|
|
var
|
|
r: TRect;
|
|
begin
|
|
with c do
|
|
r := Rect(Round(AbsLeft * Scale), Round(AbsTop * Scale),
|
|
Round((AbsLeft + Width) * Scale),
|
|
Round((AbsTop + Height) * Scale));
|
|
OffsetRect(r, Round(OffsetX), Round(OffsetY));
|
|
Result := PtInRect(r, Point(X, Y));
|
|
end;
|
|
|
|
procedure SetToAnchor(const Text: String);
|
|
var
|
|
Item: TfrxXMLItem;
|
|
PageN, Top: Integer;
|
|
begin
|
|
Item := FindAnchor(Text);
|
|
if Item <> nil then
|
|
begin
|
|
PageN := StrToInt(String(Item.Prop['page']));
|
|
Top := StrToInt(String(Item.Prop['top']));
|
|
TfrxPreview(Report.Preview).SetPosition(PageN + 1, Top);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (Index < 0) or (Index >= Count) or Engine.Running then Exit;
|
|
Page := GetPage(Index);
|
|
if Page = nil then Exit;
|
|
|
|
if Page.MirrorMargins and (Index mod 2 = 1) then
|
|
OffsetX := OffsetX + Page.RightMargin * fr01cm * Scale else
|
|
OffsetX := OffsetX + Page.LeftMargin * fr01cm * Scale;
|
|
OffsetY := OffsetY + Page.TopMargin * fr01cm * Scale;
|
|
|
|
Report.SetProgressMessage('');
|
|
Report.SetProgressMessage('', True);
|
|
Page := GetPage(Index); // get page again to ensure it was not cleared during export
|
|
if Page = nil then Exit;
|
|
|
|
drill := nil;
|
|
l := Page.AllObjects;
|
|
|
|
for i := l.Count - 1 downto 0 do
|
|
begin
|
|
c := l[i];
|
|
if (c is TfrxGroupHeader) and MouseInView(c) then
|
|
if TfrxGroupHeader(c).DrillDown then
|
|
begin
|
|
drill := TfrxGroupHeader(c);
|
|
//break;
|
|
end;
|
|
|
|
if (c is TfrxView) and MouseInView(c) then
|
|
begin
|
|
v := TfrxView(c);
|
|
if (v.Parent is TfrxGroupHeader) and TfrxGroupHeader(v.Parent).DrillDown then
|
|
begin
|
|
drill := TfrxGroupHeader(v.Parent);
|
|
//break;
|
|
end;
|
|
if v.Cursor <> crDefault then
|
|
Cursor := v.Cursor;
|
|
if v.URL <> '' then
|
|
begin
|
|
Report.SetProgressMessage(v.URL);
|
|
if v.Cursor = crDefault then
|
|
Cursor := crHandPoint;
|
|
end;
|
|
if (v.Hint <> '') and (v.ShowHint) and (Report.Preview.UseReportHints) then
|
|
begin
|
|
Report.SetProgressMessage(GetLongHint(v.Hint), True);
|
|
with v do
|
|
aRect := RectF(Round(AbsLeft * Scale), Round(AbsTop * Scale),
|
|
Round((AbsLeft + Width) * Scale),
|
|
Round((AbsTop + Height) * Scale));
|
|
OffsetRect(aRect, Round(OffsetX), Round(OffsetY));
|
|
Report.Preview.ShowHint(aRect, GetShortHint(v.Hint));
|
|
v.HintIsActive := True;
|
|
//GetShortHint(v.Hint);
|
|
//Report.Preview.ShowHint := True;}
|
|
end;
|
|
|
|
if Click and (drill = nil) then
|
|
begin
|
|
if v.URL <> '' then
|
|
if Pos('@', v.URL) = 1 then
|
|
TfrxPreview(Report.Preview).PageNo := StrToInt(Copy(v.URL, 2, 255))
|
|
else if Pos('#', v.URL) = 1 then
|
|
SetToAnchor(Copy(v.URL, 2, 255))
|
|
else
|
|
{$IFDEF MSWINDOWS}
|
|
ShellExecute(0, 'open', PChar(v.URL), '', '', 1);
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
FmuxOpenUrl(PChar(v.URL));
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
_system(PAnsiChar('open ' + AnsiString(v.URL)));
|
|
{$ENDIF}
|
|
Flag := False;
|
|
if DBClick then
|
|
Report.DoPreviewClick(v, Button, Shift, Flag, True)
|
|
else
|
|
Report.DoPreviewClick(v, Button, Shift, Flag);
|
|
if Flag then
|
|
begin
|
|
ModifyPage(Index, Page);
|
|
Report.Preview.ClearBackBuffer;
|
|
Report.Preview.Repaint;
|
|
end;
|
|
end
|
|
else if Assigned(Report.OnMouseOverObject) then
|
|
Report.OnMouseOverObject(v);
|
|
break;
|
|
end
|
|
else if c is TfrxView then
|
|
begin
|
|
if (TfrxView(c).ShowHint) and (TfrxView(c).HintIsActive) and (Report.Preview <> nil) and (Report.Preview.UseReportHints) then
|
|
begin
|
|
Report.Preview.HideHint;
|
|
TfrxView(c).HintIsActive := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if drill <> nil then
|
|
begin
|
|
Cursor := crHandPoint;
|
|
if Click and (Button = mbLeft) then
|
|
begin
|
|
if Report.DrillState.IndexOf(drill.DrillName) = -1 then
|
|
Report.DrillState.Add(drill.DrillName)
|
|
else
|
|
Report.DrillState.Delete(Report.DrillState.IndexOf(drill.DrillName));
|
|
Report.Preview.RefreshReport;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|