GridPrinter: Add example how to print a spreadsheet grid (requires fpspreadsheet)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8624 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2022-11-16 18:57:57 +00:00
parent d13027dc87
commit c70778308c
6 changed files with 391 additions and 6 deletions
--- a/components/gridprinter/examples/fpspreadsheet/fpspreadsheet_demo.lpi
+++ b/components/gridprinter/examples/fpspreadsheet/fpspreadsheet_demo.lpi
@ -0,0 +1,93 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="fpspreadsheet_demo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes>
+        <Mode Name="default">
+          <local>
+            <CommandLineParams Value="test.xlsx"/>
+          </local>
+        </Mode>
+      </Modes>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="GridPrinterPkg"/>
+      </Item>
+      <Item>
+        <PackageName Value="laz_fpspreadsheet_visual"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="fpspreadsheet_demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Project1"/>
+      </Unit>
+      <Unit>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainForm"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="fpspreadsheet_demo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/components/gridprinter/examples/fpspreadsheet/fpspreadsheet_demo.lpr
+++ b/components/gridprinter/examples/fpspreadsheet/fpspreadsheet_demo.lpr
@ -0,0 +1,25 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.
+
--- a/components/gridprinter/examples/fpspreadsheet/main.lfm
+++ b/components/gridprinter/examples/fpspreadsheet/main.lfm
@ -0,0 +1,124 @@
+object MainForm: TMainForm
+  Left = 331
+  Height = 498
+  Top = 129
+  Width = 719
+  Caption = 'Printing a TsWorksheetGrid'
+  ClientHeight = 498
+  ClientWidth = 719
+  OnCreate = FormCreate
+  LCLVersion = '2.3.0.0'
+  object ButtonPanel: TPanel
+    Left = 6
+    Height = 25
+    Top = 467
+    Width = 707
+    Align = alBottom
+    AutoSize = True
+    BorderSpacing.Around = 6
+    BevelOuter = bvNone
+    ClientHeight = 25
+    ClientWidth = 707
+    TabOrder = 1
+    object btnPrint: TButton
+      AnchorSideLeft.Control = btnOpenFile
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = ButtonPanel
+      Left = 89
+      Height = 25
+      Top = 0
+      Width = 75
+      BorderSpacing.Left = 6
+      Caption = 'Print...'
+      OnClick = btnPrintClick
+      TabOrder = 1
+    end
+    object btnPreview: TButton
+      AnchorSideLeft.Control = btnPrint
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = ButtonPanel
+      Left = 170
+      Height = 25
+      Top = 0
+      Width = 75
+      BorderSpacing.Left = 6
+      Caption = 'Preview...'
+      OnClick = btnPreviewClick
+      TabOrder = 2
+    end
+    object btnOpenFile: TButton
+      AnchorSideLeft.Control = ButtonPanel
+      AnchorSideTop.Control = ButtonPanel
+      Left = 0
+      Height = 25
+      Top = 0
+      Width = 83
+      AutoSize = True
+      Caption = 'Open file...'
+      OnClick = btnOpenFileClick
+      TabOrder = 0
+    end
+  end
+  object sWorkbookTabControl1: TsWorkbookTabControl
+    Left = 0
+    Height = 461
+    Top = 0
+    Width = 719
+    TabIndex = 0
+    Tabs.Strings = (
+      'Sheet1'
+    )
+    Align = alClient
+    TabOrder = 0
+    WorkbookSource = sWorkbookSource1
+    object sWorksheetGrid1: TsWorksheetGrid
+      Left = 2
+      Height = 436
+      Top = 23
+      Width = 715
+      FrozenCols = 0
+      FrozenRows = 0
+      PageBreakPen.Color = clBlue
+      PageBreakPen.Style = psDash
+      ReadFormulas = False
+      WorkbookSource = sWorkbookSource1
+      Align = alClient
+      AutoAdvance = aaDown
+      DefaultColWidth = 64
+      DefaultRowHeight = 22
+      TabOrder = 0
+    end
+  end
+  object GridPrinter1: TGridPrinter
+    Grid = sWorksheetGrid1
+    Footer.Font.Height = -11
+    Footer.FontSize = 8
+    Header.Font.Height = -11
+    Header.FontSize = 8
+    ShowPrintDialog = gpdPrintDialog
+    OnAfterPrint = GridPrinter1AfterPrint
+    OnBeforePrint = GridPrinter1BeforePrint
+    OnGetRowCount = GridPrinter1GetRowCount
+    OnGetColCount = GridPrinter1GetColCount
+    OnPrintCell = GridPrinter1PrintCell
+    Left = 231
+    Top = 142
+  end
+  object GridPrintPreviewDialog1: TGridPrintPreviewDialog
+    FormParams.PixelsPerInch = 96
+    GridPrinter = GridPrinter1
+    Left = 448
+    Top = 142
+  end
+  object sWorkbookSource1: TsWorkbookSource
+    FileFormat = sfUser
+    Options = []
+    Left = 112
+    Top = 142
+  end
+  object OpenDialog1: TOpenDialog
+    Filter = 'All spreadsheet files|*.xls;*.xlsx;*.ods;*.csv|All Excel files (*.xls, *.xlsx)|*.xls;*.xlsx|Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel XP/2003 XML spreadsheet (*.xml)|*.xml|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|HTML files (*.html; *.htm)|*.html;*.htm|Comma-separated text files (*.csv; *.txt)|*.csv;*.txt'
+    Left = 230
+    Top = 248
+  end
+end
--- a/components/gridprinter/examples/fpspreadsheet/main.pas
+++ b/components/gridprinter/examples/fpspreadsheet/main.pas
@ -0,0 +1,133 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+  Grids, Types, GridPrn, GridPrnPreviewDlg,
+  fpspreadsheet, fpstypes, fpspreadsheetgrid, fpspreadsheetctrls, fpsAllFormats;
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TForm)
+    btnPrint: TButton;
+    btnPreview: TButton;
+    btnOpenFile: TButton;
+    GridPrinter1: TGridPrinter;
+    GridPrintPreviewDialog1: TGridPrintPreviewDialog;
+    OpenDialog1: TOpenDialog;
+    ButtonPanel: TPanel;
+    sWorkbookSource1: TsWorkbookSource;
+    sWorkbookTabControl1: TsWorkbookTabControl;
+    sWorksheetGrid1: TsWorksheetGrid;
+    procedure btnPrintClick(Sender: TObject);
+    procedure btnPreviewClick(Sender: TObject);
+    procedure btnOpenFileClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure GridPrinter1AfterPrint(Sender: TObject);
+    procedure GridPrinter1BeforePrint(Sender: TObject);
+    procedure GridPrinter1GetColCount(Sender: TObject; AGrid: TCustomGrid;
+      var AColCount: Integer);
+    procedure GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
+      var ARowCount: Integer);
+    procedure GridPrinter1PrintCell(Sender: TObject; AGrid: TCustomGrid;
+      ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect);
+  private
+    FGridCanvas: TCanvas;
+    FOldPadding: Integer;
+    FNewPadding: Integer;
+
+  public
+
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+  Variants;
+
+type
+  TsWorksheetGridOpener = class(TsWorksheetGrid);
+
+{ TMainForm }
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+  if ParamCount > 0 then
+    sWorkbookSource1.LoadFromSpreadsheetFile(ParamStr(1));
+end;
+
+procedure TMainForm.GridPrinter1AfterPrint(Sender: TObject);
+begin
+  sWorksheetGrid1.Canvas := FGridCanvas;
+  varCellPadding := FOldPadding;
+end;
+
+procedure TMainForm.GridPrinter1BeforePrint(Sender: TObject);
+begin
+  FGridCanvas := sWorksheetGrid1.Canvas;
+  sWorksheetGrid1.Canvas := GridPrinter1.Canvas;
+  FOldPadding := varCellPadding;
+  FNewPadding := GridPrinter1.Padding - varCellPadding;
+end;
+
+procedure TMainForm.btnPrintClick(Sender: TObject);
+begin
+  GridPrinter1.Print;
+end;
+
+procedure TMainForm.btnPreviewClick(Sender: TObject);
+begin
+  GridPrintPreviewDialog1.Execute;
+end;
+
+procedure TMainForm.btnOpenFileClick(Sender: TObject);
+begin
+  if OpenDialog1.FileName <> '' then
+    OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);
+  if OpenDialog1.Execute then
+    sWorkbookSource1.LoadFromSpreadsheetFile(OpenDialog1.FileName);
+end;
+
+procedure TMainForm.GridPrinter1GetColCount(Sender: TObject; AGrid: TCustomGrid;
+  var AColCount: Integer);
+begin
+  if sWorksheetGrid1.Worksheet <> nil then
+    AColCount := sWorksheetGrid1.Worksheet.GetLastOccupiedColIndex + 1 + sWorksheetGrid1.HeaderCount;
+end;
+
+procedure TMainForm.GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
+  var ARowCount: Integer);
+begin
+  if sWorksheetGrid1.Worksheet <> nil then
+    ARowCount := sWorksheetGrid1.Worksheet.GetLastOccupiedRowIndex + 1 + sWorksheetGrid1.HeaderCount;
+end;
+
+procedure TMainForm.GridPrinter1PrintCell(Sender: TObject; AGrid: TCustomGrid;
+  ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect);
+var
+  worksheet: TsWorksheet;
+  cell: PCell;
+begin
+  worksheet := sWorksheetGrid1.Worksheet;
+  if worksheet <> nil then
+  begin
+    varCellPadding := FNewPadding;
+    TsWorksheetGridOpener(sWorksheetGrid1).DrawCell(ACol, ARow, ARect, []);
+    cell := worksheet.FindCell(sWorksheetGrid1.GetWorksheetRow(ARow), sWorksheetGrid1.GetWorksheetCol(ACol));
+    if worksheet.HasComment(cell) then
+      TsWorksheetGridOpener(sWorksheetGrid1).DrawCommentMarker(ARect);
+  end;
+end;
+
+end.
+
--- a/components/gridprinter/examples/fpspreadsheet/test.xlsx
+++ b/components/gridprinter/examples/fpspreadsheet/test.xlsx
--- a/components/gridprinter/source/gridprn.pas
+++ b/components/gridprinter/source/gridprn.pas
@ -12,6 +12,9 @@ type

  TGridPrnDialog = (gpdNone, gpdPageSetup, gpdPrintDialog, gpdPrinterSetup);

