diff --git a/components/gridprinter/examples/dbgrid/dbgrid_demo.lpi b/components/gridprinter/examples/dbgrid/dbgrid_demo.lpi
new file mode 100644
index 000000000..9ebb096bd
--- /dev/null
+++ b/components/gridprinter/examples/dbgrid/dbgrid_demo.lpi
@@ -0,0 +1,92 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/gridprinter/examples/dbgrid/dbgrid_demo.lpr b/components/gridprinter/examples/dbgrid/dbgrid_demo.lpr
new file mode 100644
index 000000000..e02a45f81
--- /dev/null
+++ b/components/gridprinter/examples/dbgrid/dbgrid_demo.lpr
@@ -0,0 +1,25 @@
+program dbgrid_demo;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF HASAMIGA}
+ athreads,
+ {$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, main, memdslaz
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Scaled:=True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/gridprinter/examples/dbgrid/main.lfm b/components/gridprinter/examples/dbgrid/main.lfm
new file mode 100644
index 000000000..8721977d8
--- /dev/null
+++ b/components/gridprinter/examples/dbgrid/main.lfm
@@ -0,0 +1,71 @@
+object Form1: TForm1
+ Left = 331
+ Height = 382
+ Top = 130
+ Width = 689
+ Caption = 'Form1'
+ ClientHeight = 382
+ ClientWidth = 689
+ OnCreate = FormCreate
+ LCLVersion = '2.3.0.0'
+ object DBGrid1: TDBGrid
+ Left = 0
+ Height = 345
+ Top = 0
+ Width = 689
+ Align = alClient
+ Color = clWindow
+ Columns = <>
+ DataSource = DataSource1
+ Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgTabs, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgThumbTracking]
+ TabOrder = 0
+ end
+ object Panel1: TPanel
+ Left = 0
+ Height = 37
+ Top = 345
+ Width = 689
+ Align = alBottom
+ AutoSize = True
+ BevelOuter = bvNone
+ ClientHeight = 37
+ ClientWidth = 689
+ TabOrder = 1
+ object Button1: TButton
+ AnchorSideLeft.Control = Panel1
+ AnchorSideTop.Control = Panel1
+ Left = 6
+ Height = 25
+ Top = 6
+ Width = 104
+ AutoSize = True
+ BorderSpacing.Around = 6
+ Caption = 'Print preview...'
+ OnClick = Button1Click
+ TabOrder = 0
+ end
+ end
+ object DataSource1: TDataSource
+ DataSet = BufDataset1
+ Left = 256
+ Top = 64
+ end
+ object GridPrinter1: TGridPrinter
+ Footer.Font.Height = -11
+ Header.Font.Height = -11
+ OnGetCellText = GridPrinter1GetCellText
+ OnGetRowCount = GridPrinter1GetRowCount
+ Left = 167
+ Top = 136
+ end
+ object GridPrintPreviewDialog1: TGridPrintPreviewDialog
+ GridPrinter = GridPrinter1
+ Left = 167
+ Top = 208
+ end
+ object BufDataset1: TBufDataset
+ FieldDefs = <>
+ Left = 167
+ Top = 64
+ end
+end
diff --git a/components/gridprinter/examples/dbgrid/main.pas b/components/gridprinter/examples/dbgrid/main.pas
new file mode 100644
index 000000000..b2f6086b2
--- /dev/null
+++ b/components/gridprinter/examples/dbgrid/main.pas
@@ -0,0 +1,115 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, memds, DB, BufDataset, Forms, Controls, Graphics, Dialogs,
+ DBGrids, ExtCtrls, StdCtrls, GridPrn, GridPrnPreviewDlg, Grids;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ BufDataset1: TBufDataset;
+ Button1: TButton;
+ DataSource1: TDataSource;
+ DBGrid1: TDBGrid;
+ GridPrinter1: TGridPrinter;
+ GridPrintPreviewDialog1: TGridPrintPreviewDialog;
+ Panel1: TPanel;
+ procedure Button1Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure GridPrinter1GetCellText(Sender: TObject; AGrid: TCustomGrid;
+ ACol, ARow: Integer; var AText: String);
+ procedure GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
+ var ARowCount: Integer);
+ private
+
+ public
+
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ // Create some dummy dataset
+ BufDataset1.FieldDefs.Add('Text', ftString, 20);
+ BufDataset1.FieldDefs.Add('Value', ftInteger);
+ BufDataset1.FieldDefs.Add('Date', ftDate);
+ BufDataset1.CreateDataset;
+ BufDataset1.Open;
+ for i := 1 to 100 do
+ BufDataset1.AppendRecord(['Record ' + IntToStr(i), 100*i, Date()-i]);
+ BufDataset1.First;
+
+ // Since the GridPrinter accesses the DBGrid assign it to the Grid property
+ // only after the Dataset is ready and the DBGrid can display valid data.
+ GridPrinter1.Grid := DBGrid1;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+ bm: TBookmark;
+begin
+ // Store currently active record so that we can return to it after preview/print.
+ bm := BufDataset1.GetBookmark;
+ try
+ // Disable scrolling of grid
+ BufDataset1.DisableControls;
+ try
+ // Show the grid printpreview
+ GridPrintPreviewDialog1.Execute;
+ finally
+ // Allow scrolling again
+ BufDataset1.EnableControls;
+ end;
+ // Return to the stored record position.
+ BufDataset1.GotoBookmark(bm);
+ finally
+ BufDataset1.FreeBookmark(bm);
+ end;
+end;
+
+procedure TForm1.GridPrinter1GetCellText(Sender: TObject; AGrid: TCustomGrid;
+ ACol, ARow: Integer; var AText: String);
+var
+ field: TField;
+ dbGrid: TDBGrid;
+begin
+ dbGrid := AGrid as TDBGrid;
+ if ACol >= dbGrid.FixedCols then
+ begin
+ // We need something to find the row to be printed and use the dataset's
+ // RecNo for this purpose which is a number starting at 1.
+ // BUT BEWARE: RecNo is no good parameter for many dataset types!
+ BufDataset1.RecNo := ARow;
+ // Using the field from the DBGrid.Columns rather than from the dataset
+ // directly accounts for rearranging the column order in the grid.
+ field := dbGrid.Columns[ACol - dbGrid.FixedCols].Field;
+ AText := field.AsString;
+ end;
+end;
+
+procedure TForm1.GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
+ var ARowCount: Integer);
+begin
+ // Since the DBGrid does not load all records, but we want to print all
+ // of them, we must tell the printer the real number of rows to print
+ ARowCount := BufDataset1.RecordCount + 1; // added 1 for the header row
+end;
+
+end.
+
diff --git a/components/gridprinter/examples/multi-language/main.lfm b/components/gridprinter/examples/multi-language/main.lfm
new file mode 100644
index 000000000..687d4e541
--- /dev/null
+++ b/components/gridprinter/examples/multi-language/main.lfm
@@ -0,0 +1,158 @@
+object MainForm: TMainForm
+ Left = 331
+ Height = 491
+ Top = 127
+ Width = 656
+ Caption = 'Multi-Language Demonstration of TGridPrinter'
+ ClientHeight = 491
+ ClientWidth = 656
+ OnCreate = FormCreate
+ LCLVersion = '2.3.0.0'
+ object StringGrid1: TStringGrid
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Panel1
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = btnPrint
+ Left = 6
+ Height = 419
+ Top = 35
+ Width = 644
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ BorderSpacing.Around = 6
+ ColCount = 6
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goSmoothScroll, goCellEllipsis]
+ RowCount = 6
+ TabOrder = 0
+ end
+ object btnPrint: TButton
+ AnchorSideLeft.Control = Owner
+ AnchorSideBottom.Control = Owner
+ AnchorSideBottom.Side = asrBottom
+ Left = 6
+ Height = 25
+ Top = 460
+ Width = 75
+ Anchors = [akLeft, akBottom]
+ BorderSpacing.Around = 6
+ Caption = 'Print...'
+ OnClick = btnPrintClick
+ TabOrder = 1
+ end
+ object btnPreview: TButton
+ AnchorSideLeft.Control = cmbDialogs
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = btnPrint
+ Left = 275
+ Height = 25
+ Top = 460
+ Width = 76
+ AutoSize = True
+ BorderSpacing.Left = 24
+ Caption = 'Preview...'
+ OnClick = btnPreviewClick
+ TabOrder = 2
+ end
+ object cmbDialogs: TComboBox
+ AnchorSideLeft.Control = btnPrint
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = btnPrint
+ AnchorSideTop.Side = asrCenter
+ Left = 87
+ Height = 23
+ Top = 461
+ Width = 164
+ BorderSpacing.Left = 6
+ ItemHeight = 15
+ Items.Strings = (
+ 'RSNoPrinterDialog'
+ 'RSPageSetupDialog'
+ 'RSPrinterDialog'
+ )
+ Style = csDropDownList
+ TabOrder = 3
+ end
+ object ccbPreviewOptions: TCheckComboBox
+ AnchorSideLeft.Control = btnPreview
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = btnPreview
+ AnchorSideTop.Side = asrCenter
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 357
+ Height = 22
+ Top = 461
+ Width = 293
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Around = 6
+ ItemHeight = 16
+ Items.Strings = (
+ 'ppoNavigationBtns'
+ 'ppoNavigationEdit'
+ 'ppoZoomBtns'
+ 'ppoPageOrientationBtns'
+ 'ppoMarginsBtn'
+ 'ppoHeaderFooterBtn'
+ 'ppoPrintOrderBtns '
+ )
+ OnItemChange = ccbPreviewOptionsItemChange
+ TabOrder = 4
+ end
+ object Panel1: TPanel
+ Left = 0
+ Height = 29
+ Top = 0
+ Width = 656
+ Align = alTop
+ AutoSize = True
+ BevelOuter = bvNone
+ ClientHeight = 29
+ ClientWidth = 656
+ TabOrder = 5
+ object Label1: TLabel
+ AnchorSideLeft.Control = Panel1
+ AnchorSideTop.Control = cmbLanguages
+ AnchorSideTop.Side = asrCenter
+ Left = 6
+ Height = 15
+ Top = 10
+ Width = 55
+ BorderSpacing.Left = 6
+ Caption = 'Language:'
+ end
+ object cmbLanguages: TComboBox
+ AnchorSideLeft.Control = Label1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Panel1
+ AnchorSideRight.Control = Panel1
+ AnchorSideRight.Side = asrBottom
+ Left = 67
+ Height = 23
+ Top = 6
+ Width = 581
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Left = 6
+ BorderSpacing.Top = 6
+ BorderSpacing.Right = 8
+ ItemHeight = 15
+ OnChange = cmbLanguagesChange
+ Style = csDropDownList
+ TabOrder = 0
+ end
+ end
+ object GridPrinter1: TGridPrinter
+ Grid = StringGrid1
+ Footer.Font.Height = -11
+ Header.Font.Height = -11
+ Header.Text = 'test||'
+ Orientation = poLandscape
+ Left = 168
+ Top = 96
+ end
+ object GridPrintPreviewDialog1: TGridPrintPreviewDialog
+ GridPrinter = GridPrinter1
+ Left = 288
+ Top = 96
+ end
+end
diff --git a/components/gridprinter/examples/multi-language/main.lrj b/components/gridprinter/examples/multi-language/main.lrj
new file mode 100644
index 000000000..b74a41fe1
--- /dev/null
+++ b/components/gridprinter/examples/multi-language/main.lrj
@@ -0,0 +1,6 @@
+{"version":1,"strings":[
+{"hash":13998722,"name":"tmainform.caption","sourcebytes":[77,117,108,116,105,45,76,97,110,103,117,97,103,101,32,68,101,109,111,110,115,116,114,97,116,105,111,110,32,111,102,32,84,71,114,105,100,80,114,105,110,116,101,114],"value":"Multi-Language Demonstration of TGridPrinter"},
+{"hash":151352958,"name":"tmainform.btnprint.caption","sourcebytes":[80,114,105,110,116,46,46,46],"value":"Print..."},
+{"hash":217709006,"name":"tmainform.btnpreview.caption","sourcebytes":[80,114,101,118,105,101,119,46,46,46],"value":"Preview..."},
+{"hash":82521866,"name":"tmainform.label1.caption","sourcebytes":[76,97,110,103,117,97,103,101,58],"value":"Language:"}
+]}
diff --git a/components/gridprinter/examples/multi-language/main.pas b/components/gridprinter/examples/multi-language/main.pas
new file mode 100644
index 000000000..8bcce87a0
--- /dev/null
+++ b/components/gridprinter/examples/multi-language/main.pas
@@ -0,0 +1,221 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids,
+ StdCtrls, ExtCtrls, ComboEx,
+ LCLTranslator, Translations,
+ PrintersDlgs, GridPrn, GridPrnPreviewForm, GridPrnPreviewDlg;
+
+type
+
+ { TMainForm }
+
+ TMainForm = class(TForm)
+ btnPrint: TButton;
+ btnPreview: TButton;
+ Button2: TButton;
+ ccbPreviewOptions: TCheckComboBox;
+ cmbDialogs: TComboBox;
+ cmbLanguages: TComboBox;
+ GridPrinter1: TGridPrinter;
+ GridPrintPreviewDialog1: TGridPrintPreviewDialog;
+ Label1: TLabel;
+ PageSetupDialog1: TPageSetupDialog;
+ Panel1: TPanel;
+ PrinterSetupDialog1: TPrinterSetupDialog;
+ StringGrid1: TStringGrid;
+ procedure btnPrintClick(Sender: TObject);
+ procedure btnPreviewClick(Sender: TObject);
+ procedure ccbPreviewOptionsItemChange(Sender: TObject; AIndex: Integer);
+ procedure cmbLanguagesChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ FLanguagesDir: String;
+ procedure PopulateLanguages;
+ procedure SelectLanguage(AIndex: Integer);
+
+ public
+
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ FileUtil;
+
+resourcestring
+ RSNoPrinterDialog = 'No printer dialog';
+ RSPageSetupDialog = 'Page-setup dialog';
+ RSPrinterDialog = 'Printer dialog';
+
+ RSNavigationButtons = 'Navigation buttons';
+ RSNavigationEdit = 'Navigation edit';
+ RSZoomButtons = 'Zoom buttons';
+ RSPageOrientationButtons = 'Page orientation buttons';
+ RSPageMarginsButtons = 'Page margins button';
+ RSHeaderFooterButton = 'Header/footer button';
+ RSPrintOrderButtons = 'Print order: colums first or rows first';
+
+
+{ TMainForm }
+
+procedure TMainForm.btnPrintClick(Sender: TObject);
+begin
+ case cmbDialogs.ItemIndex of
+ 0: GridPrinter1.PrintDialogs := gpdNone;
+ 1: GridPrinter1.PrintDialogs := gpdPageSetup;
+ 2: GridPrinter1.PrintDialogs := gpdPrintDialog;
+ end;
+ GridPrinter1.Print;
+end;
+
+procedure TMainForm.btnPreviewClick(Sender: TObject);
+begin
+ GridPrintPreviewDialog1.Execute;
+end;
+
+procedure TMainForm.ccbPreviewOptionsItemChange(Sender: TObject; AIndex: Integer);
+var
+ optns: TGridPrintPreviewOptions;
+begin
+ optns := [];
+ if ccbPreviewOptions.Checked[0] then Include(optns, ppoNavigationBtns);
+ if ccbPreviewOptions.Checked[1] then Include(optns, ppoNavigationEdit);
+ if ccbPreviewOptions.Checked[2] then Include(optns, ppoZoomBtns);
+ if ccbPreviewOptions.Checked[3] then Include(optns, ppoPageOrientationBtns);
+ if ccbPreviewOptions.Checked[4] then Include(optns, ppoMarginsBtn);
+ if ccbPreviewOptions.Checked[5] then Include(optns, ppoHeaderFooterBtn);
+ if ccbPreviewOptions.Checked[6] then Include(optns, ppoPrintOrderBtns);
+ GridPrintPreviewDialog1.Options := optns;
+end;
+
+procedure TMainForm.cmbLanguagesChange(Sender: TObject);
+begin
+ SelectLanguage(cmbLanguages.ItemIndex);
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+const
+ NUM_ROWS = 100;
+ NUM_COLS = 20;
+var
+ i, r, c: Integer;
+begin
+ cmbDialogs.ItemIndex := 2;
+ ccbPreviewOptions.ItemIndex := 0;
+ for i := 0 to ccbPreviewOptions.Count-1 do
+ ccbPreviewOptions.Checked[i] := true;
+
+ FLanguagesDir := ExpandFileName(Application.Location + '../../languages/');
+ PopulateLanguages;
+ SelectLanguage(cmbLanguages.ItemIndex);
+
+ StringGrid1.BeginUpdate;
+ try
+ StringGrid1.Clear;
+ StringGrid1.RowCount := NUM_ROWS + StringGrid1.FixedRows;
+ StringGrid1.ColCount := NUM_COLS + StringGrid1.FixedCols;
+ for r := StringGrid1.FixedRows to StringGrid1.RowCount-1 do
+ StringGrid1.Cells[0, r] := 'Row ' + IntToStr(r);
+ for c := StringGrid1.FixedCols to StringGrid1.ColCount-1 do
+ begin
+ StringGrid1.Cells[c, 0] := 'Column ' + IntToStr(c);
+ for r := StringGrid1.FixedRows to StringGrid1.RowCount-1 do
+ StringGrid1.cells[c, r] := Format('C%d R%d', [c, r]);
+ end;
+ finally
+ StringGrid1.EndUpdate;
+ end;
+end;
+
+{ Populates the languages combobox: reads the names of the app's .po files
+ in the languages directory and adds the item the combobox. }
+procedure TMainForm.PopulateLanguages;
+var
+ List: TStringList;
+ s, lang: String;
+ i, j: Integer;
+begin
+ List := TStringList.Create;
+ try
+ FindAllFiles(List, FLanguagesDir, 'multilanguage_demo.*.po');
+ for i := 0 to List.Count-1 do
+ begin
+ s := List[i];
+ lang := '';
+ for j := Length(s)-3 downto 0 do
+ begin
+ if s[j] = '.' then
+ break;
+ lang := s[j] + lang;
+ end;
+ case lowercase(lang) of
+ 'de': List[i] := 'de - Deutsch';
+ 'en': List[i] := 'en - English';
+ end;
+ end;
+ List.Sort;
+ cmbLanguages.Items.Assign(List);
+ finally
+ List.Free;
+ end;
+end;
+
+procedure TMainForm.SelectLanguage(AIndex: Integer);
+var
+ lang: String;
+ i, idx1, idx2: Integer;
+begin
+ idx1 := cmbDialogs.ItemIndex;
+ idx2 := ccbPreviewOptions.ItemIndex;
+
+ // Set the default language - the LCLTranslator translates all app strings
+ // as well as the LCL strings...
+ if AIndex = -1 then
+ begin
+ lang := SetDefaultLang('', FLanguagesDir);
+ for i := 0 to cmbLanguages.Items.Count-1 do
+ if pos(lang + ' - ', cmbLanguages.Items[i]) = 1 then
+ begin
+ cmbLanguages.ItemIndex := i;
+ break;
+ end;
+ end else
+ begin
+ lang := cmbLanguages.Items[AIndex];
+ lang := Copy(lang, 1, pos(' - ', lang) - 1);
+ SetDefaultLang(lang, FLanguagesDir);
+ end;
+ // ... and translate the strings of the GridPrinter package.
+ TranslateUnitResourceStrings('GridPrnStrings', FLanguagesDir + 'GridPrnStrings.' + lang + '.po');
+
+ // The LCL Translator does not update the strings in the comboboxes.
+
+ // Translate the items in the printer dialogs combobox...
+ cmbDialogs.Items[0] := RSNoPrinterDialog;
+ cmbDialogs.Items[1] := RSPageSetupDialog;
+ cmbDialogs.Items[2] := RSPrinterDialog;
+ cmbDialogs.ItemIndex := idx1;
+
+ // ... and of the preview dialog options check combobox.
+ ccbPreviewOptions.Items[0] := RSNavigationButtons;
+ ccbPreviewOptions.Items[1] := RSNavigationEdit;
+ ccbPreviewOptions.Items[2] := RSZoomButtons;
+ ccbPreviewOptions.Items[3] := RSPageOrientationButtons;
+ ccbPreviewOptions.Items[4] := RSPageMarginsButtons;
+ ccbPreviewOptions.Items[5] := RSHeaderFooterButton;
+ ccbPreviewOptions.Items[6] := RSPrintOrderButtons;
+ ccbPreviewOptions.ItemIndex := idx2;
+end;
+
+end.
+
diff --git a/components/gridprinter/examples/multi-language/multilanguage_demo.lpi b/components/gridprinter/examples/multi-language/multilanguage_demo.lpi
new file mode 100644
index 000000000..c2f450cc3
--- /dev/null
+++ b/components/gridprinter/examples/multi-language/multilanguage_demo.lpi
@@ -0,0 +1,92 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/gridprinter/examples/multi-language/multilanguage_demo.lpr b/components/gridprinter/examples/multi-language/multilanguage_demo.lpr
new file mode 100644
index 000000000..c58f71e41
--- /dev/null
+++ b/components/gridprinter/examples/multi-language/multilanguage_demo.lpr
@@ -0,0 +1,26 @@
+program MultiLanguage_Demo;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF HASAMIGA}
+ athreads,
+ {$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, Main, printer4lazarus
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Title:='MultiLanguage_Demo';
+ Application.Scaled:=True;
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
+
diff --git a/components/gridprinter/examples/stringgrid/main.lfm b/components/gridprinter/examples/stringgrid/main.lfm
new file mode 100644
index 000000000..e99855c9d
--- /dev/null
+++ b/components/gridprinter/examples/stringgrid/main.lfm
@@ -0,0 +1,72 @@
+object Form1: TForm1
+ Left = 331
+ Height = 494
+ Top = 127
+ Width = 653
+ Caption = 'StringGrid Demo for TGridPrinter'
+ ClientHeight = 494
+ ClientWidth = 653
+ OnCreate = FormCreate
+ LCLVersion = '2.3.0.0'
+ object StringGrid1: TStringGrid
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = btnPrint
+ Left = 6
+ Height = 451
+ Top = 6
+ Width = 641
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ BorderSpacing.Around = 6
+ ColCount = 6
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goSmoothScroll, goCellEllipsis]
+ RowCount = 6
+ TabOrder = 0
+ end
+ object btnPrint: TButton
+ AnchorSideLeft.Control = Owner
+ AnchorSideBottom.Control = Owner
+ AnchorSideBottom.Side = asrBottom
+ Left = 6
+ Height = 25
+ Top = 463
+ Width = 60
+ Anchors = [akLeft, akBottom]
+ AutoSize = True
+ BorderSpacing.Around = 6
+ Caption = 'Print...'
+ OnClick = btnPrintClick
+ TabOrder = 1
+ end
+ object btnPreview: TButton
+ AnchorSideLeft.Control = btnPrint
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = btnPrint
+ Left = 72
+ Height = 25
+ Top = 463
+ Width = 76
+ AutoSize = True
+ BorderSpacing.Left = 6
+ Caption = 'Preview...'
+ OnClick = btnPreviewClick
+ TabOrder = 2
+ end
+ object GridPrinter1: TGridPrinter
+ Grid = StringGrid1
+ Footer.Font.Height = -11
+ Header.Font.Height = -11
+ Header.Text = 'test||'
+ Orientation = poLandscape
+ PrintDialogs = gpdPrintDialog
+ Left = 168
+ Top = 96
+ end
+ object GridPrintPreviewDialog1: TGridPrintPreviewDialog
+ GridPrinter = GridPrinter1
+ Left = 288
+ Top = 96
+ end
+end
diff --git a/components/gridprinter/examples/stringgrid/main.pas b/components/gridprinter/examples/stringgrid/main.pas
new file mode 100644
index 000000000..d45157f99
--- /dev/null
+++ b/components/gridprinter/examples/stringgrid/main.pas
@@ -0,0 +1,80 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls,
+ ComboEx,
+ PrintersDlgs, GridPrn, GridPrnPreviewForm, GridPrnPreviewDlg;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ btnPrint: TButton;
+ btnPreview: TButton;
+ Button2: TButton;
+ GridPrinter1: TGridPrinter;
+ GridPrintPreviewDialog1: TGridPrintPreviewDialog;
+ PageSetupDialog1: TPageSetupDialog;
+ PrinterSetupDialog1: TPrinterSetupDialog;
+ StringGrid1: TStringGrid;
+ procedure btnPrintClick(Sender: TObject);
+ procedure btnPreviewClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+
+ public
+
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.btnPrintClick(Sender: TObject);
+begin
+ GridPrinter1.Print;
+end;
+
+procedure TForm1.btnPreviewClick(Sender: TObject);
+begin
+ GridPrintPreviewDialog1.Execute;
+end;
+
+// Populate the string grid with dummy to have something for printing.
+procedure TForm1.FormCreate(Sender: TObject);
+const
+ NUM_ROWS = 100;
+ NUM_COLS = 20;
+var
+ r, c: Integer;
+begin
+ StringGrid1.BeginUpdate;
+ try
+ StringGrid1.Clear;
+ StringGrid1.RowCount := NUM_ROWS + StringGrid1.FixedRows;
+ StringGrid1.ColCount := NUM_COLS + StringGrid1.FixedCols;
+ for r := StringGrid1.FixedRows to StringGrid1.RowCount-1 do
+ StringGrid1.Cells[0, r] := 'Row ' + IntToStr(r);
+ for c := StringGrid1.FixedCols to StringGrid1.ColCount-1 do
+ begin
+ StringGrid1.Cells[c, 0] := 'Column ' + IntToStr(c);
+ for r := StringGrid1.FixedRows to StringGrid1.RowCount-1 do
+ StringGrid1.cells[c, r] := Format('C%d R%d', [c, r]);
+ end;
+ finally
+ StringGrid1.EndUpdate;
+ end;
+end;
+
+end.
+
diff --git a/components/gridprinter/examples/stringgrid/stringgrid_demo.lpi b/components/gridprinter/examples/stringgrid/stringgrid_demo.lpi
new file mode 100644
index 000000000..fdbf47029
--- /dev/null
+++ b/components/gridprinter/examples/stringgrid/stringgrid_demo.lpi
@@ -0,0 +1,92 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/gridprinter/examples/stringgrid/stringgrid_demo.lpr b/components/gridprinter/examples/stringgrid/stringgrid_demo.lpr
new file mode 100644
index 000000000..7ab5200a4
--- /dev/null
+++ b/components/gridprinter/examples/stringgrid/stringgrid_demo.lpr
@@ -0,0 +1,25 @@
+program stringgrid_demo;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF HASAMIGA}
+ athreads,
+ {$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, main, printer4lazarus
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Scaled:=True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/gridprinter/gridprinterpkg.lpk b/components/gridprinter/gridprinterpkg.lpk
new file mode 100644
index 000000000..600466b27
--- /dev/null
+++ b/components/gridprinter/gridprinterpkg.lpk
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/gridprinter/gridprinterpkg.pas b/components/gridprinter/gridprinterpkg.pas
new file mode 100644
index 000000000..b2971d9ec
--- /dev/null
+++ b/components/gridprinter/gridprinterpkg.pas
@@ -0,0 +1,23 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit GridPrinterPkg;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ GridPrnHeaderFooterForm, GridPrn, GridPrnPreviewForm, GridPrnReg,
+ GridPrnPreviewDlg, GridPrnStrings, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('GridPrnReg', @GridPrnReg.Register);
+end;
+
+initialization
+ RegisterPackage('GridPrinterPkg', @Register);
+end.
diff --git a/components/gridprinter/images/TGridPrintPreviewDialog.png b/components/gridprinter/images/TGridPrintPreviewDialog.png
new file mode 100644
index 000000000..0c78291cd
Binary files /dev/null and b/components/gridprinter/images/TGridPrintPreviewDialog.png differ
diff --git a/components/gridprinter/images/TGridPrintPreviewDialog_150.png b/components/gridprinter/images/TGridPrintPreviewDialog_150.png
new file mode 100644
index 000000000..de31324d5
Binary files /dev/null and b/components/gridprinter/images/TGridPrintPreviewDialog_150.png differ
diff --git a/components/gridprinter/images/TGridPrintPreviewDialog_200.png b/components/gridprinter/images/TGridPrintPreviewDialog_200.png
new file mode 100644
index 000000000..cfb5e5ef4
Binary files /dev/null and b/components/gridprinter/images/TGridPrintPreviewDialog_200.png differ
diff --git a/components/gridprinter/images/TGridPrinter.png b/components/gridprinter/images/TGridPrinter.png
new file mode 100644
index 000000000..4272ca4e8
Binary files /dev/null and b/components/gridprinter/images/TGridPrinter.png differ
diff --git a/components/gridprinter/images/TGridPrinter_150.png b/components/gridprinter/images/TGridPrinter_150.png
new file mode 100644
index 000000000..d5398b6f7
Binary files /dev/null and b/components/gridprinter/images/TGridPrinter_150.png differ
diff --git a/components/gridprinter/images/TGridPrinter_200.png b/components/gridprinter/images/TGridPrinter_200.png
new file mode 100644
index 000000000..baafade33
Binary files /dev/null and b/components/gridprinter/images/TGridPrinter_200.png differ
diff --git a/components/gridprinter/images/make_res.bat b/components/gridprinter/images/make_res.bat
new file mode 100644
index 000000000..6fd7f27e6
--- /dev/null
+++ b/components/gridprinter/images/make_res.bat
@@ -0,0 +1,3 @@
+dir /b *.png > imagelist.txt
+lazres ..\source\gridprinter_icons.res @imagelist.txt
+del /q imagelist.txt
diff --git a/components/gridprinter/languages/gridprnstrings.de.po b/components/gridprinter/languages/gridprnstrings.de.po
new file mode 100644
index 000000000..fa0414d7d
--- /dev/null
+++ b/components/gridprinter/languages/gridprnstrings.de.po
@@ -0,0 +1,181 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: GridPrinter\n"
+"POT-Creation-Date: \n"
+"PO-Revision-Date: \n"
+"Last-Translator: \n"
+"Language-Team: \n"
+"Language: de\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"X-Generator: Poedit 3.1.1\n"
+
+#: gridprnstrings.rsbottommargin
+msgid "Bottom margin"
+msgstr "Unterer Rand"
+
+#: gridprnstrings.rsclose
+msgid "Close"
+msgstr "Schließen"
+
+#: gridprnstrings.rsfont
+msgid "Font"
+msgstr "Schriftart"
+
+#: gridprnstrings.rsfooter
+msgid "Footer"
+msgstr "Fußzeile"
+
+#: gridprnstrings.rsfootermargin
+msgid "Footer margin"
+msgstr "Fußzeilen-Rand"
+
+#: gridprnstrings.rsheader
+msgid "Header"
+msgstr "Kopfzeile"
+
+#: gridprnstrings.rsheaderfooterconfig
+msgid "Header/footer configuration"
+msgstr "Kopf/Fußzeilen-Konfiguration"
+
+#: gridprnstrings.rsheaderfootersectionparameterinfo
+msgid ""
+"Each section can contain the following parameters:\n"
+" $DATE - Current date\n"
+" $TIME - Current time\n"
+" $PAGE - Page number\n"
+" $PAGECOUNT - Number of pages\n"
+" $FULL_FILENAME - Full name of the printed file\n"
+" $FILENAME - Name of the printed file, without path\n"
+" $PATH - Path of the printed file"
+msgstr ""
+"Jeder Abschnitt kann die folgenden Parameter enthalten\n"
+" $DATE - Aktuelles Datum\n"
+" $TIME - Aktuelle Uhrzeit\n"
+" $PAGE - Seitennummer\n"
+" $PAGECOUNT - Seitenanzahl\n"
+" $FULL_FILENAME - Voller Name der zu druckenden Datei\n"
+" $FILENAME - Name der zu druckenden Datei ohne Pfad\n"
+" $PATH - Pfad der zu druckenden Datei"
+
+#: gridprnstrings.rsheadermargin
+msgid "Header margin"
+msgstr "Kopfzeilen-Rand"
+
+#: gridprnstrings.rslandscapepageorientation
+msgid "Landscape page orientation"
+msgstr "Seite im Querformat"
+
+#: gridprnstrings.rsleftmargin
+msgid "Left margin"
+msgstr "Linker Rand"
+
+#: gridprnstrings.rslinecolor
+msgid "Line color"
+msgstr "Linienfarbe"
+
+#: gridprnstrings.rslinewidthmm
+msgid "Line width (mm)"
+msgstr "Linienbreite (mm)"
+
+#: gridprnstrings.rsoriginalsize
+msgid "Original size (100%)"
+msgstr "Originalgröße (100%)"
+
+#: gridprnstrings.rspageandzoominfo
+#, object-pascal-format
+msgid "Page %d of %d, Zoom %d %%"
+msgstr "Seite %d von %d, Skalierung %d %%"
+
+#: gridprnstrings.rspagemarginsconfig
+msgid "Page margins configuration"
+msgstr "Einstellung der Seitenränder"
+
+#: gridprnstrings.rsportraitpageorientation
+msgid "Portrait page orientation"
+msgstr "Seite im Hochformat"
+
+#: gridprnstrings.rsprint
+msgid "Print"
+msgstr "Drucken"
+
+#: gridprnstrings.rsprintcolsfirst
+msgid ""
+"First print columns from top to bottom,\n"
+"then print from left to right"
+msgstr ""
+"Seiten zuerst entlang der Spalten von oben nach unten,\n"
+"dann von links nach rechts drucken"
+
+#: gridprnstrings.rsprintpreview
+msgid "Print Preview"
+msgstr "Druckvorschau"
+
+#: gridprnstrings.rsprintrowsfirst
+msgid ""
+"First print rows from left to right,\n"
+"then print from top to bottom"
+msgstr ""
+"Seiten zuerst entlang der Zeilen von links nach rechts,\n"
+"dann von oben nach unten drucken"
+
+#: gridprnstrings.rsrightmargin
+msgid "Right margin"
+msgstr "Rechter Rand"
+
+#: gridprnstrings.rsshow
+msgid "Show"
+msgstr "Anzeigen"
+
+#: gridprnstrings.rsshowdividingline
+msgid "Show dividing line"
+msgstr "Trennlinie anzeigen"
+
+#: gridprnstrings.rsshowfirstpage
+msgid "Show first page"
+msgstr "Erste Seite anzeigen"
+
+#: gridprnstrings.rsshowlastpage
+msgid "Show last page"
+msgstr "Letzte Seite anzeigen"
+
+#: gridprnstrings.rsshownextpage
+msgid "Show next page"
+msgstr "Nächste Seite anzeigen"
+
+#: gridprnstrings.rsshowprevpage
+msgid "Show previous page"
+msgstr "Vorige Seite anzeigen"
+
+#: gridprnstrings.rstextincenteredsection
+msgid "Text in centered section"
+msgstr "Zentrierter Text"
+
+#: gridprnstrings.rstextinleftalignedsection
+msgid "Text in left-aligned section"
+msgstr "Linksbündiger Text"
+
+#: gridprnstrings.rstextinrightalignedsection
+msgid "Text in right-aligned section"
+msgstr "Rechtsbündiger Text"
+
+#: gridprnstrings.rstopmargin
+msgid "Top margin"
+msgstr "Oberer Rand"
+
+#: gridprnstrings.rszoomin
+msgid "Zoom in"
+msgstr "Vergrößern"
+
+#: gridprnstrings.rszoomout
+msgid "Zoom out"
+msgstr "Verkleinern"
+
+#: gridprnstrings.rszoomtofitpageheight
+msgid "Zoom to fit page height"
+msgstr "Vergrößerung auf Seitenbreite einstellen"
+
+#: gridprnstrings.rszoomtofitpagewidth
+msgid "Zoom to fit page width"
+msgstr "Vergrößerung auf Seitenhöhe einstellen"
diff --git a/components/gridprinter/languages/gridprnstrings.en.po b/components/gridprinter/languages/gridprnstrings.en.po
new file mode 100644
index 000000000..70bb0c575
--- /dev/null
+++ b/components/gridprinter/languages/gridprnstrings.en.po
@@ -0,0 +1,181 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: GridPrinter\n"
+"POT-Creation-Date: \n"
+"PO-Revision-Date: \n"
+"Last-Translator: \n"
+"Language-Team: \n"
+"Language: en\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"X-Generator: Poedit 3.1.1\n"
+
+#: gridprnstrings.rsbottommargin
+msgid "Bottom margin"
+msgstr "Bottom margin"
+
+#: gridprnstrings.rsclose
+msgid "Close"
+msgstr "Close"
+
+#: gridprnstrings.rsfont
+msgid "Font"
+msgstr "Font"
+
+#: gridprnstrings.rsfooter
+msgid "Footer"
+msgstr "Footer"
+
+#: gridprnstrings.rsfootermargin
+msgid "Footer margin"
+msgstr "Footer margin"
+
+#: gridprnstrings.rsheader
+msgid "Header"
+msgstr "Header"
+
+#: gridprnstrings.rsheaderfooterconfig
+msgid "Header/footer configuration"
+msgstr "Header/footer configuration"
+
+#: gridprnstrings.rsheaderfootersectionparameterinfo
+msgid ""
+"Each section can contain the following parameters:\n"
+" $DATE - Current date\n"
+" $TIME - Current time\n"
+" $PAGE - Page number\n"
+" $PAGECOUNT - Number of pages\n"
+" $FULL_FILENAME - Full name of the printed file\n"
+" $FILENAME - Name of the printed file, without path\n"
+" $PATH - Path of the printed file"
+msgstr ""
+"Each section can contain the following parameters:\n"
+" $DATE - Current date\n"
+" $TIME - Current time\n"
+" $PAGE - Page number\n"
+" $PAGECOUNT - Number of pages\n"
+" $FULL_FILENAME - Full name of the printed file\n"
+" $FILENAME - Name of the printed file, without path\n"
+" $PATH - Path of the printed file"
+
+#: gridprnstrings.rsheadermargin
+msgid "Header margin"
+msgstr "Header margin"
+
+#: gridprnstrings.rslandscapepageorientation
+msgid "Landscape page orientation"
+msgstr "Landscape page orientation"
+
+#: gridprnstrings.rsleftmargin
+msgid "Left margin"
+msgstr "Left margin"
+
+#: gridprnstrings.rslinecolor
+msgid "Line color"
+msgstr "Line color"
+
+#: gridprnstrings.rslinewidthmm
+msgid "Line width (mm)"
+msgstr "Line width (mm)"
+
+#: gridprnstrings.rsoriginalsize
+msgid "Original size (100%)"
+msgstr "Original size (100%)"
+
+#: gridprnstrings.rspageandzoominfo
+#, object-pascal-format
+msgid "Page %d of %d, Zoom %d %%"
+msgstr "Page %d of %d, Zoom %d %%"
+
+#: gridprnstrings.rspagemarginsconfig
+msgid "Page margins configuration"
+msgstr "Page margins configuration"
+
+#: gridprnstrings.rsportraitpageorientation
+msgid "Portrait page orientation"
+msgstr "Portrait page orientation"
+
+#: gridprnstrings.rsprint
+msgid "Print"
+msgstr "Print"
+
+#: gridprnstrings.rsprintcolsfirst
+msgid ""
+"First print columns from top to bottom,\n"
+"then print from left to right"
+msgstr ""
+"First print columns from top to bottom,\n"
+"then print from left to right"
+
+#: gridprnstrings.rsprintpreview
+msgid "Print Preview"
+msgstr "Print Preview"
+
+#: gridprnstrings.rsprintrowsfirst
+msgid ""
+"First print rows from left to right,\n"
+"then print from top to bottom"
+msgstr ""
+"First print rows from left to right,\n"
+"then print from top to bottom"
+
+#: gridprnstrings.rsrightmargin
+msgid "Right margin"
+msgstr "Right margin"
+
+#: gridprnstrings.rsshow
+msgid "Show"
+msgstr "Show"
+
+#: gridprnstrings.rsshowdividingline
+msgid "Show dividing line"
+msgstr "Show dividing line"
+
+#: gridprnstrings.rsshowfirstpage
+msgid "Show first page"
+msgstr "Show first page"
+
+#: gridprnstrings.rsshowlastpage
+msgid "Show last page"
+msgstr "Show last page"
+
+#: gridprnstrings.rsshownextpage
+msgid "Show next page"
+msgstr "Show next page"
+
+#: gridprnstrings.rsshowprevpage
+msgid "Show previous page"
+msgstr "Show previous page"
+
+#: gridprnstrings.rstextincenteredsection
+msgid "Text in centered section"
+msgstr "Text in centered section"
+
+#: gridprnstrings.rstextinleftalignedsection
+msgid "Text in left-aligned section"
+msgstr "Text in left-aligned section"
+
+#: gridprnstrings.rstextinrightalignedsection
+msgid "Text in right-aligned section"
+msgstr "Text in right-aligned section"
+
+#: gridprnstrings.rstopmargin
+msgid "Top margin"
+msgstr "Top margin"
+
+#: gridprnstrings.rszoomin
+msgid "Zoom in"
+msgstr "Zoom in"
+
+#: gridprnstrings.rszoomout
+msgid "Zoom out"
+msgstr "Zoom out"
+
+#: gridprnstrings.rszoomtofitpageheight
+msgid "Zoom to fit page height"
+msgstr "Zoom to fit page height"
+
+#: gridprnstrings.rszoomtofitpagewidth
+msgid "Zoom to fit page width"
+msgstr "Zoom to fit page width"
diff --git a/components/gridprinter/languages/gridprnstrings.pot b/components/gridprinter/languages/gridprnstrings.pot
new file mode 100644
index 000000000..a05a52a04
--- /dev/null
+++ b/components/gridprinter/languages/gridprnstrings.pot
@@ -0,0 +1,160 @@
+msgid ""
+msgstr "Content-Type: text/plain; charset=UTF-8"
+
+#: gridprnstrings.rsbottommargin
+msgid "Bottom margin"
+msgstr ""
+
+#: gridprnstrings.rsclose
+msgid "Close"
+msgstr ""
+
+#: gridprnstrings.rsfont
+msgid "Font"
+msgstr ""
+
+#: gridprnstrings.rsfooter
+msgid "Footer"
+msgstr ""
+
+#: gridprnstrings.rsfootermargin
+msgid "Footer margin"
+msgstr ""
+
+#: gridprnstrings.rsheader
+msgid "Header"
+msgstr ""
+
+#: gridprnstrings.rsheaderfooterconfig
+msgid "Header/footer configuration"
+msgstr ""
+
+#: gridprnstrings.rsheaderfootersectionparameterinfo
+msgid ""
+"Each section can contain the following parameters:\n"
+" $DATE - Current date\n"
+" $TIME - Current time\n"
+" $PAGE - Page number\n"
+" $PAGECOUNT - Number of pages\n"
+" $FULL_FILENAME - Full name of the printed file\n"
+" $FILENAME - Name of the printed file, without path\n"
+" $PATH - Path of the printed file"
+msgstr ""
+
+#: gridprnstrings.rsheadermargin
+msgid "Header margin"
+msgstr ""
+
+#: gridprnstrings.rslandscapepageorientation
+msgid "Landscape page orientation"
+msgstr ""
+
+#: gridprnstrings.rsleftmargin
+msgid "Left margin"
+msgstr ""
+
+#: gridprnstrings.rslinecolor
+msgid "Line color"
+msgstr ""
+
+#: gridprnstrings.rslinewidthmm
+msgid "Line width (mm)"
+msgstr ""
+
+#: gridprnstrings.rsoriginalsize
+msgid "Original size (100%)"
+msgstr ""
+
+#: gridprnstrings.rspageandzoominfo
+#, object-pascal-format
+msgid "Page %d of %d, Zoom %d %%"
+msgstr ""
+
+#: gridprnstrings.rspagemarginsconfig
+msgid "Page margins configuration"
+msgstr ""
+
+#: gridprnstrings.rsportraitpageorientation
+msgid "Portrait page orientation"
+msgstr ""
+
+#: gridprnstrings.rsprint
+msgid "Print"
+msgstr ""
+
+#: gridprnstrings.rsprintcolsfirst
+msgid ""
+"First print columns from top to bottom,\n"
+"then print from left to right"
+msgstr ""
+
+#: gridprnstrings.rsprintpreview
+msgid "Print Preview"
+msgstr ""
+
+#: gridprnstrings.rsprintrowsfirst
+msgid ""
+"First print rows from left to right,\n"
+"then print from top to bottom"
+msgstr ""
+
+#: gridprnstrings.rsrightmargin
+msgid "Right margin"
+msgstr ""
+
+#: gridprnstrings.rsshow
+msgid "Show"
+msgstr ""
+
+#: gridprnstrings.rsshowdividingline
+msgid "Show dividing line"
+msgstr ""
+
+#: gridprnstrings.rsshowfirstpage
+msgid "Show first page"
+msgstr ""
+
+#: gridprnstrings.rsshowlastpage
+msgid "Show last page"
+msgstr ""
+
+#: gridprnstrings.rsshownextpage
+msgid "Show next page"
+msgstr ""
+
+#: gridprnstrings.rsshowprevpage
+msgid "Show previous page"
+msgstr ""
+
+#: gridprnstrings.rstextincenteredsection
+msgid "Text in centered section"
+msgstr ""
+
+#: gridprnstrings.rstextinleftalignedsection
+msgid "Text in left-aligned section"
+msgstr ""
+
+#: gridprnstrings.rstextinrightalignedsection
+msgid "Text in right-aligned section"
+msgstr ""
+
+#: gridprnstrings.rstopmargin
+msgid "Top margin"
+msgstr ""
+
+#: gridprnstrings.rszoomin
+msgid "Zoom in"
+msgstr ""
+
+#: gridprnstrings.rszoomout
+msgid "Zoom out"
+msgstr ""
+
+#: gridprnstrings.rszoomtofitpageheight
+msgid "Zoom to fit page height"
+msgstr ""
+
+#: gridprnstrings.rszoomtofitpagewidth
+msgid "Zoom to fit page width"
+msgstr ""
+
diff --git a/components/gridprinter/languages/multilanguage_demo.de.po b/components/gridprinter/languages/multilanguage_demo.de.po
new file mode 100644
index 000000000..7a98e6423
--- /dev/null
+++ b/components/gridprinter/languages/multilanguage_demo.de.po
@@ -0,0 +1,69 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: \n"
+"POT-Creation-Date: \n"
+"PO-Revision-Date: \n"
+"Last-Translator: \n"
+"Language-Team: \n"
+"Language: de\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"X-Generator: Poedit 3.1.1\n"
+
+#: main.rsheaderfooterbutton
+msgid "Header/footer button"
+msgstr "Schalter für Kopf-/Fußzeile"
+
+#: main.rsnavigationbuttons
+msgid "Navigation buttons"
+msgstr "Seitenwahl-Schalter"
+
+#: main.rsnavigationedit
+msgid "Navigation edit"
+msgstr "Eingabe der Seitennummer"
+
+#: main.rsnoprinterdialog
+msgid "No printer dialog"
+msgstr "Kein Dialog"
+
+#: main.rspagemarginsbuttons
+msgid "Page margins button"
+msgstr "Schalter für Seitenränder"
+
+#: main.rspageorientationbuttons
+msgid "Page orientation buttons"
+msgstr "Schalter für Seitenausrichtung"
+
+#: main.rspagesetupdialog
+msgid "Page-setup dialog"
+msgstr "Seiteneinrichtungs-Dialog"
+
+#: main.rsprinterdialog
+msgid "Printer dialog"
+msgstr "Drucker-Dialog"
+
+#: main.rsprintorderbuttons
+msgid "Print order: colums first or rows first"
+msgstr "Druckreihenfolge: Spalten oder Zeilen zuerst"
+
+#: main.rszoombuttons
+msgid "Zoom buttons"
+msgstr "Schalter für Vergrößerung"
+
+#: tmainform.btnpreview.caption
+msgid "Preview..."
+msgstr "Druckvorschau..."
+
+#: tmainform.btnprint.caption
+msgid "Print..."
+msgstr "Drucken..."
+
+#: tmainform.caption
+msgid "Multi-Language Demonstration of TGridPrinter"
+msgstr "Mehrsprachige Demonstration von TGridPrinter"
+
+#: tmainform.label1.caption
+msgid "Language:"
+msgstr "Sprache:"
+
diff --git a/components/gridprinter/languages/multilanguage_demo.en.po b/components/gridprinter/languages/multilanguage_demo.en.po
new file mode 100644
index 000000000..b3a29c65f
--- /dev/null
+++ b/components/gridprinter/languages/multilanguage_demo.en.po
@@ -0,0 +1,69 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: \n"
+"POT-Creation-Date: \n"
+"PO-Revision-Date: \n"
+"Last-Translator: \n"
+"Language-Team: \n"
+"Language: en\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"X-Generator: Poedit 3.1.1\n"
+
+#: main.rsheaderfooterbutton
+msgid "Header/footer button"
+msgstr "Header/footer button"
+
+#: main.rsnavigationbuttons
+msgid "Navigation buttons"
+msgstr "Navigation buttons"
+
+#: main.rsnavigationedit
+msgid "Navigation edit"
+msgstr "Navigation edit"
+
+#: main.rsnoprinterdialog
+msgid "No printer dialog"
+msgstr "No printer dialog"
+
+#: main.rspagemarginsbuttons
+msgid "Page margins button"
+msgstr "Page margins button"
+
+#: main.rspageorientationbuttons
+msgid "Page orientation buttons"
+msgstr "Page orientation buttons"
+
+#: main.rspagesetupdialog
+msgid "Page-setup dialog"
+msgstr "Page-setup dialog"
+
+#: main.rsprinterdialog
+msgid "Printer dialog"
+msgstr "Printer dialog"
+
+#: main.rsprintorderbuttons
+msgid "Print order: colums first or rows first"
+msgstr "Print order: colums first or rows first"
+
+#: main.rszoombuttons
+msgid "Zoom buttons"
+msgstr "Zoom buttons"
+
+#: tmainform.btnpreview.caption
+msgid "Preview..."
+msgstr "Preview..."
+
+#: tmainform.btnprint.caption
+msgid "Print..."
+msgstr "Print..."
+
+#: tmainform.caption
+msgid "Multi-Language Demonstration of TGridPrinter"
+msgstr "Multi-Language Demonstration of TGridPrinter"
+
+#: tmainform.label1.caption
+msgid "Language:"
+msgstr "Language:"
+
diff --git a/components/gridprinter/languages/multilanguage_demo.pot b/components/gridprinter/languages/multilanguage_demo.pot
new file mode 100644
index 000000000..939c8b8ae
--- /dev/null
+++ b/components/gridprinter/languages/multilanguage_demo.pot
@@ -0,0 +1,59 @@
+msgid ""
+msgstr "Content-Type: text/plain; charset=UTF-8"
+
+#: main.rsheaderfooterbutton
+msgid "Header/footer button"
+msgstr ""
+
+#: main.rsnavigationbuttons
+msgid "Navigation buttons"
+msgstr ""
+
+#: main.rsnavigationedit
+msgid "Navigation edit"
+msgstr ""
+
+#: main.rsnoprinterdialog
+msgid "No printer dialog"
+msgstr ""
+
+#: main.rspagemarginsbuttons
+msgid "Page margins button"
+msgstr ""
+
+#: main.rspageorientationbuttons
+msgid "Page orientation buttons"
+msgstr ""
+
+#: main.rspagesetupdialog
+msgid "Page-setup dialog"
+msgstr ""
+
+#: main.rsprinterdialog
+msgid "Printer dialog"
+msgstr ""
+
+#: main.rsprintorderbuttons
+msgid "Print order: colums first or rows first"
+msgstr ""
+
+#: main.rszoombuttons
+msgid "Zoom buttons"
+msgstr ""
+
+#: tmainform.btnpreview.caption
+msgid "Preview..."
+msgstr ""
+
+#: tmainform.btnprint.caption
+msgid "Print..."
+msgstr ""
+
+#: tmainform.caption
+msgid "Multi-Language Demonstration of TGridPrinter"
+msgstr ""
+
+#: tmainform.label1.caption
+msgid "Language:"
+msgstr ""
+
diff --git a/components/gridprinter/source/gridprinter_icons.res b/components/gridprinter/source/gridprinter_icons.res
new file mode 100644
index 000000000..a93f1659c
Binary files /dev/null and b/components/gridprinter/source/gridprinter_icons.res differ
diff --git a/components/gridprinter/source/gridprn.pas b/components/gridprinter/source/gridprn.pas
new file mode 100644
index 000000000..e3f3dae4c
--- /dev/null
+++ b/components/gridprinter/source/gridprn.pas
@@ -0,0 +1,1638 @@
+unit GridPrn;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Types, Graphics, StdCtrls, Grids, Printers, PrintersDlgs;
+
+type
+ TGridPrinter = class; // forward declaration
+
+ TGridPrnDialog = (gpdNone, gpdPageSetup, gpdPrintDialog);
+
+ TGridPrnGetCellTextEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
+ ACol, ARow: Integer; var AText: String) of object;
+
+ TGridPrnGetColCountEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
+ var AColCount: Integer) of object;
+
+ TGridPrnGetRowCountEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
+ var ARowCount: Integer) of object;
+
+ TGridPrnHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight);
+
+ TGridPrnOrder = (poRowsFirst, poColsFirst);
+
+ TGridPrnOutputDevice = (odPrinter, odPreview);
+
+ TGridPrnMargins = class(TPersistent)
+ private
+ FMargins: array[0..5] of Double;
+ FOwner: TGridPrinter;
+ function GetMargin(AIndex: Integer): Double;
+ function IsStoredMargin(AIndex: Integer): Boolean;
+ procedure SetMargin(AIndex: Integer; AValue: Double);
+ protected
+ procedure Changed;
+ public
+ constructor Create(AOwner: TGridPrinter);
+ published
+ property Left: Double index 0 read GetMargin write SetMargin stored IsStoredMargin;
+ property Top: Double index 1 read GetMargin write SetMargin stored IsStoredMargin;
+ property Right: Double index 2 read GetMargin write SetMargin stored IsStoredMargin;
+ property Bottom: Double index 3 read GetMargin write SetMargin stored IsStoredMargin;
+ property Header: Double index 4 read GetMargin write SetMargin stored IsStoredMargin;
+ property Footer: Double index 5 read GetMargin write SetMargin stored IsStoredMargin;
+ end;
+
+ TGridPrnHeaderFooter = class(TPersistent)
+ private
+ FFont: TFont;
+ FLineColor: TColor;
+ FLineWidth: Double;
+ FShowLine: Boolean;
+ FOwner: TGridPrinter;
+ FSectionSeparator: String;
+ FSectionText: array[TGridPrnHeaderFooterSection] of string;
+ FVisible: Boolean;
+ function GetProcessedText(AIndex: TGridPrnHeaderFooterSection): String;
+ function GetSectionText(AIndex: TGridPrnHeaderFooterSection): String;
+ function GetText: String;
+ function IsLineWidthStored: Boolean;
+ function IsSectionSepStored: Boolean;
+ function IsTextStored: Boolean;
+ procedure SetFont(AValue: TFont);
+ procedure SetLineColor(AValue: TColor);
+ procedure SetLineWidth(AValue: Double);
+ procedure SetSectionText(AIndex: TGridPrnHeaderFooterSection; AValue: String);
+ procedure SetShowLine(AValue: Boolean);
+ procedure SetText(AValue: String);
+ procedure SetVisible(AValue: Boolean);
+ protected
+ procedure Changed(Sender: TObject);
+ public
+ constructor Create(AOwner: TGridPrinter);
+ destructor Destroy; override;
+ function IsShown: Boolean;
+ function IsTextEmpty: Boolean;
+ function RealLineColor: TColor;
+ function RealLineWidth: Integer;
+ property ProcessedText[AIndex: TGridPrnHeaderFooterSection]: String read GetProcessedText;
+ property SectionText[AIndex: TGridPrnHeaderFooterSection]: String read GetSectionText;
+ published
+ property Font: TFont read FFont write SetFont;
+ property LineColor: TColor read FLineColor write SetLineColor default clDefault;
+ property LineWidth: Double read FLineWidth write SetLineWidth stored IsLineWidthStored;
+ property SectionSeparator: String read FSectionSeparator write FSectionSeparator stored IsSectionSepStored;
+ property ShowLine: Boolean read FShowLine write SetShowLine default true;
+ property Text: String read GetText write SetText stored IsTextStored;
+ property Visible: Boolean read FVisible write SetVisible default true;
+ end;
+
+
+ { TGridPrinter }
+
+ TGridPrinter = class(TComponent)
+ private
+ FBorderLineColor: Integer;
+ FBorderLineWidth: Double;
+ FFixedLineColor: TColor;
+ FFixedLineWidth: Double;
+ FFromPage: Integer;
+ FGrid: TCustomGrid;
+ FGridLineColor: TColor;
+ FGridLineWidth: Double;
+ FHeader: TGridPrnHeaderFooter;
+ FFileName: String; // to be used by header/footer
+ FFooter: TGridPrnHeaderFooter;
+ FMargins: TGridPrnMargins;
+ FMonochrome: Boolean;
+ FPadding: Integer;
+ FPageHeight: Integer;
+ FPageWidth: Integer;
+ FPrintDialogs: TGridPrnDialog;
+ FPrintOrder: TGridPrnOrder;
+ FToPage: Integer;
+ FOnAfterPrint: TNotifyEvent;
+ FOnBeforePrint: TNotifyEvent;
+ FOnGetCellText: TGridPrnGetCellTextEvent;
+ FOnGetColCount: TGridPrnGetColCountEvent;
+ FOnGetRowCount: TGridPrnGetRowCountEvent;
+ FOnPrepareCanvas: TOnPrepareCanvasEvent;
+ FOnUpdatePreview: TNotifyEvent;
+ function GetBorderLineWidthHor: Integer;
+ function GetBorderLineWidthVert: Integer;
+ function GetCanvas: TCanvas;
+ function GetFixedLineWidthHor: Integer;
+ function GetFixedLineWidthVert: Integer;
+ function GetGridLineWidthHor: Integer;
+ function GetGridLineWidthVert: Integer;
+ function GetOrientation: TPrinterOrientation;
+ function GetPageCount: Integer;
+ function GetPageNumber: Integer;
+ function IsBorderLineWidthStored: Boolean;
+ function IsFixedLineWidthStored: Boolean;
+ function IsGridLineWidthStored: Boolean;
+ procedure SetBorderLineColor(AValue: TColor);
+ procedure SetBorderLineWidth(AValue: Double);
+ procedure SetFileName(AValue: String);
+ procedure SetFixedLineColor(AValue: TColor);
+ procedure SetFixedLineWidth(AValue: Double);
+ procedure SetGrid(AValue: TCustomGrid);
+ procedure SetGridLineColor(AValue: TColor);
+ procedure SetGridLineWidth(AValue: Double);
+ procedure SetOrientation(AValue: TPrinterOrientation);
+ protected
+ FFactorX: Double; // Multiply to convert screen to printer/preview pixels
+ FFactorY: Double;
+ FLeftMargin: Integer; // Scaled page margins
+ FTopMargin: Integer;
+ FRightMargin: Integer;
+ FBottomMargin: Integer;
+ FHeaderMargin: Integer;
+ FFooterMargin: Integer;
+ FColWidths: array of Double; // Array of scaled grid column widts
+ FRowHeights: array of Double; // Array of scaled grid row heights
+ FFixedColPos: Integer; // Scaled right end of the fixed cols
+ FFixedRowPos: Integer; // Scaled bottom end of the fixed rows
+ FOutputDevice: TGridPrnOutputDevice;
+ FPageBreakRows: array of Integer; // Indices of first row on new page
+ FPageBreakCols: array of Integer; // Indices of first columns on new page
+ FPageNumber: Integer;
+ FPageCount: Integer;
+ FPageRect: TRect; // Bounds of printable rectangle
+ FPixelsPerInchX: Integer;
+ FPixelsPerInchY: Integer;
+ FPreviewBitmap: TBitmap; // Bitmap to which the preview image is printed
+ FPreviewPage: Integer; // Page request for the preview bitmap
+ FPreviewPercent: Integer; // Scaling factor for preview bitmap
+ FColCount: Integer;
+ FRowCount: Integer;
+ FFixedCols: Integer;
+ FFixedRows: Integer;
+ FPrinting: Boolean;
+ procedure DoPrepareCanvas(ACol, ARow: Integer); virtual;
+ procedure DoUpdatePreview; virtual;
+ procedure Execute(ACanvas: TCanvas);
+ procedure LayoutPagebreaks;
+ procedure Measure(APageWidth, APageHeight, XDpi, YDpi: Integer);
+ procedure NewPage;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure Prepare;
+ procedure PrepareCanvas(ACanvas: TCanvas; ACol, ARow: Integer); virtual;
+ procedure PrintByCols(ACanvas: TCanvas);
+ procedure PrintByRows(ACanvas: TCanvas);
+ procedure PrintCell(ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect); virtual;
+ procedure PrintCheckbox(ACanvas: TCanvas; {%H-}ACol, {%H-}ARow: Integer; ARect: TRect;
+ ACheckState: TCheckboxstate); virtual;
+ procedure PrintColHeaders(ACanvas: TCanvas; ACol1, ACol2: Integer);
+ procedure PrintFooter(ACanvas: TCanvas);
+ procedure PrintHeader(ACanvas: TCanvas);
+ procedure PrintGridLines(ACanvas: TCanvas; AFirstCol, AFirstRow, XEnd, YEnd: Integer);
+ procedure PrintPage(ACanvas: TCanvas; AStartCol, AStartRow, AEndCol, AEndRow: Integer);
+ procedure PrintRowHeader(ACanvas: TCanvas; ARow: Integer; Y: Double);
+ procedure ScaleColWidths(AFactor: Double);
+ procedure ScaleRowHeights(AFactor: Double);
+ procedure SelectFont(ACanvas: TCanvas; AFont: TFont);
+ property OutputDevice: TGridPrnOutputDevice read FOutputDevice;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function CreatePreviewBitmap(APageNo, APercentage: Integer): TBitmap;
+ function GetCellText(ACol, ARow: Integer): String; virtual;
+ procedure Print;
+ function ScaleX(AValue: Integer): Integer; inline;
+ function ScaleY(AValue: Integer): Integer; inline;
+ procedure UpdatePreview;
+ property Canvas: TCanvas read GetCanvas;
+ property FooterMargin: Integer read FFooterMargin;
+ property HeaderMargin: Integer read FHeaderMargin;
+ property PageHeight: Integer read FPageHeight;
+ property PageWidth: Integer read FPageWidth;
+ property PageRect: TRect read FPageRect;
+ property PixelsPerInchX: Integer read FPixelsPerInchX;
+ property PixelsPerInchY: Integer read FPixelsPerInchY;
+ property PageCount: Integer read GetPageCount;
+ property PageNumber: Integer read FPageNumber;
+ published
+ property Grid: TCustomGrid read FGrid write SetGrid;
+ property BorderLineColor: TColor read FBorderLineColor write SetBorderLineColor default clDefault;
+ property BorderLineWidth: Double read FBorderLineWidth write SetBorderLineWidth stored IsBorderLineWidthStored;
+ property FileName: String read FFileName write SetFileName;
+ property FixedLineColor: TColor read FFixedLineColor write SetFixedLineColor default clDefault;
+ property FixedLineWidth: Double read FFixedLineWidth write SetFixedLineWidth stored IsFixedLineWidthStored;
+ property Footer: TGridPrnHeaderFooter read FFooter write FFooter;
+ property FromPage: Integer read FFromPage write FFromPage default 0;
+ property GridLineColor: TColor read FGridLineColor write SetGridLineColor default clDefault;
+ property GridLineWidth: Double read FGridLineWidth write SetGridLineWidth stored IsGridLineWidthStored;
+ property Header: TGridPrnHeaderFooter read FHeader write FHeader;
+ property Margins: TGridPrnMargins read FMargins write FMargins;
+ property Monochrome: Boolean read FMonochrome write FMonochrome default false;
+ property Orientation: TPrinterOrientation read GetOrientation write SetOrientation default poPortrait;
+ property PrintDialogs: TGridPrnDialog read FPrintDialogs write FPrintDialogs default gpdNone;
+ property PrintOrder: TGridPrnOrder read FPrintOrder write FPrintOrder default poRowsFirst;
+ property ToPage: Integer read FToPage write FToPage default 0;
+ property OnAfterPrint: TNotifyEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforePrint: TNotifyEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnGetCellText: TGridPrnGetCellTextEvent read FOnGetCellText write FOnGetCellText;
+ property OnGetRowCount: TGridPrnGetRowCountEvent read FOnGetRowCount write FOnGetRowCount;
+ property OnGetColCount: TGridPrnGetColCountEvent read FOnGetColCount write FOnGetColCount;
+ property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
+ property OnUpdatePreview: TNotifyEvent read FOnUpdatePreview write FOnUpdatePreview;
+ end;
+
+function mm2px(mm: Double; dpi: Integer): Integer;
+function px2mm(px: Integer; dpi: Integer): Double;
+
+implementation
+
+uses
+ LCLIntf, LCLType, Dialogs, OSPrinters, Themes;
+
+type
+ TGridAccess = class(TCustomGrid);
+
+const
+ INCH = 25.4; // 1" = 25.4 mm
+
+ DefaultTextStyle: TTextStyle = (
+ Alignment: taLeftJustify;
+ Layout: tlCenter;
+ SingleLine: true;
+ Clipping: true;
+ ExpandTabs: false;
+ ShowPrefix: false;
+ WordBreak: false;
+ Opaque: false;
+ SystemFont: false;
+ RightToLeft: false;
+ EndEllipsis: false
+ );
+
+function IfThen(cond: Boolean; a, b: Integer): Integer;
+begin
+ if cond then Result := a else Result := b;
+end;
+
+function IfThen(cond: Boolean; a, b: TColor): TColor;
+begin
+ if cond then Result := a else Result := b;
+end;
+
+function DefaultFontSize(AFont: TFont): Integer;
+var
+ fontData: TFontData;
+begin
+ fontData := GetFontData(AFont.Handle);
+ Result := abs(fontData.Height) * 72 div ScreenInfo.PixelsPerInchY;
+end;
+
+procedure FixFontSize(AFont: TFont);
+begin
+ if AFont.Size = 0 then
+ AFont.Size := DefaultFontSize(AFont);
+end;
+
+function mm2px(mm: Double; dpi: Integer): Integer;
+begin
+ Result := round(mm/INCH * dpi);
+end;
+
+function px2mm(px: Integer; dpi: Integer): Double;
+begin
+ Result := px * INCH / dpi;
+end;
+
+
+{ TGridPrnMargins }
+
+constructor TGridPrnMargins.Create(AOwner: TGridPrinter);
+var
+ i: Integer;
+begin
+ inherited Create;
+ FOwner := AOwner;
+ for i := 0 to 3 do FMargins[i] := 20.0;
+ for i := 4 to 5 do FMargins[i] := 10.0;
+end;
+
+procedure TGridPrnMargins.Changed;
+begin
+ if (FOwner <> nil) then
+ FOwner.UpdatePreview;
+end;
+
+function TGridPrnMargins.GetMargin(AIndex: Integer): Double;
+begin
+ Result := FMargins[AIndex];
+end;
+
+function TGridPrnMargins.IsStoredMargin(AIndex: Integer): Boolean;
+begin
+ case AIndex of
+ 0..3: Result := FMargins[AIndex] <> 20.0;
+ 4..5: Result := FMargins[AIndex] <> 10.0;
+ end;
+end;
+
+procedure TGridPrnMargins.SetMargin(AIndex: Integer; AValue: Double);
+begin
+ if FMargins[AIndex] <> AValue then
+ begin
+ FMargins[AIndex] := AValue;
+ Changed;
+ end;
+end;
+
+
+{ TGridPrnHeaderFooter }
+
+constructor TGridPrnHeaderFooter.Create(AOwner: TGridPrinter);
+begin
+ inherited Create;
+ FOwner := AOwner;
+
+ FSectionSeparator := '|';
+
+ FFont := TFont.Create;
+ FixFontSize(FFont);
+ FFont.Size := FFont.Size - 1;
+ FFont.OnChange := @Changed;
+
+ FLineColor := clDefault;
+ FLineWidth := 0;
+ FShowLine := true;
+ FVisible := true;
+end;
+
+destructor TGridPrnHeaderFooter.Destroy;
+begin
+ FFont.Free;
+ inherited;
+end;
+
+procedure TGridPrnHeaderFooter.Changed(Sender: TObject);
+begin
+ if (FOwner <> nil) then
+ FOwner.UpdatePreview;
+end;
+
+function TGridPrnHeaderFooter.GetProcessedText(AIndex: TGridPrnHeaderFooterSection): String;
+const
+ UNKNOWN = '';
+
+ procedure Replace(AParam: String);
+ var
+ s: String;
+ begin
+ if FOwner <> nil then
+ case AParam of
+ '$PAGECOUNT': s := IntToStr(FOwner.PageCount);
+ '$PAGE': s := IntToStr(FOwner.PageNumber);
+ '$FULL_FILENAME': s := ExpandFileName(FOwner.FileName);
+ '$FILENAME': s := ExtractFileName(FOwner.FileName);
+ '$PATH': s := ExtractFilePath(ExpandFileName(FOwner.FileName));
+ end
+ else
+ s := UNKNOWN;
+ Result := StringReplace(Result, AParam, s, [rfReplaceAll, rfIgnoreCase]);
+ end;
+
+ begin
+ Result := FSectionText[AIndex];
+ Result := StringReplace(Result, '$DATE', DateToStr(Now), [rfReplaceAll, rfIgnoreCase]);
+ Result := StringReplace(Result, '$TIME', TimeToStr(Now), [rfReplaceAll, rfIgnoreCase]);
+ Replace('$PAGECOUNT');
+ Replace('$PAGE');
+ Replace('$FULL_FILENAME');
+ Replace('$FILENAME');
+ Replace('$PATH');
+end;
+
+function TGridPrnHeaderFooter.GetSectionText(AIndex: TGridPrnHeaderFooterSection): String;
+begin
+ Result := FSectionText[AIndex];
+end;
+
+function TGridPrnHeaderFooter.GetText: String;
+begin
+ Result :=
+ FSectionText[hfsLeft] + FSectionSeparator +
+ FSectionText[hfsCenter] + FSectionSeparator +
+ FSectionText[hfsRight];
+end;
+
+function TGridPrnHeaderFooter.IsLineWidthStored: Boolean;
+begin
+ Result := FLineWidth > 0;
+end;
+
+function TGridPrnHeaderFooter.IsSectionSepStored: Boolean;
+begin
+ Result := FSectionSeparator <> '|';
+end;
+
+function TGridPrnHeaderFooter.IsShown: Boolean;
+begin
+ Result := FVisible and not IsTextEmpty;
+end;
+
+function TGridPrnHeaderFooter.IsTextEmpty: Boolean;
+begin
+ Result :=
+ (FSectionText[hfsLeft] = '') and
+ (FSectionText[hfsCenter] = '') and
+ (FSectionText[hfsRight] = '');
+end;
+
+function TGridPrnHeaderFooter.IsTextStored: Boolean;
+begin
+ Result := not IsTextEmpty;
+end;
+
+function TGridPrnHeaderFooter.RealLineColor: TColor;
+begin
+ if ((FOwner <> nil) and FOwner.Monochrome) or (FLineColor = clDefault) then
+ Result := clBlack
+ else
+ Result := FLineColor;
+end;
+
+function TGridPrnHeaderFooter.RealLineWidth: Integer;
+begin
+ if FLineWidth = 0 then
+ Result := FOwner.ScaleY(1)
+ else
+ Result := mm2px(FLineWidth, FOwner.PixelsPerInchY);
+end;
+
+procedure TGridPrnHeaderFooter.SetFont(AValue: TFont);
+begin
+ FFont.Assign(AValue);
+ Changed(nil);
+end;
+
+procedure TGridPrnHeaderFooter.SetLineColor(AValue: TColor);
+begin
+ if FLineColor <> AValue then
+ begin
+ FLineColor := AValue;
+ Changed(nil);
+ end;
+end;
+
+procedure TGridPrnHeaderFooter.SetLineWidth(AValue: Double);
+begin
+ if FLineWidth <> AValue then
+ begin
+ FLineWidth := AValue;
+ Changed(nil);
+ end;
+end;
+
+procedure TGridPrnHeaderFooter.SetSectionText(AIndex: TGridPrnHeaderFooterSection;
+ AValue: String);
+begin
+ if FSectionText[AIndex] <> AValue then
+ begin
+ FSectionText[AIndex] := AValue;
+ Changed(nil);
+ end;
+end;
+
+procedure TGridPrnHeaderFooter.SetShowLine(AValue: Boolean);
+begin
+ if FShowLine <> AValue then
+ begin
+ FShowLine := AValue;
+ Changed(nil);
+ end;
+end;
+
+procedure TGridPrnHeaderFooter.SetText(AValue: String);
+var
+ sa: TStringArray;
+begin
+ if GetText = AValue then
+ exit;
+ sa := AValue.Split([FSectionSeparator]);
+ if Length(sa) > 0 then FSectionText[hfsLeft] := sa[0] else FSectionText[hfsLeft] := '';
+ if Length(sa) > 1 then FSectionText[hfsCenter] := sa[1] else FSectionText[hfsCenter] := '';
+ if Length(sa) > 2 then FSectionText[hfsRight] := sa[2] else FSectionText[hfsRight] := '';
+ Changed(self);
+end;
+
+procedure TGridPrnHeaderFooter.SetVisible(AValue: Boolean);
+begin
+ if FVisible <> AValue then
+ begin
+ FVisible := AValue;
+ Changed(self);
+ end;
+end;
+
+
+{ TGridPrinter }
+
+constructor TGridPrinter.Create(AOwner: TComponent);
+begin
+ inherited;
+
+ FMargins := TGridPrnMargins.Create(Self);
+ FHeader := TGridPrnHeaderFooter.Create(Self);
+ FFooter := TGridPrnHeaderFooter.Create(Self);
+
+ FPrintOrder := poRowsFirst;
+ FBorderLineColor := clDefault;
+ FFixedLineColor := clDefault;
+ FGridLineColor := clDefault;
+ FBorderLineWidth := -1;
+ FFixedLineWidth := -1;
+ FGridLineWidth := -1;
+end;
+
+destructor TGridPrinter.Destroy;
+begin
+ FHeader.Free;
+ FFooter.Free;
+ FMargins.Free;
+ inherited;
+end;
+
+function TGridPrinter.CreatePreviewBitmap(APageNo, APercentage: Integer): TBitmap;
+begin
+ if FGrid = nil then
+ begin
+ Result := nil;
+ exit;
+ end;
+
+ FOutputDevice := odPreview;
+
+ FPreviewPercent := APercentage;
+ FPreviewPage := APageNo; // out-of-range values are handled by Prepare
+ SetGrid(FGrid);
+ Prepare;
+
+ FPreviewBitmap := TBitmap.Create;
+ FPreviewBitmap.SetSize(FPageWidth, FPageHeight);
+ FPreviewBitmap.Canvas.Brush.Color := clWhite;
+ FPreviewBitmap.Canvas.FillRect(0, 0, FPageWidth, FPageHeight);
+
+ Execute(FPreviewBitmap.Canvas);
+
+ Result := FPreviewBitmap;
+end;
+
+procedure TGridPrinter.DoPrepareCanvas(ACol, ARow: Integer);
+begin
+ if Assigned(FOnPrepareCanvas) then
+ FOnPrepareCanvas(Self, ACol, ARow, []);
+end;
+
+procedure TGridPrinter.DoUpdatePreview;
+begin
+ if Assigned(FOnUpdatePreview) and (FOutputDevice = odPreview) then
+ FOnUpdatePreview(Self);
+end;
+
+procedure TGridPrinter.Execute(ACanvas: TCanvas);
+begin
+ FPrinting := true;
+ case FPrintOrder of
+ poRowsFirst: PrintByRows(ACanvas);
+ poColsFirst: PrintByCols(ACanvas);
+ end;
+ FPrinting := false;
+end;
+
+function TGridPrinter.GetBorderLineWidthHor: Integer;
+begin
+ if FBorderLineWidth < 0.0 then
+ Result := ScaleY(2)
+ else
+ Result := mm2px(FBorderLineWidth, FPixelsPerInchY);
+end;
+
+function TGridPrinter.GetBorderLineWidthVert: Integer;
+begin
+ if FBorderLineWidth < 0.0 then
+ Result := ScaleX(2)
+ else
+ Result := mm2px(FBorderLineWidth, FPixelsPerInchX);
+end;
+
+
+function TGridPrinter.GetCanvas: TCanvas;
+begin
+ if FPrinting then
+ case FOutputDevice of
+ odPrinter: Result := Printer.Canvas;
+ odPreview: Result := FPreviewBitmap.Canvas;
+ end
+ else
+ Result := nil;
+end;
+
+function TGridPrinter.GetCellText(ACol, ARow: Integer): String;
+var
+ col: TGridColumn;
+ lGrid: TGridAccess;
+begin
+ Result := '';
+ if FGrid = nil then
+ exit;
+
+ lGrid := TGridAccess(FGrid);
+ if lGrid.Columns.Enabled and (ACol >= FFixedCols) and (ARow = 0) then
+ begin
+ col := lGrid.Columns[ACol - FFixedCols];
+ Result := col.Title.Caption;
+ exit;
+ end;
+
+ if Assigned(FOnGetCellText) then
+ FOnGetCellText(self, FGrid, ACol, ARow, Result)
+ else
+ Result := lGrid.GetCells(Acol, ARow);
+end;
+
+function TGridPrinter.GetFixedLineWidthHor: Integer;
+begin
+ if FFixedLineWidth < 0.0 then
+ Result := ScaleY(TGridAccess(FGrid).GridLineWidth)
+ else
+ Result := mm2px(FFixedLineWidth, FPixelsPerInchY);
+end;
+
+function TGridPrinter.GetFixedLineWidthVert: Integer;
+begin
+ if FFixedLineWidth < 0.0 then
+ Result := ScaleX(TGridAccess(FGrid).GridLineWidth)
+ else
+ Result := mm2px(FFixedLineWidth, FPixelsPerInchX);
+end;
+
+function TGridPrinter.GetGridLineWidthHor: Integer;
+begin
+ if FGridLineWidth < 0.0 then
+ Result := ScaleY(TGridAccess(FGrid).GridLineWidth)
+ else
+ Result := mm2px(FGridLineWidth, FPixelsPerInchY);
+end;
+
+function TGridPrinter.GetGridLineWidthVert: Integer;
+begin
+ if FGridLineWidth < 0.0 then
+ Result := ScaleX(TGridAccess(FGrid).GridLineWidth)
+ else
+ Result := mm2px(FGridLineWidth, FPixelsPerInchX);
+end;
+
+function TGridPrinter.GetOrientation: TPrinterOrientation;
+begin
+ Result := Printer.Orientation;
+end;
+
+function TGridPrinter.GetPageCount: Integer;
+begin
+ if FPageCount = 0 then
+ Prepare;
+ Result := FPageCount;
+end;
+
+function TGridPrinter.GetPageNumber: Integer;
+begin
+ if FPageNumber <= 0 then
+ Prepare;
+ Result := FPageNumber;
+end;
+
+function TGridPrinter.IsBorderLineWidthStored: Boolean;
+begin
+ Result := FBorderLineWidth >= 0.0;
+end;
+
+function TGridPrinter.IsFixedLineWidthStored: Boolean;
+begin
+ Result := FFixedLineWidth >= 0.0;
+end;
+
+function TGridPrinter.IsGridLineWidthStored: Boolean;
+begin
+ Result := FGridLineWidth >= 0.0;
+end;
+
+{ Find the column and row indices before which page breaks are occuring.
+ Store them in the arrays FPageBreakCols and FPageBreakRows.
+ Note that the indices do not contain the fixed columns/rows. }
+procedure TGridPrinter.LayoutPageBreaks;
+var
+ col, row: Integer;
+ n: Integer;
+ totalWidth, totalHeight: Double;
+begin
+ // Scanning horizontally --> get page break column indices
+ SetLength(FPageBreakCols, FColCount);
+ n := 0;
+ totalWidth := FFixedColPos;
+ FPageBreakCols[0] := FFixedCols;
+ for col := FFixedCols to FColCount-1 do
+ begin
+ totalWidth := totalWidth + FColWidths[col];
+ if totalWidth >= FPageRect.Right then
+ begin
+ inc(n);
+ FPageBreakCols[n] := col;
+ totalWidth := FFixedColPos + FColWidths[col];
+ end;
+ end;
+ SetLength(FPageBreakCols, n+1);
+
+ // Scanning vertically --> get page break row indices
+ SetLength(FPageBreakRows, FRowCount);
+ n := 0;
+ totalHeight := FFixedRowPos;
+ FPageBreakRows[0] := FFixedRows;
+ for row := FFixedRows to FRowCount-1 do
+ begin
+ totalHeight := totalHeight + FRowHeights[row];
+ if totalHeight > FPageRect.Bottom then
+ begin
+ inc(n);
+ FPageBreakRows[n] := row;
+ totalHeight := FFixedRowPos + FRowHeights[row];
+ end;
+ end;
+ SetLength(FPageBreakRows, n+1);
+
+ FPageCount := Length(FPageBreakCols) * Length(FPageBreakRows);
+end;
+
+{ Converts length properties to the specified pixel density. }
+procedure TGridPrinter.Measure(APageWidth, APageHeight, XDpi, YDpi: Integer);
+begin
+ // Multiplication factor needed by ScaleX and ScaleY
+ FFactorX := XDpi / ScreenInfo.PixelsPerInchX;
+ FFactorY := YDpi / ScreenInfo.PixelsPerInchY;
+
+ // Margins in the new pixeld density units.
+ FLeftMargin := mm2px(FMargins.Left, XDpi);
+ FTopMargin := mm2px(FMargins.Top, YDpi);
+ FRightMargin := mm2px(FMargins.Right, XDpi);
+ FBottomMargin := mm2px(FMargins.Bottom, YDpi);
+ FHeaderMargin := mm2px(FMargins.Header, YDpi);
+ FFooterMargin := mm2px(FMargins.Footer, YDpi);
+ FPageRect := Rect(FLeftMargin, FTopMargin, APageWidth - FRightMargin, APageHeight - FBottomMargin);
+ FPadding := ScaleX(varCellPadding);
+
+ // Calculates column widths and row heights in the new pixel density units
+ ScaleColWidths(FFactorX);
+ ScaleRowHeights(FFactorY);
+end;
+
+procedure TGridPrinter.NewPage;
+begin
+ if FOutputDevice = odPrinter then
+ Printer.NewPage;
+end;
+
+procedure TGridPrinter.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ begin
+ if AComponent = FGrid then
+ FGrid := nil;
+ end;
+end;
+
+procedure TGridPrinter.Prepare;
+begin
+ // Calculate grid indices at which page breaks occur. Since the font size is
+ // an integer, the zoomed preview may have slightly different values - which
+ // is not desired. Therefore, we calculate this for the printer resolution.
+ Measure(Printer.PageWidth, Printer.PageHeight, Printer.XDPI, Printer.YDPI);
+ LayoutPagebreaks;
+
+ case FOutputDevice of
+ odPrinter:
+ begin
+ FPixelsPerInchX := Printer.XDPI;
+ FPixelsPerInchY := Printer.YDPI;
+ FPageWidth := Printer.PageWidth;
+ FPageHeight := Printer.PageHeight;
+ end;
+ odPreview:
+ begin
+ if FPreviewPercent = 0 then
+ exit;
+ FPixelsPerInchX := ScreenInfo.PixelsPerInchX * FPreviewPercent div 100;
+ FPixelsPerInchY := ScreenInfo.PixelsPerInchY * FPreviewPercent div 100;
+ FPageWidth := round(Printer.PageWidth * FPixelsPerInchX / Printer.XDPI);
+ FPageHeight := round(Printer.PageHeight * FPixelsPerInchY / Printer.YDPI);
+ // Recalculates page dimensions and col/row sizes, now based on
+ // the "real" ppi of the preview.
+ Measure(FPageWidth, FPageHeight, FPixelsPerInchX, FPixelsPerInchY);
+ end;
+ end;
+end;
+
+procedure TGridPrinter.PrepareCanvas(ACanvas: TCanvas; ACol, ARow: Integer);
+var
+ lGrid: TGridAccess;
+ color, alternateColor: TColor;
+ textStyle: TTextStyle;
+begin
+ lGrid := TGridAccess(FGrid);
+
+ // Background color
+ ACanvas.Brush.Style := bsSolid;
+ if (ACol < FFixedCols) or (ARow < FFixedRows) then
+ ACanvas.Brush.Color := ColorToRGB(lGrid.FixedColor)
+ else
+ begin
+ color := ColorToRGB(lGrid.Color);
+ alternateColor := ColorToRGB(lGrid.AlternateColor);
+ if (color <> alternateColor) and Odd(ARow) then
+ ACanvas.Brush.Color := alternateColor
+ else
+ ACanvas.Brush.Color := color;
+ end;
+ // Font
+ SelectFont(ACanvas, lGrid.Font);
+ // Text style
+ textStyle := DefaultTextStyle;
+ if (goCellEllipsis in lGrid.Options) then
+ textStyle.EndEllipsis := true;
+ ACanvas.TextStyle := textStyle;
+
+ // Fire the event OnPrepareCanvas
+ DoPrepareCanvas(ACol, ARow);
+
+ // Fix zero font size and monochrome text color
+ FixFontSize(ACanvas.Font);
+ if FMonochrome then
+ ACanvas.Font.Color := clBlack;
+end;
+
+procedure TGridPrinter.Print;
+var
+ pageDlg: TPageSetupDialog;
+ printDlg: TPrintDialog;
+begin
+ if FGrid = nil then
+ exit;
+ SetGrid(FGrid);
+
+ case FPrintDialogs of
+ gpdNone:
+ ;
+ gpdPageSetup:
+ begin
+ pageDlg := TPageSetupDialog.Create(nil);
+ try
+ pageDlg.Units := pmMillimeters;
+ pageDlg.MarginLeft := round(FMargins.Left*100);
+ pageDlg.MarginTop := round(FMargins.Top*100);
+ pageDlg.MarginRight := round(FMargins.Right*100);
+ pageDlg.MarginBottom := round(FMargins.Bottom*100);
+ if pageDlg.Execute then
+ begin
+ FMargins.FMargins[0] := pageDlg.MarginLeft*0.01;
+ FMargins.FMargins[1] := pageDlg.MarginTop*0.01;
+ FMargins.FMargins[2] := pageDlg.MarginRight*0.01;
+ FMargins.FMargins[3] := pageDlg.MarginBottom*0.01;
+ FFromPage := 0; // all pages
+ FToPage := 0;
+ end else
+ exit;
+ finally
+ pageDlg.Free;
+ end;
+ end;
+ gpdPrintDialog:
+ begin
+ printDlg := TPrintDialog.Create(nil);
+ try
+ printDlg.MinPage := 1;
+ printDlg.MaxPage := PageCount;
+ printDlg.Options := printDlg.Options + [poPageNums];
+ if printDlg.Execute then
+ begin
+ Printer.Copies := printDlg.Copies;
+ if printDlg.PrintRange = prAllPages then
+ begin
+ FFromPage := 0; // all pages
+ FToPage := 0;
+ end else
+ begin
+ FFromPage := printDlg.FromPage;
+ FToPage := printDlg.ToPage;
+ end;
+ end else
+ exit;
+ finally
+ printDlg.Free;
+ end;
+ end;
+ end;
+
+ if Assigned(FOnBeforePrint) then
+ FOnBeforePrint(Self);
+
+ FOutputDevice := odPrinter;
+ Prepare;
+ Printer.BeginDoc;
+ try
+ Execute(Printer.Canvas);
+ finally
+ Printer.EndDoc;
+ end;
+
+ if Assigned(FOnAfterPrint) then
+ FOnAfterPrint(Self);
+end;
+
+{ Advances first along rows when handling page-breaks. }
+procedure TGridPrinter.PrintByCols(ACanvas: TCanvas);
+var
+ vertPage, horPage: Integer;
+ col1, col2: Integer;
+ row1, row2: Integer;
+ firstPrintPage, lastPrintPage: Integer;
+ printThisPage: Boolean;
+begin
+ firstPrintPage := IfThen((FFromPage < 1) or (FFromPage > FPageCount), 1, FFromPage);
+ lastPrintPage := IfThen((FToPage < 1) or (FToPage > FPageCount), FPageCount, FToPage);
+
+ SelectFont(ACanvas, FGrid.Font);
+ FPageNumber := 1;
+
+ for horPage := 0 to High(FPageBreakCols) do
+ begin
+ col1 := FPageBreakCols[horPage];
+ if horPage < High(FPageBreakCols) then
+ col2 := FPageBreakCols[horPage+1] - 1
+ else
+ col2 := FColCount-1;
+
+ for vertPage := 0 to High(FPageBreakRows) do
+ begin
+ row1 := FPageBreakRows[vertPage];
+ if vertPage < High(FPageBreakRows) then
+ row2 := FPageBreakRows[vertPage+1] - 1
+ else
+ row2 := FRowCount-1;
+ // Print page beginning at col1/row1
+ case FOutputDevice of
+ odPrinter: // Render all requested pages
+ printThisPage := (FPageNumber >= firstPrintPage) and (FPageNumber <= lastPrintPage);
+ odPreview: // Preview can render only a single page
+ printThisPage := (FPageNumber = FPreviewPage);
+ else
+ raise Exception.Create('[TGridPrinter.PrintByCols] Unknown output device.');
+ end;
+ if printThisPage then
+ PrintPage(ACanvas, col1, row1, col2, row2);
+ inc(FPageNumber);
+ end;
+ end;
+end;
+
+{ Advances first along columns when handling page-breaks. }
+procedure TGridPrinter.PrintByRows(ACanvas: TCanvas);
+var
+ vertPage, horPage: Integer;
+ col1, col2: Integer;
+ row1, row2: Integer;
+ firstPrintPage, lastPrintPage: Integer;
+ printThisPage: Boolean;
+begin
+ firstPrintPage := IfThen((FFromPage < 1) or (FFromPage > FPageCount), 1, FFromPage);
+ lastPrintPage := IfThen((FToPage < 1) or (FToPage > FPageCount), FPageCount, FToPage);
+
+ SelectFont(ACanvas, FGrid.Font);
+ FPageNumber := 1;
+
+ for vertPage := 0 to High(FPageBreakRows) do
+ begin
+ row1 := FPageBreakRows[vertPage];
+ if vertPage < High(FPageBreakRows) then
+ row2 := FPageBreakRows[vertPage+1] - 1
+ else
+ row2 := FRowCount-1;
+
+ for horPage := 0 to High(FPageBreakCols) do
+ begin
+ col1 := FPageBreakCols[horPage];
+ if horPage < High(FPageBreakCols) then
+ col2 := FPageBreakCols[horPage+1] - 1
+ else
+ col2 := FColCount-1;
+ // Print the page beginning at col1/row1
+ case FOutputDevice of
+ odPrinter: // Render all requested pages
+ printThisPage := (FPageNumber >= firstPrintPage) and (FPageNumber <= lastPrintPage);
+ odPreview: // Preview can render only a single page
+ printThisPage := (FPageNumber = FPreviewPage);
+ else
+ raise Exception.Create('[TGridPrinter.PrintByRows] Unknown output device.');
+ end;
+ if printThisPage then
+ PrintPage(ACanvas, col1, row1, col2, row2);
+ inc(FPageNumber);
+ end;
+ end;
+end;
+
+{ Prints the cell at ACol/ARow. The cell will appear in the given rectangle. }
+procedure TGridPrinter.PrintCell(ACanvas: TCanvas; ACol, ARow: Integer;
+ ARect: TRect);
+var
+ s: String;
+ col: TGridColumn;
+ lGrid: TGridAccess;
+ checkedState: TCheckboxState;
+begin
+ lGrid := TGridAccess(FGrid);
+
+ PrepareCanvas(ACanvas, ACol, ARow);
+ if not FMonochrome then
+ ACanvas.FillRect(ARect);
+
+ s := GetCellText(ACol, ARow);
+ InflateRect(ARect, -FPadding, 0);
+
+ // Handle checkbox columns
+ if lGrid.Columns.Enabled and (ACol >= FFixedCols) and (ARow >= FFixedRows) then
+ begin
+ col := lGrid.Columns[ACol - FFixedCols];
+ if col.Buttonstyle = cbsCheckboxColumn
+ then begin
+ if s = col.ValueChecked then
+ checkedState := cbChecked
+ else
+ if s = col.ValueUnChecked then
+ checkedState := cbUnchecked
+ else
+ checkedState := cbGrayed;
+ PrintCheckbox(ACanvas, ACol, ARow, ARect, checkedState);
+ exit;
+ end;
+ end;
+
+ // Normal text output
+ ACanvas.TextRect(ARect, ARect.Left, ARect.Top, s);
+end;
+
+procedure TGridPrinter.PrintCheckbox(ACanvas: TCanvas; ACol, ARow: Integer;
+ ARect: TRect; ACheckState: TCheckboxstate);
+const
+ arrtb:array[TCheckboxState] of TThemedButton =
+ (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
+var
+ details: TThemedElementDetails;
+ cSize: TSize;
+ R: TRect;
+ P: Array[0..2] of TPoint;
+begin
+ // Determine size of checkbox
+ details := ThemeServices.GetElementDetails(arrtb[ACheckState]);
+ cSize := ThemeServices.GetDetailSize(Details);
+ cSize.cx := ScaleX(cSize.cx);
+ cSize.cy := ScaleY(cSize.cy);
+ // Position the checkbox within the given rectangle, ARect.
+ R.Left := (ARect.Left + ARect.Right - cSize.cx) div 2;
+ R.Top := (ARect.Top + ARect.Bottom - cSize.cy) div 2;
+ R.BottomRight := Point(R.Left + cSize.cx, R.Top + cSize.cy);
+ // Prepare pen and brush
+ ACanvas.Pen.Width := ScaleX(1);
+ ACanvas.Pen.Color := clBlack;
+ ACanvas.Pen.Style := psSolid;
+ if ACheckState = cbGrayed then
+ ACanvas.Brush.Color := clSilver
+ else
+ ACanvas.Brush.Color := clWhite;
+ ACanvas.Brush.Style := bsSolid;
+ // Draw checkbox border (= unchecked state)
+ InflateRect(R, -ACanvas.Pen.Width div 2, -ACanvas.Pen.Width div 2);
+ ACanvas.Rectangle(R);
+ InflateRect(R, -ACanvas.Pen.Width div 2, -ACanvas.Pen.Width div 2);
+ // Draw checkmark if checked or grayed
+ if ACheckState in [cbChecked, cbGrayed] then
+ begin
+ if ACheckState = cbGrayed then ACanvas.Pen.Color := clGray;
+ ACanvas.Pen.Width := ScaleX(2);
+ P[0] := Point(R.Left + cSize.cx div 6, R.Top + cSize.cy div 2);
+ P[1] := Point(R.Left + cSize.cx div 3, R.Bottom - cSize.cy div 6);
+ P[2] := Point(R.Right - cSize.cx div 6, R.Top + cSize.cy div 6);
+ ACanvas.PolyLine(P);
+ end;
+end;
+
+{ Prints the column headers: at first the fixed column headers, then the
+ headers between ACol1 and ACol2. }
+procedure TGridPrinter.PrintColHeaders(ACanvas: TCanvas; ACol1, ACol2: Integer);
+var
+ R: TRect;
+ col, row: Integer;
+ x, y, x2, y2: Double;
+begin
+ x := FLeftMargin;
+ y := FTopMargin;
+ for row := 0 to FFixedRows-1 do
+ begin
+ y2 := FTopMargin + FRowHeights[row];
+ for col := 0 to FFixedCols-1 do
+ begin
+ x2 := x + FColWidths[col];
+ R := Rect(round(x), round(y), round(x2), round(y2));
+ PrintCell(ACanvas, col, row, R);
+ x := x2;
+ end;
+ for col := ACol1 to ACol2 do
+ begin
+ x2 := x + FColWidths[col];
+ R := Rect(round(x), round(y), round(x2), round(y2));
+ PrintCell(ACanvas, col, row, R);
+ x := x2;
+ end;
+ y := y2;
+ end;
+end;
+
+procedure TGridPrinter.PrintFooter(ACanvas: TCanvas);
+var
+ Width: array[TGridPrnHeaderFooterSection] of Integer = (0, 0, 0);
+ printableWidth, lineHeight: Integer;
+ x, y: Integer;
+ s: String;
+ R: TRect;
+ textStyle: TTextStyle;
+begin
+ if not FFooter.IsShown then
+ exit;
+
+ SelectFont(ACanvas, FFooter.Font);
+ printableWidth := FPageRect.Width;
+ if (FFooter.SectionText[hfsLeft] <> '') and (FFooter.SectionText[hfsCenter] = '') and (FFooter.SectionText[hfsRight] = '') then
+ Width[hfsLeft] := printableWidth
+ else
+ if (FFooter.SectionText[hfsLeft] = '') and (FFooter.SectionText[hfsCenter] <> '') and (FFooter.SectionText[hfsRight] = '') then
+ Width[hfsCenter] := printableWidth
+ else
+ if (FFooter.SectionText[hfsLeft] = '') and (FFooter.SectionText[hfsCenter] = '') and (FFooter.SectionText[hfsRight] <> '') then
+ Width[hfsRight] := printableWidth
+ else begin
+ Width[hfsLeft] := printableWidth div 3;
+ Width[hfsCenter] := printableWidth div 3;
+ Width[hfsRight] := printableWidth div 3;
+ end;
+
+ lineHeight := ACanvas.TextHeight('Rg');
+ textStyle := DefaultTextStyle;
+
+ y := FPageHeight - FFooterMargin - lineHeight;
+ if FFooter.SectionText[hfsLeft] <> '' then
+ begin
+ s := FFooter.ProcessedText[hfsLeft];
+ x := FLeftMargin;
+ R := Rect(x, y, x + Width[hfsLeft], y + lineHeight);
+ ACanvas.TextRect(R, R.Left, R.Top, s);
+ end;
+ if FFooter.SectionText[hfsCenter] <> '' then
+ begin
+ s := FFooter.ProcessedText[hfsCenter];
+ x := (FPageRect.Left + FPageRect.Right - Width[hfsCenter]) div 2;
+ R := Rect(x, y, x + Width[hfsCenter], y + lineHeight);
+ textStyle.Alignment := taCenter;
+ ACanvas.TextRect(R, R.Left, R.Top, s, textStyle);
+ end;
+ if FFooter.SectionText[hfsRight] <> '' then
+ begin
+ s := Footer.ProcessedText[hfsRight];
+ x := FPageRect.Right;
+ R := Rect(x, y, x + Width[hfsRight], y + lineHeight);
+ textStyle.Alignment := taRightJustify;
+ ACanvas.TextRect(R, R.Left, R.Top, s, textStyle);
+ end;
+
+ if FFooter.ShowLine then
+ begin
+ ACanvas.Pen.Color := FFooter.RealLineColor;
+ ACanvas.Pen.Width := FFooter.RealLineWidth;
+ ACanvas.Pen.Style := psSolid;
+ dec(y, (ACanvas.Pen.Width+1) div 2);
+ ACanvas.Line(FPageRect.Left, y, FPageRect.Right, y);
+ end;
+end;
+
+procedure TGridPrinter.PrintGridLines(ACanvas: TCanvas;
+ AFirstCol, AFirstRow, XEnd, YEnd: Integer);
+var
+ x, y: Double;
+ xr, yr: Integer; // x, y rounded to integer
+ col, row: Integer;
+ lGrid: TGridAccess;
+begin
+ lGrid := TGridAccess(FGrid);
+
+ // Print inner grid lines
+ ACanvas.Pen.EndCap := pecFlat;
+ ACanvas.Pen.Style := lGrid.GridLineStyle;
+ ACanvas.Pen.Color := IfThen(FMonoChrome, clBlack,
+ IfThen(FGridLineColor = clDefault, lGrid.GridLineColor, FGridLineColor));
+ // ... vertical fixed cell lines
+ if (goFixedVertLine in lGrid.Options) then
+ begin
+ ACanvas.Pen.Width := GetGridLineWidthVert;
+ col := 1;
+ x := FLeftMargin;
+ while col < lGrid.FixedCols do
+ begin
+ x := x + FColWidths[col-1];
+ xr := round(x);
+ ACanvas.Line(xr, FTopMargin, xr, YEnd);
+ inc(col);
+ end;
+ col := AFirstCol;
+ x := FFixedColPos;
+ xr := round(x);
+ while (xr < XEnd) and (col < lGrid.ColCount) do
+ begin
+ x := x + FColWidths[col];
+ xr := round(x);
+ ACanvas.Line(xr, FTopMargin, xr, FFixedRowPos);
+ inc(col);
+ end;
+ end;
+ // ... vertical grid lines
+ if (goVertLine in lGrid.Options) then
+ begin
+ ACanvas.Pen.Width := GetGridLineWidthVert;
+ col := AFirstCol;
+ x := FFixedColPos;
+ xr := round(x);
+ while (xr < XEnd) and (col < FColCount) do
+ begin
+ x := x + FColWidths[col];
+ xr := round(x);
+ ACanvas.Line(xr, FFixedRowPos, xr, YEnd);
+ inc(col);
+ end;
+ end;
+ // ... horizontal fixed cell lines
+ if (goFixedHorzLine in lGrid.Options) then
+ begin
+ ACanvas.Pen.Width := GetGridLineWidthHor;
+ row := 1;
+ y := FTopMargin;
+ yr := round(y);
+ while row < lGrid.FixedRows do
+ begin
+ y := y + FRowHeights[row];
+ yr := round(y);
+ ACanvas.Line(FLeftMargin, yr, XEnd, yr);
+ inc(row);
+ end;
+ row := AFirstRow;
+ y := FFixedRowPos;
+ yr := round(y);
+ while (yr < YEnd) and (row < FRowCount) do
+ begin
+ y := y + FRowHeights[row];
+ yr := round(y);
+ ACanvas.Line(FLeftMargin, yr, FFixedColPos, yr);
+ inc(row);
+ end;
+ end;
+ // ... horizontal grid lines
+ if (goHorzLine in lGrid.Options) then
+ begin
+ ACanvas.Pen.Width := GetGridLineWidthHor;
+ row := AFirstRow;
+ y := FFixedRowPos;
+ yr := round(y);
+ while (yr < YEnd) and (row < FRowCount) do
+ begin
+ y := y + FRowHeights[row];
+ yr := round(y);
+ ACanvas.Line(FFixedColPos, yr, XEnd, yr);
+ inc(row);
+ end;
+ end;
+
+ // Print header border lines between fixed and normal cells
+ // ... horizontal
+ ACanvas.Pen.Style := psSolid;
+ ACanvas.Pen.Color := IfThen(FMonochrome or (FFixedLineColor = clDefault), clBlack, FFixedLineColor);
+ ACanvas.Pen.Width := GetFixedLineWidthHor;
+ ACanvas.Line(FLeftMargin, FFixedRowPos, XEnd, FFixedRowPos);
+ // ... vertical
+ ACanvas.Pen.Width := GetFixedLineWidthVert;
+ ACanvas.Line(FFixedColPos, FTopMargin, FFixedColPos, YEnd);
+
+ // Print outer border lines
+ ACanvas.Pen.EndCap := pecRound;
+ ACanvas.Pen.Style := psSolid;
+ ACanvas.Pen.Color := IfThen(FMonochrome, clBlack,
+ IfThen(FBorderLineColor = clDefault, clBlack, ColorToRGB(FBorderLineColor)));
+ // ... horizontal
+ ACanvas.Pen.Width := GetBorderLineWidthHor;
+ ACanvas.Line(FLeftMargin, FTopMargin, XEnd, FTopMargin);
+ ACanvas.Line(FLeftMargin, YEnd, XEnd, YEnd);
+ // ... vertical
+ ACanvas.Pen.Width := GetBorderLineWidthVert;
+ ACanvas.Line(FLeftMargin, FTopMargin, FLeftMargin, YEnd);
+ ACanvas.Line(XEnd, FTopMargin, XEnd, YEnd);
+end;
+
+procedure TGridPrinter.PrintHeader(ACanvas: TCanvas);
+var
+ Width: array[TGridPrnHeaderFooterSection] of Integer = (0, 0, 0);
+ printableWidth, lineHeight: Integer;
+ x, y: Integer;
+ s: String;
+ R: TRect;
+ textStyle: TTextStyle;
+begin
+ if not FHeader.IsShown then
+ exit;
+
+ SelectFont(ACanvas, FHeader.Font);
+ printableWidth := FPageRect.Width;
+ if (FHeader.SectionText[hfsLeft] <> '') and (FHeader.SectionText[hfsCenter] = '') and (FHeader.SectionText[hfsRight] = '') then
+ Width[hfsLeft] := printableWidth
+ else
+ if (FHeader.SectionText[hfsLeft] = '') and (FHeader.SectionText[hfsCenter] <> '') and (FHeader.SectionText[hfsRight] = '') then
+ Width[hfsCenter] := printableWidth
+ else
+ if (FHeader.SectionText[hfsLeft] = '') and (FHeader.SectionText[hfsCenter] = '') and (FHeader.SectionText[hfsRight] <> '') then
+ Width[hfsRight] := printableWidth
+ else begin
+ Width[hfsLeft] := printableWidth div 3;
+ Width[hfsCenter] := printableWidth div 3;
+ Width[hfsRight] := printableWidth div 3;
+ end;
+
+ lineHeight := ACanvas.TextHeight('Rg');
+ textStyle := DefaultTextStyle;
+
+ y := FHeaderMargin;
+ if FHeader.SectionText[hfsLeft] <> '' then
+ begin
+ s := FHeader.ProcessedText[hfsLeft];
+ x := FLeftMargin;
+ R := Rect(x, y, x + Width[hfsLeft], y + lineHeight);
+ ACanvas.TextRect(R, R.Left, R.Top, s);
+ end;
+ if FHeader.SectionText[hfsCenter] <> '' then
+ begin
+ s := FHeader.ProcessedText[hfsCenter];
+ x := (FPageRect.Left + FPageRect.Right - Width[hfsCenter]) div 2;
+ R := Rect(x, y, x + Width[hfsCenter], y + lineHeight);
+ textStyle.Alignment := taCenter;
+ ACanvas.TextRect(R, R.Left, R.Top, s, textStyle);
+ end;
+ if FHeader.SectionText[hfsRight] <> '' then
+ begin
+ s := FHeader.ProcessedText[hfsRight];
+ x := FPageRect.Right - Width[hfsRight];
+ R := Rect(x, y, x + Width[hfsRight], y + lineHeight);
+ textStyle.Alignment := taRightJustify;
+ ACanvas.TextRect(R, R.Left, R.Top, s, textStyle);
+ end;
+
+ if FHeader.ShowLine then
+ begin
+ ACanvas.Pen.Color := FHeader.RealLineColor;
+ ACanvas.Pen.Width := FHeader.RealLineWidth;
+ ACanvas.Pen.Style := psSolid;
+ inc(y, lineHeight + (ACanvas.Pen.Width+1) div 2);
+ ACanvas.Line(FPageRect.Left, y, FPageRect.Right, y);
+ end;
+end;
+
+procedure TGridPrinter.PrintPage(ACanvas: TCanvas;
+ AStartCol, AStartRow, AEndCol, AEndRow: Integer);
+var
+ x, y: Double;
+ x2, y2: Double;
+ row, col: Integer;
+ lastPagePrinted: Boolean;
+ R: TRect;
+begin
+ // Print column headers
+ PrintColHeaders(ACanvas, AStartCol, AEndCol);
+
+ // Print grid cells
+ y := FFixedRowPos;
+ for row := AStartRow to AEndRow do
+ begin
+ y2 := y + FRowHeights[row];
+ PrintRowHeader(ACanvas, row, y);
+ x := FFixedColPos;
+ for col := AStartCol to AEndCol do
+ begin
+ x2 := x + FColWidths[col];
+ R := Rect(round(x), round(y), round(x2), round(y2));
+ PrintCell(ACanvas, col, row, R);
+ x := x2;
+ end;
+ y := y2;
+ end;
+
+ // Print cell grid lines
+ PrintGridLines(ACanvas, AStartCol, AStartRow, round(x2), round(y2));
+
+ // Print header and footer
+ PrintHeader(ACanvas);
+ PrintFooter(ACanvas);
+
+ // Unless we printed the last cell we must send a pagebreak to the printer.
+ lastPagePrinted := (AEndCol = FColCount-1) and (AEndRow = FRowCount-1);
+ if not lastPagePrinted then
+ NewPage;
+end;
+
+{ Prints the row headers of the specified row. Row headers are the cells in the
+ FixedCols of that row. The row is positioned at the given y coordinate on
+ the canvas. }
+procedure TGridPrinter.PrintRowHeader(ACanvas: TCanvas; ARow: Integer;
+ Y: Double);
+var
+ R: TRect;
+ col: Integer;
+ y1, y2: Integer;
+ x, x2: Double;
+begin
+ x := FLeftMargin; // left side of the row
+ y1 := round(Y); // upper end of the row
+ y2 := round(Y + FRowHeights[ARow]); // lower end of the row
+ for col := 0 to FFixedCols-1 do
+ begin
+ x2 := x + FColWidths[col];
+ R := Rect(round(x), y1, round(x2), y2);
+ PrintCell(ACanvas, col, ARow, R);
+ x := x2;
+ end;
+end;
+
+procedure TGridPrinter.ScaleColWidths(AFactor: Double);
+var
+ i: Integer;
+ w: Double;
+ fixed: Double;
+begin
+ fixed := FLeftMargin;
+ SetLength(FColWidths, FColCount);
+ for i := 0 to FColCount-1 do
+ begin
+ w := AFactor * TGridAccess(FGrid).ColWidths[i];
+ FColWidths[i] := w;
+ if i < FFixedCols then
+ fixed := fixed + w;
+ end;
+ FFixedColPos := round(fixed);
+end;
+
+procedure TGridPrinter.ScaleRowHeights(AFactor: Double);
+var
+ i: Integer;
+ h: Double;
+ fixed: Double;
+begin
+ fixed := FTopMargin;
+ SetLength(FRowHeights, FRowCount);
+ for i := 0 to FRowCount-1 do
+ begin
+ h := AFactor * TGridAccess(FGrid).RowHeights[i];
+ FRowHeights[i] := h;
+ if i < FFixedRows then
+ fixed := fixed + h;
+ end;
+ FFixedRowPos := round(fixed);
+end;
+
+function TGridPrinter.ScaleX(AValue: Integer): Integer;
+begin
+ Result := Round(FFactorX * AValue);
+end;
+
+function TGridPrinter.ScaleY(AValue: Integer): Integer;
+begin
+ Result := Round(FFactorY * AValue);
+end;
+
+procedure TGridPrinter.SelectFont(ACanvas: TCanvas; AFont: TFont);
+var
+ fd: TFontData;
+begin
+ ACanvas.Font.Assign(AFont);
+ ACanvas.Font.PixelsPerInch := FPixelsPerInchY;
+ if AFont.Size = 0 then
+ begin
+ fd := GetFontData(AFont.Handle);
+ ACanvas.Font.Size := abs(fd.Height) * 72 div ScreenInfo.PixelsPerInchY;
+ end;
+end;
+
+procedure TGridPrinter.SetBorderLineColor(AValue: TColor);
+begin
+ if FBorderLineColor <> AValue then
+ begin
+ FBorderLineColor := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetBorderLineWidth(AValue: Double);
+begin
+ if FBorderLineWidth <> AValue then
+ begin
+ FBorderLineWidth := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetFileName(AValue: String);
+begin
+ if FFileName <> AValue then
+ begin
+ FFileName := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetFixedLineColor(AValue: TColor);
+begin
+ if FFixedLineColor <> AValue then
+ begin
+ FFixedLineColor := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetFixedLineWidth(AValue: Double);
+begin
+ if FFixedLineWidth <> AValue then
+ begin
+ FFixedLineWidth := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetGrid(AValue: TCustomGrid);
+begin
+ FGrid := AValue;
+ FColCount := TGridAccess(FGrid).ColCount;
+ FRowCount := TGridAccess(FGrid).RowCount;
+ FFixedCols := TGridAccess(FGrid).FixedCols;
+ FFixedRows := TGridAccess(FGrid).FixedRows;
+ if Assigned(FOnGetColCount) then
+ FOnGetColCount(Self, FGrid, FColCount);
+ if Assigned(FOnGetRowCount) then
+ FOnGetRowCount(self, FGrid, FRowCount);
+ FPageNumber := 0;
+ FPageCount := 0;
+end;
+
+procedure TGridPrinter.SetGridLineColor(AValue: TColor);
+begin
+ if FGridLineColor <> AValue then
+ begin
+ FGridLineColor := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetGridLineWidth(AValue: Double);
+begin
+ if FGridLineWidth <> AValue then
+ begin
+ FGridLineWidth := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.SetOrientation(AValue: TPrinterOrientation);
+begin
+ if GetOrientation <> AValue then
+ begin
+ Printer.Orientation := AValue;
+ UpdatePreview;
+ end;
+end;
+
+procedure TGridPrinter.UpdatePreview;
+begin
+ if FOutputDevice = odPreview then
+ DoUpdatePreview;
+end;
+
+end.
+
diff --git a/components/gridprinter/source/gridprnheaderfooterform.lfm b/components/gridprinter/source/gridprnheaderfooterform.lfm
new file mode 100644
index 000000000..04252e2fe
--- /dev/null
+++ b/components/gridprinter/source/gridprnheaderfooterform.lfm
@@ -0,0 +1,222 @@
+object GridPrintHeaderFooterForm: TGridPrintHeaderFooterForm
+ Left = 552
+ Height = 369
+ Top = 253
+ Width = 582
+ Caption = 'Header/Footer'
+ ClientHeight = 369
+ ClientWidth = 582
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ LCLVersion = '2.3.0.0'
+ object ButtonPanel1: TButtonPanel
+ Left = 6
+ Height = 34
+ Top = 329
+ Width = 570
+ OKButton.Name = 'OKButton'
+ OKButton.DefaultCaption = True
+ OKButton.OnClick = OKClick
+ HelpButton.Name = 'HelpButton'
+ HelpButton.DefaultCaption = True
+ CloseButton.Name = 'CloseButton'
+ CloseButton.DefaultCaption = True
+ CancelButton.Name = 'CancelButton'
+ CancelButton.DefaultCaption = True
+ TabOrder = 0
+ ShowButtons = [pbOK, pbCancel]
+ end
+ object TabControl: TTabControl
+ Left = 6
+ Height = 317
+ Top = 6
+ Width = 570
+ OnChange = TabControlChange
+ OnChanging = TabControlChanging
+ TabIndex = 0
+ Tabs.Strings = (
+ 'Header'
+ 'Footer'
+ )
+ Align = alClient
+ BorderSpacing.Around = 6
+ TabOrder = 1
+ object edTextLeft: TEdit
+ AnchorSideLeft.Control = cbShow
+ AnchorSideTop.Control = cbShow
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Bevel1
+ Left = 10
+ Height = 23
+ Top = 58
+ Width = 176
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Top = 8
+ Constraints.MinWidth = 125
+ TabOrder = 1
+ TextHint = 'Text in left-aligned section'
+ end
+ object edTextCenter: TEdit
+ AnchorSideLeft.Control = Bevel1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = edTextLeft
+ AnchorSideRight.Control = Bevel2
+ Left = 194
+ Height = 23
+ Top = 58
+ Width = 185
+ Alignment = taCenter
+ Anchors = [akTop, akLeft, akRight]
+ Constraints.MinWidth = 125
+ TabOrder = 2
+ TextHint = 'Text in centered section'
+ end
+ object edTextRight: TEdit
+ AnchorSideLeft.Control = Bevel2
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = edTextLeft
+ AnchorSideRight.Control = TabControl
+ AnchorSideRight.Side = asrBottom
+ Left = 387
+ Height = 23
+ Top = 58
+ Width = 173
+ Alignment = taRightJustify
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Right = 8
+ Constraints.MinWidth = 125
+ TabOrder = 3
+ TextHint = 'Text in right-aligned section'
+ end
+ object cbShow: TCheckBox
+ AnchorSideLeft.Control = TabControl
+ AnchorSideTop.Control = TabControl
+ Left = 10
+ Height = 19
+ Top = 31
+ Width = 47
+ BorderSpacing.Left = 8
+ BorderSpacing.Top = 8
+ Caption = 'Show'
+ TabOrder = 4
+ end
+ object Bevel1: TBevel
+ Left = 186
+ Height = 51
+ Top = 31
+ Width = 8
+ Anchors = [akTop]
+ Shape = bsSpacer
+ end
+ object Bevel2: TBevel
+ Left = 379
+ Height = 59
+ Top = 24
+ Width = 8
+ Anchors = [akTop]
+ Shape = bsSpacer
+ end
+ object btnFont: TButton
+ AnchorSideLeft.Control = cbShow
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = cbShow
+ AnchorSideTop.Side = asrCenter
+ Left = 89
+ Height = 25
+ Top = 28
+ Width = 75
+ BorderSpacing.Left = 32
+ Caption = 'Font...'
+ OnClick = btnFontClick
+ TabOrder = 5
+ end
+ object Bevel3: TBevel
+ AnchorSideLeft.Control = edTextLeft
+ AnchorSideTop.Control = lblTextInfo
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = edTextRight
+ AnchorSideRight.Side = asrBottom
+ Left = 10
+ Height = 4
+ Top = 224
+ Width = 550
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Top = 16
+ Shape = bsTopLine
+ end
+ object cbShowLine: TCheckBox
+ AnchorSideLeft.Control = cbShow
+ AnchorSideTop.Control = Bevel3
+ AnchorSideTop.Side = asrBottom
+ Left = 10
+ Height = 19
+ Top = 240
+ Width = 115
+ BorderSpacing.Top = 12
+ Caption = 'Show dividing line'
+ TabOrder = 6
+ end
+ object lblLineWidth: TLabel
+ AnchorSideLeft.Control = cbShowLine
+ AnchorSideTop.Control = seLineWidth
+ AnchorSideTop.Side = asrCenter
+ Left = 10
+ Height = 15
+ Top = 271
+ Width = 88
+ Caption = 'Line width (mm)'
+ end
+ object seLineWidth: TFloatSpinEdit
+ AnchorSideLeft.Control = lblLineWidth
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = cbShowLine
+ AnchorSideTop.Side = asrBottom
+ Left = 106
+ Height = 23
+ Top = 267
+ Width = 64
+ Alignment = taRightJustify
+ BorderSpacing.Left = 8
+ BorderSpacing.Top = 8
+ BorderSpacing.Bottom = 8
+ DecimalPlaces = 1
+ Increment = 0.1
+ MaxValue = 3
+ MinValue = 0.1
+ TabOrder = 7
+ Value = 0.1
+ end
+ object clbLineColor: TColorButton
+ AnchorSideLeft.Control = seLineWidth
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = seLineWidth
+ AnchorSideTop.Side = asrCenter
+ Left = 186
+ Height = 25
+ Top = 266
+ Width = 94
+ BorderSpacing.Left = 16
+ BorderSpacing.Bottom = 8
+ BorderWidth = 2
+ ButtonColorAutoSize = False
+ ButtonColorSize = 16
+ ButtonColor = clBlack
+ Caption = 'Line color'
+ Margin = 4
+ end
+ object lblTextInfo: TLabel
+ Left = 10
+ Height = 120
+ Top = 88
+ Width = 278
+ Caption = 'Each section can contain the following parameters:'#13#10' $DATE - Current date'#13#10' $TIME - Current time'#13#10' $PAGE - Page number'#13#10' $PAGECOUNT - Number of pages'#13#10' $FULL_FILENAME - Full name of the printed file'#13#10' $FILENAME - Name of the printed file, without path'#13#10' $PATH - Path of the printed file'
+ end
+ end
+ object FontDialog: TFontDialog
+ MinFontSize = 0
+ MaxFontSize = 0
+ Left = 200
+ Top = 16
+ end
+end
diff --git a/components/gridprinter/source/gridprnheaderfooterform.lrj b/components/gridprinter/source/gridprnheaderfooterform.lrj
new file mode 100644
index 000000000..a0ad0bb1c
--- /dev/null
+++ b/components/gridprinter/source/gridprnheaderfooterform.lrj
@@ -0,0 +1,12 @@
+{"version":1,"strings":[
+{"hash":226739922,"name":"tgridprintheaderfooterform.caption","sourcebytes":[72,101,97,100,101,114,47,70,111,111,116,101,114],"value":"Header/Footer"},
+{"hash":197166558,"name":"tgridprintheaderfooterform.edtextleft.texthint","sourcebytes":[84,101,120,116,32,105,110,32,108,101,102,116,45,97,108,105,103,110,101,100,32,115,101,99,116,105,111,110],"value":"Text in left-aligned section"},
+{"hash":148404254,"name":"tgridprintheaderfooterform.edtextcenter.texthint","sourcebytes":[84,101,120,116,32,105,110,32,99,101,110,116,101,114,101,100,32,115,101,99,116,105,111,110],"value":"Text in centered section"},
+{"hash":219388318,"name":"tgridprintheaderfooterform.edtextright.texthint","sourcebytes":[84,101,120,116,32,105,110,32,114,105,103,104,116,45,97,108,105,103,110,101,100,32,115,101,99,116,105,111,110],"value":"Text in right-aligned section"},
+{"hash":368487,"name":"tgridprintheaderfooterform.cbshow.caption","sourcebytes":[83,104,111,119],"value":"Show"},
+{"hash":224751950,"name":"tgridprintheaderfooterform.btnfont.caption","sourcebytes":[70,111,110,116,46,46,46],"value":"Font..."},
+{"hash":67550677,"name":"tgridprintheaderfooterform.cbshowline.caption","sourcebytes":[83,104,111,119,32,100,105,118,105,100,105,110,103,32,108,105,110,101],"value":"Show dividing line"},
+{"hash":248872777,"name":"tgridprintheaderfooterform.lbllinewidth.caption","sourcebytes":[76,105,110,101,32,119,105,100,116,104,32,40,109,109,41],"value":"Line width (mm)"},
+{"hash":124613410,"name":"tgridprintheaderfooterform.clblinecolor.caption","sourcebytes":[76,105,110,101,32,99,111,108,111,114],"value":"Line color"},
+{"hash":107799029,"name":"tgridprintheaderfooterform.lbltextinfo.caption","sourcebytes":[69,97,99,104,32,115,101,99,116,105,111,110,32,99,97,110,32,99,111,110,116,97,105,110,32,116,104,101,32,102,111,108,108,111,119,105,110,103,32,112,97,114,97,109,101,116,101,114,115,58,13,10,32,32,36,68,65,84,69,32,45,32,67,117,114,114,101,110,116,32,100,97,116,101,13,10,32,32,36,84,73,77,69,32,45,32,67,117,114,114,101,110,116,32,116,105,109,101,13,10,32,32,36,80,65,71,69,32,45,32,80,97,103,101,32,110,117,109,98,101,114,13,10,32,32,36,80,65,71,69,67,79,85,78,84,32,45,32,78,117,109,98,101,114,32,111,102,32,112,97,103,101,115,13,10,32,32,36,70,85,76,76,95,70,73,76,69,78,65,77,69,32,45,32,70,117,108,108,32,110,97,109,101,32,111,102,32,116,104,101,32,112,114,105,110,116,101,100,32,102,105,108,101,13,10,32,32,36,70,73,76,69,78,65,77,69,32,45,32,78,97,109,101,32,111,102,32,116,104,101,32,112,114,105,110,116,101,100,32,102,105,108,101,44,32,119,105,116,104,111,117,116,32,112,97,116,104,13,10,32,32,36,80,65,84,72,32,45,32,80,97,116,104,32,111,102,32,116,104,101,32,112,114,105,110,116,101,100,32,102,105,108,101],"value":"Each section can contain the following parameters:\r\n $DATE - Current date\r\n $TIME - Current time\r\n $PAGE - Page number\r\n $PAGECOUNT - Number of pages\r\n $FULL_FILENAME - Full name of the printed file\r\n $FILENAME - Name of the printed file, without path\r\n $PATH - Path of the printed file"}
+]}
diff --git a/components/gridprinter/source/gridprnheaderfooterform.pas b/components/gridprinter/source/gridprnheaderfooterform.pas
new file mode 100644
index 000000000..476663406
--- /dev/null
+++ b/components/gridprinter/source/gridprnheaderfooterform.pas
@@ -0,0 +1,226 @@
+unit GridPrnHeaderFooterForm;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel, StdCtrls,
+ ComCtrls, ExtCtrls, Spin, GridPrn;
+
+type
+
+ { TGridPrintHeaderFooterForm }
+
+ TGridPrintHeaderFooterForm = class(TForm)
+ Bevel1: TBevel;
+ Bevel2: TBevel;
+ Bevel3: TBevel;
+ btnFont: TButton;
+ ButtonPanel1: TButtonPanel;
+ cbShow: TCheckBox;
+ cbShowLine: TCheckBox;
+ clbLineColor: TColorButton;
+ edTextLeft: TEdit;
+ edTextCenter: TEdit;
+ edTextRight: TEdit;
+ FontDialog: TFontDialog;
+ lblTextInfo: TLabel;
+ lblLineWidth: TLabel;
+ seLineWidth: TFloatSpinEdit;
+ TabControl: TTabControl;
+ procedure btnFontClick(Sender: TObject);
+ procedure OKClick(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure TabControlChange(Sender: TObject);
+ procedure TabControlChanging(Sender: TObject; var {%H-}AllowChange: Boolean);
+ private
+ type
+ THFParams = record
+ Visible: Boolean;
+ LeftText: String;
+ CenterText: String;
+ RightText: String;
+ Font: TFont;
+ ShowLine: Boolean;
+ LineWidth: Double;
+ LineColor: TColor;
+ end;
+ private
+ FGridPrinter: TGridPrinter;
+ FParams: array[0..1] of THFParams; // 0=Header, 1=Footer
+ procedure SetGridPrinter(AValue: TGridPrinter);
+ protected
+ procedure ControlsToParams(AIndex: Integer);
+ procedure ParamsToControls(AIndex: Integer);
+ procedure ParamsToPrinter(AIndex: Integer);
+ procedure PrinterToParams(AIndex: Integer);
+ public
+ procedure UpdateStrings;
+ property GridPrinter: TGridPrinter read FGridPrinter write SetGridPrinter;
+ end;
+
+var
+ GridPrintHeaderFooterForm: TGridPrintHeaderFooterForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ GridPrnStrings;
+
+{ TGridPrintHeaderFooterForm }
+
+procedure TGridPrintHeaderFooterForm.FormActivate(Sender: TObject);
+var
+ delta: Integer;
+begin
+ delta := TabControl.Height - TabControl.ClientHeight;
+ Constraints.MinHeight := delta + clbLineColor.Top + clbLineColor.Height +
+ clbLinecolor.BorderSpacing.Bottom + ButtonPanel1.Height +
+ TabControl.BorderSpacing.Around * 2;
+ Constraints.MinWidth := edTextLeft.Left + edTextLeft.Width + Bevel1.Width +
+ edTextCenter.Width + Bevel2.Width + edTextRight.Width + edTextRight.BorderSpacing.Right +
+ TabControl.BorderSpacing.Around * 2;
+ Width := 0;
+ Height := 0;
+end;
+
+procedure TGridPrintHeaderFooterForm.OKClick(Sender: TObject);
+begin
+ ControlsToParams(TabControl.TabIndex);
+ ParamsToPrinter(0);
+ ParamsToPrinter(1);
+end;
+
+procedure TGridPrintHeaderFooterForm.btnFontClick(Sender: TObject);
+begin
+ FontDialog.Execute;
+end;
+
+procedure TGridPrintHeaderFooterForm.FormCreate(Sender: TObject);
+begin
+ UpdateStrings;
+ FParams[0].Font := TFont.Create;
+ FParams[1].Font := TFont.Create;
+end;
+
+procedure TGridPrintHeaderFooterForm.FormDestroy(Sender: TObject);
+begin
+ FParams[0].Font.Free;
+ FParams[1].Font.Free;
+end;
+
+procedure TGridPrintHeaderFooterForm.TabControlChange(Sender: TObject);
+begin
+ ParamsToControls(TabControl.TabIndex);
+end;
+
+procedure TGridPrintHeaderFooterForm.TabControlChanging(Sender: TObject;
+ var AllowChange: Boolean);
+begin
+ ControlsToParams(TabControl.TabIndex);
+end;
+
+procedure TGridPrintHeaderFooterForm.ControlsToParams(AIndex: Integer);
+begin
+ FParams[AIndex].Visible := cbShow.Checked;
+ FParams[AIndex].LeftText := edTextLeft.Text;
+ FParams[AIndex].CenterText:= edTextCenter.Text;
+ FParams[AIndex].RightText := edTextRight.Text;
+ FParams[AIndex].Font.Assign(FontDialog.Font);
+
+ FParams[AIndex].ShowLine := cbShowLine.Checked;
+ FParams[AIndex].LineWidth := seLineWidth.Value;
+ FParams[AIndex].LineColor := clbLinecolor.ButtonColor;
+end;
+
+procedure TGridPrintHeaderFooterForm.ParamsToControls(AIndex: Integer);
+begin
+ cbShow.Checked := FParams[AIndex].Visible;
+ edTextLeft.Text := FParams[AIndex].LeftText;
+ edTextCenter.Text := FParams[AIndex].CenterText;
+ edTextRight.Text := FParams[AIndex].RightText;
+ FontDialog.Font.Assign(FParams[AIndex].Font);
+
+ cbShowLine.Checked := FParams[AIndex].ShowLine;
+ seLineWidth.Value := FParams[AIndex].LineWidth;
+ clbLinecolor.ButtonColor := FParams[AIndex].LineColor;
+end;
+
+procedure TGridPrintHeaderFooterForm.ParamsToPrinter(AIndex: Integer);
+var
+ HF: TGridPrnHeaderFooter;
+begin
+ case AIndex of
+ 0: HF := FGridPrinter.Header;
+ 1: HF := FGridPrinter.Footer;
+ end;
+
+ with FParams[AIndex] do
+ begin
+ HF.Visible := Visible;
+ HF.Text := LeftText + HF.SectionSeparator + CenterText + HF.SectionSeparator + RightText;
+ HF.Font.Assign(Font);
+ HF.ShowLine := ShowLine;
+ HF.Linecolor := LineColor;
+ HF.LineWidth := LineWidth;
+ end;
+end;
+
+procedure TGridPrintHeaderFooterForm.PrinterToParams(AIndex: Integer);
+var
+ HF: TGridPrnHeaderFooter;
+begin
+ case AIndex of
+ 0: HF := FGridPrinter.Header;
+ 1: HF := FGridPrinter.Footer;
+ end;
+
+ with FParams[AIndex] do
+ begin
+ Visible := HF.Visible;
+ LeftText := HF.SectionText[hfsLeft];
+ CenterText := HF.SectionText[hfsCenter];
+ RightText := HF.SectionText[hfsRight];
+ Font.Assign(HF.Font);
+ ShowLine := HF.ShowLine;
+ LineColor := HF.RealLineColor;
+ LineWidth := HF.LineWidth;
+ end;
+end;
+
+procedure TGridPrintHeaderFooterForm.SetGridPrinter(AValue: TGridPrinter);
+begin
+ if AValue = nil then
+ raise Exception.Create('GridPrinter is nil.');
+
+ if FGridPrinter <> AValue then
+ begin
+ FGridPrinter := AValue;
+ PrinterToParams(0);
+ PrinterToParams(1);
+ ParamsToControls(TabControl.TabIndex);
+ end;
+end;
+
+procedure TGridPrintHeaderFooterForm.UpdateStrings;
+begin
+ TabControl.Tabs[0] := RSHeader;
+ TabControl.Tabs[1] := RSFooter;
+ cbShow.Caption := RSShow;
+ btnFont.Caption := RSFont;
+ lblTextInfo.Caption := RSHeaderFooterSectionParameterInfo;
+ cbShowLine.Caption := RSShowDividingLine;
+ lblLineWidth.Caption := RSLineWidthMM;
+ clbLineColor.Caption := RSLineColor;
+ edTextLeft.TextHint := RSTextInLeftAlignedSection;
+ edTextCenter.TextHint := RSTextInCenteredSection;
+ edTextRight.TextHint := RSTextInRightAlignedSection;
+end;
+
+end.
+
diff --git a/components/gridprinter/source/gridprnpreviewdlg.pas b/components/gridprinter/source/gridprnpreviewdlg.pas
new file mode 100644
index 000000000..a0ef21b85
--- /dev/null
+++ b/components/gridprinter/source/gridprnpreviewdlg.pas
@@ -0,0 +1,67 @@
+unit GridPrnPreviewDlg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, GridPrn, GridPrnPreviewForm;
+
+type
+ TGridPrintPreviewDialog = class(TComponent)
+ private
+ FGridPrinter: TGridPrinter;
+ FOptions: TGridPrintPreviewOptions;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Execute;
+ published
+ property GridPrinter: TGridPrinter read FGridPrinter write FGridPrinter;
+ property Options: TGridPrintPreviewOptions
+ read FOptions write FOptions default DEFAULT_GRIDPRN_OPTIONS;
+ end;
+
+implementation
+
+uses
+ Controls;
+
+constructor TGridPrintPreviewDialog.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOptions := DEFAULT_GRIDPRN_OPTIONS;
+end;
+
+procedure TGridPrintPreviewDialog.Execute;
+var
+ F: TGridPrintPreviewForm;
+begin
+ if FGridPrinter = nil then
+ exit;
+
+ F := TGridPrintPreviewForm.Create(nil);
+ try
+ F.GridPrinter := FGridPrinter;
+ F.Options := FOptions;
+ if (F.ShowModal = mrOK) then
+ FGridPrinter.Print;
+ finally
+ F.Free;
+ end;
+end;
+
+procedure TGridPrintPreviewDialog.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ begin
+ if AComponent = FGridPrinter then
+ FGridPrinter := nil;
+ end;
+end;
+
+end.
+
diff --git a/components/gridprinter/source/gridprnpreviewform.lfm b/components/gridprinter/source/gridprnpreviewform.lfm
new file mode 100644
index 000000000..afabfe099
--- /dev/null
+++ b/components/gridprinter/source/gridprnpreviewform.lfm
@@ -0,0 +1,596 @@
+object GridPrintPreviewForm: TGridPrintPreviewForm
+ Left = 331
+ Height = 649
+ Top = 129
+ Width = 938
+ Caption = 'Print Preview'
+ ClientHeight = 649
+ ClientWidth = 938
+ OnActivate = FormActivate
+ Position = poMainFormCenter
+ ShowHint = True
+ LCLVersion = '2.3.0.0'
+ object ToolBar: TToolBar
+ Left = 0
+ Height = 24
+ Top = 0
+ Width = 938
+ AutoSize = True
+ ButtonHeight = 24
+ ButtonWidth = 30
+ Caption = 'ToolBar'
+ EdgeBorders = []
+ Images = ToolbarImages
+ List = True
+ ShowCaptions = True
+ TabOrder = 0
+ OnResize = ToolBarResize
+ object tbPrint: TToolButton
+ Left = 1
+ Top = 0
+ Action = acPrint
+ end
+ object tbClose: TToolButton
+ Left = 570
+ Top = 0
+ Action = acClose
+ end
+ object tbFirst: TToolButton
+ Left = 60
+ Top = 0
+ Action = acFirstPage
+ ShowCaption = False
+ end
+ object tbPrev: TToolButton
+ Left = 90
+ Top = 0
+ Action = acPrevPage
+ ShowCaption = False
+ end
+ object tbNext: TToolButton
+ Left = 160
+ Top = 0
+ Action = acNextPage
+ ShowCaption = False
+ end
+ object tbLast: TToolButton
+ Left = 190
+ Top = 0
+ Action = acLastPage
+ ShowCaption = False
+ end
+ object tbDivider1: TToolButton
+ Left = 55
+ Height = 24
+ Top = 0
+ Caption = 'tbDivider1'
+ Style = tbsDivider
+ end
+ object tbDivider2: TToolButton
+ Left = 220
+ Height = 24
+ Top = 0
+ Caption = 'tbDivider2'
+ Style = tbsDivider
+ end
+ object tbZoomIn: TToolButton
+ Left = 225
+ Top = 0
+ Action = acZoomIn
+ ShowCaption = False
+ end
+ object tbDivider3: TToolButton
+ Left = 375
+ Height = 24
+ Top = 0
+ Caption = 'tbDivider3'
+ Style = tbsDivider
+ end
+ object tbZoomOut: TToolButton
+ Left = 255
+ Top = 0
+ Action = acZoomOut
+ ShowCaption = False
+ end
+ object InfoPanel: TPanel
+ Left = 720
+ Height = 24
+ Top = -1
+ Width = 196
+ Align = alRight
+ Alignment = taRightJustify
+ BorderSpacing.Top = 2
+ BevelOuter = bvNone
+ Color = clRed
+ ParentColor = False
+ TabOrder = 0
+ end
+ object tbZoomWidth: TToolButton
+ Left = 315
+ Top = 0
+ Action = acZoomToFitWidth
+ ShowCaption = False
+ end
+ object tbZoomHeight: TToolButton
+ Left = 345
+ Top = 0
+ Action = acZoomToFitHeight
+ ShowCaption = False
+ end
+ object tbZoom100: TToolButton
+ Left = 285
+ Top = 0
+ Action = acZoom100
+ ShowCaption = False
+ end
+ object edPageNumber: TEdit
+ Left = 120
+ Height = 23
+ Top = 0
+ Width = 40
+ Alignment = taCenter
+ OnEditingDone = edPageNumberEditingDone
+ OnKeyDown = edPageNumberKeyDown
+ OnMouseWheel = edPageNumberMouseWheel
+ TabOrder = 1
+ Text = 'edPageNumber'
+ end
+ object ToolButton1: TToolButton
+ Left = 470
+ Top = 0
+ Action = acPageMargins
+ ShowCaption = False
+ Style = tbsCheck
+ end
+ object tbHeaderFooter: TToolButton
+ Left = 440
+ Top = 0
+ Action = acHeaderFooter
+ ShowCaption = False
+ end
+ object tbDivider4: TToolButton
+ Left = 500
+ Height = 24
+ Top = 0
+ Caption = 'tbDivider4'
+ Style = tbsDivider
+ end
+ object tbPortraint: TToolButton
+ Left = 380
+ Top = 0
+ Action = acPortrait
+ ShowCaption = False
+ end
+ object tbLandscape: TToolButton
+ Left = 410
+ Top = 0
+ Action = acLandscape
+ ShowCaption = False
+ end
+ object ToolButton2: TToolButton
+ Left = 505
+ Top = 0
+ Action = acPrintColsFirst
+ ShowCaption = False
+ end
+ object ToolButton3: TToolButton
+ Left = 535
+ Top = 0
+ Action = acPrintRowsFirst
+ ShowCaption = False
+ end
+ object tbDivider5: TToolButton
+ Left = 565
+ Height = 24
+ Top = 0
+ Caption = 'tbDivider5'
+ Style = tbsDivider
+ end
+ end
+ object ScrollBox: TScrollBox
+ Left = 0
+ Height = 625
+ Top = 24
+ Width = 938
+ HorzScrollBar.Page = 98
+ HorzScrollBar.Tracking = True
+ VertScrollBar.Page = 98
+ VertScrollBar.Tracking = True
+ Align = alClient
+ ClientHeight = 621
+ ClientWidth = 934
+ Color = clAppWorkspace
+ ParentColor = False
+ TabOrder = 1
+ TabStop = True
+ OnMouseDown = ScrollBoxMouseDown
+ OnMouseWheel = PreviewImageMouseWheel
+ object PreviewImage: TImage
+ Left = 8
+ Height = 90
+ Top = 8
+ Width = 90
+ OnMouseDown = PreviewImageMouseDown
+ OnMouseMove = PreviewImageMouseMove
+ OnMouseUp = PreviewImageMouseUp
+ OnMouseWheel = PreviewImageMouseWheel
+ OnPaint = PreviewImagePaint
+ end
+ end
+ object ToolbarImages: TImageList
+ Scaled = True
+ Left = 248
+ Top = 56
+ Bitmap = {
+ 4C7A1100000010000000100000001A0600000000000078DAED5B4B6CDD4414BD
+ 8008B0E4271136E5B762C306092A214008A4F215E223B10195C20221D8F12F12
+ 15A8503E855D11AAF8AB24CF2F01DA081650C40A2804819A9084CFE249B0005A
+ C85349241AC18B39C78CD3C9C463CF789C9797D48B2BDBE339F7DEB99FF1F578
+ 1CC7B1C415D17791C42E9487779151746FBC215B4C996C73C5775B3EDADA45B6
+ C9B071DB94EBA3BF766CBBFA2D83DA2E328BC6B25AF0E8DB52985685F283EC1F
+ 5798BF264D34E509920F662C92CB262239458DEF5352C20B6DBC679515491F64
+ BD9D8CAB29F79A78B6F11EFABDF5F52B727C862D7781E691678F45911C67E2D9
+ 061E8FB30FE5E8D8F1A6DCA4783F62F05CC02FF4057FF69D6CC88D5ABF7DA089
+ 788B1C5B844FF488640AF419AF7F78474E4B743264DBF0890E916C467B676C97
+ 9C3C312417297DAE59826FCA6DA425ED0DB93E999386E4C2140F9B5CEDEA63D8
+ EBBA143FF5AE9C4AFDC1F361E7B8C258D598D338D987318D9BF6CB2265BF09F4
+ FF42E3778B9A631F70941DD3E747DAE5185C376853F07D304B8F442EC6C83E8C
+ 35F37EEB753951F1883916F2A14D49F0C143D43989ED860CFCF4A19C909373B7
+ A2DF57894D8FE439CFBF04F666571B7F13C9E9C8B7F5249E2FE73CD14B043B7D
+ 0B3BEDCCF0FBF9C8914B1DE7E451634E5B8FB6432EF3AD89D7B01DE8B0D107AF
+ 6139AFDDE3F14C199D1A90B352B9C06EF27C2605E343F5AFC27E25FD17143F35
+ F51EC177377C3F206796AC81B6AADA6047592CE8E7FD919CED358F35E4A9143B
+ 3E28E77A8EF7BEB2D82AF0AAF67852F1F805FCCE0BB17D19FB55E1BF2AE2A7A6
+ EE137D459F05F87B87AA89B796C1335619B3213C2687655DFABE091ECF97E1C1
+ DCD5F4B8BF9BF845FA47F25C37ED17EABFD0F8A969E588351A6BB58CE7E94ED6
+ 760EF51FD7630EB16634DA475DD67A58A3AA77C4453C5CF1EA9975A7E2319BAE
+ 99F8E0D53AC5A6540F954F5DC3EBFAA73573B7EC17EABFD0F859ED34362CE7A0
+ 76BB3B59EBC091D72E38B58ED504FD0ADC1BA06DC991D79144BC5F80FD9198CF
+ 233949BFC76BE8F22CEFDB78903FE819638DEC76A31EDDC67E99E3858E5CBFC9
+ 5BE74FF4403FD31E89AD304E97EF04EC07BDEE3272E551E4DAD35AEC2F59E74D
+ DF7BD98FFD4BCB6FC89BA6FC74FCA6DD6DE3CFAAC393752FF828CFFED0FB65B4
+ 8D64F94FAD215AFDAF9EE7F3C01F065D9B134351126F1867E26F1E23F98D7271
+ 3CACEC69E561C63F6D958E173A6C00F66FC563AE4C7D40B9861E5705F21829F9
+ 8CBC92D8ACF58CB592FF19B9E795FF26F9E6BF4587AEE5BF654DC139FF6DE377
+ CDFF8C9AA0CEFF5590FFE9B74DDBF7CF2ABE8F177C5B75A156D5F26B7C8D5F23
+ F1DB2A792F6F1F420773FCE5217603FD8E39F38AB278602FC9E3A1EF6B31F71A
+ A5C73C1E0578D3369D32BEC9ADCD2DF2F3C653CBEF3DF92BA87FBB57F60D95FC
+ 6EBF26E69FBC7B2EF38FA36D966DFE49F4E49EA041B960E11ECED9E682A79F30
+ BE037A7F9EB32DF56141FEFC638B03D4BEFF2EB7FC80F1B73CECDFEAD5F53F4B
+ 1D53987F0E7B3272F3AF085F947FA9EF1923A6AE2EF937392817334694AC03BC
+ F6CA3F152309DE889FBA4676987F02ED97E73F571D6DF11332D7761BEFF81ED2
+ AE9FBF2BFAFC6D2D674CA8BD7B7BB94E65F1E71CE2FC637EA3CFC2E3FC13EE93
+ E59E6CDB5E6DEE83260F0B9EEB637DCC41EEFFD17334BDE61E58F6B3E0E3744E
+ 58D46E5E7B9C43D70F7C31597E71C4CCA5B64B7DADC96F398C7F2FED9B6BFF48
+ 36E3F89119A35C2BA65FE99B3CFF136BF8BFCEFF1EA9BF6B7C8D3F5ADEFF3DF5
+ EED86AFBB2EF21BE78730E29E3379D8727BE6D7C17EC1C4DFFDFF5287E3AE0FF
+ BDE935F3DF4D53EE30DB921AA7292F2A1B4DF3DCF6EF9365BFCA4B68DF8D383F
+ 03B54A3FCEF79087C79C3843ACB627B51FF8BF42E6645BBCD4F815C7CFE7B5B1
+ 2E66DDACE6CD3EF35F22D4DBB38C0F7D0F30E347E335047A5FE52D8F4346FC33
+ CE47885358EE39D8AED7EC3ADEACEDD5FBC076D01FA083D0E705B34F52F737E5
+ 55DB7BC12AFE3F67A3C79C399B378F38EC4BEF377D53667F38FD14883F18801D
+ 617C2C8A9DFFE7CA5907FBCD98B1A56277B73E577A3E07A7CB6215FE4F17BCDA
+ 933C6CC6BFD27F8F9EBF59C4FFC6F15EFC1EDFC5F5F8D19E5333AE71085D5EF3
+ 1DA74DBEE79EECE12AF3FF3F3D4DF8CA
+ }
+ BitmapAdv = {
+ 4C69020000004C7A110000001800000018000000B10B00000000000078DAED5D
+ 7D8C5D45153FF583F8518D60D468B4884A827F68FC408D1FD1B4318A5634C658
+ BFA8FA8F088A1F51C0D428AE5A49255D4C50FF20048948E9BEFB762B58C5A8C5
+ 2A6CD5D652BAFB76DBBAED525A43BB24162C867477E9F6797EF79E799DDEDE8F
+ 99B9735FF775E78F93B77B67EE6FE69E3973CE99B9E79E69B7DBD4EE26F5D1D3
+ C6223AE1427CFBA232FC28A2A773DD36D3EF5B0DFAB609A12EEE41DF4CF15B11
+ 5D63FACC634DBAD6157F3CA2738AA82ABEF02A97AAE2337FAF2FA285C21F2E9F
+ D4EF73E18F469319F8B83ECC757FEC2A9F638DF8DE61F55C697CEE4F5F55F907
+ 868ECF63F450198F5D49C3BE879FED5B5E0998AA2D7E3EDF7AF294315FC0F82C
+ 672B45FFAB71DDEB137FF77A7A25CBC96AC65803E2BF3FDF75FED4289F75CFAF
+ 76B7FD873345ACBBF8796F0799D8115B62DC251A5F9754C3A3452C039F836FA3
+ FA0A3957F8F85B3D53ECFF705D13DF0A34BA8ECE55FE1268D700BD290F1F65BA
+ 8C3FF86B7A41090FCEE3F9FE40870F4DBA15F6260F1F65A8A3F16D3BFA97CB93
+ 88364ADD597EE64FA5F5C069FC51FD6AD267E27B92F2BBB37805BDA1F5E3D359
+ 7A260F5FFC80CB347DF359BD6CFBCDF44C358FB92FBFCAD36345F8A273EE54FE
+ C3E6CDF48C4EDB4D7A9FF4FBF8E810BDCA15BF3540AFE6F2B9582E1AF45ECD77
+ F8A9F80C7F2DD2C365F88275BFF82A3FD1AE6D96FEAFCEC5DF402FE43A4F81F0
+ 77815E5E237DFD9386BF5B78FFC522F9E5677E37A8C49E5D29CF39AEE18F4B9B
+ 5756B62B0DFAB2E08F69F89B843F3754C567395D2B587F4C5FE3FEFFBD323E63
+ 88AFB9B6A373227A8F3CD389D141BAC8197B805EAB7C8953C62959934E481B77
+ 39F33EA2DF08C6BFD23A82C7E5639DF9CD63E4C0F7AF6A6B878F96CCEF39D4B7
+ E0F9D7D4BCE5FBEEC8ABB77D233D87EBDCA7F5E3772C076FC8D5E783F446DD56
+ 70DDBFFC2DA26717F505E5DA7328DAC1FDBA89E7DF3741F81BD75275D6EDBF8D
+ 9E656C6F9BF411BE67C4C0CFD9C9E3756905BBFE2EC6F83E78C5BFDB98B6F2B5
+ DFE21AE3BE73C1F84F81ECE6FB20BD9EE7C1D7E113D581CFF2775874D12DB97D
+ 584FAFE03AFD5C67A903BE9A3F1BB3CA4722BA80CB1E963A477CE2A7B063DFD3
+ 173E7CF3D49A6A78CFDDF43C1FF8BEB0B3F07D6267E1EB7E3B6C04B7B5B8A27C
+ 7615BF6EFED43DBEDD90CF6ECC2F8FFAA156FD56B77E0E1428D099A1782FA249
+ 3796ADE51DD703AF619DF36FD16B876BC4AEB496CDD99FD9EFD306F73AB6F825
+ 2D0DFB5EAC91BDAE036AC6AF9B3F67531B75CEAF6EE8876EE8B7408102F50E41
+ 07401714BD73F1B2CFC43A0DBAAD06FCBB347DECBD0DD9F3DE14DA306EE35EAD
+ 8D915EC1AF933FBD8ADD8DF955B77EA85BBF050A14E8CC10F65EB1078BBD5887
+ 3889A5D8FBC51E70419D5B5CD761D8B3967B1FC65E764E9D8D7A1CB125FE3D9A
+ 5ECE6CA30ABED8953F6B6D1C447C8F2F7C9336AAE297B5E1035FE470B11E17C1
+ F4CF5EC1CFE0CF01150356C3F81ED0E3CB3CCBE78174ECDA7C9E5FB5EB879AF5
+ 5BDDFA39D0596DB7178F37E92BB26E3924B1B5F8DD84EB55F66D59DE3EC9388F
+ C6F17C4DFA41AB491F1A8DE8EDF86579FF21BE1F609A6A356885430C1EBE159B
+ 46FC9E1E3FAB13AECBB34DF3EF2A8B7DFE4F08F6D2AC98B89CF98D363E6E683F
+ 1ECD8A3B8CE76844C7B2DE634BCCE1E191DBE9B925B17478DE892C9EEC594F2F
+ 838EC16F16AFB86C5F593C642C273C96596545F8F27CABF558D5BC3528E443FD
+ BF23A217C196C4C4B2037CFCAA6B28D7F03FCCE58F94E0CF30FE3B3AF18DCCEF
+ 9298C3636ACC711FEE2FC13F5467FF110B8DB9E3C4FF26FD88CBFF50229F5761
+ 5EDACA0FE2E2E3EFEA9AF42503F99F829C5AC97F12177BA84CFE65AEACB09CBF
+ 5F88E37423DACD63F366C398D5556803F3324FFF80277A3CAFD0E36303F41643
+ 1DB742F664F6C563D7A04B6319E45F19CB7DB1BC494CBC4B1BE027E63CE62564
+ 0FF28DDFF87F1E4B94832731A6631B467B43C9F7294752DF34FD777C90DED64B
+ 6D802719BC3A9237277DB5E162430DDA50BCFA8FCFFE77C663885E8A7EE337F8
+ 3FBDE1FF14AC6F2AFB3F06DF5C54F27F8AC887FF63F0ECD5FC9F0CEA29FFC743
+ FF8BFC1F039B5DC9FF29DC03F1E0FF187C1754D9FFC999BFC1FF09FE4FF07FE6
+ A9FF93B5DF5FF0CDEF4197F8FFD6205D6C10677FB1E3FEAA777C3CA787BC0907
+ 8B7889792F73BFBD33A295EAFF3CDA99E4C768ABFF4DC6AC57F91FF0037EC00F
+ F8670ABF6EFD5CB77D39CBC6D7BB7F82359225AF876DF66AC467BCAC4C66947C
+ F15A60C2E63B06539EABBA23112D432C81E937A2B6F8A88B9C3FD2C696B23674
+ FCA27C7BE9BAD206722B6CD97B073DDF1BBE36566343B494D781BB79DDB6CD13
+ 7FA6CAFA50A5FF2E73CDA6FF55F16DF55AE87FE87FE8FFC2E97FCFF2C7D0BE67
+ 91CA01E7D13FC9A2A91083E4FCAD8215FFF1DEA00EFF50AD29E2DC5435F8874A
+ CE25D7A377FF509F47AEFEA1CD3C75F10F6DF58096BBF2BEAAF83CC6AF2BD375
+ 55F51BDAC893ABF9605FBA812FFBED8F64C5C84A6E9843FAFB162BFB75F27D41
+ 7FC1BBA6EBF5772136F82C6BC72DF4D0716BFCE4DDF72CF7EFBA027B85F771B3
+ BC2EBADA85FF62EF660AF83F8B3A55E4A728FE395D360FE4F3A0E9FEBDCF7731
+ 819CF7E2865D6375F4BD445FFB3FB6FB73B6FB3FA998C6F37CEFFF68B6F412D1
+ 5B3798CC4553FBAE611F13FC19D62F579BF86226FB3F9D581AC6947CC1880B7A
+ 324B07B9ECFFE8B1A4EAF9CBF2A95678D769ADEB027EC0EF757C3557157E91FF
+ E0822F719EFDF1FAAA41DFCDF37F9CF1F53895263DA5FB4FBEF88F36E053B22E
+ FD465DE35B877FD54DFC32FBEEB2FFE3E95DE15478FF35FFDF7FD9F4C5F7FE46
+ 2FBCFF3A1BF61F6C0963CB73E23B75E15791FF5D0DFAA0C8E04C89CE988973E0
+ 37E903A6F86C6B96C7B1FE115D8758DC421DCAE58CFD3DB4936E230F1FF313D8
+ 9D6B79E7FB68D7E51CB3AD86F8D32AD77F9C8F26A2A3BB06E9C2D3F2D468D751
+ 1FF719E29FDC776AD28D2ADE44D9A1CCEB19B26A82DF4ECED169AB5896F8EFF8
+ BBFB93D77DE1C7FB949D6FFAEBC13FB9DFE21FDF237FA6F5B3221023ACE42495
+ 4FE188A3FC6CC39CB191FFF8FC8A88FE516ADF07E922CCC3B164ADDD67327F05
+ 7B066B75039BF1047241481B5B635E15EB9FE9F88C9906BD3F830F9396E79FED
+ B0F57FE48CC635A594E42EC7370CF75BF93FCC638BBA0DF9F66C8BB1FF6387DF
+ 27E7DECC1AFB3F96F822EB466D58E327DFFDC4E7E9E15C1C8C07C6DC13FEA493
+ FF63889FF3BEA12FE007FC801FF0037E4DF89ACDB0A5F8DE62FC490FF13F93E1
+ FD9ED59AD707CF21170F64F971563EA183AF5855E6CB7C458FF899BEA24FFC2C
+ 5FD11B7E86AFC8F4A027FC4219AC8A5FA4EB027EC05FF0F8156C7A99AD977C02
+ ED9A685FB0E1BD47D8D363F9BB027124C86B829C16A5392522BAA0EC5D2FFB06
+ E7C859DC732939D95F968F01FBE3383BB924A7C7CFE57CE57E9C4388F37825DE
+ 6602718E45B16D65BEB53A5B5C3F17BAF3EC43F472EC9D73D92F9CF193DC46D8
+ D35B9263839B4C8F39E347B421293FFDEC78E1EF865671FFCAFA1FCA4379289F
+ A7E55C36D4B29CFFBB86E87C75DEBD8E1FE7588B68998EA5F417EEC9697FB095
+ D25F7CED36A6FFE1DDA3C2979C5243D0E3FA9919B0496237FA7362B58F8E37E9
+ D653F4F2067AB19C5FF724DB865F8A7E851E3C91753E3DAF657FA6EC07DA466C
+ A3BCD741CEBAC7D3F9BDE3B6EFA49770D9B8ACE960CB4EE4E5B982FD93B3E3E7
+ 52EF711E627A6BEED8721BAD24A71EEA5E65628BB9DEE5F159F5112D37C9EB35
+ BA8EF95B92C72B503EC567DA39FAE23C5603E30D5A95255F9AFD5E29B259C51F
+ 9F838C430E6BC8EB74BEC415626EDD54DB7E581247309797B3DED373609E5D5E
+ 077E9C7B2D59D35D534B6ECF445F017FB9F73569A267F7425FE5E914C830F2E4
+ B1BF3C6021FF91F8B747A167B37461BC7648F4F39CA3EC3F06FB9037C7645D02
+ D95D9B67C3AAACA7F26C97A7BD822BE231B78815B69C73D702DF26D63F3DA7B0
+ 36821DCBEC3F72C32673EE1227FEB28F023F027638AB0DF8147226FD04D66A4E
+ 3C48E2599E609C3D59B9EBB07EC51A5364B819CBB4AD2D18A09B254E652A6BAD
+ 8A6BE02364B9F2DE8C652E5A935CA0CAB7B2CDF36998A776A80E6CD12DCBF27C
+ 423F448BF2F4CEFF0127F2618F4C7A110000002000000020000000B30D000000
+ 00000078DAED5D6B8C1F55153F45041554C017A236C6E0EB93014D14A5E2BB7E
+ 50636A29F2F0111E41890242C19860EC17AB0245D4885D302ED43EF63FB36DC5
+ 6A31B1A6E2B6B5853EDCFD775FA911D8B2AD0462132A7DECBA5DCF993DB3BD3B
+ 9DC79DB98FF9EFEEF97092FFEEDC99DF9973CF3D8FFB38333E3E0EE342A7D0DE
+ 00C66DD274C5B725C799805F45D633095FFA7FE6F63FB6E9B2613734ED5897AE
+ BD7365C78BE4ED4AFF5A0D3FABDF3D519DD856F5CC542F055FF067127EC6D8EE
+ 9A2DF8D3ADFF67A90FE8925CB71AF5067076B3013F27A2DFBEF111F7E6B81FE9
+ 770DF84B14FC25CEC669085F6D06F0C7BE067C51179FDAD23D746F55DCC1D5F0
+ 7A7CC67A65ACFC47179FDAC6D75037D6F5AF83D795D4ADF3F1DE5E75AC222F7F
+ D6C5A7B68971BE979EA9897D1EB61F54EE3DD11BC2CFB605F04A5D7C6A4BF7D0
+ BD8A1C067A56C1B9F9F83007DBFE4EC13EBEB7015FAAAA7F88B910AF8FA87D91
+ ABD3015CA7BE77338405A6FACF3CA872F87A5ABB7D1BE14CBC3EA43CF35E5BE3
+ 0F65F853E5BD9E461ECE481967D72B6D0E24FBDB047FE7067815B63BA8E8F275
+ 29FE78D3247E08B7DAB63F2883EF648D25D6F951EE9FFF3557C39B6CE3F7AD85
+ 3763DB31BE6764CF7A3847B1571F5564BF436B9C86F083499DC2DF5A363B805D
+ 8A1E5EAAC8E60605BF5D13FF9324AB88F0B7A6CF58A9C8EC5A45F7EE54F07FA4
+ 6B277B3AE13D44DABEA4013F51F0172B7C2D5674EFC70E7DE6BD693A8EF2BB51
+ E1EB37CE7C69031E99C4C73E57F4FF52656CEC721873EF89717A02B864D23E04
+ F05A656C8CEA8CBF0AF1DAF9F11827AC7D2BE13509DEFE52C6FE94C60FE17645
+ C737A5E8C6B5CAF5E1EE157096CD58956CBAD2F75FCBB0D1FB15FB70B713BD0F
+ E0992CDF42F19AEA7FB37C7F49EC45AAFFC5BFAFC96CBF044EC3361B141E8ED1
+ FD95B103B8228A614E3EEF518A71727DE5C45850E32F1A17CBA87F74714977D8
+ E78F29CFE94FEA7CE6FD6BE1AD14332662C8217C9F3B282ECEBA6F77006F605B
+ BE5FBD1775A967600D5C504676142BE2BD1B5372D6B1C88E84F0308EA97B22DD
+ C2DF6C5BC692ED11FB0FAAAFADD0875F993276F4E900F277B5A5F17B06E7418F
+ 27F42949C7B1ED5F89E7B418CF06916E91BF271B42362DB26BC81BE27DA28C8E
+ 0A0909B53E715C720869378EF1B935CCD31E2A1393908F43DBF410C573689BE6
+ 599E276ED3F0DD3B549FE90B3F05DB1B7E06F651CC6B3FE51A9FB1B727DA1D6B
+ 86F03907EB046D3EB1F3F07D6067E147632CA5BF71DCCD77BC4ED3C679C25D3E
+ B05B15BF6EF9E7E8DF711FFAE793878AF6E7B80FFBD30AF6B715FC8F63FF5B6B
+ FC5177FC252424242424D4D2E75526D677FFD60CE016EF7B8142B8674A9CD201
+ EFAB0DDB237E2AB6C3F5D3445CB43465FE7B99603BDDF376F729EB2BA8035EC6
+ 37EA745DD8AD805FB7FC9531FFC394317F9FF0500B0FB5D9DF56F03FADE07F5B
+ 21FE1012121212129AD17B11D0B7928FC538F836EFFE3D11FFFB8EBB25FF90D8
+ 7F3AE41F36F70D4F87FCA3D5E6DF7CC95FE6DF64FEADCEF937DF7EA7EEF84348
+ 48484848A8C5EB62CCA5BD6AB4674D3DE36B10E3CE8BF6D205F06BDADF573246
+ 3A6461FFDF907A36BB8807DAA368B97EDB5022EECAE5C1363EC63C9F8EF6166B
+ F2601B3FE22184CF60BF1E49D4C3D845E7F67DE097E1C115BE2E0F2EF1799D6B
+ 7E9A3EC4674B5DE367F210C25DB301BF4EF993FE25B17DE99F0EB64BFBA3833D
+ 13ED6FDDFEA76EFF5B77FC5177FC2524245437C19CBE0EB898EA4944FB8C90E8
+ 37FDAFA89E8869CD1CA4FBA91E4D4ECD8961AA3562B7660FCCE13A22FFE5DA2D
+ 5D54A389EA64C5359F7A02B88CEA91E0B52DCCC7E1899A4E66F2886AD705D0C1
+ CFDC8A32FE90467CF0E1C933800D58F3543BBCC2E0BD57C767DD76B6C1CB75EF
+ DDBC194EA7BD7F7C6F58450E4A1DAE5F18E8CC033C3F7F7B85FA4C8749E6F42E
+ 39F1EFF78932CF00A2CCB82F0E97D149D6F31345FD8DED761215C4E81F29B71E
+ 1BD53D1CD6A9C7AA83CF71D0566CF7AC8E1E343BE103C99A68C6F8AC4B1336AA
+ 30C6BA9A6B825D660DBF011FE7F178A5C69A5E54FFADAF13DE99D4B5182F266C
+ F712D129FF4FE8647700EFD61D07716D30BAC7163ED9485E0FBE4D43565746FD
+ 1FC2C76CC93FAA113491275D5158EB2980F773DB3B6CEB5F6F275C5462FC6DB1
+ F6FE016CA33A58BA7638AED149BEC4143FAEE757544374CA18405B19D9CC00FE
+ 9EE77734EDEF13482F76AF8337965C5B5FCC63F69706F9627BEC03D3F2730D3D
+ 5855D5FFF634E0C1E4F9F7A44D29228A1D2886E0FBB717E983D2DF4FA4C567E4
+ 03CAF24072E0BE38CCCFD9128D27B4A971FC15D9D7067C97F59CDABC88D4698F
+ 07D649F4A1C97A7209A26BCB48D7B88EEB904D1E6279901D89EC24C7DFF47BC2
+ B64C1DDF84415819BC1E6C76C07B5DE70BC283160F43E5ED83651E42B8C947FE
+ 98C98327FC9887C4D87CDA87FC1376F23CF46FDF24F28D2DF9BFE4FF92FF9BE7
+ FF45E43AFFD78CE59DE5FF25E26027F97F595DB29DFF97E80327F97F16F9CAFF
+ 75F15DE5FF25D6CD9CE4FF65F5CF76FE5FC29E38C9FF35B19DE5FF9AF657F27F
+ C9FF25FF97DC5BF27FC9FFA76DFE4FDFE1289BC7A4C4758306BEACB0E6A9CE5E
+ A8E9844FDF2971F8BDCB7ECD18A44DD947D6A7FC5D96FA62191295CDAF6663FF
+ 0BBEE00BBEE00BBEE00BBEE00BFEECC2AF3BFEAE3BFF10FDAB37FF4E7C7BB32C
+ 8DA8DFD53590799F81AED3F7DA6FF4DDE7CA78DD11F110C0B7EAC057BEC75389
+ 0753FC680D44E521846F9BE017E95CD658231E682D27FA8E7D036EF68D5F9507
+ 9BF8491E74FAA26AFFE3FB2D2FE2B519C2A82BFCDE4EF8A08E7D70257F5BBEC0
+ D4E7CC347CD39843E42FF217F98BFC45FE227FC117FD73987FB6598A3F071DCE
+ BF0CDA96ABD0CC2299FF91F99F569AFFA96ADF6DCDFF98F8171BF33FA6FE4DE6
+ 7FCCE67F667BFCDD2AF868CB2EC4FF3F95779E83AE719B0B6DE233F67EAA3D49
+ 67F032F778E235AE4FB93FC94355FCFE35F0767EA7233ADFB3271EF8DCE0141E
+ 0CF28F91CAF14003464CF17B4F9E2B1CDC3B71BE203F0EA0368D891886EE35EF
+ FFE82CC0F2F86C6310C0CB32EF5F02A7ED0DE1617E463BFD6D45FFE9B9F1B98E
+ 10EED438BF3805DBCAF8C7E7A1FFF81ED9D93C1B4C6D92D862FF4AE11BADF9BA
+ DA8B2D346BF3C17E9FF95FC17E18E7F99FE9F836CDFF4CF14DF33F1BF6CD24FF
+ 53896A3AE3339E41BFF6A0AFFC4FC58ECFF6E1FDE345DFB5B595FF25B04FB04E
+ FD3B7A460E0FB6F2BF68CC05F0788CC7DFF36A8FF9C1F7B8C665FEC7CF5A89F4
+ 0DD51FB32E04F80E97BBCCFF5CC50355F78209BEE00BBEE00BBE3FFC2AFEC72A
+ 7E05FF6B13BF4AFC61BBFFCBC65F2EF48F78406C8A3F1FAA4BFF7DCF3F087EE5
+ FCB3CD51FCD9EF73FD5FD67F65FD57D67F65FD57D67F65FDD5F2FAC3E554DBB3
+ 2E7C5BE39FE26FB26DC9EF10EA10DD436391EA3D56C18FFB906A19518E52D647
+ F23DC31C532F2F83CFEF4DF51C7FBB6F239C59794E17EF9DAC3197529B320B9F
+ 65FEAC09F6941A73011CA0FCA2C4FE832324BF943A714BB1FDA69C3A72A9D759
+ 062F9578FF53FE4FF50DF3CE21E55DCFB20765F0A36F210470300B3FEFBA0D7C
+ 1DBB9683E3049FBF51F2645DF8844D31685DF875CB7FA6F67FBAFD89F67C5CAF
+ DA9753FA3F71BDAAFDE11872B87A6DEFA935C6D92E6CD57E7FAE914C3230E121
+ C28E6B8C87F0659DFC133117310FBFE2EB07587E6573D4557C2FF9F0074AE4DF
+ AB143DB88AFC5695F883BF9DB425EDBD15FC2E83FC7F2C9E37358CBF4CE88449
+ 5DC7AADF4D9D826FB0EE6D8CDF801B4C7830C567BF5F99071BF8263CD8C2AFCA
+ 834D7CB6FF37C53C50DD4F0FFA9F6B1F1CE27795390F671BDFD673055FF0055F
+ F0055FF0055FF005BF1E7C57642B8EAD485DB6E52A34EDCF77B8D4B7C2F920D7
+ E3AD683EC8B5BD29CAFF9DE317CC41F8B0B7793CF8B2F7593CF8F437693CF8F6
+ 77C9F9200FFA9F6B1F1CE277D9F4CBAEE523F8822FF8822FF8DEF14F788841B3
+ 6353B7F1B7E48342420E29DACF883135EF8F394444BF29B6AEB25791F7CD6FD7
+ DA531BC05CC4D995B9DF1AAF511B17F364BC87670FEF65196886B060CF7A3887
+ 887ED3FFF859BBA9AD6D7CDA4FCF6D7BE99C56DABEF778CFB78BF5FFDE46B4CF
+ 8BF2EBCFE7F4CF17F8794F3A98A78C72A7B4774FD44FD05A7777354F5BA14EBE
+ E00BBEE00BBEE00B7EE976DD2BE02CA2AC76C9EBB6F1F17FFFA4DA8BCD35F0B6
+ 643BFA1F5DA33645CFCDAB3348D772F01FE36BDD038FC2ABE376FCBB9BFF7E2C
+ 13BF012F501BFA5E79569BFE0E7817C73ECFA79E990FA0C9387F52E2D1DFC7DF
+ 80EB5905E7E6C44C2BB8DDB29C3A87F731FE2369D77BD6C23BF0FA732931F173
+ 742DAF5FFB3AE0626C379AB576C573E6147B8DF676C24559CFE909E0126C7354
+ C13E4AFFD31A0321DCAADCD78D32B99FA94789ED6FD18891174DB6E73DECA5CE
+ EBF159B1040D231F0BB59FD380A5445572ABCD9BE174C4FA2CBD6B540BA301F3
+ E97F92770A09399913DD6E7D8E11FD09D9F43C5BE914FF248D925DF5294FF2D3
+ E447C997C5F97AD5FA41A644BE2CB6DF75D9D038FE209B5E073EF9505DDF3913
+ F127E33FF4A3B341FF68FC45B1EA44BC38C6BAB7B0685E93E616A3F9BDC6C9FD
+ 0936EC4F51BFD35C6D3CA76AD1FE3EAF637F69AE5A994BEEA379CDBCB945EBBA
+ 39B12F259A4BF6899B38DF4A354A16D4343669ED609CE6CFA73B3EE5D7D88FFF
+ A23C332FD74BE8FE365BF2277CCEB3235D2ECAF994BC2ED23F5A3B30E561600D
+ 5CA08CA717D0EFCF2B33FE68EDC0741CE033CEC6676DE0671ECBAB3BA2D89FDD
+ 2ED79C8B7241B2BFB45E139D63B76B7FB5F02DFBFBA9F20FE02A5FD8FF08E02D
+ 4A5F16EA9F4DAA32FE6CE397B53FB395FE0FAE915C78
+ }
+ end
+ object ActionList: TActionList
+ Images = ToolbarImages
+ OnUpdate = ActionListUpdate
+ Left = 408
+ Top = 56
+ object acPrint: TAction
+ Caption = 'Print'
+ Hint = 'Print'
+ ImageIndex = 0
+ OnExecute = acPrintExecute
+ end
+ object acClose: TAction
+ Caption = 'Close'
+ Hint = 'Close'
+ ImageIndex = 1
+ OnExecute = acCloseExecute
+ end
+ object acFirstPage: TAction
+ Caption = 'First'
+ Hint = 'Show first page'
+ ImageIndex = 2
+ OnExecute = acFirstPageExecute
+ end
+ object acPrevPage: TAction
+ Caption = 'Previous'
+ Hint = 'Show previous page'
+ ImageIndex = 3
+ OnExecute = acPrevPageExecute
+ end
+ object acNextPage: TAction
+ Caption = 'Next'
+ Hint = 'Show next page'
+ ImageIndex = 4
+ OnExecute = acNextPageExecute
+ end
+ object acLastPage: TAction
+ Caption = 'Last'
+ Hint = 'Show last page'
+ ImageIndex = 5
+ OnExecute = acLastPageExecute
+ end
+ object acZoomIn: TAction
+ Caption = 'Zoom in'
+ Hint = 'Zoom in'
+ ImageIndex = 6
+ OnExecute = acZoomInZoomOutExecute
+ end
+ object acZoomOut: TAction
+ Caption = 'Zoom out'
+ Hint = 'Zoom out'
+ ImageIndex = 7
+ OnExecute = acZoomInZoomOutExecute
+ end
+ object acZoomToFitWidth: TAction
+ Caption = 'Fit width'
+ Hint = 'Zoom to fit width'
+ ImageIndex = 10
+ OnExecute = acZoomToFitWidthExecute
+ end
+ object acZoomToFitHeight: TAction
+ Caption = 'Fit height'
+ Hint = 'Zoom to fit page height'
+ ImageIndex = 11
+ OnExecute = acZoomToFitHeightExecute
+ end
+ object acZoom100: TAction
+ Caption = '100%'
+ Hint = 'Original size'
+ ImageIndex = 12
+ OnExecute = acZoom100Execute
+ end
+ object acPageMargins: TAction
+ Caption = 'Margins'
+ Hint = 'Page margins'
+ ImageIndex = 8
+ OnExecute = acPageMarginsExecute
+ end
+ object acHeaderFooter: TAction
+ Caption = 'Header/footer...'
+ Hint = 'Header/footer configuration'
+ ImageIndex = 9
+ OnExecute = acHeaderFooterExecute
+ end
+ object acPortrait: TAction
+ Caption = 'Portrait'
+ GroupIndex = 1
+ Hint = 'Portrait page orientation'
+ ImageIndex = 13
+ OnExecute = acPortraitExecute
+ end
+ object acLandscape: TAction
+ Caption = 'Landscape'
+ GroupIndex = 1
+ Hint = 'Landscape page orientation'
+ ImageIndex = 14
+ OnExecute = acLandscapeExecute
+ end
+ object acPrintColsFirst: TAction
+ Caption = 'Columns first'
+ GroupIndex = 2
+ Hint = 'First print columns from top to bottom,'#13#10'then print from left to right'
+ ImageIndex = 15
+ OnExecute = acPrintColsFirstExecute
+ end
+ object acPrintRowsFirst: TAction
+ Caption = 'Rows first'
+ GroupIndex = 2
+ Hint = 'First print rows from left to right,'#13#10'then print from top to bottom'
+ ImageIndex = 16
+ OnExecute = acPrintRowsFirstExecute
+ end
+ end
+end
diff --git a/components/gridprinter/source/gridprnpreviewform.lrj b/components/gridprinter/source/gridprnpreviewform.lrj
new file mode 100644
index 000000000..18917e5fb
--- /dev/null
+++ b/components/gridprinter/source/gridprnpreviewform.lrj
@@ -0,0 +1,44 @@
+{"version":1,"strings":[
+{"hash":1874375,"name":"tgridprintpreviewform.caption","sourcebytes":[80,114,105,110,116,32,80,114,101,118,105,101,119],"value":"Print Preview"},
+{"hash":191236306,"name":"tgridprintpreviewform.toolbar.caption","sourcebytes":[84,111,111,108,66,97,114],"value":"ToolBar"},
+{"hash":13109985,"name":"tgridprintpreviewform.tbdivider1.caption","sourcebytes":[116,98,68,105,118,105,100,101,114,49],"value":"tbDivider1"},
+{"hash":13109986,"name":"tgridprintpreviewform.tbdivider2.caption","sourcebytes":[116,98,68,105,118,105,100,101,114,50],"value":"tbDivider2"},
+{"hash":13109987,"name":"tgridprintpreviewform.tbdivider3.caption","sourcebytes":[116,98,68,105,118,105,100,101,114,51],"value":"tbDivider3"},
+{"hash":14901026,"name":"tgridprintpreviewform.edpagenumber.text","sourcebytes":[101,100,80,97,103,101,78,117,109,98,101,114],"value":"edPageNumber"},
+{"hash":13109988,"name":"tgridprintpreviewform.tbdivider4.caption","sourcebytes":[116,98,68,105,118,105,100,101,114,52],"value":"tbDivider4"},
+{"hash":13109989,"name":"tgridprintpreviewform.tbdivider5.caption","sourcebytes":[116,98,68,105,118,105,100,101,114,53],"value":"tbDivider5"},
+{"hash":5738580,"name":"tgridprintpreviewform.acprint.caption","sourcebytes":[80,114,105,110,116],"value":"Print"},
+{"hash":5738580,"name":"tgridprintpreviewform.acprint.hint","sourcebytes":[80,114,105,110,116],"value":"Print"},
+{"hash":4863637,"name":"tgridprintpreviewform.acclose.caption","sourcebytes":[67,108,111,115,101],"value":"Close"},
+{"hash":4863637,"name":"tgridprintpreviewform.acclose.hint","sourcebytes":[67,108,111,115,101],"value":"Close"},
+{"hash":5048740,"name":"tgridprintpreviewform.acfirstpage.caption","sourcebytes":[70,105,114,115,116],"value":"First"},
+{"hash":217173685,"name":"tgridprintpreviewform.acfirstpage.hint","sourcebytes":[83,104,111,119,32,102,105,114,115,116,32,112,97,103,101],"value":"Show first page"},
+{"hash":147653555,"name":"tgridprintpreviewform.acprevpage.caption","sourcebytes":[80,114,101,118,105,111,117,115],"value":"Previous"},
+{"hash":239386821,"name":"tgridprintpreviewform.acprevpage.hint","sourcebytes":[83,104,111,119,32,112,114,101,118,105,111,117,115,32,112,97,103,101],"value":"Show previous page"},
+{"hash":347380,"name":"tgridprintpreviewform.acnextpage.caption","sourcebytes":[78,101,120,116],"value":"Next"},
+{"hash":923269,"name":"tgridprintpreviewform.acnextpage.hint","sourcebytes":[83,104,111,119,32,110,101,120,116,32,112,97,103,101],"value":"Show next page"},
+{"hash":338084,"name":"tgridprintpreviewform.aclastpage.caption","sourcebytes":[76,97,115,116],"value":"Last"},
+{"hash":84807877,"name":"tgridprintpreviewform.aclastpage.hint","sourcebytes":[83,104,111,119,32,108,97,115,116,32,112,97,103,101],"value":"Show last page"},
+{"hash":23459486,"name":"tgridprintpreviewform.aczoomin.caption","sourcebytes":[90,111,111,109,32,105,110],"value":"Zoom in"},
+{"hash":23459486,"name":"tgridprintpreviewform.aczoomin.hint","sourcebytes":[90,111,111,109,32,105,110],"value":"Zoom in"},
+{"hash":106918100,"name":"tgridprintpreviewform.aczoomout.caption","sourcebytes":[90,111,111,109,32,111,117,116],"value":"Zoom out"},
+{"hash":106918100,"name":"tgridprintpreviewform.aczoomout.hint","sourcebytes":[90,111,111,109,32,111,117,116],"value":"Zoom out"},
+{"hash":108902056,"name":"tgridprintpreviewform.aczoomtofitwidth.caption","sourcebytes":[70,105,116,32,119,105,100,116,104],"value":"Fit width"},
+{"hash":28176728,"name":"tgridprintpreviewform.aczoomtofitwidth.hint","sourcebytes":[90,111,111,109,32,116,111,32,102,105,116,32,119,105,100,116,104],"value":"Zoom to fit width"},
+{"hash":116338068,"name":"tgridprintpreviewform.aczoomtofitheight.caption","sourcebytes":[70,105,116,32,104,101,105,103,104,116],"value":"Fit height"},
+{"hash":122522228,"name":"tgridprintpreviewform.aczoomtofitheight.hint","sourcebytes":[90,111,111,109,32,116,111,32,102,105,116,32,112,97,103,101,32,104,101,105,103,104,116],"value":"Zoom to fit page height"},
+{"hash":213797,"name":"tgridprintpreviewform.aczoom100.caption","sourcebytes":[49,48,48,37],"value":"100%"},
+{"hash":23626005,"name":"tgridprintpreviewform.aczoom100.hint","sourcebytes":[79,114,105,103,105,110,97,108,32,115,105,122,101],"value":"Original size"},
+{"hash":59301891,"name":"tgridprintpreviewform.acpagemargins.caption","sourcebytes":[77,97,114,103,105,110,115],"value":"Margins"},
+{"hash":116328739,"name":"tgridprintpreviewform.acpagemargins.hint","sourcebytes":[80,97,103,101,32,109,97,114,103,105,110,115],"value":"Page margins"},
+{"hash":208537918,"name":"tgridprintpreviewform.acheaderfooter.caption","sourcebytes":[72,101,97,100,101,114,47,102,111,111,116,101,114,46,46,46],"value":"Header/footer..."},
+{"hash":120242270,"name":"tgridprintpreviewform.acheaderfooter.hint","sourcebytes":[72,101,97,100,101,114,47,102,111,111,116,101,114,32,99,111,110,102,105,103,117,114,97,116,105,111,110],"value":"Header/footer configuration"},
+{"hash":110855028,"name":"tgridprintpreviewform.acportrait.caption","sourcebytes":[80,111,114,116,114,97,105,116],"value":"Portrait"},
+{"hash":97583166,"name":"tgridprintpreviewform.acportrait.hint","sourcebytes":[80,111,114,116,114,97,105,116,32,112,97,103,101,32,111,114,105,101,110,116,97,116,105,111,110],"value":"Portrait page orientation"},
+{"hash":79284965,"name":"tgridprintpreviewform.aclandscape.caption","sourcebytes":[76,97,110,100,115,99,97,112,101],"value":"Landscape"},
+{"hash":214097038,"name":"tgridprintpreviewform.aclandscape.hint","sourcebytes":[76,97,110,100,115,99,97,112,101,32,112,97,103,101,32,111,114,105,101,110,116,97,116,105,111,110],"value":"Landscape page orientation"},
+{"hash":252759476,"name":"tgridprintpreviewform.acprintcolsfirst.caption","sourcebytes":[67,111,108,117,109,110,115,32,102,105,114,115,116],"value":"Columns first"},
+{"hash":179142132,"name":"tgridprintpreviewform.acprintcolsfirst.hint","sourcebytes":[70,105,114,115,116,32,112,114,105,110,116,32,99,111,108,117,109,110,115,32,102,114,111,109,32,116,111,112,32,116,111,32,98,111,116,116,111,109,44,13,10,116,104,101,110,32,112,114,105,110,116,32,102,114,111,109,32,108,101,102,116,32,116,111,32,114,105,103,104,116],"value":"First print columns from top to bottom,\r\nthen print from left to right"},
+{"hash":90873668,"name":"tgridprintpreviewform.acprintrowsfirst.caption","sourcebytes":[82,111,119,115,32,102,105,114,115,116],"value":"Rows first"},
+{"hash":159637965,"name":"tgridprintpreviewform.acprintrowsfirst.hint","sourcebytes":[70,105,114,115,116,32,112,114,105,110,116,32,114,111,119,115,32,102,114,111,109,32,108,101,102,116,32,116,111,32,114,105,103,104,116,44,13,10,116,104,101,110,32,112,114,105,110,116,32,102,114,111,109,32,116,111,112,32,116,111,32,98,111,116,116,111,109],"value":"First print rows from left to right,\r\nthen print from top to bottom"}
+]}
diff --git a/components/gridprinter/source/gridprnpreviewform.pas b/components/gridprinter/source/gridprnpreviewform.pas
new file mode 100644
index 000000000..58b82e65a
--- /dev/null
+++ b/components/gridprinter/source/gridprnpreviewform.pas
@@ -0,0 +1,970 @@
+unit GridPrnPreviewForm;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Types, LazLoggerBase,
+ StdCtrls, ExtCtrls, ComCtrls, Dialogs, Menus, ActnList,
+ GridPrn;
+
+type
+ TGridPrintPreviewZoomMode = (zmCustom, zmFitWidth, zmFitHeight);
+
+ TGridPrintPreviewOption = (ppoNavigationBtns, ppoNavigationEdit,
+ ppoZoomBtns, ppoPageOrientationBtns, ppoMarginsBtn, ppoHeaderFooterBtn,
+ ppoPrintOrderBtns
+ );
+ TGridPrintPreviewOptions = set of TGridPrintPreviewOption;
+
+const
+ DEFAULT_GRIDPRN_OPTIONS = [
+ ppoNavigationBtns, ppoNavigationEdit,
+ ppoZoomBtns, ppoPageOrientationBtns, ppoMarginsBtn, ppoHeaderFooterBtn,
+ ppoPrintOrderBtns
+ ];
+
+type
+ { TGridPrintPreviewForm }
+
+ TGridPrintPreviewForm = class(TForm)
+ acPrint: TAction;
+ acClose: TAction;
+ acFirstPage: TAction;
+ acPrevPage: TAction;
+ acNextPage: TAction;
+ acLastPage: TAction;
+ acPageMargins: TAction;
+ acHeaderFooter: TAction;
+ acPortrait: TAction;
+ acLandscape: TAction;
+ acPrintColsFirst: TAction;
+ acPrintRowsFirst: TAction;
+ acZoom100: TAction;
+ acZoomToFitWidth: TAction;
+ acZoomToFitHeight: TAction;
+ acZoomOut: TAction;
+ acZoomIn: TAction;
+ ActionList: TActionList;
+ edPageNumber: TEdit;
+ InfoPanel: TPanel;
+ PreviewImage: TImage;
+ ScrollBox: TScrollBox;
+ ToolbarImages: TImageList;
+ ToolBar: TToolBar;
+ tbPrint: TToolButton;
+ tbClose: TToolButton;
+ tbFirst: TToolButton;
+ tbPrev: TToolButton;
+ tbNext: TToolButton;
+ tbLast: TToolButton;
+ tbDivider1: TToolButton;
+ tbDivider2: TToolButton;
+ tbDivider3: TToolButton;
+ tbZoomIn: TToolButton;
+ tbZoomOut: TToolButton;
+ tbZoomWidth: TToolButton;
+ tbZoomHeight: TToolButton;
+ tbZoom100: TToolButton;
+ ToolButton1: TToolButton;
+ tbHeaderFooter: TToolButton;
+ ToolButton2: TToolButton;
+ ToolButton3: TToolButton;
+ tbDivider5: TToolButton;
+ tbDivider4: TToolButton;
+ tbPortraint: TToolButton;
+ tbLandscape: TToolButton;
+ procedure acCloseExecute(Sender: TObject);
+ procedure acFirstPageExecute(Sender: TObject);
+ procedure acHeaderFooterExecute(Sender: TObject);
+ procedure acLandscapeExecute(Sender: TObject);
+ procedure acLastPageExecute(Sender: TObject);
+ procedure acNextPageExecute(Sender: TObject);
+ procedure acPageMarginsExecute(Sender: TObject);
+ procedure acPortraitExecute(Sender: TObject);
+ procedure acPrevPageExecute(Sender: TObject);
+ procedure acPrintColsFirstExecute(Sender: TObject);
+ procedure acPrintExecute(Sender: TObject);
+ procedure acPrintRowsFirstExecute(Sender: TObject);
+ procedure ActionListUpdate({%H-}AAction: TBasicAction; var {%H-}Handled: Boolean);
+ procedure acZoom100Execute(Sender: TObject);
+ procedure acZoomInZoomOutExecute(Sender: TObject);
+ procedure acZoomToFitHeightExecute(Sender: TObject);
+ procedure acZoomToFitWidthExecute(Sender: TObject);
+ procedure edPageNumberEditingDone(Sender: TObject);
+ procedure edPageNumberKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
+ procedure edPageNumberMouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
+ WheelDelta: Integer; {%H-}MousePos: TPoint; var {%H-}Handled: Boolean);
+ procedure FormActivate(Sender: TObject);
+ procedure PreviewImageMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure PreviewImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+ procedure PreviewImageMouseUp(Sender: TObject; {%H-}Button: TMouseButton;
+ {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
+ procedure PreviewImageMouseWheel(Sender: TObject; Shift: TShiftState;
+ WheelDelta: Integer; {%H-}MousePos: TPoint; var {%H-}Handled: Boolean);
+ procedure PreviewImagePaint(Sender: TObject);
+ procedure ScrollBoxKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
+ procedure ScrollBoxMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
+ {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
+ procedure ToolBarResize(Sender: TObject);
+ private
+ FActivated: Boolean;
+ FDraggedMargin: Integer; // 0=left margin, 1=top, 2=right, 3=bottom 4=header 5=footer
+ FDraggedPos: Integer;
+ FGridPrinter: TGridPrinter;
+ FHintWindow: THintWindow;
+ FPageCount: Integer;
+ FPageNumber: Integer;
+ FOptions: TGridPrintPreviewOptions;
+ FUpdatePreviewHandler: TNotifyEvent;
+ FZoom: Integer;
+ FZoomMax: Integer;
+ FZoomMin: Integer;
+ FZoomMode: TGridPrintPreviewZoomMode;
+ procedure SetGridPrinter(AValue: TGridPrinter);
+ procedure SetPageNumber(AValue: Integer);
+ procedure SetOptions(AValue: TGridPrintPreviewOptions);
+ protected
+ function CalcDraggedMargin(AMargin: Integer; APosition: Integer): Double;
+ procedure DoOnResize; override;
+ procedure HideDraggedMarginHint;
+ function MouseOverMarginLine(X, Y: Integer): Integer;
+ function NextZoomFactor(AZoomIn: Boolean): Integer;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure ShowDraggedMarginHint(AMarginIndex, ADraggedPos: Integer; AMarginName: String);
+ procedure ShowPage(APageNo: Integer; AZoom: Integer = 0;
+ AZoomMode: TGridPrintPreviewZoomMode = zmCustom);
+ procedure UpdateInfoPanel;
+ procedure VerifyZoomMin;
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure UpdateStrings;
+ procedure ZoomToFitHeight;
+ procedure ZoomToFitWidth;
+ property PageNumber: Integer read FPageNumber write SetPageNumber;
+
+ published
+ property GridPrinter: TGridPrinter read FGridPrinter write SetGridPrinter;
+ property Options: TGridPrintPreviewOptions
+ read FOptions write SetOptions default DEFAULT_GRIDPRN_OPTIONS;
+
+ end;
+
+var
+ GridPrintPreviewForm: TGridPrintPreviewForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ LCLIntf, LCLType, Printers, GridPrnStrings, GridPrnHeaderFooterForm;
+
+const
+ ZOOM_MULTIPLIER = 1.05;
+
+{ Returns true when X1 is in range between X2-Delta and X2+Delta. }
+function InRange(X1, X2, Delta: Integer): Boolean; inline;
+begin
+ Result := (X1 >= X2-Delta) and (X1 <= X2+Delta);
+end;
+
+{ Returns X if it is in the range between X1 and X2, otherwise either X1 or X2,
+ depending on wheter X is X2. }
+function EnsureRange(X, X1, X2: Integer): Integer;
+begin
+ if X < X1 then
+ Result := X1
+ else
+ if X > X2 then
+ Result := X2
+ else
+ Result := X;
+end;
+
+{ TGridPrintPreviewForm }
+
+constructor TGridPrintPreviewForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ Scrollbox.OnKeyDown := @ScrollBoxKeyDown;
+ InfoPanel.ParentColor := true;
+ FPageNumber := 0;
+ FZoom := 100;
+ FZoomMax := 1000; // To avoid too-large bitmaps
+ FZoomMin := 10;
+ FDraggedMargin := -1;
+ FOptions := DEFAULT_GRIDPRN_OPTIONS;
+ VerifyZoomMin;
+ ActiveControl := Scrollbox;
+ UpdateStrings;
+end;
+
+procedure TGridPrintPreviewForm.acCloseExecute(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TGridPrintPreviewForm.acFirstPageExecute(Sender: TObject);
+begin
+ ShowPage(1);
+end;
+
+procedure TGridPrintPreviewForm.acHeaderFooterExecute(Sender: TObject);
+var
+ F: TGridPrintHeaderFooterForm;
+begin
+ F := TGridPrintHeaderFooterForm.Create(nil);
+ try
+ F.GridPrinter := FGridPrinter;
+ if F.ShowModal = mrOK then
+ ShowPage(FPageNumber, FZoom);
+ finally
+ F.Free;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.acLandscapeExecute(Sender: TObject);
+begin
+ if Assigned(FGridPrinter) then
+ begin
+ acLandscape.Checked := true;
+ FGridPrinter.Orientation := poLandscape;
+ ShowPage(FPageNumber);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.acLastPageExecute(Sender: TObject);
+begin
+ ShowPage(FPageCount);
+end;
+
+procedure TGridPrintPreviewForm.acNextPageExecute(Sender: TObject);
+begin
+ if FPageNumber < FPageCount then
+ ShowPage(FPageNumber+1);
+end;
+
+procedure TGridPrintPreviewForm.acPageMarginsExecute(Sender: TObject);
+begin
+ acPageMargins.Checked := not acPageMargins.Checked;
+ PreviewImage.Invalidate;
+end;
+
+procedure TGridPrintPreviewForm.acPortraitExecute(Sender: TObject);
+begin
+ if Assigned(FGridPrinter) then
+ begin
+ acPortrait.Checked := true;
+ FGridPrinter.Orientation := poPortrait;
+ ShowPage(FPageNumber);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.acPrevPageExecute(Sender: TObject);
+begin
+ if FPageNumber > 1 then
+ ShowPage(FPageNumber-1);
+end;
+
+procedure TGridPrintPreviewForm.acPrintColsFirstExecute(Sender: TObject);
+begin
+ if Assigned(FGridPrinter) then
+ begin
+ acPrintColsFirst.Checked := true;
+ FGridPrinter.PrintOrder := poColsFirst;
+ ShowPage(FPageNumber);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.acPrintExecute(Sender: TObject);
+begin
+ ModalResult := mrOK;
+end;
+
+procedure TGridPrintPreviewForm.acPrintRowsFirstExecute(Sender: TObject);
+begin
+ if Assigned(FGridPrinter) then
+ begin
+ acPrintRowsFirst.Checked := true;
+ FGridPrinter.PrintOrder := poRowsFirst;
+ ShowPage(FPageNumber);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.acZoom100Execute(Sender: TObject);
+begin
+ ShowPage(FPageNumber, 100);
+end;
+
+procedure TGridPrintPreviewForm.acZoomToFitHeightExecute(Sender: TObject);
+begin
+ ZoomToFitHeight;
+end;
+
+procedure TGridPrintPreviewForm.ActionListUpdate(AAction: TBasicAction;
+ var Handled: Boolean);
+begin
+ acPrint.Enabled := (FGridPrinter <> nil) and (FPageCount > 0);
+ acFirstPage.Enabled := (FGridPrinter <> nil) and (FPageCount > 0) and (FPageNumber > 1);
+ acPrevPage.Enabled := acFirstPage.Enabled;
+ acNextPage.Enabled := (FGridPrinter <> nil) and (FPageCount > 0) and (FPageNumber < FPageCount);
+ acLastPage.Enabled := acNextPage.Enabled;
+
+ acZoomIn.Enabled := acPrint.Enabled;
+ acZoomOut.Enabled := acPrint.Enabled;
+ acZoom100.Enabled := acPrint.Enabled;
+ acZoomToFitWidth.Enabled := acPrint.Enabled;
+ acZoomToFitHeight.Enabled := acPrint.Enabled;
+
+ acPortrait.Enabled := (FGridPrinter <> nil);
+ acLandscape.Enabled := (FGridPrinter <> nil);
+ acHeaderFooter.Enabled := acPrint.Enabled;
+ acPageMargins.Enabled := acPrint.Enabled;
+ acPrintColsFirst.Enabled := acPrint.Enabled;;
+ acPrintRowsFirst.Enabled := acPrint.Enabled;;
+end;
+
+procedure TGridPrintPreviewForm.acZoomInZoomOutExecute(Sender: TObject);
+var
+ newZoom: Integer;
+begin
+ newZoom := NextZoomFactor(Sender = acZoomIn);
+ ShowPage(FPageNumber, newZoom);
+end;
+
+{ Selects a zoom factor such that the preview of the page fills the form. }
+procedure TGridPrintPreviewForm.acZoomToFitWidthExecute(Sender: TObject);
+begin
+ ZoomToFitWidth;
+end;
+
+{ Converts the position of the dragged margin to millimeters. }
+function TGridPrintPreviewForm.CalcDraggedMargin(AMargin: Integer;
+ APosition: Integer): Double;
+begin
+ case AMargin of
+ 0: Result := px2mm(APosition, FGridPrinter.PixelsPerInchX);
+ 1: Result := px2mm(APosition, FGridPrinter.PixelsPerInchY);
+ 2: Result := px2mm(FGridPrinter.PageWidth - APosition, FGridPrinter.PixelsPerInchX);
+ 3: Result := px2mm(FGridPrinter.PageHeight - APosition, FGridPrinter.PixelsPerInchY);
+ 4: Result := px2mm(APosition, FGridPrinter.PixelsPerInchY);
+ 5: Result := px2mm(FGridPrinter.PageHeight - APosition, FGridPrinter.PixelsPerInchY);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.DoOnResize;
+begin
+ case FZoomMode of
+ zmFitWidth: ZoomToFitWidth;
+ zmFitHeight: ZoomToFitHeight;
+ zmCustom: ;
+ end;
+ inherited;
+end;
+
+{ Allows to select a page by entering its number in the PageNo edit and
+ pressing ENTER: }
+procedure TGridPrintPreviewForm.edPageNumberEditingDone(Sender: TObject);
+begin
+ if TryStrToInt(edPageNumber.Text, FPageNumber) then
+ begin
+ if FPageNumber < 1 then FPageNumber := 1;
+ if FPageNumber > FPageCount then FPageNumber := FPageCount;
+ ShowPage(FPageNumber);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.edPageNumberKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ case Key of
+ VK_LEFT:
+ if FPageNumber > 1 then ShowPage(FPageNumber-1);
+ VK_RIGHT:
+ if FPageNumber < FPageCount then ShowPage(FPageNumber+1);
+ VK_HOME:
+ ShowPage(1);
+ VK_END:
+ ShowPage(FPageCount);
+ end;
+end;
+
+{ Activates scrolling of pages by means of rotating mouse wheel over the
+ PageNo edit. }
+procedure TGridPrintPreviewForm.edPageNumberMouseWheel(Sender: TObject;
+ Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
+ var Handled: Boolean);
+begin
+ if WheelDelta < 0 then
+ begin
+ if FPageNumber < FPageCount then FPageNumber := FPageNumber + 1 else exit;
+ end else
+ if FPageNumber > 1 then FPageNumber := FPageNumber - 1 else exit;
+ ShowPage(FPageNumber);
+end;
+
+procedure TGridPrintPreviewForm.FormActivate(Sender: TObject);
+begin
+ if FActivated then
+ exit;
+ FUpdatePreviewHandler := FGridPrinter.OnUpdatePreview;
+ ShowPage(1, 100);
+ FActivated := true;
+end;
+
+procedure TGridPrintPreviewForm.HideDraggedMarginHint;
+begin
+ FreeAndNil(FHintWindow);
+end;
+
+// Result 0=left margin, 1=top margin, 2=right margin, 3=bottom margin, 4=header, 5=footer
+function TGridPrintPreviewForm.MouseOverMarginLine(X, Y: Integer): Integer;
+CONST
+ DELTA = 4;
+var
+ coord: Integer;
+begin
+ if (FGridPrinter = nil) or (not acPageMargins.Checked) then
+ exit(-1);
+
+ if InRange(X, FGridPrinter.PageRect.Left, DELTA) then
+ exit(0);
+
+ if InRange(Y, FGridPrinter.PageRect.Top, DELTA) then
+ exit(1);
+
+ if InRange(X, FGridPrinter.PageRect.Right, DELTA) then
+ exit(2);
+
+ if InRange(Y, FGridPrinter.PageRect.Bottom, DELTA) then
+ exit(3);
+
+ if FGridPrinter.Header.IsShown then
+ begin
+ coord := mm2px(FGridPrinter.Margins.Header, FGridPrinter.PixelsPerInchY);
+ if InRange(y, coord, DELTA) then
+ exit(4);
+ end;
+
+ if FGridPrinter.Footer.IsShown then
+ begin
+ coord := mm2px(FGridPrinter.Margins.Footer, FGridPrinter.PixelsPerInchY);
+ if InRange(y, FGridPrinter.PageHeight - coord, DELTA) then
+ exit(5);
+ end;
+
+ Result := -1;
+end;
+
+function TGridPrintPreviewForm.NextZoomFactor(AZoomIn: Boolean): Integer;
+begin
+ if AZoomIn then
+ Result := round(FZoom * ZOOM_MULTIPLIER)
+ else
+ Result := round(FZoom / ZOOM_MULTIPLIER);
+ Result := EnsureRange(Result, FZoomMin, FZoomMax);
+end;
+
+procedure TGridPrintPreviewForm.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ begin
+ if AComponent = FGridPrinter then
+ FGridPrinter := nil;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.PreviewImageMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+ Scrollbox.SetFocus;
+ if (ssLeft in Shift) then
+ FDraggedMargin := MouseOverMarginLine(X, Y);
+end;
+
+procedure TGridPrintPreviewForm.PreviewImageMouseMove(Sender: TObject;
+ Shift: TShiftState; X, Y: Integer);
+var
+ minWidth: Integer;
+ minHeight: Integer;
+ y0: Integer;
+ one_mm: Integer;
+ marginName: String;
+begin
+ if (FGridPrinter = nil) or not (acPageMargins.Checked) then
+ exit;
+
+ if not (ssLeft in Shift) then
+ begin
+ FDraggedMargin := MouseOverMarginLine(X, Y);
+ case FDraggedMargin of
+ -1:
+ begin
+ Screen.Cursor := crDefault;
+ HideDraggedMarginHint;
+ exit;
+ end;
+ 0,2:
+ begin
+ Screen.Cursor := crHSplit;
+ FDraggedPos := X;
+ end;
+ 1,3,4,5:
+ begin
+ Screen.Cursor := crVSplit;
+ FDraggedPos := Y;
+ end;
+ end;
+ end;
+
+ if (ssLeft in Shift) then
+ begin
+ minWidth := FGridPrinter.PageWidth div 4;
+ minHeight := FGridPrinter.PageHeight div 4;
+ one_mm := mm2px(1.0, FGridPrinter.PixelsPerInchY);
+ case FDraggedMargin of
+ 0: begin
+ // Left margin
+ FDraggedPos := X;
+ if (FDraggedPos < 0) then
+ FDraggedPos := 0;
+ if FGridPrinter.PageRect.Right - FDraggedPos < minWidth then
+ FDraggedPos := FGridPrinter.PageRect.Right - minWidth
+ end;
+ 1: begin
+ // Top margin
+ FDraggedPos := Y;
+ if FGridPrinter.Header.IsShown then
+ begin
+ y0 := FGridPrinter.HeaderMargin + one_mm;
+ if (FDraggedPos < y0) then
+ FDraggedPos := y0;
+ end;
+ if (FDraggedPos < 0) then
+ FDraggedPos := 0;
+ if FGridPrinter.PageRect.Bottom - FDraggedPos < minHeight then
+ FDraggedPos := FGridPrinter.PageRect.Bottom - minWidth;
+ end;
+ 2: begin
+ // Right margin
+ FDraggedPos := X;
+ if FDraggedPos > FGridPrinter.PageWidth then
+ FDraggedPos := FGridPrinter.PageWidth;
+ if FDraggedPos - FGridPrinter.PageRect.Left < minWidth then
+ FDraggedPos := FGridPrinter.PageRect.Left + minWidth;
+ end;
+ 3: begin
+ // Bottom margin
+ FDraggedPos := Y;
+ if FGridPrinter.Footer.IsShown then
+ begin
+ y0 := FGridPrinter.PageHeight - FGridPrinter.FooterMargin - one_mm;
+ if FDraggedPos > y0 then
+ FDraggedPos := y0;
+ end;
+ if FDraggedPos > FGridPrinter.PageHeight then
+ FDraggedPos := FGridPrinter.PageHeight;
+ if FDraggedPos - FGridPrinter.PageRect.Top < minHeight then
+ FDraggedPos := FGridPrinter.PageRect.Top + minHeight;
+ end;
+ 4: begin
+ // Header
+ FDraggedPos := Y;
+ if FDraggedPos < 0 then
+ FDraggedPos := 0;
+ if FDraggedPos > FGridPrinter.PageRect.Top - one_mm then
+ FDraggedPos := FGridPrinter.PageRect.Top - one_mm;
+ end;
+ 5: begin
+ // Footer
+ FDraggedPos := Y;
+ if FDraggedPos > FGridPrinter.PageHeight then
+ FDraggedPos := FGridPrinter.PageHeight;
+ if FDraggedPos < FGridPrinter.PageRect.Bottom + one_mm then
+ FDraggedPos := FGridPrinter.PageRect.Bottom + one_mm;
+ end;
+ else
+ raise Exception.Create('[PreviewImageMouseMove] Unexpected value of FDraggedMargin');
+ end;
+
+
+ // Redraw the preview to update the dragged red margin line
+ PreviewImage.Repaint;
+ end;
+
+ case FDraggedMargin of
+ 0: marginName := RSLeftMargin;
+ 1: marginName := RSTopMargin;
+ 2: marginName := RSRightMargin;
+ 3: marginName := RSBottomMargin;
+ 4: marginName := RSHeaderMargin;
+ 5: marginName := RSFooterMargin;
+ else
+ raise Exception.Create('[PreviewImageMouseMove] Unexpected value of FDraggedMargin');
+ end;
+ ShowDraggedMarginHint(FDraggedMargin, FDraggedPos, marginName);
+end;
+
+procedure TGridPrintPreviewForm.PreviewImageMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+var
+ dragged: Integer;
+ newMargin: Double;
+begin
+ if (FDraggedMargin > -1) then
+ begin
+ newMargin := CalcDraggedMargin(FDraggedMargin, FDraggedPos);
+ dragged := FDraggedMargin;
+ FDraggedMargin := -1;
+ case dragged of
+ 0: FGridPrinter.Margins.Left := newMargin;
+ 1: FGridPrinter.Margins.Top := newMargin;
+ 2: FGridPrinter.Margins.Right := newMargin;
+ 3: FGridPrinter.Margins.Bottom := newMargin;
+ 4: FGridPrinter.Margins.Header := newMargin;
+ 5: FGridPrinter.Margins.Footer := newMargin;
+ end;
+ HideDraggedMarginHint;
+ Screen.Cursor := crDefault;
+ ShowPage(FPageNumber);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.PreviewImageMouseWheel(Sender: TObject;
+ Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
+ var Handled: Boolean);
+var
+ newZoom: Integer;
+begin
+ if (ssCtrl in Shift) then
+ begin
+ newZoom := NextZoomFactor(WheelDelta > 0);
+ ShowPage(FPageNumber, newZoom);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.PreviewImagePaint(Sender: TObject);
+var
+ x, y: Integer;
+
+begin
+ if FGridPrinter = nil then
+ exit;
+
+ if acPageMargins.Checked then
+ begin
+ PreviewImage.Canvas.Pen.Color := clRed;
+ PreviewImage.Canvas.Pen.Style := psDash;
+
+ // Left margin line
+ if FDraggedMargin = 0 then
+ x := FDraggedPos
+ else
+ x := FGridPrinter.PageRect.Left;
+ PreviewImage.Canvas.Line(x, 0, x, PreviewImage.Height);
+
+ // Top margin line
+ if FDraggedMargin = 1 then
+ y := FDraggedPos
+ else
+ y := FGridPrinter.PageRect.Top;
+ PreviewImage.Canvas.Line(0, y, PreviewImage.Width, y);
+
+ // Right margin line
+ if FDraggedMargin = 2 then
+ x := FDraggedPos
+ else
+ x := FGridPrinter.PageRect.Right;
+ PreviewImage.Canvas.Line(x, 0, x, PreviewImage.Height);
+
+ // Bottom margin line
+ if FDraggedMargin = 3 then
+ y := FDraggedPos
+ else
+ y := FGridPrinter.PageRect.Bottom;
+ PreviewImage.Canvas.Line(0, y, PreviewImage.Width, y);
+
+ // Header line
+ if FGridPrinter.Header.IsShown then
+ begin
+ if FDraggedMargin = 4 then
+ y := FDraggedPos
+ else
+ y := mm2px(FGridPrinter.Margins.Header, FGridPrinter.PixelsPerInchY);
+ PreviewImage.Canvas.Line(0, y, PreviewImage.Width, y);
+ end;
+
+ // Footer line
+ if FGridPrinter.Footer.IsShown then
+ begin
+ if FDraggedMargin = 5 then
+ y := FDraggedPos
+ else
+ y := FGridPrinter.PageHeight - mm2px(FGridPrinter.Margins.Footer, FGridPrinter.PixelsPerInchY);
+ PreviewImage.Canvas.Line(0, y, PreviewImage.Width, y);
+ end;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.ScrollBoxKeyDown(Sender: TObject;
+ var Key: Word; Shift: TShiftState);
+begin
+ case Key of
+ VK_DOWN, VK_Next:
+ with Scrollbox.VertScrollbar do
+ begin
+ if (Position = Range-Page) and (FPageNumber < FPageCount) then
+ begin
+ ShowPage(FPageNumber+1);
+ Position := 0;
+ end
+ else
+ case Key of
+ VK_DOWN: Position := Position + Increment;
+ VK_NEXT: Position := Position + Page;
+ end;
+ end;
+ VK_UP, VK_PRIOR:
+ with Scrollbox.VertScrollbar do
+ begin
+ if (Position = 0) and (FPageNumber > 1) then
+ begin
+ ShowPage(FPageNumber-1);
+ Position := Range-Page;
+ end
+ else
+ case Key of
+ VK_UP: Position := Position - Increment;
+ VK_PRIOR: Position := Position - Page;
+ end;
+ end;
+ VK_LEFT:
+ with Scrollbox.HorzScrollbar do
+ Position := Position - Increment;
+ VK_RIGHT:
+ with Scrollbox.HorzScrollbar do
+ Position := Position + Increment;
+ VK_HOME:
+ with Scrollbox.HorzScrollbar do
+ Position := Position - Page;
+ VK_END:
+ with Scrollbox.HorzScrollbar do
+ Position := Position + Page;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.ScrollBoxMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+ Scrollbox.SetFocus;
+end;
+
+procedure TGridPrintPreviewForm.SetGridPrinter(AValue: TGridPrinter);
+begin
+ if FGridPrinter <> AValue then
+ begin
+ FGridPrinter := AValue;
+ case FGridPrinter.Orientation of
+ poPortrait: acPortrait.Checked := true;
+ poLandscape: acLandscape.Checked := true;
+ end;
+ case FGridPrinter.PrintOrder of
+ poRowsFirst: acPrintRowsFirst.Checked := true;
+ poColsFirst: acPrintColsFirst.Checked := true;
+ end;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.SetOptions(AValue: TGridPrintPreviewOptions);
+begin
+ if FOptions <> AValue then
+ begin
+ FOptions := AValue;
+
+ acFirstPage.Visible := ppoNavigationBtns in FOptions;
+ acPrevpage.Visible := acFirstpage.Visible;
+ acNextPage.Visible := acFirstPage.Visible;
+ acLastPage.Visible := acFirstPage.Visible;
+ edPageNumber.Visible := ppoNavigationEdit in FOptions;
+ tbDivider1.Visible := acFirstPage.Visible or edPageNumber.Visible;
+
+ acZoomIn.Visible := ppoZoomBtns in FOptions;
+ acZoomOut.Visible := acZoomIn.Visible;
+ acZoom100.Visible := acZoomIn.Visible;
+ acZoomToFitWidth.Visible := acZoomIn.Visible;
+ acZoomtoFitHeight.Visible := acZoomIn.Visible;
+ tbDivider2.Visible := acZoomIn.Visible;
+
+ acPortrait.Visible := ppoPageOrientationBtns in FOptions;
+ acLandscape.Visible := acPortrait.Visible;
+ acHeaderFooter.Visible := ppoHeaderFooterBtn in FOptions;
+ acPageMargins.Visible := ppoMarginsBtn in FOptions;
+ tbDivider3.Visible := acPortrait.Visible or acHeaderFooter.Visible or acPageMargins.Visible;
+
+ acPrintColsFirst.Visible := ppoPrintOrderBtns in FOptions;
+ acPrintRowsFirst.Visible := acPrintColsFirst.Visible;
+ tbDivider4.Visible := acPrintColsFirst.Visible;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.SetPageNumber(AValue: Integer);
+begin
+ if AValue <> FPageNumber then
+ ShowPage(AValue);
+end;
+
+procedure TGridPrintPreviewForm.ShowDraggedMarginHint(
+ AMarginIndex, ADraggedPos: Integer; AMarginName: String);
+var
+ hintStr: String;
+ P: TPoint;
+ R: TRect;
+begin
+ if FHintWindow = nil then
+ FHintWindow := THintWindow.Create(nil);
+ hintStr := Format('%s: %.1f mm', [AMarginName, CalcDraggedMargin(AMarginIndex, ADraggedPos)]);
+ P := Mouse.CursorPos;
+ R := FHintWindow.CalcHintRect(Screen.Width, hintStr, nil);
+ OffsetRect(R, P.X, P.Y);
+ FHintWindow.ActivateHint(R, hintStr);
+ // Note: Application.Hint is not showing with pressed mouse button! }
+end;
+
+procedure TGridPrintPreviewForm.ShowPage(APageNo: Integer; AZoom: Integer = 0;
+ AZoomMode: TGridPrintPreviewZoomMode = zmCustom);
+var
+ bmp: TBitmap;
+begin
+ if FGridPrinter = nil then
+ begin
+ FPageCount := 0;
+ FPageNumber := 0;
+ PreviewImage.Picture.Clear;
+ exit;
+ end;
+
+ FPageNumber := APageNo;
+ if AZoom > 0 then
+ FZoom := AZoom;
+
+ FZoomMode := AZoomMode;
+
+ // Instruct the GridPrinter to create the preview bitmap of the selected page
+ bmp := FGridPrinter.CreatePreviewBitmap(FPageNumber, FZoom);
+ try
+ // Load the bitmap into the PreviewImage component
+ PreviewImage.Width := bmp.Width;
+ PreviewImage.Height := bmp.Height;
+ PreviewImage.Picture.Bitmap.Assign(bmp);
+ FPageCount := FGridPrinter.PageCount;
+ UpdateInfoPanel;
+ finally
+ bmp.Free;
+ end;
+end;
+
+procedure TGridPrintPreviewForm.ToolBarResize(Sender: TObject);
+begin
+ UpdateInfoPanel;
+end;
+
+procedure TGridPrintPreviewForm.UpdateInfoPanel;
+begin
+ InfoPanel.Caption := Format(RSPageAndZoomInfo, [FPageNumber, FPageCount, FZoom]);
+ InfoPanel.Width := InfoPanel.Canvas.TextWidth(InfoPanel.Caption);
+ InfoPanel.Left := Toolbar.ClientWidth - InfoPanel.Width - 8;
+ edPageNumber.Text := IntToStr(FPageNumber);
+end;
+
+procedure TGridPrintPreviewForm.UpdateStrings;
+begin
+ Caption := RSPrintPreview;
+
+ // Toolbar captions
+ acPrint.Caption := RSPrint;
+ acClose.Caption := RSClose;
+
+ // Toolbar hints
+ acPrint.Hint := RSPrint;
+ acClose.Hint := RSClose;
+ acFirstPage.Hint := RSShowFirstPage;
+ acPrevPage.Hint := RSShowPrevPage;
+ acNextPage.Hint := RSShowNextPage;
+ acLastPage.Hint := RSShowLastPage;
+ acZoomIn.Hint := RSZoomIn;
+ acZoomOut.Hint := RSZoomOut;
+ acZoomToFitWidth.Hint := RSZoomToFitPageWidth;
+ acZoomToFitHeight.Hint := RSZoomToFitPageHeight;
+ acZoom100.Hint := RSOriginalSize;
+ acPageMargins.Hint := RSPageMarginsConfig;
+ acHeaderFooter.Hint := RSHeaderFooterConfig;
+ acPortrait.Hint := RSPortraitPageOrientation;
+ acLandscape.Hint := RSLandscapePageOrientation;
+ acPrintColsFirst.Hint := RSPrintColsFirst;
+ acPrintRowsFirst.Hint := RSPrintRowsFirst;
+end;
+
+
+{ Adjusts FZoomMin to avoid the situation that, due to integer rounding,
+ the zoom factor cannot be changed any more by clicking a zoom button or
+ by mousewheel. }
+procedure TGridPrintPreviewForm.VerifyZoomMin;
+var
+ nextHigherZoom: Integer;
+begin
+ nextHigherZoom := round(FZoomMin * ZOOM_MULTIPLIER);
+ while nextHigherZoom = FZoomMin do
+ begin
+ FZoomMin := nextHigherZoom + 1;
+ nextHigherZoom := round(FZoomMin * ZOOM_MULTIPLIER);
+ end;
+end;
+
+procedure TGridPrintPreviewForm.ZoomToFitHeight;
+var
+ h: Integer;
+begin
+ if Printer = nil then
+ exit;
+
+ // Correct for scrollbar height when the horizontal scrollbar is currently hidden,
+ // but will be shown after displaying the preview page.
+ if (not Scrollbox.HorzScrollbar.IsScrollbarVisible) and
+ (Printer.PageHeight/Printer.PageWidth < Scrollbox.ClientHeight/Scrollbox.ClientWidth)
+ then
+ h := Scrollbox.HorzScrollbar.ClientSizeWithBar
+ else
+ h := Scrollbox.ClientHeight;
+ h := h - 2*PreviewImage.Top;
+ FZoom := round(h / Printer.PageHeight * Printer.YDPI / ScreenInfo.PixelsPerInchY * 100);
+ ShowPage(FPageNumber, FZoom, zmFitHeight);
+end;
+
+procedure TGridPrintPreviewForm.ZoomToFitWidth;
+var
+ w: Integer;
+begin
+ if Printer = nil then
+ exit;
+
+ // Correct for scrollbar width when the vert scrollbar is currently hidden,
+ // but will be shown after displaying the preview page.
+ if (not Scrollbox.VertScrollbar.IsScrollbarVisible) and
+ (Printer.PageHeight/Printer.PageWidth > Scrollbox.ClientHeight/Scrollbox.ClientWidth)
+ then
+ w := Scrollbox.VertScrollbar.ClientSizeWithBar
+ else
+ w := Scrollbox.ClientWidth;
+ w := w - 2*PreviewImage.Left;
+ FZoom := round(w / Printer.PageWidth * Printer.XDPI/ ScreenInfo.PixelsPerInchX * 100);
+ ShowPage(FPageNumber, FZoom, zmFitWidth);
+end;
+
+end.
+
diff --git a/components/gridprinter/source/gridprnreg.pas b/components/gridprinter/source/gridprnreg.pas
new file mode 100644
index 000000000..dc0f3bcaa
--- /dev/null
+++ b/components/gridprinter/source/gridprnreg.pas
@@ -0,0 +1,25 @@
+unit GridPrnReg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+procedure Register;
+
+implementation
+
+uses
+ GridPrn, GridPrnPreviewDlg;
+
+{$R gridprinter_icons.res}
+
+procedure Register;
+begin
+ RegisterComponents('Misc', [TGridPrinter, TGridPrintPreviewDialog]);
+end;
+
+end.
+
diff --git a/components/gridprinter/source/gridprnstrings.pas b/components/gridprinter/source/gridprnstrings.pas
new file mode 100644
index 000000000..69ba01fac
--- /dev/null
+++ b/components/gridprinter/source/gridprnstrings.pas
@@ -0,0 +1,67 @@
+unit GridPrnStrings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+resourcestring
+ // Print Preview
+ RSPrintPreview = 'Print Preview';
+ RSPrint = 'Print';
+ RSClose = 'Close';
+
+ RSShowFirstPage = 'Show first page';
+ RSShowPrevPage = 'Show previous page';
+ RSShowNextPage = 'Show next page';
+ RSShowLastPage = 'Show last page';
+ RSZoomIn = 'Zoom in';
+ RSZoomOut = 'Zoom out';
+ RSZoomToFitPageWidth = 'Zoom to fit page width';
+ RSZoomToFitPageHeight = 'Zoom to fit page height';
+ RSOriginalSize = 'Original size (100%)';
+ RSPageMarginsConfig = 'Page margins configuration';
+ RSHeaderFooterConfig = 'Header/footer configuration';
+ RSPortraitPageOrientation = 'Portrait page orientation';
+ RSLandscapePageOrientation = 'Landscape page orientation';
+ RSPrintColsFirst = 'First print columns from top to bottom,' + LineEnding +
+ 'then print from left to right';
+ RSPrintRowsFirst = 'First print rows from left to right,' + LineEnding +
+ 'then print from top to bottom';
+
+ RSLeftMargin = 'Left margin';
+ RSTopMargin = 'Top margin';
+ RSRightMargin = 'Right margin';
+ RSBottomMargin = 'Bottom margin';
+ RSHeaderMargin = 'Header margin';
+ RSFooterMargin = 'Footer margin';
+
+ RSPageAndZoomInfo = 'Page %d of %d, Zoom %d %%';
+
+ // Header / footer
+ RSHeader = 'Header';
+ RSFooter = 'Footer';
+ RSShow = 'Show';
+ RSFont = 'Font';
+ RSHeaderFooterSectionParameterInfo =
+ 'Each section can contain the following parameters:' + LineEnding +
+ ' $DATE - Current date' + LineEnding +
+ ' $TIME - Current time' + LineEnding +
+ ' $PAGE - Page number' + LineEnding +
+ ' $PAGECOUNT - Number of pages' + LineEnding +
+ ' $FULL_FILENAME - Full name of the printed file' + LineEnding +
+ ' $FILENAME - Name of the printed file, without path' + LineEnding +
+ ' $PATH - Path of the printed file';
+ RSShowDividingLine = 'Show dividing line';
+ RSLineWidthMM = 'Line width (mm)';
+ RSLineColor = 'Line color';
+ RSTextInLeftAlignedSection = 'Text in left-aligned section';
+ RSTextInCenteredSection = 'Text in centered section';
+ RSTextInRightAlignedSection = 'Text in right-aligned section';
+
+implementation
+
+end.
+