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.