+  TGridPrnPrintCellEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
+    ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect) of object;
+
  TGridPrnGetCellTextEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
    ACol, ARow: Integer; var AText: String) of object;

@ -137,6 +140,7 @@ type
    FOnGetColCount: TGridPrnGetColCountEvent;
    FOnGetRowCount: TGridPrnGetRowCountEvent;
    FOnPrepareCanvas: TOnPrepareCanvasEvent;
+    FOnPrintCell: TGridPrnPrintCellEvent;
    FOnUpdatePreview: TNotifyEvent;
    function GetBorderLineWidthHor: Integer;
    function GetBorderLineWidthVert: Integer;
@ -239,6 +243,7 @@ type
    property PageRect: TRect read FPageRect;
    property PixelsPerInchX: Integer read FPixelsPerInchX;
    property PixelsPerInchY: Integer read FPixelsPerInchY;
+    property Padding: Integer read FPadding;
    property PageCount: Integer read GetPageCount;
    property PageNumber: Integer read FPageNumber;
    property PrintScaleToNumHorPages: Integer read FPrintScaleToNumHorPages write FPrintScaleToNumHorPages;
@ -270,6 +275,7 @@ type
    property OnGetRowCount: TGridPrnGetRowCountEvent read FOnGetRowCount write FOnGetRowCount;
    property OnGetColCount: TGridPrnGetColCountEvent read FOnGetColCount write FOnGetColCount;
    property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
