unit ReportFrameUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Dialogs, PrintersDlgs, MainDM; type { TReportFrame } TReportFrame = class(TFrame) PrintDialog: TPrintDialog; ReportPanel: TPanel; ReportMemo: TMemo; ReportToolBar: TToolBar; SaveDialog: TSaveDialog; tbCopyReport: TToolButton; tbPrintReport: TToolButton; tbSaveReport: TToolButton; procedure tbCopyReportClick(Sender: TObject); procedure tbPrintReportClick(Sender: TObject); procedure tbSaveReportClick(Sender: TObject); private FPrintY: Integer; function LongestLine(AReport: TStrings): Integer; protected procedure PrintText; virtual; public constructor Create(AOwner: TComponent); override; procedure Clear; virtual; procedure ClearBorderSpacings; procedure DisplayReport(AReport: TStrings; Add: Boolean = false); virtual; procedure UpdateBtnStates; virtual; end; implementation {$R *.lfm} uses Graphics, StrUtils, Printers, OSPrinters, Globals; const LEFT_MARGIN = 20; // mm RIGHT_MARGIN = 20; TOP_MARGIN = 15; BOTTOM_MARGIN = 20; INCH = 25.4; // 1 inch in mm constructor TReportFrame.Create(AOwner: TComponent); begin inherited; Name := ''; ReportPanel.Color := ReportMemo.Color; UpdateBtnStates; end; procedure TReportFrame.Clear; begin ReportMemo.Lines.Clear; UpdateBtnStates; end; procedure TReportFrame.ClearBorderSpacings; begin with BorderSpacing do begin Left := 0; Top := 0; Right := 0; Bottom := 0; Around := 0; end; end; procedure TReportFrame.DisplayReport(AReport: TStrings; Add: Boolean = false); var maxLen: Integer; s: String; begin ReportMemo.Lines.BeginUpdate; try if not Add then ReportMemo.Clear; maxLen := Longestline(AReport); for s in AReport do if s = DIVIDER_AUTO then ReportMemo.Lines.Add(AddChar('=', '', maxLen)) else if s = DIVIDER_SMALL_AUTO then ReportMemo.Lines.Add(AddChar('-', '', maxLen)) else ReportMemo.Lines.Add(s); finally Reportmemo.Lines.EndUpdate; end; UpdateBtnStates; end; function TReportFrame.LongestLine(AReport: TStrings): Integer; var len: Integer; s: String; begin len := 0; for s in AReport do if Length(s) > len then len := Length(s); Result := len; end; procedure TReportFrame.PrintText; var i: Integer; x: Integer; xmax, ymax: Integer; pageNo: Integer; oldFontSize: Integer; h: Integer; leftMM, rightMM, topMM, bottomMM: Integer; begin with Printer do begin leftMM := round(LEFT_MARGIN / INCH * XDpi); rightMM := round(RIGHT_MARGIN / INCH * XDpi); topMM := round(TOP_MARGIN / INCH * YDpi); bottomMM := round(BOTTOM_MARGIN / INCH * YDpi); x := leftMM; FPrintY := topMM; xMax := PaperSize.Width - rightMM; yMax := PaperSize.Height - bottomMM; pageNo := 1; try Canvas.Brush.Style := bsClear; // no text background color Canvas.Font.Assign(ReportMemo.Font); if Canvas.Font.Size < 10 then Canvas.Font.Size := 10; oldFontSize := Canvas.Font.Size; for i:=0 to ReportMemo.Lines.Count-1 do begin // Print page number if FPrintY = topMM then begin Canvas.Font.Size := 10; h := Canvas.TextHeight('Page 9') + 4; Canvas.TextOut(x+1, FPrintY, 'Page ' + IntToStr(PageNo)); Canvas.Pen.Width := 3; Canvas.Line(leftMM, FPrintY+h, xMax, FPrintY+h); inc(FPrintY, 2*h); Canvas.Font.Size := oldFontSize; end; Canvas.TextOut(x, FPrintY, ReportMemo.Lines[i]); inc(FPrintY, Canvas.TextHeight('Tg')); if FPrintY > yMax then begin NewPage; FPrintY := topMM; inc(PageNo); end; end; except on E: EPrinter do ShowMessage('Printer Error: ' + E.Message); on E: Exception do ShowMessage('Unexpected error when printing.'); end; end; end; procedure TReportFrame.UpdateBtnStates; begin tbCopyReport.Enabled := ReportMemo.Lines.Count > 0; tbPrintReport.Enabled := ReportMemo.Lines.Count > 0; tbSaveReport.Enabled := ReportMemo.Lines.Count > 0; end; procedure TReportFrame.tbPrintReportClick(Sender: TObject); begin if PrintDialog.Execute then begin Printer.BeginDoc; try PrintText; finally Printer.EndDoc; end; end; end; procedure TReportFrame.tbCopyReportClick(Sender: TObject); begin with ReportMemo do begin SelectAll; CopyToClipboard; SelLength := 0; end; end; procedure TReportFrame.tbSaveReportClick(Sender: TObject); begin SaveDialog.Filter := 'LazStats text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*'; SaveDialog.FilterIndex := 1; {text file} SaveDialog.Title := 'Save to File'; if SaveDialog.Execute then ReportMemo.Lines.SaveToFile(SaveDialog.FileName); end; end.