admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 22:45:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/SRC/SCSNormBase/U_frOLEExl.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

2109 lines
60 KiB
ObjectPascal
Raw Blame History

{******************************************}
{ }
{ Excel export filter }
{ }
{ }
{ }
{******************************************}
unit U_frOLEExl;
{$I Fr.inc}
interface
uses
Windows, U_LNG, U_BaseConstants, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, extctrls, Clipbrd, Printers, ComObj, FR_Class, XLSFile, XLSWorkbook, XLSFormat
//{$IFDEF Delphi6}
, Variants,
//{$ENDIF},
U_Common_Classes, FR_Progr, FR_Ctrls, siComp, siLngLnk, jpeg, PDF, cxLookAndFeelPainters,
cxButtons, cxGraphics, cxLookAndFeels, Menus;
function ComparePoints(Item1, Item2: Pointer): Integer;
function CompareObjects(Item1, Item2: Pointer): Integer;
const
SheetName = cfrOLEExl_Msg1;
Xdivider = 1;
Ydivider = 1.3;
XLMaxHeight = 409;
xlLeft = -4131;
xlRight = -4152;
xlTop = -4160;
xlCenter = -4108 ;
xlBottom = -4107;
xlJustify = -4130 ;
xlThin = 2;
xlHairline = 1;
xlNone = -4142;
xlAutomatic = -4105;
xlInsideHorizontal = 12 ;
xlInsideVertical = 11 ;
xlEdgeBottom = 9 ;
xlEdgeLeft = 7 ;
xlEdgeRight = 10 ;
xlEdgeTop = 8 ;
xlSolid = 1 ;
xlTextWindows = 20 ;
xlNormal = -4143 ;
xlNoChange = 1 ;
xlPageBreakManual = -4135 ;
tgUnXls = '#UNXLS';
type
TExlStartExportPageEvent = procedure(Sender: TObject; ACaption: string; AObjCount: Integer) of object;
TExlProgressExportPageEvent = procedure(Sender: TObject; var AWasCancel: Boolean; AObjIndex, AObjectCount: Integer) of object;
TExlEndExportPageEvent = procedure(Sender: TObject; AWasCancel: Boolean) of object;
TfrOLEExcelSet = class(TForm)
OK: TcxButton;
Cancel: TcxButton;
GroupPageSettings: TGroupBox;
GroupPageRange: TGroupBox;
LeftM: TLabel;
Pages: TLabel;
E_Range: TEdit;
Descr: TLabel;
E_LMargin: TEdit;
TopM: TLabel;
E_TMargin: TEdit;
ScX: TLabel;
E_ScaleX: TEdit;
Label2: TLabel;
ScY: TLabel;
E_ScaleY: TEdit;
Label9: TLabel;
GroupCellProp: TGroupBox;
CB_Merged: TCheckBox;
CB_Align: TCheckBox;
CB_FillColor: TCheckBox;
CB_Borders: TCheckBox;
CB_WrapWords: TCheckBox;
CB_FontName: TCheckBox;
CB_FontSize: TCheckBox;
CB_FontStyle: TCheckBox;
CB_FontColor: TCheckBox;
CB_PageBreaks: TCheckBox;
CB_OpenExcel: TCheckBox;
Better: TButton;
Faster: TButton;
CB_Pictures: TCheckBox;
lng_Forms: TsiLangLinked;
procedure BetterClick(Sender: TObject);
procedure FasterClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Localize;
end;
TFrExcel = class;
TObjCell = class(TObject)
public
Value: integer;
end;
TObjPos = class(TObject)
public
obj: integer;
x,y: integer;
dx, dy: integer;
end;
TfrBasicExpFilter = class(TfrExportFilter)
private
FFileCaption: String;
FFileName: String;
FTitle: String;
FCanceledExport: Boolean;
FLeaveCellsWithTag: Boolean;
FTagForLeaveCell: String;
FOnStartExportPageEvent: TExlStartExportPageEvent;
FOnProgressExportPageEvent: TExlProgressExportPageEvent;
FOnEndExportPageEvent: TExlEndExportPageEvent;
public
constructor Create(AOwner: TComponent); override;
property FileCaption: String read FFileCaption write FFileCaption;
property FileName: String read FFileName write FFileName;
property Title: string read FTitle write FTitle;
property LeaveCellsWithTag: Boolean read FLeaveCellsWithTag write FLeaveCellsWithTag; //#From Oleg#
property TagForLeaveCell: String read FTagForLeaveCell write FTagForLeaveCell; //#From Oleg#
property OnStartExportPageEvent: TExlStartExportPageEvent read FOnStartExportPageEvent write FOnStartExportPageEvent;
property OnProgressExportPageEvent: TExlProgressExportPageEvent read FOnProgressExportPageEvent write FOnProgressExportPageEvent;
property OnEndExportPageEvent: TExlEndExportPageEvent read FOnEndExportPageEvent write FOnEndExportPageEvent;
end;
TMyfrOleExl = class(TfrBasicExpFilter)
private
CurrentPage: integer;
FirstPage: boolean;
CurY: integer;
RX: TList;
RY: TList;
ObjectPos: TList;
PageObj: TList;
Excel: TFrExcel;
CY, LastY: integer;
frExportSet: TfrOLEExcelSet;
pgList: TStringList;
pgBreakList: TStringList;
PicFormat: Word;
PicData: Cardinal;
PicPalette: HPALETTE;
CntPics: integer;
expMerged, expWrapWords, expFillColor, expBorders, expAlign,
expPageBreaks, expFontName, expFontSize, expFontStyle,
expFontColor, expPictures, expOpenAfter: boolean;
expScaleX, expScaleY, expTopMargin, expLeftMargin: Double;
FTmpDir: String;
FTmpFiles: TStringList;
//FOnStartExportPageEvent: TExlStartExportPageEvent;
//FOnProgressExportPageEvent: TExlProgressExportPageEvent;
//FOnEndExportPageEvent: TExlEndExportPageEvent;
procedure ObjCellAdd(Vector: TList; Value: integer);
procedure ObjPosAdd(Vector: TList; x, y, dx, dy, obj: integer);
procedure DeleteMultiplePoint(Vector: TList);
procedure ClearLastPage;
procedure OrderObjectByCells;
procedure ExportPage;
function CleanReturns(Str: string): string;
procedure AfterExport(const FileName: string);
procedure ClearTmpFiles;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ShowModal: Word; override;
procedure OnBeginDoc; override;
procedure OnEndDoc; override;
procedure OnEndPage; override;
procedure OnBeginPage; override;
procedure OnData(x, y: Integer; View: TfrView); override;
published
property CellsAlign : Boolean read expAlign write expAlign default True;
property CellsBorders : Boolean read expBorders write expBorders default True;
property CellsFillColor : Boolean read expFillColor write expFillColor default True;
property CellsFontColor : Boolean read expFontColor write expFontColor default True;
property CellsFontName : Boolean read expFontName write expFontName default True;
property CellsFontSize : Boolean read expFontSize write expFontSize default True;
property CellsFontStyle : Boolean read expFontStyle write expFontStyle default True;
property CellsMerged : Boolean read expMerged write expMerged default True;
property CellsWrapWords : Boolean read expWrapWords write expWrapWords default True;
property ExportPictures : Boolean read expPictures write expPictures default True;
property LeftMargin : Double read expLeftMargin write expLeftMargin;
property OpenExcelAfterExport : Boolean read expOpenAfter write expOpenAfter default False;
property PageBreaks : Boolean read expPageBreaks write expPageBreaks default True;
property TopMargin : Double read expTopMargin write expTopMargin;
{property LeaveCellsWithTag: Boolean read FLeaveCellsWithTag write FLeaveCellsWithTag; //#From Oleg#
property TagForLeaveCell: String read FTagForLeaveCell write FTagForLeaveCell; //#From Oleg#
property OnStartExportPageEvent: TExlStartExportPageEvent read FOnStartExportPageEvent write FOnStartExportPageEvent;
property OnProgressExportPageEvent: TExlProgressExportPageEvent read FOnProgressExportPageEvent write FOnProgressExportPageEvent;
property OnEndExportPageEvent: TExlEndExportPageEvent read FOnEndExportPageEvent write FOnEndExportPageEvent;
}
end;
TFrExcel = class(TComponent)
private
IsOpened: Boolean;
IsVisible: Boolean;
BorderStyle: TXLBorderStyle;
RangeXF: TRange;
XF: TXLSFile;
protected
procedure SetVisible(DoShow: Boolean);
function GetCell(x, y: Integer): string;
procedure SetCell(x, y: Integer; const Value: string);
function Pos2Str(Pos: Integer): string;
function IntToCoord(X, Y: Integer): string;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
procedure OpenExcel;
procedure SetRange(x, y, dx, dy: integer);
procedure SetColSize(x: integer; Size: Extended);
procedure SetRowSize(y: integer; Size: Extended);
procedure MergeCells;
procedure SetPageMargin(Left, Right, Top, Bottom: Extended; Orient: integer);
procedure SetCellBorderColorRGB(AFrame, ARGBColor: integer);
procedure SetCellBorderStyle(AObj: TfrView);
procedure SetCellFontName(FontName: string);
procedure SetCellFontSize(FontSize: integer);
procedure SetCellFontColor(FontColor: Integer);
procedure SetCellFontStyle(Style: TFontStyles);
procedure SetCellHAlign(Horiz: Integer);
procedure SetCellNumFormat(Format: char);
procedure SetCellHAlignM(Horiz: Integer);
procedure SetCellVAlign(Vert: Integer);
procedure SetCellVAlignM(Vert: Integer);
procedure SetCellOrientation(Grad: Integer);
procedure SetCellFrame(Frame: integer);
procedure SetCellFrameInsideV;
procedure SetCellFrameInsideH;
procedure SetCellFillColor(AColor: integer);
procedure SendArrayValue(Arr: variant);
property Cell[x, y: Integer]: string read GetCell write SetCell;
function IsOpen: Boolean;
published
property Visible: Boolean read IsVisible write SetVisible;
end;
TfrPDFExport = class(TfrBasicExpFilter)
private
FPDF: TPDFDocument;
FP: Boolean;
CurPage: Integer;
Alpha: Extended;
FObjectsCount: Integer;
FObjectCountExported: Integer;
FObjectsToExport: TList;
FIsDefObjCountMode: Boolean;
procedure BeforeExport(var FileName: String; var bContinue: Boolean);
procedure AfterExport(const FileName: String);
procedure Cancel;
procedure ExportDoc;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure OnBeginPage; override;
procedure OnBeginDoc; override;
procedure OnEndDoc; override;
procedure OnData(x, y: Integer; View: TfrView); override;
end;
implementation
uses FR_Const, FR_Utils, U_ProgressExp, U_Preview, U_Main, U_BaseCommon, U_Common{, U_Types, U_Ukrainization};
{$R *.dfm}
function ComparePoints(Item1, Item2: Pointer): Integer;
begin
Result := TObjCell(Item1).Value - TObjCell(Item2).Value;
end;
function CompareObjects(Item1, Item2: Pointer): Integer;
var
r: integer;
begin
r := TfrView(Item1).y - TfrView(Item2).y;
if r = 0 then
r := TfrView(Item1).x - TfrView(Item2).x;
if r = 0 then
r :=Length(TfrView(Item1).Memo.Text) - Length(TfrView(Item2).Memo.Text);
Result := r;
end;
constructor TMyfrOleExl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
frRegisterExportFilter(Self, frLoadStr(frRes + 1840), '*.xls');
RX := TList.Create;
RY := TList.Create;
PageObj := TList.Create;
ObjectPos := TList.Create;
Excel := TfrExcel.Create(nil);
pgList := TStringList.Create;
pgBreakList := TStringList.Create;
ShowDialog := True;
expMerged := True;
expWrapWords := True;
expFillColor := True;
expBorders := True;
expAlign := True;
expPageBreaks := True;
expFontName := True;
expFontSize := True;
expFontStyle := True;
expFontColor := True;
expPictures := True;
{
expScaleX := 0.98;
expScaleY := 0.98;
}
expScaleX := 1.0;
expScaleY := 1.0;
//FCanceledExport := false; //#From Oleg#
//FLeaveCellsWithTag := false; //#From Oleg#
//FTagForLeaveCell := #0; //#From Oleg#
FTmpDir := '';
FTmpFiles := TStringList.Create;
//FOnStartExportPageEvent := nil;
//FOnProgressExportPageEvent := nil;
//FOnEndExportPageEvent := nil;
end;
destructor TMyfrOleExl.Destroy;
begin
ClearLastPage;
frUnRegisterExportFilter(Self);
RX.Destroy;
RY.Destroy;
PageObj.Destroy;
ObjectPos.Destroy;
Excel.Destroy;
pgList.Destroy;
pgBreakList.Destroy;
FTmpFiles.Free;
inherited;
end;
function TMyfrOleExl.CleanReturns(Str: string): string;
var
i: integer;
begin
i := Pos(#13, Str);
while i > 0 do
begin
if i > 0 then Delete(Str, i, 1);
i := Pos(#13, Str);
end;
i := Pos(#1, Str);
while i > 0 do
begin
if i > 0 then Delete(Str, i, 1);
i := Pos(#1, Str);
end;
while Copy(Str, Length(str), 1) = #10 do
Delete(Str, Length(Str), 1);
Result := Str;
end;
procedure TMyfrOleExl.ClearLastPage;
var
i: integer;
begin
for i := 0 to RX.Count - 1 do TObjCell(RX[i]).Free;
RX.Clear;
for i := 0 to RY.Count - 1 do TObjCell(RY[i]).Free;
RY.Clear;
for i := 0 to PageObj.Count - 1 do
begin
if TfrView(PageObj[i]) is TfrMemoView then
TfrMemoView(PageObj[i]).Destroy
else
if TfrView(PageObj[i]) is TfrPictureView then
TfrPictureView(PageObj[i]).Destroy;
end;
PageObj.Clear;
for i := 0 to ObjectPos.Count - 1 do TObjPos(ObjectPos[i]).Free;
ObjectPos.Clear;
end;
procedure TMyfrOleExl.ObjCellAdd(Vector: TList; Value: integer);
var
ObjCell: TObjCell;
begin
ObjCell := TObjCell.Create;
ObjCell.Value := Value;
Vector.Add(ObjCell);
end;
procedure TMyfrOleExl.ObjPosAdd(Vector: TList; x, y, dx, dy, obj: integer);
var
ObjPos: TObjPos;
begin
ObjPos := TObjPos.Create;
ObjPos.x := x;
ObjPos.y := y;
ObjPos.dx := dx;
ObjPos.dy := dy;
ObjPos.obj := Obj;
Vector.Add(ObjPos);
end;
procedure TMyfrOleExl.DeleteMultiplePoint(Vector: TList);
var
i: integer;
point, lpoint: TObjCell;
begin
if Vector.Count > 0 then
begin
i := 0;
lpoint := TObjCell(Vector[i]);
inc(i);
while i <= Vector.Count - 1 do
begin
point := TObjCell(Vector[i]);
if (point.Value = lpoint.Value) then
begin
point.Free;
Vector.Delete(i);
end
else
begin
lpoint := point;
inc(i);
end;
end;
end;
end;
procedure TMyfrOleExl.OrderObjectByCells;
var
obj, c, fx, fy, dx, dy, m, mi, curx, cury: integer;
begin
for obj := 0 to PageObj.Count - 1 do
begin
fx := 0; fy := 0;
dx := 1; dy := 1;
for c := 0 to RX.Count - 1 do
if TObjCell(RX[c]).Value = TfrView(PageObj[obj]).x then
begin
fx := c;
m := TfrView(PageObj[obj]).x;
mi := c + 1;
curx :=TfrView(PageObj[obj]).x + (TfrView(PageObj[obj]).dx - 1{0}); //TfrView(PageObj[obj]).dx div 10
while m < curx do
begin
m := m + TObjCell(RX[mi]).Value - TObjCell(RX[mi - 1]).Value;
inc(mi);
end;
dx := mi - c - 1;
break;
end;
for c := 0 to RY.Count - 1 do
if TObjCell(RY[c]).Value = TfrView(PageObj[obj]).y then
begin
fy := c;
m := TfrView(PageObj[obj]).y;
mi := c + 1;
cury := TfrView(PageObj[obj]).y + (TfrView(PageObj[obj]).dy - 1{0}); //TfrView(PageObj[obj]).dy div 10
while m < cury do
begin
m := m + TObjCell(RY[mi]).Value - TObjCell(RY[mi - 1]).Value;
inc(mi);
end;
dy := mi - c - 1;
break;
end;
ObjPosAdd(ObjectPos, fx, fy, dx, dy, obj);
end;
end;
{$WARNINGS OFF}
procedure TMyfrOleExl.ExportPage;
var
i, j, k, l, x, y, dx, dy : integer;
x1, y1, dx1, dy1, olddx, olddy : integer;
dcol, drow, delta, conv : Extended;
s : string;
Left, Right, Top, Bottom : Extended;
Orient, Vert, Horiz: integer;
m: TRect;
obj: TfrMemoView;
PicObj: TfrPictureView;
ExlArray: Variant;
TimeBegin, TimeRemain, TimeEstimate: TDateTime;
Step: integer;
defaultV, defaultH: integer;
oldxFN, oldyFN: integer;
oldFN: string;
oldxFS, oldyFS: integer;
oldFS: integer;
oldxFSt, oldyFSt: integer;
oldFSt: TFontStyles;
oldxAH, oldyAH: integer;
oldAH: integer;
oldxAV, oldyAV: integer;
oldAV: integer;
oldxFC, oldyFC: integer;
oldFC: integer;
oldxFR, oldyFR: integer;
oldFR: integer;
oldxC, oldyC: integer;
oldC: integer;
MyAH: integer;
Merged: BOOL;
Tempi: integer;
ImgFile: String;
Jpeg: TJPEGImage;
CanvasRect: TRect;
Bmp: TBitmap;
MetaFile: TMetafile;
// Tolik 04/02/2020 --
eRows: integer;
eNewRowHeight: Double;
enewRange: TRange;
ePageBreak: word;
ePageBreakIndex: Integer;
type
{TCellCoord}
TCellCoord = packed record
Row: Word;
Column: Byte;
RelativeFlags: Byte;
end;
PCellCoord = ^TCellCoord;
//
procedure AlignFR2AlignExcel(Align: integer; var AlignH, AlignV: integer);
begin
if (Align and frtaRight) <> 0 then
if (Align and frtaCenter) <> 0 then AlignH := xlJustify
else AlignH := xlRight
else if (Align and frtaCenter) <> 0 then AlignH := xlCenter
else AlignH := xlLeft;
if (Align and frtaMiddle) <> 0 then AlignV := xlCenter
else if (Align and frtaDown) <> 0 then AlignV := xlBottom
else AlignV := xlTop;
end;
procedure SetRegionAttrib(x1, y1, x2, y2: integer; Attr: variant; Attr2:TfontStyles; func: integer);
var
dx, dy: integer;
procedure CallFunc(param: variant; param2: TfontStyles; numb: integer);
begin
case numb of
1 : Excel.SetCellFontStyle(param2);
2 : Excel.SetCellFontSize(param);
3 : Excel.SetCellFontName(param);
4 : Excel.SetCellHAlignM(param);
5 : Excel.SetCellVAlignM(param);
6 : Excel.SetCellFontColor(param);
7 : begin
Excel.SetCellFrame(param);
if (dx > 1) and (param > 0) then
Excel.SetCellFrameInsideH;
if (dy > 1) and (param > 0) then
Excel.SetCellFrameInsideV;
end;
8 : Excel.SetCellFillColor(param);
end;
end;
begin
if y2 > y1 then
begin
dx := RX.Count - x1; dy := 1;
Excel.SetRange(x1, y1, dx, dy);
CallFunc(Attr, Attr2, func);
if y2 - y1 > 1 then
begin
dx := RX.Count - 1; dy := y2 - 1;
Excel.SetRange(1, y1 + 1, dx, dy);
CallFunc(Attr, Attr2, func);
end;
dx := x2 - 1; dy := 1;
Excel.SetRange(1, y2, dx, dy);
CallFunc(Attr, Attr2, func);
end
else
begin
dx := x2 - x1; dy := 1;
Excel.SetRange(x1, y2, dx, dy);
CallFunc(Attr, Attr2, func);
end;
end;
begin
TimeBegin := Time;
Step := 0;
TimeRemain := 0;
ImgFile := '';
if CurReport.EMFPages[CurrentPage - 1].pgor = poLandscape then Orient := 0
else Orient := 1;
m := CurReport.EMFPages[CurrentPage - 1].pgMargins;
Left := m.Left / 90;
Right := m.Right / 90;
Top := m.Top / 90;
Bottom := m.Bottom / 90;
Excel.SetPageMargin(Left, Right, Top, Bottom, Orient);
i := 0;
CurReport.Terminated := false;
for y := 1 to RY.Count - 1 do
begin
drow := expScaleY * (TObjCell(RY[y]).Value - TObjCell(RY[y - 1]).Value) / Ydivider;
Excel.SetRowSize(y + cury, drow);
if pgBreakList.Count > i then
if (pgBreakList[i] = IntToStr(TObjCell(RY[y - 1]).Value)) and expPageBreaks then
begin
// Tolik 05/02/2020
Excel.XF.Workbook.Sheets[0].PageBreaks.Add(y,0); //PM - D0000005830
Excel.SetRowSize(y + cury, 0);
inc(i); // Tolik 05/02/2020
end;
end;
for x := 1 to RX.Count - 1 do
begin
dcol := expScaleX*(TObjCell(RX[x]).Value - TObjCell(RX[x - 1]).Value) / Xdivider;
Excel.SetColSize(x, dcol);
end;
ExlArray := VarArrayCreate([0,RY.Count - 1, 0,RX.Count - 1], varVariant);
oldxFN := 1; oldyFN := CurY + 1;
oldFN := '';
oldxFC := 1; oldyFC := CurY + 1;
oldFC := clBlack;
oldxFS := 1; oldyFS := CurY + 1;
oldFS := 10;
oldxFSt := 1; oldyFSt := CurY + 1;
oldFSt := [];
oldxAH := 1; oldyAH := CurY + 1;
oldAH:=xlLeft;
MyAH := xlLeft;
oldxAV := 1; oldyAV := CurY + 1;
oldAV := xlTop;
oldxFR := 1; oldyFR := CurY + 1;
oldFR := 0;
oldxC := 1; oldyC := CurY + 1;
oldC := clNone;
//F_ProjMan.F_ProgressExp.Message1.Visible := False;
//F_ProjMan.F_ProgressExp.esBitBtn1.Visible := True;
//F_ProjMan.F_ProgressExp.Gauge1.Visible := True;
//F_ProjMan.F_ProgressExp.Gauge1.MinValue := 0;
//F_ProjMan.F_ProgressExp.Gauge1.MaxValue := ObjectPos.Count - 1;
//F_ProjMan.F_ProgressExp.Repaint;
if Assigned(FOnStartExportPageEvent) then
FOnStartExportPageEvent(Self, FFileCaption, ObjectPos.Count);
FCanceledExport := false;
Screen.Cursor := crDefault; //!!!
for i := 0 to ObjectPos.Count - 1 do
begin
//if F_ProjMan.F_ProgressExp.WasCancel then
//begin
// break; //Exit;
//end
//else
//begin
// Application.ProcessMessages;
// F_ProjMan.F_ProgressExp.Gauge1.Progress := i;
// F_ProjMan.F_ProgressExp.Gauge1.Refresh;
//end;
if Assigned(FOnProgressExportPageEvent) then
begin
FOnProgressExportPageEvent(Self, FCanceledExport, i, ObjectPos.Count);
if FCanceledExport then
break; //Exit;
end;
x := TObjPos(ObjectPos[i]).x + 1;
y := TObjPos(ObjectPos[i]).y + CurY + 1;
dx := TObjPos(ObjectPos[i]).dx;
dy := TObjPos(ObjectPos[i]).dy;
Excel.SetRange(x, y, dx, dy);
if TfrView(PageObj[TObjPos(ObjectPos[i]).obj]) is TfrMemoView then
begin
Obj := TfrMemoView(PageObj[TObjPos(ObjectPos[i]).obj]);
//Excel.SetRange(x, y, dx, dy);
if FLeaveCellsWithTag then //#From Oleg#
if Obj.Tag = FTagForLeaveCell then //#From Oleg#
Continue; //// CONTINUE //// //#From Oleg#
Excel.BorderStyle := bsThin;
if Obj.FrameWidth > 1 then
Excel.BorderStyle := bsThick;
s:=CleanReturns(Obj.Memo.Text);
l:=pos('.', s);
if l>0 then
begin
s[l]:=',';
{$IFDEF Delphi6}
if TryStrToFloat(s, conv) then
Excel.RangeXF.FormatStringIndex := 35;
{$ENDIF}
end;
AlignFR2AlignExcel(Obj.Alignment, Horiz, Vert);
if expBorders then
Excel.SetCellFrame(Obj.FrameTyp);
if expFillColor then
if Obj.FillColor <> clNone then
Excel.SetCellFillColor(Obj.FillColor);
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //#From Oleg#
Excel.SetCellBorderStyle(Obj);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //#From Oleg#
Excel.SetCellBorderColorRGB(Obj.FrameTyp, Obj.FrameColor);
if (Obj.Alignment and $4) <>0 then
Excel.SetCellOrientation(90);
if expMerged then
if (dx >= 1) or (dy >= 1) then
begin
olddx := dx; olddy := dy;
for j:=i+1 to ObjectPos.Count - 1 do
begin
x1 := TObjPos(ObjectPos[j]).x + 1;
y1 := TObjPos(ObjectPos[j]).y + CurY + 1;
if ((y + dy) > y1) and ((x + dx) > x1) and (x <= x1) then
begin
if y = y1 then
begin
if (x + dx) > x1 then dx := x1 - x;
dy:=1
end
else
dy := y1 - y;
end;
{if j = (i+1) then
if ( ((y + dy) <> y1) or ((x + dx) <> x1) ) and (x <= x1) then
begin
if y = y1 then
begin
if (x + dx) <> x1 then
dx := Abs(x1 - x);
dy := 1;
end
else
dy := y1 - y;
end; }
end;
Merged := False;
MyAH := OLDAH;
if (dx >= 1) or (dy >= 1) then
begin
if (dx <> olddx) or (dy <> olddy) then
begin
Excel.SetRange(x, y, dx, dy);
{if expBorders then
Excel.SetCellFrame(Obj.FrameTyp);
if expFillColor then
if Obj.FillColor <> clNone then
Excel.SetCellFillColor(Obj.FillColor);
if (Obj.Alignment and $4) <>0 then
Excel.SetCellOrientation(90); }
end;
Excel.MergeCells;
if dy > 1 then
begin
MyAH := Horiz;
end;
Merged := True;
end;
end;
begin
if (Obj.Font.Style <> OldFSt) and expFontStyle then
begin
SetRegionAttrib(OldxFSt, OldyFSt, x, y, 0, OldFSt, 1);
OldxFSt := x; OldYFSt := y;
OldFSt := Obj.Font.Style;
end;
if (Obj.Font.Size <> OldFS) and expFontSize then
begin
SetRegionAttrib(OldxFS, OldyFS, x, y, OldFS, [], 2);
OldxFS := x; OldYFS := y;
OldFS := Obj.Font.Size;
end;
if (Obj.Font.Name <> OldFN) and expFontName then
begin
SetRegionAttrib(OldxFN, OldyFN, x, y, OldFN, [], 3);
OldxFN := x; OldYFN := y;
OldFN := Obj.Font.Name;
end;
if expAlign then
begin
if Horiz <> OldAH then
begin
SetRegionAttrib(OldxAH, OldyAH, x, y, OldAH, [], 4);
OldxAH := x; OldyAH := y;
OldAH := Horiz;
end;
if Vert <> OldAV then
begin
SetRegionAttrib(OldxAV, OldyAV, x, y, OldAV, [], 5);
OldxAV := x; OldyAV := y;
OldAV := Vert;
end;
end;
if (Obj.Font.Color <> OldFC) and expFontColor then
begin
SetRegionAttrib(OldxFC, OldyFC, x, y, OldFC, [], 6);
OldxFC := x; OldYFC := y;
OldFC := Obj.Font.Color;
end;
end;
s := Obj.Memo.Text;
if (Pos('/',s) <> 0) and (Length(s) < 10)then
begin
Excel.SetRange(x, y-CurY, dx, dy);
Excel.SetCellNumFormat('@');
end;
if (Pos('-',s) <> 0) and (Length(s) < 10)then
begin
Excel.SetRange(x, y-CurY, dx, dy);
Excel.SetCellNumFormat('@');
end;
if (Pos(#1#13#10, s) = Length(s) - 2) then
begin
while Pos(#13#10, s) > 1 do
if s[Pos(#13#10, s) - 1] <> #1 then
begin
Tempi := pos(#13#10, s);
delete(s, Tempi, 2);
insert(' ', s, Tempi);
end
else
begin
delete(s, pos(#13, s), 1)
end;
end;
s := CleanReturns(s);
ExlArray[y-1-CurY, x-1] := s;
Excel.SetRange(x, y, dx, dy);
Excel.SetCellHAlignM(Horiz);
Excel.SetCellVAlignM(Vert);
try
if s <> '' then
begin
if Excel.RangeXF <> nil then
begin
Excel.RangeXF.Value := s;
end;
end;
except
end;
end
else
if TfrView(PageObj[TObjPos(ObjectPos[i]).obj]) is TfrPictureView then
begin
Inc(CntPics);
PicObj := TfrPictureView(PageObj[TObjPos(ObjectPos[i]).obj]);
(* //#From Oleg#
{$IFDEF Delphi3}
PicObj.Picture.SaveToClipboardFormat(PicFormat, THandle(PicData), HPALETTE(PicPalette));
{$ELSE}
PicObj.Picture.SaveToClipboardFormat(PicFormat, PicData, PicPalette);
{$ENDIF}
Clipboard.SetAsHandle(PicFormat,THandle(PicData));
{$IFDEF Delphi3}
Excel.Range.PasteSpecial;
{$ELSE}
// Excel.Range.PasteSpecial(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
{$ENDIF}
// Excel.WorkSheet.Pictures[CntPics].Width := PicObj.dx / 1.5;
// Excel.WorkSheet.Pictures[CntPics].Height := PicObj.dy / 1.5;
*)
try
if FTmpDir = '' then
begin
FTmpDir := ExtractSCSTempDir; //ExtractFileDir(FileName)+'\'+'~'+FileNameCorrect(ExtractFileNameOnly(FileName));
//if DirectoryExists(FTmpDir) then
// RmDir(FTmpDir);
//CreateDir(FTmpDir);
end;
ImgFile := GetNoExistsFileNameForCopy(FTmpDir+'Image.jpg');
FTmpFiles.Add(ImgFile);
//Bmp.Assign(PicObj.Picture.Bitmap);
//Bmp.Canvas. Assign(PicObj.Picture.Bitmap.Canvas);
{CanvasRect.Top := 0;
CanvasRect.Left := 0;
CanvasRect.Right := PicObj.Picture.Bitmap.Width;
CanvasRect.Bottom := PicObj.Picture.Bitmap.Height;}
//PicObj.Picture.Bitmap.Canvas.StretchDraw(CanvasRect, Bmp);
//PicObj.Picture.SaveToFile('c:\excelpict.bmp');
//PicObj.Picture.Graphic.SaveToFile('c:\excelpict.bmp');
//PicObj.Picture.Bitmap.SaveToFile('c:\excelpict_.bmp');
//PicObj.Picture.Graphic.SaveToFile('c:\excelpict__.bmp');
Jpeg := TJPEGImage.Create;
Jpeg.Assign(PicObj.Picture.Graphic);
try
Jpeg.SaveToFile(ImgFile);
except
begin
Bmp := TBitmap.Create;
Bmp.Height := PicObj.Picture.Bitmap.Height;
Bmp.Width := PicObj.Picture.Bitmap.Width;
CanvasRect := Rect(0, 0, PicObj.Picture.Bitmap.Width, PicObj.Picture.Bitmap.Height);
Bmp.Canvas.Draw(0, 0, PicObj.Picture.Graphic);
Jpeg.Assign(Bmp);
Jpeg.SaveToFile(ImgFile);
FreeAndNil(Bmp);
end;
end;
FreeAndNil(Jpeg);
Excel.XF.Workbook.Sheets[0].Images.Add(ImgFile, x-1, y-1);
except
on E: Exception do AddExceptionToLogEx('TMyfrOleExl.ExportPage', E.Message);
end;
end;
inc(Step);
TimeEstimate := TimeBegin + (ObjectPos.Count - 1) * (Time - TimeBegin) / Step;
TimeRemain := TimeEstimate - Time;
Application.ProcessMessages;
if CurReport.Terminated then
break;
end;
//if F_ProjMan.F_ProgressExp.WasCancel then
// Exit;
if FCanceledExport then
Exit; ///// EXIT /////
x := x + dx; y := y + dy;
SetRegionAttrib(OldxFSt, OldyFSt, x, y, 0, OldFSt, 1); //Font style
SetRegionAttrib(OldxFS, OldyFS, x, y, OldFS, [], 2); //Font size
SetRegionAttrib(OldxFN, OldyFN, x, y, OldFN, [], 3); //Font name
SetRegionAttrib(OldxAH, OldyAH, x, y, OldAH, [], 4); //H Align
SetRegionAttrib(OldxAV, OldyAV, x, y, OldAV, [], 5); //V Align
SetRegionAttrib(OldxFC, OldyFC, x, y, OldFC, [], 6);
//Tolik 04/02/2020 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
eRows := RY.Count;
for i := 1 to eRows do
begin
if Excel.XF.Workbook.Sheets[0].Rows[i].Height > 409 then
begin
ePageBreakIndex := -1;
for j := 0 to Excel.XF.Workbook.Sheets[0].PageBreaks.ItemsCount - 1 do
begin
if Excel.XF.Workbook.Sheets[0].PageBreaks.Item[j].Row >= i then
begin
ePageBreakIndex := j;
ePageBreak := Excel.XF.Workbook.Sheets[0].PageBreaks.Item[j].Row;
break;
end;
end;
eNewRowHeight := Excel.XF.Workbook.Sheets[0].Rows[i].Height - 409;
Excel.XF.Workbook.Sheets[0].Rows.InsertRows(i, 1);
Excel.XF.Workbook.Sheets[0].Rows[i].Height := 409;
Excel.XF.Workbook.Sheets[0].Rows[i + 1].Height := eNewRowHeight + 10;
//Excel.XF.Workbook.Sheets[0].Rows[i + 1].Height := eNewRowHeight + 10;
for j := 1 to Rx.Count - 2 do
begin
enewRange := Excel.XF.Workbook.Sheets[0].Ranges.Add;
enewRange.AddRect(i, i + 1, j, j);
//enewRange.Wrap := True;
enewRange.MergeCells;
Excel.SetRange(i,i+1,j,j);
Excel.SetCellHAlignM(Horiz);
Excel.SetCellVAlignM(Vert);
end;
inc(eRows);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if ePageBreakIndex <> -1 then
begin
//Excel.XF.Workbook.Sheets[0].PageBreaks.Remove(ePageBreakIndex);
Excel.XF.Workbook.Sheets[0].PageBreaks.SetItem(ePageBreakIndex, ePageBreak + 1, 0);
end;
end;
end;
//Tolik 10/02/2020
//Excel.SetRange(1, CurY + 1, RX.Count - 1, RY.Count - 1);
Excel.SetRange(1, CurY + 1, RX.Count - 1, eRows - 1);
//
CurY := Y - 1;
end;
{$WARNINGS ON}
function TMyfrOleExl.ShowModal: Word;
var
PageNumbers: string;
procedure ParsePageNumbers;
var
i, j, n1, n2: Integer;
s: String;
IsRange: Boolean;
begin
s := PageNumbers;
while Pos(' ', s) <> 0 do
Delete(s, Pos(' ', s), 1);
if s = '' then Exit;
s := s + ',';
i := 1; j := 1; n1 := 1;
IsRange := False;
while i <= Length(s) do
begin
if s[i] = ',' then
begin
n2 := StrToInt(Copy(s, j, i - j));
j := i + 1;
if IsRange then
while n1 <= n2 do
begin
pgList.Add(IntToStr(n1));
Inc(n1);
end
else
pgList.Add(IntToStr(n2));
IsRange := False;
end
else if s[i] = '-' then
begin
IsRange := True;
n1 := StrToInt(Copy(s, j, i - j));
j := i + 1;
end;
Inc(i);
end;
end;
begin
if ShowDialog then
begin
frExportSet := TfrOLEExcelSet.Create(nil);
frExportSet.CB_Merged.Checked := expMerged;
frExportSet.CB_WrapWords.Checked := expWrapWords;
frExportSet.CB_FillColor.Checked := expFillColor;
frExportSet.CB_Borders.Checked := expBorders;
frExportSet.CB_Align.Checked := expAlign;
frExportSet.CB_PageBreaks.Checked := expPageBreaks;
frExportSet.CB_FontName.Checked := expFontName;
frExportSet.CB_FontSize.Checked := expFontSize;
frExportSet.CB_FontStyle.Checked := expFontStyle;
frExportSet.CB_FontColor.Checked := expFontColor;
frExportSet.CB_Pictures.Checked := expPictures;
frExportSet.CB_OpenExcel.Checked := expOpenAfter;
frExportSet.E_ScaleX.Text := FloatToStr(Int(expScaleX*100));
frExportSet.E_ScaleY.Text := FloatToStr(Int(expScaleY*100));
frExportSet.E_TMargin.Text := FloatToStr(expTopMargin);
frExportSet.E_LMargin.Text := FloatToStr(expLeftMargin);
Result := frExportSet.ShowModal;
PageNumbers := frExportSet.E_Range.Text;
expMerged := frExportSet.CB_Merged.Checked;
expWrapWords := frExportSet.CB_WrapWords.Checked;
expFillColor := frExportSet.CB_FillColor.Checked;
expBorders := frExportSet.CB_Borders.Checked;
expAlign := frExportSet.CB_Align.Checked;
expPageBreaks := frExportSet.CB_PageBreaks.Checked;
expFontName := frExportSet.CB_FontName.Checked;
expFontSize := frExportSet.CB_FontSize.Checked;
expFontStyle := frExportSet.CB_FontStyle.Checked;
expFontColor := frExportSet.CB_FontColor.Checked;
expPictures := frExportSet.CB_Pictures.Checked;
expOpenAfter := frExportSet.CB_OpenExcel.Checked;
expScaleX := StrToInt(frExportSet.E_ScaleX.Text) / 100;
expScaleY := StrToInt(frExportSet.E_ScaleY.Text) / 100;
expTopMargin := StrToFloat_My(frExportSet.E_TMargin.Text);
expLeftMargin := StrToFloat_My(frExportSet.E_LMargin.Text);
frExportSet.Destroy;
end
else
Result := mrOk;
pgList.Clear;
pgBreakList.Clear;
ParsePageNumbers;
end;
procedure TMyfrOleExl.OnBeginDoc;
begin
OnAfterExport := AfterExport;
Excel.OpenExcel;
CurrentPage := 0;
CurY := 0;
FirstPage := true;
ClearLastPage;
CY := 0;
lastY := 0;
CntPics := 0;
end;
procedure TMyfrOleExl.OnBeginPage;
begin
Inc(CurrentPage);
end;
procedure TMyfrOleExl.OnData(x, y: Integer; View: TfrView);
var
MemoView : TfrMemoView;
PicView : TfrPictureView;
ind, maxy, j, k, dy : integer;
delta : Extended;
bit : TBitmap;
BottomView: TfrView;
LineDY: Integer;
rect: TRect;
begin
ind := 0;
if (pgList.Find(IntToStr(CurrentPage),ind)) or (pgList.Count = 0) then
begin
if View is TfrMemoView then
begin
if (TfrMemoView(View).Memo.Count > 0) or (TfrMemoView(View).FrameTyp > 0) then
begin
MemoView := TfrMemoView.Create;
MemoView.Assign(View);
MemoView.y := MemoView.y + CY;
PageObj.Add(MemoView);
end;
end
{else
if View is TfrLineView then
begin
PicView := TfrPictureView.Create;
PicView.x := View.x;
PicView.y := View.y;
PicView.dx := View.dx;
PicView.dy := View.dy;
bit := TBitmap.Create;
bit.Height := View.dy+1;
bit.Width := View.dx+1;
if bit.Height < View.FrameWidth then
bit.Height := View.FrameWidth;
if bit.Width < View.FrameWidth then
bit.Width := View.FrameWidth;
View.x := 0;
View.y := 0;
View.Draw(bit.Canvas);
View.x := PicView.x;
View.y := PicView.y;
PicView.Picture.Bitmap.Assign(bit);
bit.Destroy;
PicView.y := PicView.y + CY;
PageObj.Add(PicView);
end}
else
begin
PicView := TfrPictureView.Create;
if (PicView.Flags and flStretched) = flStretched then
PicView.Flags := PicView.Flags xor flStretched;
PicView.FrameWidth := 0;
PicView.x := View.x;
PicView.y := View.y;
PicView.dx := View.dx;
PicView.dy := View.dy;
bit := TBitmap.Create;
bit.Height := View.dy+2;
bit.Width := View.dx+2;
//#From Oleg#
//*** <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if View is TfrLineView then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> 1-<2D><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if bit.Height > 1 then
begin
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 10% <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
LineDY := Trunc(bit.Height * (10/100));
bit.Height := bit.Height + LineDY;
//PicView.dy := PicView.dy + LineDY;
View.dy := View.dy + LineDY;
end;
//*** <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if bit.Height < View.FrameWidth then
bit.Height := Trunc(View.FrameWidth)+1;
if bit.Width < View.FrameWidth then
bit.Width := Trunc(View.FrameWidth)+1;
end;
//#From Oleg#
View.x := 0;
View.y := 0;
View.Draw(bit.Canvas);
View.x := PicView.x;
View.y := PicView.y;
// Tolik 10/02/2020 --
//PicView.Picture.Bitmap.Assign(bit);
//Ydivider = 1.3
PicView.Picture.Bitmap.width := view.dx + 2;
PicView.Picture.Bitmap.height := view.dy + 2;
rect.Left := 0;
rect.Right := view.dx + 2;
rect.Top := 0;
rect.Bottom := view.dy + 2;
PicView.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
//
bit.Destroy;
PicView.y := PicView.y + CY;
//PageObj.Add(PicView);
PageObj.Insert(0, PicView);
end;
//if View is TfrMemoView then //17.02.2009
begin
ObjCellAdd(RX, View.x);
ObjCellAdd(RX, View.x + View.dx);
ObjCellAdd(RY, View.y + CY);
ObjCellAdd(RY, View.y + View.dy + CY);
// Excel capability code
if (View.y + CY) > lastY then
begin
delta := expScaleY * (View.y + CY - LastY) / Ydivider;
if delta > XLMaxHeight then
begin
k := Trunc (delta / XLMaxHeight);
dy := Trunc (XLMaxHeight * Ydivider / expScaleY);
for j := 1 to k do
ObjCellAdd(RY, LastY + dy * k);
end;
end;
maxy := View.y + View.dy + CY;
if maxy > LastY then
LastY := maxy;
end;
end;
end;
procedure TMyfrOleExl.OnEndPage;
var
ind: integer;
begin
CY := LastY;
ind := 0;
if (pgList.Find(IntToStr(CurrentPage),ind)) or (pgList.Count = 0) then
pgBreakList.Add(IntToStr(LastY));
end;
procedure TMyfrOleExl.OnEndDoc;
begin
//
end;
procedure TMyfrOleExl.AfterExport(const FileName: string);
var
i: Integer;
TempList: TList;
begin
RX.Sort(@ComparePoints);
RY.Sort(@ComparePoints);
DeleteMultiplePoint(RX);
DeleteMultiplePoint(RY);
TempList := TList.Create;
for i := 0 to PageObj.Count - 1 do
begin
if TObject(PageObj[i]) is TfrPictureView then
begin
TempList.Add(PageObj[i]);
PageObj[i] := nil;
end;
end;
PageObj.Pack;
PageObj.Sort(@CompareObjects);
for i := 0 to TempList.Count - 1 do
PageObj.Insert(0, TempList[i]);
FreeAndNil(TempList);
OrderObjectByCells;
ExportPage;
//if F_ProjMan.F_ProgressExp.WasCancel then
// begin
// Exit;
// end
//else
// begin
// F_ProjMan.F_Preview.frPreview1.PopupMenu := F_ProjMan.F_Preview.PopupMenu1;
// end;
if Assigned(FOnEndExportPageEvent) then
FOnEndExportPageEvent(Self, FCanceledExport);
if FCanceledExport then
Exit; ///// EXIT /////
Excel.SetRange(1, 1, 1, 1);
try
DeleteFile(FileName);
{$IFDEF Delphi3}
Excel.WorkBook.SaveAs(FileName,xlNormal);
{$ELSE}
try
Excel.XF.SaveAs(FileName);
except
end;
{$ENDIF}
except
end;
if DirectoryExists(FTmpDir) then
ClearTmpFiles;
end;
procedure TMyfrOleExl.ClearTmpFiles;
var
i: Integer;
begin
for i := 0 to FTmpFiles.Count - 1 do
DeleteFile(FTmpFiles[i]);
end;
///////////////////////////////////////////////////
constructor TFrExcel.Create (AOwner : TComponent);
begin
inherited Create(AOwner);
IsOpened := false;
IsVisible := false;
BorderStyle := bsThin;
end;
destructor TFrExcel.Destroy;
begin
if IsOpened then
try
xf.Destroy;
except
end;
inherited Destroy;
end;
function TfrExcel.Pos2Str(Pos: Integer): String;
var
i, j: integer;
begin
if Pos > 26 then
begin
i := Pos mod 26; j := Pos div 26;
if i = 0 then Result := Chr(64 + j - 1)
else Result := Chr(64 + j);
if i = 0 then Result := Result + chr(90)
else result := Result + Chr(64 + i);
end
else Result := Chr(64 + Pos);
end;
procedure TFrExcel.SetVisible(DoShow: Boolean);
begin
if not IsOpened then
exit;
end;
function TFrExcel.IntToCoord(X, Y: Integer): string;
begin
Result := Pos2Str(X) + IntToStr(Y);
end;
function TFrExcel.GetCell(x, y: Integer): string;
begin
result := xf.Workbook.Sheets[0].Cells[y - 1, x - 1].ValueAsString;
end;
procedure TFrExcel.SetCell(x, y: Integer; const Value: string);
begin
xf.Workbook.Sheets[0].Cells[y - 1, x - 1].Value := Value;
end;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
procedure TFrExcel.SetColSize(x: Integer; Size: Extended);
var
SizeO: Extended;
SizeInt: integer;
begin
SizeInt := trunc(Size);
xf.Workbook.Sheets[0].Columns[x - 1].WidthPx := SizeInt;
end;
// Tolik 04/02/2020 -- <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (<28><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> 409 <20><><EFBFBD><EFBFBD><EFBFBD>)
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
procedure TFrExcel.SetRowSize(y: Integer; Size: Extended);
begin
//Size := Size*1.07;
Size := Size*1.075;
//if size > 409 then
// size := 409;
xf.Workbook.Sheets[0].Rows[y - 1].Height := Size;
end;
{procedure TFrExcel.SetRowSize(y: Integer; Size: Extended);
begin
Size := Size*1.07;
if size > 409 then
size := 409;
xf.Workbook.Sheets[0].Rows[y - 1].Height := Size;
end;}
//
procedure TFrExcel.MergeCells;
begin
if RangeXF <> nil then
begin
RangeXF.MergeCells;
end;
end;
procedure TFrExcel.OpenExcel;
begin
try
xf := TXLSFile.Create;
xf.Workbook.Sheets[0].Name := SheetName;
IsOpened := True;
except
IsOpened := false;
end;
end;
function TFrExcel.IsOpen: Boolean;
begin
result := IsOpened;
end;
procedure TFrExcel.SetPageMargin(Left, Right, Top, Bottom: Extended; Orient : Integer);
begin
try
// Tolik 03/02/2020 -- <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>!!!
{xf.Workbook.Sheets[0].PageSetup.LeftMargin := Left;
xf.Workbook.Sheets[0].PageSetup.RightMargin := Right;
xf.Workbook.Sheets[0].PageSetup.TopMargin := Top;
xf.Workbook.Sheets[0].PageSetup.BottomMargin := Bottom;}
xf.Workbook.Sheets[0].PageSetup.LeftMargin := Left/2.54;
xf.Workbook.Sheets[0].PageSetup.RightMargin := Right/2.54;
xf.Workbook.Sheets[0].PageSetup.TopMargin := Top/2.54;
xf.Workbook.Sheets[0].PageSetup.BottomMargin := Bottom/2.54;
//
xf.Workbook.Sheets[0].PageSetup.Orientation := TXLSPageOrientation(Orient);
except
end;
end;
procedure TFrExcel.SetCellBorderColorRGB(AFrame, ARGBColor: integer);
begin
if RangeXF <> nil then
begin
if (AFrame and frftLeft) <> 0 then
RangeXF.BorderColorRGB[xlBorderLeft] := ARGBColor;
if (AFrame and frftRight) <> 0 then
RangeXF.BorderColorRGB[xlBorderRight] := ARGBColor;
if (AFrame and frftTop) <> 0 then
RangeXF.BorderColorRGB[xlBorderTop] := ARGBColor;
if (AFrame and frftBottom) <> 0 then
RangeXF.BorderColorRGB[xlBorderBottom] := ARGBColor;
end;
end;
procedure TFrExcel.SetCellBorderStyle(AObj: TfrView);
var
BorderStyle: TXLBorderStyle;
begin
if RangeXF <> nil then
begin
BorderStyle := bsThin;
case AObj.FrameStyle of
0: // Solid - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
BorderStyle := bsThin; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if (AObj.FrameWidth > 1) and (AObj.FrameWidth <= 2) then
BorderStyle := bsMedium // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
else
if AObj.FrameWidth > 2 then
BorderStyle := bsThick; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
end;
1: // Dash - <20><><EFBFBD><EFBFBD>
begin
BorderStyle := bsDashed; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if AObj.FrameWidth > 1 then
BorderStyle := bsMediumDashed; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
end;
2: // Dot - <20><><EFBFBD><EFBFBD><EFBFBD>
begin
BorderStyle := bsDotted; //bsHair; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if AObj.FrameWidth > 1 then
BorderStyle := bsDotted;
end;
3: // DashDot - <20><><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD>
begin
BorderStyle := bsDashDot; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if AObj.FrameWidth > 1 then
BorderStyle := bsMediumDashDot; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
end;
4: // DashDotDot - <20><><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD>
begin
BorderStyle := bsDashDotDot; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if AObj.FrameWidth > 1 then
BorderStyle := bsMediumDashDotDot; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
end;
5: // Double - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
BorderStyle := bsDouble;
end;
end;
if (AObj.FrameTyp and frftLeft) <> 0 then
RangeXF.BorderStyle[xlBorderLeft] := BorderStyle;
if (AObj.FrameTyp and frftRight) <> 0 then
RangeXF.BorderStyle[xlBorderRight] := BorderStyle;
if (AObj.FrameTyp and frftTop) <> 0 then
RangeXF.BorderStyle[xlBorderTop] := BorderStyle;
if (AObj.FrameTyp and frftBottom) <> 0 then
RangeXF.BorderStyle[xlBorderBottom] := BorderStyle;
end;
end;
procedure TFrExcel.SetCellFontName(FontName: string);
begin
if RangeXF <> nil then
begin
if length(FontName) > 0 then
RangeXF.FontName := FontName;
end;
end;
procedure TFrExcel.SetCellFontSize(FontSize: integer);
begin
if RangeXF <> nil then
begin
RangeXF.FontHeight := FontSize;
end;
end;
procedure TFrExcel.SetCellFontColor(FontColor: integer);
begin
if RangeXF <> nil then
begin
RangeXF.FontColorRGB := FontColor;
end;
end;
procedure TFrExcel.SetCellFontStyle(Style: TFontStyles);
begin
if RangeXF <> nil then
begin
RangeXF.FontBold := fsBold in Style;
RangeXF.FontItalic := fsItalic in Style;
RangeXF.FontUnderline := fsUnderline in Style;;
end;
end;
procedure TFrExcel.SetCellVAlign(Vert: Integer);
var
CellVAl: TCellVAlignment;
begin
if RangeXF <> nil then
begin
CellVAl := xlVAlignCenter;
case Vert of
-4160: CellVAl := xlVAlignTop;
-4107: CellVAl := xlVAlignBottom;
-4108: CellVAl := xlVAlignCenter;
-4130: CellVAl := xlVAlignJustify;
end;
RangeXF.VAlign := CellVAl;
end;
end;
procedure TFrExcel.SetCellVAlignM(Vert: Integer);
var
CellVAl: TCellVAlignment;
begin
if RangeXF <> nil then
begin
CellVAl := xlVAlignCenter;
case Vert of
-4160: CellVAl := xlVAlignTop;
-4107: CellVAl := xlVAlignBottom;
-4108: CellVAl := xlVAlignCenter;
-4130: CellVAl := xlVAlignJustify;
end;
RangeXF.VAlign := CellVAl;
end;
end;
procedure TFrExcel.SetCellHAlign(Horiz: Integer);
var
CellHAl: TCellHAlignment;
begin
if RangeXF <> nil then
begin
CellHAl := xlHAlignCenter;
case Horiz of
-4152: CellHAl := xlHAlignRight;
-4131: CellHAl := xlHAlignLeft;
-4108: CellHAl := xlHAlignCenter ;
-4130: CellHAl := xlHAlignJustify;
end;
RangeXF.HAlign := TCellHAlignment(Horiz);
end;
end;
procedure TFrExcel.SetCellHAlignM(Horiz: Integer);
var
CellHAl: TCellHAlignment;
begin
if RangeXF <> nil then
begin
CellHAl := xlHAlignCenter;
case Horiz of
-4152: CellHAl := xlHAlignRight;
-4131: CellHAl := xlHAlignLeft;
-4108: CellHAl := xlHAlignCenter;
-4130: CellHAl := xlHAlignJustify;
end;
if CellHAl = xlHAlignCenter then
CellHAl := CellHAl;
RangeXF.HAlign := CellHAl;
end;
end;
procedure TFrExcel.SetCellOrientation(Grad: Integer);
begin
if RangeXF <> nil then
begin
RangeXF.Rotation := Grad;
end;
end;
procedure TFrExcel.SetRange(x, y, dx, dy: Integer);
begin
if (dx = 0) or (dy = 0) then
dx := dx;
RangeXF := nil;
if (dx > 0) and (dy > 0) then
begin
RangeXF := XF.Workbook.Sheets[0].Ranges.Add;
RangeXF.AddRect(y - 1, y - 1 + dy - 1, x - 1, x - 1 + dx - 1);
RangeXF.Wrap := True;
end;
end;
procedure TfrExcel.SetCellFrame(Frame: integer);
begin
if RangeXF <> nil then
begin
if (Frame and frftLeft) <> 0 then
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderLeft);
if (Frame and frftRight) <> 0 then
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderRight);
if (Frame and frftTop) <> 0 then
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderTop);
if (Frame and frftBottom) <> 0 then
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderBottom);
end;
end;
procedure TfrExcel.SetCellFrameInsideH;
begin
if RangeXF <> nil then
begin
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderLeft);
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderRight);
end;
end;
procedure TfrExcel.SetCellFrameInsideV;
begin
if RangeXF <> nil then
begin
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderTop);
RangeXF.BordersEdge(xlColorBlack, BorderStyle, xlBorderBottom);
end;
end;
procedure TfrExcel.SetCellFillColor(AColor: integer);
begin
if RangeXF <> nil then
begin
RangeXF.FillPattern := xlPatternSolid;
//RangeXF.FillPatternBGColorIndex := AColor;
RangeXF.FillPatternBGColorRGB := AColor;
end;
end;
procedure TfrExcel.SendArrayValue(Arr: variant);
begin
if RangeXF <> nil then
begin
RangeXF.Value := Arr;
end;
end;
//////////////////////////////////////////////
procedure TfrOLEExcelSet.Localize;
begin
Ok.Caption := frLoadStr(SOk);
Cancel.Caption := frLoadStr(SCancel);
GroupPageRange.Caption := frLoadStr(frRes + 44);
Pages.Caption := frLoadStr(frRes + 47);
Descr.Caption := frLoadStr(frRes + 48);
Caption := frLoadStr(frRes + 1844);
GroupPageSettings.Caption := frLoadStr(frRes + 1845);
Topm.Caption := frLoadStr(frRes + 1846);
Leftm.Caption := frLoadStr(frRes + 1847);
ScX.Caption := frLoadStr(frRes + 1848);
ScY.Caption := frLoadStr(frRes + 1849);
GroupCellProp.Caption := frLoadStr(frRes + 1850);
CB_Merged.Caption := frLoadStr(frRes + 1851);
CB_Align.Caption := frLoadStr(frRes + 1852);
CB_FillColor.Caption := frLoadStr(frRes + 1853);
CB_Borders.Caption := frLoadStr(frRes + 1854);
CB_WrapWords.Caption := frLoadStr(frRes + 1855);
CB_FontName.Caption := frLoadStr(frRes + 1856);
CB_FontSize.Caption := frLoadStr(frRes + 1857);
CB_FontStyle.Caption := frLoadStr(frRes + 1858);
CB_FontColor.Caption := frLoadStr(frRes + 1859);
CB_PageBreaks.Caption := frLoadStr(frRes + 1860);
Better.Caption := frLoadStr(frRes + 1861);
Faster.Caption := frLoadStr(frRes + 1862);
CB_Pictures.Caption := frLoadStr(frRes + 1863);
CB_OpenExcel.Caption := frLoadStr(frRes + 1864);
end;
procedure TfrOLEExcelSet.BetterClick(Sender: TObject);
begin
CB_Merged.Checked := true;
CB_WrapWords.Checked := true;
CB_FillColor.Checked := true;
CB_Borders.Checked := true;
CB_Align.Checked := true;
CB_PageBreaks.Checked := true;
CB_FontName.Checked := true;
CB_FontSize.Checked := true;
CB_FontStyle.Checked := true;
CB_FontColor.Checked := true;
CB_Pictures.Checked := true;
end;
procedure TfrOLEExcelSet.FasterClick(Sender: TObject);
begin
CB_Merged.Checked := true;
CB_WrapWords.Checked := true;
CB_FillColor.Checked := false;
CB_Borders.Checked := false;
CB_Align.Checked := false;
CB_PageBreaks.Checked := true;
CB_FontName.Checked := false;
CB_FontSize.Checked := false;
CB_FontStyle.Checked := false;
CB_FontColor.Checked := false;
CB_Pictures.Checked := false;
end;
procedure TfrOLEExcelSet.FormCreate(Sender: TObject);
begin
Localize;
end;
procedure TFrExcel.SetCellNumFormat(Format: char);
var
Fsi: integer;
begin
if RangeXF <> nil then
begin
Fsi := 0;
case Format of
'@': Fsi := 35;
end;
RangeXF.FormatStringIndex := Fsi;
end;
end;
{ TfrBasicExpFilter }
constructor TfrBasicExpFilter.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFileCaption := '';
FCanceledExport := false;
FLeaveCellsWithTag := false;
FTagForLeaveCell := #0;
FOnStartExportPageEvent := nil;
FOnProgressExportPageEvent := nil;
FOnEndExportPageEvent := nil;
end;
{ TfrPDFExport }
procedure TfrPDFExport.AfterExport(const FileName: String);
begin
//ExportDoc;
if Assigned(FOnEndExportPageEvent) then
FOnEndExportPageEvent(Self, FCanceledExport);
if FCanceledExport then
Cancel;
end;
procedure TfrPDFExport.BeforeExport(var FileName: String;
var bContinue: Boolean);
var
i: Integer;
begin
FObjectsCount := 0;
FObjectCountExported := 0;
FCanceledExport := false;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to CurReport.Pages.Count - 1 do
FObjectsCount := FObjectsCount + CurReport.Pages[i].Objects.Count;
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> 4.5 <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FObjectsCount := FObjectsCount * 2; //Trunc(FObjectsCount * 4.53);
if Assigned(FOnStartExportPageEvent) then
FOnStartExportPageEvent(Self, FFileCaption, FObjectsCount);
//if Assigned(FOnStartExportPageEvent) then
// FOnStartExportPageEvent(Self, FCaption, CurReport.Pages.Count);
end;
procedure TfrPDFExport.Cancel;
begin
CurReport.Terminated := True;
end;
procedure TfrPDFExport.ExportDoc;
var
i: integer;
CanDraw: Boolean;
View: TfrView;
begin
for i := 0 to FObjectsToExport.Count - 1 do
begin
View := TfrView(FObjectsToExport[i]);
if Assigned(FOnProgressExportPageEvent) then
begin
FOnProgressExportPageEvent(Self, FCanceledExport, FObjectCountExported, FObjectsCount);
if FCanceledExport then
begin
Cancel;
Exit; ///// EXIT /////
end;
end;
CanDraw := true;
if FLeaveCellsWithTag then
if View.Tag = FTagForLeaveCell then
CanDraw := true;
if CanDraw and Assigned(FPDF) then
View.Draw(FPDF.Canvas);
FObjectCountExported := FObjectCountExported + 1;
end;
end;
constructor TfrPDFExport.Create(AOwner: TComponent);
begin
try
inherited Create(AOwner);
//02.03.2012 FPDF := TPDFDocument.Create(Self);
if ClassName = 'TfrPDFExport' then
frRegisterExportFilter(Self, 'Adobe Acrobat Documents (*.pdf)', '*.pdf');
FIsDefObjCountMode := false;
FObjectsToExport := TList.Create;
OnBeforeExport := BeforeExport;
OnAfterExport := AfterExport;
except
on e: Exception do
ShowMessage('Pdf Error!!!');
end;
end;
destructor TfrPDFExport.Destroy;
begin
FreeAndNil(FObjectsToExport);
frUnRegisterExportFilter(Self);
//02.03.2012 FreeAndNil(FPDF);
inherited;
end;
procedure TfrPDFExport.OnBeginDoc;
//var
// DC: HDC;
begin
{inherited;
if FPDF.Printing then FPDF.Abort;
FPDF.FileName := FileName;
FPDF.OutputStream := Stream;
FPDF.Compression := ctFlate;
FPDF.NonEmbeddedFont.Add('WingDings');
FPDF.OnePass := True;
DC := GetDC(0);
FPDF.Resolution := GetDeviceCaps(dc, LOGPIXELSX);
Alpha := FPDF.Resolution/91.4;
ReleaseDC(0, DC);
FPDF.BeginDoc;
FP := True;
CurPage := -1;}
try
FPDF := CreatePDFObject(Self, FTitle, FileName, Stream); //02.03.2012
inherited;
if FPDF.Printing then FPDF.Abort;
{//02.03.2012
FPDF.DocumentInfo.Title := FTitle; //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FPDF.DocumentInfo.Subject := '';
FPDF.DocumentInfo.Producer := cResourceReport_Msg24 +ApplicationName+' '+VersionEXE;
FPDF.DocumentInfo.Author := ExpertSoft_r;
FPDF.DocumentInfo.Creator := '';
FPDF.DocumentInfo.Keywords := '';
FPDF.FileName := FileName;
FPDF.OutputStream := Stream;
FPDF.Compression := ctFlate;
FPDF.NonEmbeddedFont.Add('WingDings');
FPDF.OnePass := True;
DC := GetDC(0);
FPDF.Resolution := GetDeviceCaps(dc, LOGPIXELSX);
ReleaseDC(0, DC); }
Alpha := 1;// FPDF.Resolution/91.4;
FPDF.BeginDoc;
FP := True;
CurPage := -1;
except
on e: Exception do
ShowMessage('Pdf Error!!!');
end;
end;
procedure TfrPDFExport.OnBeginPage;
begin
try
Inc(CurPage);
if CurPage <> 0 then
FPDF.NewPage;
FPDF.CurrentPage.Width := Round(CurReport.EMFPages[CurPage].PrnInfo.Pgw * Alpha);
FPDF.CurrentPage.Height := Round(CurReport.EMFPages[CurPage].PrnInfo.Pgh * Alpha);
{FOnProgressExportPageEvent(Self, FCanceledExport, CurPage + 1, CurReport.EMFPages.Count);
if FCanceledExport then
begin
Cancel;
Exit; ///// EXIT /////
end; }
except
on e: Exception do
ShowMessage('Pdf Error!!!');
end;
end;
procedure TfrPDFExport.OnData(x, y: Integer; View: TfrView);
//var
// ax, ay: Extended;
var
CanDraw: Boolean;
begin
try
//FObjectsToExport.Add(View);
//FObjectsCount := FObjectsCount + 1;
if FIsDefObjCountMode then
FObjectsCount := FObjectsCount + 1
else
begin
// ax := View.ScaleX;
// ay := View.ScaleY;
// View.ScaleX := View.ScaleX*Alpha;
// View.ScaleY := View.ScaleY*Alpha;
if Assigned(FOnProgressExportPageEvent) then
begin
if FObjectsCount < FObjectCountExported then
FObjectsCount := FObjectCountExported;
FOnProgressExportPageEvent(Self, FCanceledExport, FObjectCountExported, FObjectsCount);
if FCanceledExport then
begin
Cancel;
Exit; ///// EXIT /////
end;
end;
CanDraw := true;
if FLeaveCellsWithTag then
if View.Tag = FTagForLeaveCell then
CanDraw := true;
if CanDraw and Assigned(FPDF) then
View.Draw(FPDF.Canvas);
FObjectCountExported := FObjectCountExported + 1;
// View.ScaleX := AX;
// View.ScaleY := AY;
end;
except
on e: Exception do
ShowMessage('Pdf Error!!!');
end;
end;
procedure TfrPDFExport.OnEndDoc;
begin
//ExportDoc;
try
FPDF.EndDoc;
except
on Exception do
begin
FPDF.Abort;
raise;
end;
end;
FreeAndNil(FPDF); //02.03.2012
end;
end.
Reference in New Issue View Git Blame Copy Permalink