unit U_Preview; interface uses Windows, U_LNG, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry, Menus, Buttons, FR_Ctrls, ExtCtrls, FR_View, FR_Class, U_BaseCommon, U_BaseConstants, siComp, siLngLnk{, U_MsgDlg, U_Types, U_DM, U_Protect}, Printers, FR_PrDlg, ShellApi {, FR_E_TNPDF}{, FR_E_PDF}, U_frOLEExl, StdCtrls, RzTrkBar; type TF_Preview = class(TForm) frPreview1: TfrPreview; Panel4: TPanel; FullPage: TfrSpeedButton; Scale100: TfrSpeedButton; byWidth: TfrSpeedButton; First: TfrSpeedButton; Prior: TfrSpeedButton; Next: TfrSpeedButton; Last: TfrSpeedButton; Open: TfrSpeedButton; Save: TfrSpeedButton; Print: TfrSpeedButton; btnExit: TfrSpeedButton; PopupMenu1: TPopupMenu; Edit: TfrSpeedButton; SaveToExcel: TSpeedButton; N2001: TMenuItem; N1501: TMenuItem; N1001: TMenuItem; N751: TMenuItem; N501: TMenuItem; N251: TMenuItem; N101: TMenuItem; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; SaveDialog: TSaveDialog; lng_Forms: TsiLangLinked; spExportToPdf: TSpeedButton; pnZoom: TPanel; tbZoom: TRzTrackBar; lbZoom: TLabel; pnBPanel: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; procedure SaveClick(Sender: TObject); procedure PrintClick(Sender: TObject); procedure FullPageClick(Sender: TObject); procedure Scale100Click(Sender: TObject); procedure OpenClick(Sender: TObject); procedure FirstClick(Sender: TObject); procedure PriorClick(Sender: TObject); procedure NextClick(Sender: TObject); procedure LastClick(Sender: TObject); procedure btnExitClick(Sender: TObject); procedure byWidthClick(Sender: TObject); procedure EditClick(Sender: TObject); procedure frPreview1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure frPreview1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormShow(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SaveToExcelClick(Sender: TObject); procedure N2001Click(Sender: TObject); procedure CreateParams(VAR Params: TCreateParams); override; procedure PopupMenu1Popup(Sender: TObject); procedure frPreview1DblClick(Sender: TObject); procedure spExportToPdfClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDeactivate(Sender: TObject); procedure tbZoomChange(Sender: TObject); procedure tbZoomDrawTick(TrackBar: TRzTrackBar; Canvas: TCanvas; Location: TPoint; Index: Integer); procedure tbZoomKeyPress(Sender: TObject; var Key: Char); procedure tbZoomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); private GForm: TForm; FPBox: TfrPBox; FPreviewWndProcOriginal: TWndMethod; procedure FPreviewWndProc(var Message: TMessage); protected FPreviewMouseWheelUp: TMouseWheelUpDownEvent; FPreviewMouseWheelDown: TMouseWheelUpDownEvent; //FPreviewFormResize: TNotifyEvent; procedure PreviewMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure PreviewMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure PreviewFormResize(Sender: TObject); procedure ZoomChange; public ReportFileName: string; ReportCaption: String; Focus: THandle; // нужен, чтобы отловить Excell и сделать его активным { Public declarations } constructor Create(AOwner: TComponent; AForm: TForm); destructor Destroy; override; end; var // F_Preview: TF_Preview; F_PreviewForm: TfrPreviewForm; implementation uses U_ProgressExp, U_Main {U_FR, U_Stroika, U_Params, U_Procs, U_ReportConfig}; {$R *.DFM} procedure TF_Preview.CreateParams(VAR Params: TCreateParams); begin Inherited CreateParams(Params); //этот код позволяет открывать дочернюю форму как отдельное приложение и //сворачивать все открытые дочерние окна вместе с родительским в один значок // Params.ExStyle:=Params.ExStyle or WS_EX_APPWINDOW; //этот код позволяет открывать дочернюю форму как отдельное приложение Params.WndParent := GetDesktopWindow; end; procedure TF_Preview.SaveClick(Sender: TObject); //var // StroikaName, ExportDir: string; // b: boolean; begin //ExportDir := ExtractFileDir(Application.ExeName); //_F_Stroika.CreateSaveDir(DM.STROIKANameBrief.Value); with {F_Preview.}SaveDialog do begin TF_Main(GForm).CreateFResourceReport; InitialDir := TF_Main(GForm).F_ResourceReport.ExtractDirToNewReport(0); //ExtractSaveDir; //ExportDir; //GetEXEDir + '\Save' + ...; Filter := cPreview_Msg1+' (*.frp)|*.frp'; FilterIndex := 1; // FileName := Copy(F_FR.Reports.FileName, length(ExeDir) + 13, length(F_FR.Reports.FileName) - length(ExeDir) - 16); FileName := ReportCaption; //Copy({F_Preview.}Caption, 0, pos(' - Документ №', {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 := '' + FileName + '_' + StroikaName + ''; FileName := FileNameCorrect(FileName); } if Execute then begin F_PreviewForm := frPreview1.Window; F_PreviewForm.ConnectBack; TfrReport(F_PreviewForm.Doc).SavePreparedReport({F_Preview.}SaveDialog.FileName); F_PreviewForm.Connect(F_PreviewForm.Doc); end; end; end; procedure TF_Preview.PrintClick(Sender: TObject); begin frPreview1.Print; {var Pages: String; ind : integer; begin if (frPreview1.Window.EMFPages = nil) or (Printer.Printers.Count = 0) then Exit; with TfrPrintForm.Create(nil) do begin E1.Text := IntToStr(TfrReport(frPreview1.Window.Doc).DefaultCopies); CollateCB.Checked := TfrReport(frPreview1.Window.Doc).DefaultCollate; ind := Printer.PrinterIndex; if not TfrReport(frPreview1.Window.Doc).ShowPrintDialog or (ShowModal = mrOk) then begin if CurReport.RebuildPrinter then if Printer.PrinterIndex <> ind then if TfrReport(frPreview1.Window.Doc).CanRebuild then if TfrReport(frPreview1.Window.Doc).ChangePrinter(ind, Printer.PrinterIndex) then begin TfrEMFPages(frPreview1.Window.EMFPages).Free; frPreview1.Window.EMFPages := nil; TfrReport(frPreview1.Window.Doc).PrepareReport; frPreview1.Window.Connect(frPreview1.Window.Doc); end else begin Free; Exit; end; if RB1.Checked then Pages := '' else if RB2.Checked then Pages := IntToStr(frPreview1.Page) else Pages := E2.Text; frPreview1.Window.ConnectBack; TfrReport(frPreview1.Window.Doc).PrintPreparedReport(Pages, StrToInt(E1.Text), CollateCB.Checked, TfrPrintPages(CB2.ItemIndex)); frPreview1.Window.Connect(frPreview1.Window.Doc); frPreview1.Window. RedrawAll(False); end; Free; end;} end; procedure TF_Preview.FullPageClick(Sender: TObject); begin frPreview1.OnePage; ZoomChange; end; procedure TF_Preview.Scale100Click(Sender: TObject); begin frPreview1.Zoom := 100; ZoomChange; end; // Tolik 21/05/2020 -- procedure TF_Preview.SpeedButton1Click(Sender: TObject); var i: integer; temp: string; begin TF_Main(GForm).F_ResourceReport.ExportToXLSX := True; try //Focus := GetForegroundWindow; if Not Assigned(TF_Main(GForm).F_ProgressExp) then TF_Main(GForm).F_ProgressExp := TF_ProgressExp.Create(Application, GForm); TF_Main(GForm).CreateFResourceReport; TF_Main(GForm).F_ResourceReport.ApplMinimize(nil); TF_Main(GForm).F_Preview := self; TF_Main(GForm).F_ResourceReport.Report.Preview := {F_Preview.}frPreview1; TF_Main(GForm).F_ResourceReport.Report.FileName := {F_Preview.}ReportFileName; TF_Main(GForm).F_ProgressExp.SetControls; TF_Main(GForm).F_ProgressExp.Timer1.Enabled := True; TF_Main(GForm).F_ProgressExp.pnTotalProgress.Visible := false; TF_Main(GForm).F_ProgressExp.Message1.Caption := cProgressExp_Msg5; TF_Main(GForm).F_ProgressExp.Message1.Visible := True; TF_Main(GForm).F_ProgressExp.HideGauges; TF_Main(GForm).F_ProgressExp.ShowModal; TF_Main(GForm).F_ResourceReport.ApplRestore(nil); //SetForegroundWindow(self.Handle); except end; TF_Main(GForm).F_ResourceReport.ExportToXLSX := False; end; procedure TF_Preview.SpeedButton2Click(Sender: TObject); begin TF_Main(GForm).F_ResourceReport.ExportToDocX := True; try Focus := GetForegroundWindow; if Not Assigned(TF_Main(GForm).F_ProgressExp) then TF_Main(GForm).F_ProgressExp := TF_ProgressExp.Create(Application, GForm); TF_Main(GForm).CreateFResourceReport; TF_Main(GForm).F_ResourceReport.ApplMinimize(nil); TF_Main(GForm).F_Preview := self; TF_Main(GForm).F_ResourceReport.Report.Preview := {F_Preview.}frPreview1; TF_Main(GForm).F_ResourceReport.Report.FileName := {F_Preview.}ReportFileName; TF_Main(GForm).F_ProgressExp.SetControls; TF_Main(GForm).F_ProgressExp.Timer1.Enabled := True; TF_Main(GForm).F_ProgressExp.pnTotalProgress.Visible := false; TF_Main(GForm).F_ProgressExp.Message1.Caption := cProgressExp_Msg5; TF_Main(GForm).F_ProgressExp.Message1.Visible := True; TF_Main(GForm).F_ProgressExp.HideGauges; TF_Main(GForm).F_ProgressExp.ShowModal; TF_Main(GForm).F_ResourceReport.ApplRestore(nil); SetForegroundWindow(self.Handle); except end; TF_Main(GForm).F_ResourceReport.ExportToDocX := False; end; // procedure TF_Preview.OpenClick(Sender: TObject); begin frPreview1.LoadFromFile; end; procedure TF_Preview.FirstClick(Sender: TObject); begin frPreview1.First; end; procedure TF_Preview.PriorClick(Sender: TObject); begin frPreview1.Prev; end; procedure TF_Preview.NextClick(Sender: TObject); begin frPreview1.Next; end; procedure TF_Preview.LastClick(Sender: TObject); begin frPreview1.Last; end; procedure TF_Preview.btnExitClick(Sender: TObject); begin Close; end; procedure TF_Preview.byWidthClick(Sender: TObject); begin frPreview1.PageWidth; ZoomChange; end; procedure TF_Preview.EditClick(Sender: TObject); begin frPreview1.Edit; end; procedure TF_Preview.frPreview1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Screen.Cursor := crHandPoint; end; procedure TF_Preview.frPreview1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Screen.Cursor := crDefault; end; procedure TF_Preview.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Screen.Cursor := crHandPoint; end; procedure TF_Preview.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin end; //функция возвращает истину если отчет можно импортировать в excel function XLok: Boolean; begin Result := true; { case CurentReport of rkLS, rkLS_NoRazdel: result := True; rkLS_RESN: Result := False; rkOS: Result := False; rkNakl: Result := True; rkNaklAkt: Result := True; rkM29: Result := True; rkM29_2: Result := False; rkAKT: Result := True; rkD_Price: Result := True; rkF3: Result := True; rkRESN: Result := False; rkSSR: Result := True; rkVed: Result := True; rkVed_Pot: Result := True; rkVed_Rash: Result := True; rkInflation: Result := True; rkKomandir: Result := True; rkPerevozka: Result := True; rkZemlya: Result := True; rkAKT_RESN: Result := False; rkAKT12: Result := True; rkKB6: Result := True; rkTzVed: Result := False; rkLSDPrice: Result := True; rkProfit: Result := False; rkAdmin: Result := False; rkRisk: Result := False; rkLeto: Result := False; rkZima: Result := False; rkVrem: Result := False; rkKomun: Result := False; else Result := False; end; } end; procedure TF_Preview.FormShow(Sender: TObject); begin {if UkrVer then begin Scale100.Hint := 'Збільшення 100%'; FullPage.Hint := 'Сторінка цілковито'; byWidth.Hint := 'По ширині сторінки'; First.Hint := 'Перша сторінка'; Prior.Hint := 'Попередня сторінка'; Next.Hint := 'Наступна сторінка'; Last.Hint := 'Остання сторінка'; Print.Hint := 'Друк'; Edit.Hint := 'Редагування'; Open.Hint := 'Завантажити документ'; Save.Hint := 'Зберегти документ'; SaveToExcel.Hint := 'Експортувати в Excel'; btnExit.Hint := 'Вихід'; btnExit.Caption := 'Вихід'; end else } self.BringToFront; begin Scale100.Hint := cPreview_Msg2_1; FullPage.Hint := cPreview_Msg2_2; byWidth.Hint := cPreview_Msg2_3; First.Hint := cPreview_Msg2_4; Prior.Hint := cPreview_Msg2_5; Next.Hint := cPreview_Msg2_6; Last.Hint := cPreview_Msg2_7; Print.Hint := cPreview_Msg2_8; Edit.Hint := cPreview_Msg2_9; Open.Hint := cPreview_Msg2_10; Save.Hint := cPreview_Msg2_11; SaveToExcel.Hint := cPreview_Msg2_12; btnExit.Hint := cPreview_Msg2_13; btnExit.Caption := cPreview_Msg2_14; end; //byWidthClick(Sender); byWidthClick(Self); byWidth.Down := True; //frPreview1.SetFocus; //19.12.2011 - Перехват MouseWheel // Tolik 15/01/2021 - это циклит процедуру прокрутки при повторном показе формы, тут низзя ставить, нужно сделать подмену только 1 РАЗ!!! // перенесено в конструктор { FPreviewMouseWheelDown := OnMouseWheelDown; //frPreview1.Window.ScrollBox1.OnMouseWheelDown; FPreviewMouseWheelUp := OnMouseWheelUp; //frPreview1.Window.ScrollBox1.OnMouseWheelUp; OnMouseWheelDown := PreviewMouseWheelDown; OnMouseWheelUp := PreviewMouseWheelUp; } //19.12.2011 - Перехват FormResize //FPreviewFormResize := frPreview1.Window.OnResize; //frPreview1.Window.OnResize := PreviewFormResize; //pnZoom.Parent := frPreview1.Window.BPanel; //pnZoom.Align := alRight; pnBPanel.BevelOuter := bvNone; pnBPanel.Height := 18; pnBPanel.Parent := frPreview1.Window.PreviewPanel; pnBPanel.Align := alBottom; if frPreview1.Window.RPanel.Visible then pnBPanel.Width := pnBPanel.Width - frPreview1.Window.VScrollBar.Width; pnZoom.Parent := pnBPanel; pnZoom.Align := alRight; pnZoom.BevelOuter := bvNone; frPreview1.Window.BPanel.Parent := pnBPanel; frPreview1.Window.BPanel.Align := alClient; frPreview1.Window.FormResize(frPreview1.Window); KeyPreview := true; ZoomChange; pnZoom.BringToFront; byWidth.Click; // Tolik 06/02/2020 end; procedure TF_Preview.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); const cnstScrollStep = 10; var ScrollStep: Integer; begin if (frDesigner = nil) or (Not frDesigner.Visible) then begin if Key = VK_ESCAPE then Close; if (ssCtrl in Shift) and (Char(Key) in ['P', 'p', 'З', 'з']) then PrintClick(nil); if (ssCtrl in Shift) then if (Key in [Ord('0'), VK_NUMPAD0]) then begin Scale100.Click; Scale100.Down := true; end; ScrollStep := 10; if (ssCtrl in Shift) then ScrollStep := ScrollStep * 4; if Key = VK_UP then frPreview1.Window.VScrollBar.Position := frPreview1.Window.VScrollBar.Position - ScrollStep else if Key = VK_DOWN then frPreview1.Window.VScrollBar.Position := frPreview1.Window.VScrollBar.Position + ScrollStep else if Key = VK_LEFT then frPreview1.Window.HScrollBar.Position := frPreview1.Window.HScrollBar.Position - ScrollStep else if Key = VK_RIGHT then frPreview1.Window.HScrollBar.Position := frPreview1.Window.HScrollBar.Position + ScrollStep else if Key = VK_PRIOR then frPreview1.Prev else if Key = VK_NEXT then frPreview1.Next else if Key = VK_HOME then frPreview1.First else if Key = VK_END then frPreview1.Last; end; end; procedure TF_Preview.SaveToExcelClick(Sender: TObject); var i: integer; temp: string; begin try //if (Length(temp) * StrToInt64(Copy(temp, 1, 1)) = StrToInt64(Copy(temp, 2, 1))/length(temp)) then //begin //F_Params.BackUpTimer.Enabled := false; Focus := GetForegroundWindow; if Not Assigned(TF_Main(GForm).F_ProgressExp) then TF_Main(GForm).F_ProgressExp := TF_ProgressExp.Create(Application, GForm); TF_Main(GForm).CreateFResourceReport; TF_Main(GForm).F_ResourceReport.ApplMinimize(nil); TF_Main(GForm).F_Preview := self; TF_Main(GForm).F_ResourceReport.Report.Preview := {F_Preview.}frPreview1; TF_Main(GForm).F_ResourceReport.Report.FileName := {F_Preview.}ReportFileName; TF_Main(GForm).F_ProgressExp.SetControls; TF_Main(GForm).F_ProgressExp.Timer1.Enabled := True; TF_Main(GForm).F_ProgressExp.pnTotalProgress.Visible := false; TF_Main(GForm).F_ProgressExp.Message1.Caption := cProgressExp_Msg5; TF_Main(GForm).F_ProgressExp.Message1.Visible := True; TF_Main(GForm).F_ProgressExp.HideGauges; TF_Main(GForm).F_ProgressExp.ShowModal; TF_Main(GForm).F_ResourceReport.ApplRestore(nil); //SetForegroundWindow(self.Focus); SetForegroundWindow(self.Handle); except //ShowMessageByType(smtDisplay, 'Сперва установите'); //F_Params.BackUpTimer.Enabled := RegParams.AutoBackup; end; end; {popup menu - 200%} procedure TF_Preview.N2001Click(Sender: TObject); begin case TMenuItem(Sender).Tag of 1: frPreview1.PageWidth; 2: frPreview1.OnePage; 3: frPreview1.TwoPages; else frPreview1.Zoom := TMenuItem(Sender).Tag; end; ZoomChange; end; procedure TF_Preview.PopupMenu1Popup(Sender: TObject); begin {if UkrVer then begin PopupMenu1.Items[7].Caption := 'По ширині сторінки'; PopupMenu1.Items[8].Caption := 'Сторінка цілковито'; PopupMenu1.Items[9].Caption := 'Дві сторінки'; end else} begin PopupMenu1.Items[7].Caption := cPreview_Msg3_1; PopupMenu1.Items[8].Caption := cPreview_Msg3_2; PopupMenu1.Items[9].Caption := cPreview_Msg3_3; end; end; procedure TF_Preview.frPreview1DblClick(Sender: TObject); begin exit; end; constructor TF_Preview.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); // Tolik 15/01/2021 -- перенесено из OnShow, НЕ ТРОГАТЬ!!! FPreviewMouseWheelDown := OnMouseWheelDown; //frPreview1.Window.ScrollBox1.OnMouseWheelDown; FPreviewMouseWheelUp := OnMouseWheelUp; //frPreview1.Window.ScrollBox1.OnMouseWheelUp; OnMouseWheelDown := PreviewMouseWheelDown; OnMouseWheelUp := PreviewMouseWheelUp; // end; destructor TF_Preview.Destroy; begin inherited; end; procedure TF_Preview.spExportToPdfClick(Sender: TObject); var //frTNPDFExportFilter: TfrTNPDFExportFilter; SavePDFDialog: TSaveDialog; frPDFExport: TfrPDFExport; FileName: String; begin {frTNPDFExportFilter := TfrTNPDFExportFilter.Create(Self); Screen.Cursor := crHourGlass; try TF_Main(GForm).F_ResourceReport.Report.ExportTo(frTNPDFExportFilter, 'C:\TestExportReport.pdf'); finally Screen.Cursor := crDefault; FreeAndNil(frTNPDFExportFilter); end;} TF_Main(GForm).CreateFResourceReport; TF_Main(GForm).F_ResourceReport.ApplMinimize(nil); SavePDFDialog := TSaveDialog.Create(Self); try SavePDFDialog.InitialDir := TF_Main(GForm).F_ResourceReport.ExtractDirToNewReport(0); //ExtractSaveDir; //ExtractFileDir(Application.ExeName); //ExportDir; //GetEXEDir + '\Save' + ...; SavePDFDialog.DefaultExt := 'pdf'; SavePDFDialog.Filter := cProgressExp_Msg9_1; SavePDFDialog.FilterIndex := 1; SavePDFDialog.FileName := FileNameCorrect(ReportCaption); //Copy(TF_Main(GForm).F_Preview.Caption, 0, pos(' - Документ №', TF_Main(GForm).F_Preview.Caption)); SavePDFDialog.Options := SavePDFDialog.Options + [ofOverwritePrompt]; if SavePDFDialog.Execute then begin try frPDFExport := TfrPDFExport.Create(Self); frPDFExport.FileCaption := cProgressExp_Msg6; frPDFExport.Title := ReportCaption; frPDFExport.FileName := SavePDFDialog.FileName; //frPDFExport.OnStartExportPageEvent := TF_Main(GForm).F_ResourceReport.frOLEExcelExportStartExportPageEvent; //frPDFExport.OnProgressExportPageEvent := TF_Main(GForm).F_ResourceReport.frOLEExcelExportProgressExportPageEvent; //frPDFExport.OnEndExportPageEvent := TF_Main(GForm).F_ResourceReport.frOLEExcelExportEndExportPageEvent; frPDFExport.OnStartExportPageEvent := TF_Main(GForm).F_ProgressExp.frOLEExcelExportMyStartExportPageEvent; frPDFExport.OnProgressExportPageEvent := TF_Main(GForm).F_ProgressExp.frOLEExcelExportMyProgressExportPageEvent; frPDFExport.OnEndExportPageEvent := TF_Main(GForm).F_ProgressExp.frOLEExcelExportMyEndExportPageEvent; TF_Main(GForm).F_ProgressExp.cbOpenCaption := cProgressExp_Msg2_1; Screen.Cursor := crHourGlass; try TF_Main(GForm).F_ResourceReport.Report.ExportTo(frPDFExport, frPDFExport.FileName); // вызывается таймер, для закрытия окна и открытия файла Application.ProcessMessages; Sleep(1000); //ShellExecute(0, nil, PChar(SavePDFDialog.FileName), nil, nil, SW_MAXIMIZE); finally Screen.Cursor := crDefault; FreeAndNil(frPDFExport); end; except frPreview1.Connect(CurReport); if TF_Main(GForm).F_ProgressExp.Visible then TF_Main(GForm).F_ProgressExp.Hide; CustMessageDlg(cProgressExp_Msg7, ''); end; //SetForegroundWindow(self.Focus); SetForegroundWindow(self.Handle); end; finally FreeAndNil(SavePDFDialog); end; TF_Main(GForm).F_ResourceReport.ApplRestore(nil); Application.ProcessMessages; SetForegroundWindow(self.Handle); end; procedure TF_Preview.FormCreate(Sender: TObject); var PreviewComponent: TComponent; i: Integer; frPBox: TfrPBox; begin //FPreviewWndProcOriginal := frPreview1.WindowProc; //frPreview1.WindowProc := FPreviewWndProc; frPBox := nil; for i := 0 to frPreview1.Window.ComponentCount - 1 do begin PreviewComponent := frPreview1.Window.Components[i]; if PreviewComponent is TfrPBox then frPBox := TfrPBox(PreviewComponent); end; if frPBox <> nil then begin frPBox.Cursor := crHandFingers; FPreviewWndProcOriginal := frPBox.WindowProc; frPBox.WindowProc := nil; frPBox.WindowProc := FPreviewWndProc; end; FPBox := frPBox; end; procedure TF_Preview.FPreviewWndProc(var Message: TMessage); begin case Message.Msg of WM_LBUTTONDOWN: FPBox.Cursor := crHandFist; //crHandPoint; //Screen.Cursor := crHandPoint; WM_LBUTTONUP: FPBox.Cursor := crHandFingers; //crDefault; //Screen.Cursor := crDefault; end; FPreviewWndProcOriginal(Message); end; procedure TF_Preview.FormDeactivate(Sender: TObject); begin // end; procedure TF_Preview.PreviewMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin if ssCtrl in Shift then begin if (frPreview1.Zoom - 5) >= 10 then frPreview1.Zoom := frPreview1.Zoom - 10 else frPreview1.Zoom := 10; ZoomChange; end else FPreviewMouseWheelDown(Sender, Shift, MousePos, Handled); end; procedure TF_Preview.PreviewMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin if ssCtrl in Shift then begin if (frPreview1.Zoom + 5) <= 200 then frPreview1.Zoom := frPreview1.Zoom + 5 else frPreview1.Zoom := 200; ZoomChange; end else FPreviewMouseWheelUp(Sender, Shift, MousePos, Handled); end; procedure TF_Preview.PreviewFormResize(Sender: TObject); begin {FPreviewFormResize(Sender); with frPreview1.Window do begin if RPanel.Visible then HScrollBar.Width := BPanel.Width - HScrollBar.Left - VScrollBar.Width - pnZoom.Width else HScrollBar.Width := BPanel.Width - HScrollBar.Left - pnZoom.Width; end; } end; procedure TF_Preview.ZoomChange; begin tbZoom.OnChange := nil; tbZoom.Position := Round(frPreview1.Zoom); tbZoom.OnChange := tbZoomChange; lbZoom.Caption := IntToStr(tbZoom.Position)+'%'; end; procedure TF_Preview.tbZoomChange(Sender: TObject); begin lbZoom.Caption := IntToStr(tbZoom.Position)+'%'; frPreview1.Zoom := tbZoom.Position; end; procedure TF_Preview.tbZoomDrawTick(TrackBar: TRzTrackBar; Canvas: TCanvas; Location: TPoint; Index: Integer); begin if Index = 100 then begin Canvas.MoveTo(Location.X, Location.Y-3); Canvas.LineTo(Location.X, Location.Y+10); end; end; procedure TF_Preview.tbZoomKeyPress(Sender: TObject; var Key: Char); begin Key := #0; end; procedure TF_Preview.tbZoomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin Key := 0; end; end.