mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
1334 lines
40 KiB
ObjectPascal
1334 lines
40 KiB
ObjectPascal
unit U_ProgressExp;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Clipbrd, Printers, Dialogs, Gauges, StdCtrls, Buttons, {U_Types,} ExtCtrls,
|
|
OleServer, {Excel2000,} U_FrOleEXl, {U_MsgDlg,} FR_Class, {U_DM,}
|
|
ShellAPI{ðàáîòà ñ êîìàíäíîé ñòðîêîé}, U_Preview, FR_View{, U_Ukrainization,
|
|
U_Stroika},
|
|
U_BaseCommon, U_BaseConstants, siComp, siLngLnk, RzButton;
|
|
|
|
|
|
|
|
type
|
|
{ TMyFrExcel = class;
|
|
|
|
TMyfrOleExl = class(TfrOLEExcelExport)
|
|
private
|
|
CurrentPage: integer;
|
|
FirstPage: boolean;
|
|
CurY: integer;
|
|
RX: TList; // TObjCell
|
|
RY: TList; // TObjCell
|
|
ObjectPos: TList; // TObjPos
|
|
PageObj: TList; // TfrView
|
|
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;
|
|
Excel: TMyFrExcel;
|
|
procedure DeleteMultiplePoint(Vector: TList);
|
|
procedure ObjPosAdd(Vector: TList; x, y, dx, dy, obj: integer);
|
|
procedure OrderObjectByCells;
|
|
function CleanReturns(Str: string): string;
|
|
procedure ExportPage;
|
|
procedure AfterExport(const FileName: string);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
function ShowModal: Word; override;
|
|
end;
|
|
|
|
TMyFrExcel = class(TFrExcel)
|
|
private
|
|
IsOpened: Boolean;
|
|
IsVisible: Boolean;
|
|
Excel: Variant;
|
|
WorkBook: Variant;
|
|
WorkSheet: Variant;
|
|
Range : Variant;
|
|
public
|
|
procedure SetCellNumFormat(Format: char);
|
|
procedure SetColSize(x: integer; Size: Extended);
|
|
procedure SetRowSize(y: integer; Size: Extended);
|
|
procedure SetCellHAlignM(Horiz: Integer);
|
|
end;
|
|
}
|
|
TF_ProgressExp = class(TForm)
|
|
lng_Forms: TsiLangLinked;
|
|
pnProgress: TPanel;
|
|
Timer1: TTimer;
|
|
TimerClose: TTimer;
|
|
Gauge1: TGauge;
|
|
Message1: TLabel;
|
|
pnCancel: TPanel;
|
|
cbOpen: TCheckBox;
|
|
pnTotalProgress: TPanel;
|
|
gTotal: TGauge;
|
|
lbProgress: TLabel;
|
|
lbTotalProgress: TLabel;
|
|
pnMain: TPanel;
|
|
esBitBtn1: TRzBitBtn;
|
|
Timer_HandleExportedFile: TTimer;
|
|
procedure Timer1Timer(Sender: TObject);
|
|
procedure TimerCloseTimer(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure esBitBtn1Click(Sender: TObject);
|
|
procedure Timer_HandleExportedFileTimer(Sender: TObject);
|
|
private
|
|
GForm: TForm;
|
|
frOLEExcelExportMy: TMyfrOleExl;
|
|
FFileNameExported: String;
|
|
public
|
|
// Tolik 23/06/2020 --
|
|
//WasCancel: BOOL;
|
|
WasCancel: Boolean;
|
|
Set_Window: Boolean;
|
|
//
|
|
|
|
cbOpenCaption: String;
|
|
|
|
procedure frOLEExcelExportMyStartExportPageEvent(Sender: TObject; ACaption: string; AObjCount: Integer);
|
|
procedure frOLEExcelExportMyProgressExportPageEvent(Sender: TObject; var AWasCancel: Boolean; AObjIndex, AObjectCount: Integer);
|
|
procedure frOLEExcelExportMyEndExportPageEvent(Sender: TObject; AWasCancel: Boolean);
|
|
|
|
constructor Create(AOwner: TComponent; AForm: TForm);
|
|
destructor Destroy; override;
|
|
function CreateMyfrOleExl: TMyfrOleExl;
|
|
procedure HideGauges;
|
|
procedure SetControls;
|
|
// Tolik 23/06/2020 --
|
|
Procedure StartExport(aPageCount: Integer; aCapt: String);
|
|
Procedure EndExportPage;
|
|
Procedure EndExportReport;
|
|
//
|
|
end;
|
|
|
|
|
|
//var
|
|
// F_ProgressExp: TF_ProgressExp;
|
|
|
|
implementation
|
|
|
|
uses U_Main; //U_FR, U_Procs;
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
procedure TF_ProgressExp.Timer1Timer(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
ExportStream: TFileStream;
|
|
StroikaName, ExportDir: string;
|
|
b: boolean;
|
|
SavedTop: Integer;
|
|
begin
|
|
Timer1.Enabled := False;
|
|
|
|
TF_Main(GForm).CreateFResourceReport;
|
|
|
|
SetControls;
|
|
esBitBtn1.Caption := cProgressExp_Msg1; //GetLStr('Îòìåíà', '³äì³íèòè');
|
|
//cbOpen.Caption := cProgressExp_Msg2; //GetLStr('Çàïóñòèòü Excel ïîñëå ïåðåäà÷è äàííûõ','Çàïóñòèòè Excel ï³ñëÿ ïåðåäà÷³ äàíèõ');
|
|
cbOpenCaption := cProgressExp_Msg2;
|
|
|
|
// Message1.Visible := False;
|
|
esBitBtn1.Visible := False;
|
|
Gauge1.Progress := 0;
|
|
cbOpen.Visible := False;
|
|
Gauge1.Visible := False;
|
|
WasCancel := False;
|
|
|
|
//ExportDir := _F_Stroika.CreateSaveDir(DM.STROIKANameBrief.Value);
|
|
|
|
SavedTop := Top;
|
|
Top := 2000;
|
|
try
|
|
with TF_Main(GForm).F_Preview.SaveDialog do
|
|
begin
|
|
InitialDir := TF_Main(GForm).F_ResourceReport.ExtractDirToNewReport(0); //ExtractSaveDir; //ExtractFileDir(Application.ExeName); //ExportDir; //GetEXEDir + '\Save' + ...;
|
|
// Tolik 21/05/2020 --
|
|
if TF_Main(GForm).F_ResourceReport.ExportToXLSX then
|
|
Filter := cProgressExp_Msg8+' (*.xlsx)|*.xlsx'
|
|
else
|
|
if TF_Main(GForm).F_ResourceReport.ExportToDocX then
|
|
Filter := cProgressExp_Msg8+' (*.docx)|*.docx'
|
|
else
|
|
//
|
|
Filter := cProgressExp_Msg8+' (*.xls)|*.xls';
|
|
FilterIndex := 1;
|
|
// FileName := Copy(F_FR.Reports.FileName, length(ExeDir) + 13, length(F_FR.Reports.FileName) - length(ExeDir) - 16);
|
|
// FileName := '' + FileName + '_' + StroikaName + '';
|
|
// FileName := '' + FileName + '';
|
|
|
|
FileName := FileNameCorrect(TF_Main(GForm).F_Preview.ReportCaption); //Copy(TF_Main(GForm).F_Preview.Caption, 0, pos(' - Äîêóìåíò ¹', TF_Main(GForm).F_Preview.Caption));
|
|
|
|
{
|
|
b := false;
|
|
case CurentReport of
|
|
rkLS, rkLS_NoRazdel, rkLS_RESN, rkLSDPrice, rkLS_Com, rkF5:
|
|
b := True;
|
|
end;
|
|
if b then
|
|
FileName := FileName + ' ¹' + dm.LSNoLS.Value;
|
|
|
|
FileName := FileNameCorrect(FileName); }
|
|
|
|
if Execute then
|
|
begin
|
|
|
|
if FileExists(TF_Main(GForm).F_Preview.SaveDialog.FileName) then
|
|
begin
|
|
//if CustMessageDlg(cProgressExp_Msg3,
|
|
// 'Ôàéë âæå ³ñíóº.'+ #13#10 +
|
|
// 'Çáåðåãòè ï³ä öèì æå ³ì''ÿì?'{, coShowCancel}) = mrOk then
|
|
if CustMessageDlg(cProgressExp_Msg3,
|
|
'Ôàéë óæå ñóùåñòâóåò.'+ #13#10 +
|
|
'Ñîõðàíèòü ïîä ýòèì èìåíåì?'{, coShowCancel}) = mrOk then
|
|
|
|
begin
|
|
try
|
|
ExportStream := TFileStream.Create(TF_Main(GForm).F_Preview.SaveDialog.FileName, fmCreate);
|
|
except
|
|
//CustMessageDlg(cProgressExp_Msg4,
|
|
// 'Íåìîæëèâî âèêîíàòè çàïèñ - '+ #13#10 +
|
|
// 'ôàéë âæå â³äêðèòèé ³ âèêîðèñòîâóºòüñÿ.'+ #13#10 +
|
|
// 'Çáåðåæ³òü ï³ä ³íøèì ³ì''ÿì.'{, coHideCancel});
|
|
CustMessageDlg(cProgressExp_Msg4,
|
|
'Íå óäàåòñÿ âûïîëíèòü ñîõðàíåíèå - '+ #13#10 +
|
|
'ôàéë óæå îòêðûò èëè èñïîëüçóåòñÿ.'+ #13#10 +
|
|
'Ñîõðàíèòå ïîä äðóãèì èìåíåì.'{, coHideCancel});
|
|
Timer1.Enabled := True;
|
|
Exit;
|
|
end;
|
|
ExportStream.Free;
|
|
end
|
|
else
|
|
begin
|
|
//Timer1.Enabled := True;
|
|
ModalResult := mrCancel;
|
|
TimerClose.Enabled := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Gauge1.Visible := False;
|
|
esBitBtn1.Visible := False;
|
|
Message1.Caption := cProgressExp_Msg5;
|
|
//Message1.Caption_r := 'Ïîäãîòîâêà ê ïåðåäà÷å äàííûõ...';
|
|
//Message1.Caption_u := 'ϳäãîòîâêà äî ïåðåäà÷³ äàíèõ...';
|
|
//Message1.Caption := GetLStr('Ïîäãîòîâêà ê ïåðåäà÷å äàííûõ...', 'ϳäãîòîâêà äî ïåðåäà÷³ äàíèõ...');
|
|
Message1.Visible := True;
|
|
cbOpen.Visible := true;
|
|
Self.Caption := cProgressExp_Msg6; //GetLStr('Çàãðóçêà îáúåêòîâ...', 'Çàâàíòàæåííÿ îá''ºêò³â...');
|
|
|
|
Self.Repaint; //F_ProgressExp.Repaint;
|
|
|
|
//Self.Position := poScreenCenter; //F_ProgressExp.Position := poScreenCenter;
|
|
|
|
// F_Preview.frPreview1.Repaint;
|
|
|
|
if NOT Assigned(frOLEExcelExportMy) then
|
|
begin
|
|
//frOLEExcelExportMy := TMyfrOleExl.Create(Self);
|
|
frOLEExcelExportMy := CreateMyfrOleExl;
|
|
frOLEExcelExportMy.FileCaption := cProgressExp_Msg6;
|
|
frOLEExcelExportMy.Title := FileNameCorrect(TF_Main(GForm).F_Preview.ReportCaption);
|
|
frOLEExcelExportMy.FileName := TF_Main(GForm).F_Preview.SaveDialog.FileName;
|
|
frOLEExcelExportMy.OnStartExportPageEvent := frOLEExcelExportMyStartExportPageEvent;
|
|
frOLEExcelExportMy.OnProgressExportPageEvent := frOLEExcelExportMyProgressExportPageEvent;
|
|
frOLEExcelExportMy.OnEndExportPageEvent := frOLEExcelExportMyEndExportPageEvent;
|
|
end;
|
|
|
|
{
|
|
frOLEExcelExportMy.ShowDialog := False;
|
|
frOLEExcelExportMy.CellsAlign := True;
|
|
frOLEExcelExportMy.CellsBorders := True;
|
|
frOLEExcelExportMy.CellsFillColor := False;
|
|
frOLEExcelExportMy.CellsFontColor := False;
|
|
frOLEExcelExportMy.CellsFontName := True;
|
|
frOLEExcelExportMy.CellsFontSize := True;
|
|
frOLEExcelExportMy.CellsFontStyle := True;
|
|
frOLEExcelExportMy.CellsMerged := True;
|
|
frOLEExcelExportMy.CellsWrapWords := True;
|
|
frOLEExcelExportMy.Default := True;
|
|
frOLEExcelExportMy.ExportPictures := False;
|
|
frOLEExcelExportMy.LeftMargin := 2;
|
|
frOLEExcelExportMy.TopMargin := 2;
|
|
frOLEExcelExportMy.OpenExcelAfterExport := False;
|
|
frOLEExcelExportMy.PageBreaks := True;
|
|
|
|
frOLEExcelExportMy.LeaveCellsWithTag := true; //#From Oleg#
|
|
frOLEExcelExportMy.TagForLeaveCell := tgUnXls; //#From Oleg# }
|
|
|
|
{
|
|
frOLEExcelExportMy.ShowDialog := False;
|
|
frOLEExcelExportMy.CellsAlign := True;
|
|
frOLEExcelExportMy.CellsBorders := True;
|
|
frOLEExcelExportMy.CellsFillColor := False;
|
|
frOLEExcelExportMy.CellsFontColor := False;
|
|
frOLEExcelExportMy.CellsFontName := True;
|
|
frOLEExcelExportMy.CellsFontSize := True;
|
|
frOLEExcelExportMy.CellsFontStyle := True;
|
|
frOLEExcelExportMy.CellsMerged := True;
|
|
frOLEExcelExportMy.CellsWrapWords := True;
|
|
frOLEExcelExportMy.Default := True;
|
|
frOLEExcelExportMy.ExportPictures := False;
|
|
frOLEExcelExportMy.LeftMargin := 2;
|
|
frOLEExcelExportMy.TopMargin := 2;
|
|
frOLEExcelExportMy.OpenExcelAfterExport := False;
|
|
frOLEExcelExportMy.PageBreaks := True;
|
|
|
|
//frOLEExcelExportMy.LeaveCellsWithTag := true; //#From Oleg#
|
|
frOLEExcelExportMy.TagForLeaveCell := tgUnXls; //#From Oleg# }
|
|
|
|
try
|
|
Screen.Cursor := crHourGlass;
|
|
try
|
|
// ExtractFileDir(F_Preview.SaveDialog.FileName) + ExtractFileName(F_Preview.SaveDialog.FileName)
|
|
// Tolik 21/05/2020 --
|
|
if TF_Main(GForm).F_ResourceReport.ExportToXLSX then
|
|
TF_Main(GForm).F_ResourceReport.ShowXLSXReport(TF_Main(GForm).F_ResourceReport.Report, frOLEExcelExportMy.FileName)
|
|
else
|
|
if TF_Main(GForm).F_ResourceReport.ExportToDocX then
|
|
TF_Main(GForm).F_ResourceReport.ShowXLSXReport(TF_Main(GForm).F_ResourceReport.Report, frOLEExcelExportMy.FileName)
|
|
else
|
|
//
|
|
TF_Main(GForm).F_ResourceReport.Report.ExportTo(frOLEExcelExportMy, frOLEExcelExportMy.FileName);
|
|
|
|
finally
|
|
FreeAndNil(frOLEExcelExportMy);
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
|
|
|
|
{if NOT WasCancel then
|
|
begin
|
|
Sleep(500);
|
|
if FileExists(frOLEExcelExportMy.FileName) then
|
|
begin
|
|
if cbOpen.Checked then
|
|
begin
|
|
ShellExecute(0, nil, PChar(frOLEExcelExportMy.FileName), nil, nil, SW_MAXIMIZE);
|
|
Sleep(200);
|
|
TF_Main(GForm).F_Preview.Focus := GetForegroundWindow;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FileExists(frOLEExcelExportMy.FileName) then
|
|
try
|
|
DeleteFile(frOLEExcelExportMy.FileName);
|
|
except
|
|
end;
|
|
end; }
|
|
|
|
except
|
|
TF_Main(GForm).F_Preview.frPreview1.Connect(CurReport);
|
|
//CustMessageDlg(cProgressExp_Msg7,
|
|
// 'Íåìîæëèâî âèêîíàòè çàïèñ'+ #13#10 +
|
|
// 'ôàéë âèêîðèñòîâóºòüñÿ'+ #13#10 +
|
|
// 'Çâåðí³òüñÿ äî ðîçðîáíèêà:'+ #13#10 +
|
|
// ExpertSoft_u + ' ' + ExpertSoftTel{, coHideCancel});
|
|
CustMessageDlg(cProgressExp_Msg7,
|
|
'Íå óäàåòñÿ âûïîëíèòü ñîõðàíåíèå - '+ #13#10 +
|
|
'ôàéë èñïîëüçóåòñÿ.'+ #13#10 +
|
|
'Îáðàòèòåñü ê ðàçðàáîò÷èêó:'+ #13#10 +
|
|
ExpertSoft_u + ' ' + ExpertSoftTel{, coHideCancel});
|
|
end;
|
|
end;
|
|
end; // end of SaveDialog
|
|
finally
|
|
//Top := SavedTop;
|
|
end;
|
|
|
|
TimerClose.Enabled := true;
|
|
end;
|
|
|
|
procedure TF_ProgressExp.TimerCloseTimer(Sender: TObject);
|
|
begin
|
|
TimerClose.Enabled := false;
|
|
//Self.Position := poDesigned;
|
|
//Self.Top := 2000;
|
|
Close;
|
|
end;
|
|
|
|
(*
|
|
procedure TMyfrOleExl.AfterExport(const FileName: string);
|
|
begin
|
|
RX.Sort(@ComparePoints);
|
|
RY.Sort(@ComparePoints);
|
|
DeleteMultiplePoint(RX);
|
|
DeleteMultiplePoint(RY);
|
|
PageObj.Sort(@CompareObjects);
|
|
OrderObjectByCells;
|
|
|
|
//frProgressForm.Show;
|
|
{ F_Progress.Show;
|
|
F_Progress.LabelExcel.Caption_r := 'Ïîäãîòîâêà ê ïåðåäà÷å äàííûõ...';
|
|
F_Progress.LabelExcel.Caption_u := 'ϳäãîòîâêà äî ïåðåäà÷³ äàíèõ...';
|
|
F_Progress.LabelExcel.Visible := True;
|
|
F_Progress.ProgressBar1.Visible := False;
|
|
F_Progress.esLabel1.Visible := False;
|
|
F_Progress.Refresh;
|
|
}
|
|
// frProgressForm.Label1.Caption := frLoadStr(frRes + 1843);
|
|
// frProgressForm.Refresh;
|
|
|
|
// F_Progress1.Show;
|
|
|
|
// F_Preview.frPreview1.PopupMenu := nil;
|
|
|
|
F_ProgressExp.Gauge1.Visible := False;
|
|
F_ProgressExp.esBitBtn1.Visible := False;
|
|
F_ProgressExp.Message1.Caption_r := 'Ïîäãîòîâêà ê ïåðåäà÷å äàííûõ...';
|
|
F_ProgressExp.Message1.Caption_u := 'ϳäãîòîâêà äî ïåðåäà÷³ äàíèõ...';
|
|
F_ProgressExp.Message1.Visible := True;
|
|
F_ProgressExp.Refresh;
|
|
|
|
ExportPage;
|
|
|
|
|
|
if F_ProgressExp.WasCancel then
|
|
begin
|
|
// F_Progress1.esBitBtn1.ModalResult := 0;
|
|
// F_Progress1.Close;
|
|
// F_Preview.frPreview1.PopupMenu := F_Preview.PopupMenu1;
|
|
|
|
// Excel.Destroy;
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
// F_Progress1.Close;
|
|
F_Preview.frPreview1.PopupMenu := F_Preview.PopupMenu1;
|
|
end;
|
|
|
|
Excel.SetRange(1, 1, 1, 1);
|
|
Excel.Range.Select;
|
|
|
|
if expOpenAfter then
|
|
Excel.Visible := true;
|
|
try
|
|
DeleteFile(FileName);
|
|
{$IFDEF Delphi3}
|
|
Excel.WorkBook.SaveAs(FileName,xlNormal);
|
|
{$ELSE}
|
|
Excel.WorkBook.SaveAs(FileName,xlNormal, EmptyParam,
|
|
EmptyParam, EmptyParam, EmptyParam, xlNoChange, EmptyParam, EmptyParam, EmptyParam);
|
|
{$ENDIF}
|
|
except
|
|
end;
|
|
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;
|
|
|
|
function frLoadStr(ID: Integer): String;
|
|
begin
|
|
Result := frLocale.LoadStr(ID);
|
|
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 := 1.0;
|
|
expScaleY := 1.0;
|
|
|
|
// Excel.Free;
|
|
Excel := TMyfrExcel.Create(nil);
|
|
|
|
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.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;
|
|
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);
|
|
|
|
// 4 : Excel.SetCellHAlign(param);
|
|
//////////////////////////
|
|
5 : Excel.SetCellVAlign(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;
|
|
|
|
if CurReport.EMFPages[CurrentPage - 1].pgor = poLandscape then Orient := 2
|
|
else Orient := 1;
|
|
m := CurReport.EMFPages[CurrentPage - 1].pgMargins;
|
|
Left := m.Left / 4;
|
|
Right := m.Right / 4;
|
|
Top := m.Top / 4;
|
|
Bottom := m.Bottom / 4;
|
|
Excel.SetPageMargin(Left, Right, Top, Bottom, Orient);
|
|
|
|
i := 0;
|
|
CurReport.Terminated := false;
|
|
for y := 1 to RY.Count - 1 do
|
|
begin
|
|
// frProgressForm.Label1.Caption := frLoadStr(frRes + 1865) + IntToStr(y);
|
|
// frProgressForm.Label1.Refresh;
|
|
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]).Value)) and expPageBreaks then
|
|
begin
|
|
Excel.WorkSheet.Rows[y + 2].PageBreak := xlPageBreakManual;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
for x := 1 to RX.Count - 1 do
|
|
begin
|
|
// frProgressForm.Label1.Caption := frLoadStr(frRes + 1866) + IntToStr(x);
|
|
// frProgressForm.Label1.Refresh;
|
|
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;
|
|
|
|
////////////////////
|
|
if UkrVer then F_ProgressExp.Caption := 'Çàâàíòàæåííÿ îá''ºêò³â...'
|
|
else F_ProgressExp.Caption := 'Çàãðóçêà îáúåêòîâ...';
|
|
|
|
F_ProgressExp.Message1.Visible := False;
|
|
F_ProgressExp.esBitBtn1.Visible := True;
|
|
F_ProgressExp.Gauge1.Visible := True;
|
|
F_ProgressExp.Gauge1.MinValue := 0;
|
|
F_ProgressExp.Gauge1.MaxValue := ObjectPos.Count - 1;
|
|
F_ProgressExp.Repaint;
|
|
///////////////////
|
|
|
|
for i := 0 to ObjectPos.Count - 1 do
|
|
begin
|
|
if F_ProgressExp.WasCancel then
|
|
begin
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
Application.ProcessMessages;
|
|
F_ProgressExp.Gauge1.Progress := i;
|
|
F_ProgressExp.Gauge1.Refresh;
|
|
end;
|
|
|
|
// frProgressForm.Label1.Caption := frLoadStr(frRes + 1841) + IntToStr(Step) + frLoadStr(frRes + 1842) + TimeToStr(TimeRemain);
|
|
// frProgressForm.Label1.Refresh;
|
|
|
|
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]);
|
|
s:=CleanReturns(Obj.Memo.Text);
|
|
l:=pos('.', s);
|
|
if l>0 then
|
|
begin
|
|
s[l]:=',';
|
|
{$IFDEF Delphi6}
|
|
if TryStrToFloat(s, conv) then
|
|
Excel.Range.Cells.NumberFormat := '@';
|
|
{$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);
|
|
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;
|
|
end;
|
|
Merged := False;
|
|
MyAH := OLDAH;
|
|
if (dx > 1) or (dy > 1) then
|
|
begin
|
|
if (dx <> olddx) or (dy <> olddy) then
|
|
Excel.SetRange(x, y, dx, dy);
|
|
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
|
|
delete(s, pos(#13, s), 1)
|
|
end;
|
|
s := CleanReturns(s);
|
|
ExlArray[y-1-CurY, x-1] := s;
|
|
|
|
///////
|
|
// Excel.SetRange(x, y-CurY, dx, dy);
|
|
Excel.SetRange(x, y, dx, dy);
|
|
Excel.SetCellHAlignM(Horiz);
|
|
////////
|
|
|
|
end
|
|
else
|
|
if TfrView(PageObj[TObjPos(ObjectPos[i]).obj]) is TfrPictureView then
|
|
begin
|
|
Inc(CntPics);
|
|
PicObj := TfrPictureView(PageObj[TObjPos(ObjectPos[i]).obj]);
|
|
{$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;
|
|
end;
|
|
|
|
inc(Step);
|
|
TimeEstimate := TimeBegin + (ObjectPos.Count - 1) * (Time - TimeBegin) / Step;
|
|
TimeRemain := TimeEstimate - Time;
|
|
|
|
Application.ProcessMessages;
|
|
|
|
if CurReport.Terminated then break;
|
|
|
|
end;
|
|
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);
|
|
|
|
Excel.SetRange(1, CurY + 1, RX.Count - 1, RY.Count - 1);
|
|
Excel.Range.Value := ExlArray;
|
|
CurY := Y - 1;
|
|
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.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 - 10); //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 - 10); //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;
|
|
|
|
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;
|
|
|
|
{ TMyFrExcel }
|
|
|
|
procedure TMyFrExcel.SetCellHAlignM(Horiz: Integer);
|
|
begin
|
|
Range.Select;
|
|
Excel.ActiveCell.HorizontalAlignment := Horiz;
|
|
end;
|
|
|
|
procedure TMyFrExcel.SetCellNumFormat(Format: char);
|
|
begin
|
|
Range.Select;
|
|
Excel.ActiveCell.NumberFormat := Format;
|
|
end;
|
|
|
|
procedure TMyFrExcel.SetColSize(x: integer; Size: Extended);
|
|
var
|
|
r: variant;
|
|
begin
|
|
r := WorkSheet.Columns;
|
|
Size := Size*1.12;
|
|
r.Columns[x].ColumnWidth := Size;
|
|
end;
|
|
|
|
procedure TMyFrExcel.SetRowSize(y: integer; Size: Extended);
|
|
var
|
|
r: variant;
|
|
begin
|
|
r := WorkSheet.Rows;
|
|
Size := Size*1.07;
|
|
if size > 409 then size := 409;
|
|
r.Rows[y].RowHeight := Size;
|
|
end;
|
|
*)
|
|
|
|
procedure TF_ProgressExp.FormCreate(Sender: TObject);
|
|
begin
|
|
//Timer1.Enabled := true;
|
|
lbProgress.Caption := '';
|
|
lbTotalProgress.Caption := '';
|
|
end;
|
|
|
|
|
|
procedure TF_ProgressExp.esBitBtn1Click(Sender: TObject);
|
|
begin
|
|
WasCancel := True;
|
|
end;
|
|
|
|
constructor TF_ProgressExp.Create(AOwner: TComponent; AForm: TForm);
|
|
begin
|
|
GForm := AForm;
|
|
inherited Create(AOwner);
|
|
Set_Window := True; // Tolik
|
|
WasCancel := False; // Tolik 02/10/2020 --
|
|
end;
|
|
|
|
function TF_ProgressExp.CreateMyfrOleExl: TMyfrOleExl;
|
|
begin
|
|
Result := TMyfrOleExl.Create(Self);
|
|
//Result.ShowDialog := True;
|
|
Result.ShowDialog := false;
|
|
Result.CellsAlign := True;
|
|
Result.CellsBorders := True;
|
|
Result.CellsFillColor := True; //False;
|
|
Result.CellsFontColor := True; //False;
|
|
Result.CellsFontName := True;
|
|
Result.CellsFontSize := True;
|
|
Result.CellsFontStyle := True;
|
|
Result.CellsMerged := true;
|
|
Result.CellsWrapWords := True;
|
|
Result.Default := True;
|
|
Result.ExportPictures := False;
|
|
Result.LeftMargin := 2;
|
|
Result.TopMargin := 2;
|
|
Result.OpenExcelAfterExport := False;
|
|
Result.PageBreaks := True;
|
|
|
|
//Result.LeaveCellsWithTag := true; //#From Oleg#
|
|
Result.TagForLeaveCell := tgUnXls; //#From Oleg#
|
|
end;
|
|
|
|
destructor TF_ProgressExp.Destroy;
|
|
begin
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TF_ProgressExp.HideGauges;
|
|
begin
|
|
lbProgress.Visible := false;
|
|
Gauge1.Visible := false;
|
|
lbTotalProgress.Visible := false;
|
|
gTotal.Visible := false;
|
|
end;
|
|
|
|
procedure TF_ProgressExp.SetControls;
|
|
begin
|
|
Message1.Visible := False;
|
|
esBitBtn1.Visible := True;
|
|
Gauge1.Visible := True;
|
|
|
|
pnTotalProgress.Visible := false;
|
|
lbProgress.Visible := false;
|
|
|
|
AutoSize := false;
|
|
AutoSize := true;
|
|
end;
|
|
|
|
Procedure TF_ProgressExp.StartExport(aPageCount: Integer; aCapt: String);
|
|
begin
|
|
//SetControls;
|
|
Caption := aCapt;
|
|
Gauge1.MinValue := 0;
|
|
Gauge1.MaxValue := aPageCount;
|
|
Gauge1.Progress := 0;
|
|
|
|
Self.gTotal.MinValue := 0;
|
|
Self.gTotal.MaxValue := TF_Main(F_ProjMan).F_ResourceReport.ReportCountToPrint;
|
|
|
|
|
|
pnTotalProgress.Visible := True;
|
|
pnProgress.Visible := True;
|
|
|
|
Application.ProcessMessages;
|
|
|
|
Repaint;
|
|
|
|
//if Set_Window then
|
|
begin
|
|
Self.Position := poScreenCenter;
|
|
FormStyle := fsStayOnTop;
|
|
if Not Visible then
|
|
begin
|
|
Show;
|
|
end;
|
|
if Set_Window then
|
|
begin
|
|
SetForegroundWindow(Handle);
|
|
Set_Window := False;
|
|
end;
|
|
|
|
|
|
//Gauge1.Visible := false;
|
|
//Message1.Visible := true;
|
|
Application.ProcessMessages;
|
|
Sleep(500);
|
|
|
|
Gauge1.Visible := true;
|
|
GTotal.Visible := True;
|
|
Message1.Visible := false;
|
|
Application.ProcessMessages;
|
|
Sleep(500);
|
|
|
|
Repaint;
|
|
//Set_Window := False;
|
|
end;
|
|
end;
|
|
|
|
Procedure TF_ProgressExp.EndExportPage;
|
|
begin
|
|
//Gauge1.AddProgress(1);
|
|
Gauge1.Progress := Gauge1.Progress + 1;
|
|
Gauge1.refresh;
|
|
end;
|
|
|
|
Procedure TF_ProgressExp.EndExportReport;
|
|
var i: integer;
|
|
begin
|
|
if WasCancel then
|
|
begin
|
|
TF_Main(F_ProjMan).F_ResourceReport.ReportCountPrinted := TF_Main(F_ProjMan).F_ResourceReport.ReportCountToPrint;
|
|
close;
|
|
end;
|
|
|
|
|
|
|
|
if GTotal.Progress = TF_Main(F_ProjMan).F_ResourceReport.ReportCountToPrint then
|
|
begin
|
|
//*** Äîãíàòü äî 100
|
|
for i := TF_Main(GForm).F_ProgressExp.gTotal.Progress + 1 to TF_Main(GForm).F_ProgressExp.gTotal.MaxValue do
|
|
begin
|
|
TF_Main(GForm).F_ProgressExp.gTotal.Progress := i;
|
|
TF_Main(GForm).F_ProgressExp.gTotal.Refresh;
|
|
// Tolik 29/07/2019 --
|
|
//Sleep(500);
|
|
Sleep(5);
|
|
//
|
|
end;
|
|
|
|
if TF_Main(GForm).F_ProgressExp.cbOpen.Checked then
|
|
//ShellExecute(Handle, nil, PChar(FPackgeDir), nil, nil, SW_SHOW);
|
|
ShellExecute(Handle, nil, PChar(TF_Main(F_ProjMan).F_ResourceReport.FPackgeDir), nil, nil, SW_SHOW);
|
|
close;
|
|
end;
|
|
|
|
//TF_Main(F_ProjMan).F_ResourceReport.FReportCountPrinted := TF_Main(F_ProjMan).F_ResourceReport.FReportCountToPrint;
|
|
|
|
GTotal.Progress := GTotal.Progress + 1;
|
|
GTotal.refresh;
|
|
|
|
Application.ProcessMessages;
|
|
|
|
//if GTotal.Progress = TF_Main(F_ProjMan).F_ResourceReport.ReportCountToPrint then
|
|
// Close;
|
|
|
|
end;
|
|
|
|
|
|
procedure TF_ProgressExp.frOLEExcelExportMyStartExportPageEvent(
|
|
Sender: TObject; ACaption: string; AObjCount: Integer);
|
|
begin
|
|
SetControls;
|
|
|
|
Gauge1.MinValue := 0;
|
|
Gauge1.MaxValue := AObjCount - 1;
|
|
|
|
Caption := ACaption;
|
|
cbOpen.Caption := cbOpenCaption;
|
|
cbOpen.Visible := true;
|
|
|
|
WasCancel := false;
|
|
|
|
Self.Position := poScreenCenter;
|
|
FormStyle := fsStayOnTop;
|
|
if Not Visible then
|
|
begin
|
|
Show;
|
|
end;
|
|
SetForegroundWindow(Handle);
|
|
|
|
Gauge1.Visible := false;
|
|
Message1.Visible := true;
|
|
Application.ProcessMessages;
|
|
Sleep(500);
|
|
|
|
Gauge1.Visible := true;
|
|
Message1.Visible := false;
|
|
Application.ProcessMessages;
|
|
Sleep(500);
|
|
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TF_ProgressExp.frOLEExcelExportMyProgressExportPageEvent(
|
|
Sender: TObject; var AWasCancel: Boolean; AObjIndex, AObjectCount: Integer);
|
|
begin
|
|
if Not WasCancel then
|
|
begin
|
|
Application.ProcessMessages;
|
|
Gauge1.Progress := AObjIndex;
|
|
Gauge1.Refresh;
|
|
end;
|
|
AWasCancel := WasCancel;
|
|
end;
|
|
|
|
procedure TF_ProgressExp.frOLEExcelExportMyEndExportPageEvent(
|
|
Sender: TObject; AWasCancel: Boolean);
|
|
var
|
|
frBasicExpFilter: TfrBasicExpFilter;
|
|
begin
|
|
//F_ProjMan.F_Preview.frPreview1.PopupMenu := F_ProjMan.F_Preview.PopupMenu1;
|
|
|
|
frBasicExpFilter := nil;
|
|
if Sender is TfrBasicExpFilter then
|
|
frBasicExpFilter := TfrBasicExpFilter(Sender);
|
|
|
|
FFileNameExported := '';
|
|
if frBasicExpFilter <> nil then
|
|
begin
|
|
FFileNameExported := frBasicExpFilter.FileName;
|
|
end;
|
|
Timer_HandleExportedFile.Enabled := True;
|
|
end;
|
|
|
|
procedure TF_ProgressExp.Timer_HandleExportedFileTimer(Sender: TObject);
|
|
var
|
|
FocusDescr: Cardinal;
|
|
begin
|
|
Timer_HandleExportedFile.Enabled := false;
|
|
|
|
if NOT WasCancel then
|
|
begin
|
|
//Sleep(500);
|
|
if FileExists(FFileNameExported) then
|
|
begin
|
|
if cbOpen.Checked then
|
|
begin
|
|
FocusDescr := GetForegroundWindow;
|
|
|
|
//ShellExecute(0, nil, PChar(FFileNameExported), nil, nil, SW_MAXIMIZE);
|
|
ShellExecute(0, PChar('open'), PChar(FFileNameExported), nil, nil, SW_MAXIMIZE);
|
|
Sleep(500);
|
|
TF_Main(GForm).F_Preview.Focus := FocusDescr;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FileExists(FFileNameExported) then
|
|
try
|
|
DeleteFile(FFileNameExported);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
TimerClose.Enabled := true;
|
|
end;
|
|
|
|
end.
|