+    property OnPrintCell: TGridPrnPrintCellEvent read FOnPrintCell write FOnPrintCell;
    property OnUpdatePreview: TNotifyEvent read FOnUpdatePreview write FOnUpdatePreview;
  end;

@ -712,10 +718,14 @@ end;
 procedure TGridPrinter.Execute(ACanvas: TCanvas);
 begin
  FPrinting := true;
+  if Assigned(FOnBeforePrint) then
+    FOnBeforePrint(Self);
  case FPrintOrder of
    poRowsFirst: PrintByRows(ACanvas);
    poColsFirst: PrintByCols(ACanvas);
  end;
+  if Assigned(FOnAfterPrint) then
+    FOnAfterPrint(Self);
  FPrinting := false;
 end;

@ -1105,9 +1115,6 @@ begin
      end;
  end;

-  if Assigned(FOnBeforePrint) then
-    FOnBeforePrint(Self);
-
  FOutputDevice := odPrinter;
  Prepare;
  Printer.BeginDoc;
@ -1116,9 +1123,6 @@ begin
  finally
    Printer.EndDoc;
  end;
-
-  if Assigned(FOnAfterPrint) then
-    FOnAfterPrint(Self);
 end;

 { Advances first along rows when handling page-breaks. }
@ -1222,6 +1226,12 @@ var
  lGrid: TGridAccess;
  checkedState: TCheckboxState;
 begin
+  if Assigned(FOnPrintCell) then
+  begin
+    FOnPrintCell(Self, FGrid, ACanvas, ACol, ARow, ARect);
+    exit;
+  end;
+
  lGrid := TGridAccess(FGrid);

  PrepareCanvas(ACanvas, ACol, ARow);