mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 21:59:36 +02:00
LazReport: Added LrDotMatrix component, a TfrReport derived that handle print to do matrix kind printers, from @Heliosroots
git-svn-id: trunk@63936 -
This commit is contained in:
jesus
parent
48bcee6f50
commit
b6c3d95216
10
.gitattributes
vendored
10
.gitattributes
vendored
@ -2989,6 +2989,16 @@ components/lazreport/source/addons/DialogControls/resources/tlrlistbox.bmp -text
|
||||
components/lazreport/source/addons/DialogControls/resources/tlrmemo.bmp -text
|
||||
components/lazreport/source/addons/DialogControls/resources/tlrradiobutton.bmp -text
|
||||
components/lazreport/source/addons/DialogControls/resources/tlrradiogroup.bmp -text
|
||||
components/lazreport/source/addons/LrDotMatrix/README.md svneol=native#text/plain
|
||||
components/lazreport/source/addons/LrDotMatrix/image/TlrDMReport.png -text svneol=unset#image/png
|
||||
components/lazreport/source/addons/LrDotMatrix/image/make_icon.bat svneol=native#text/x-msdos-program
|
||||
components/lazreport/source/addons/LrDotMatrix/lr_dotmatrix_pack.lpk svneol=native#text/plain
|
||||
components/lazreport/source/addons/LrDotMatrix/lr_dotmatrix_pack.pas svneol=native#text/pascal
|
||||
components/lazreport/source/addons/LrDotMatrix/source/lr_dotmatrix.pas svneol=native#text/pascal
|
||||
components/lazreport/source/addons/LrDotMatrix/source/lr_dotmatrix.res -text
|
||||
components/lazreport/source/addons/LrDotMatrix/source/lr_dotmatrix_dlg.lfm svneol=native#text/plain
|
||||
components/lazreport/source/addons/LrDotMatrix/source/lr_dotmatrix_dlg.pas svneol=native#text/pascal
|
||||
components/lazreport/source/addons/LrDotMatrix/source/lr_dotmatrix_filter.pas svneol=native#text/pascal
|
||||
components/lazreport/source/addons/SqlDB/lr_editsqldbparamsunit.lfm svneol=native#text/plain
|
||||
components/lazreport/source/addons/SqlDB/lr_editsqldbparamsunit.pas svneol=native#text/pascal
|
||||
components/lazreport/source/addons/SqlDB/lr_ibconnection.pas svneol=native#text/plain
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
The following people contributed to LazReport :
|
||||
|
||||
@Heliosroots (br)
|
||||
Aleksey Lagunov (ru)
|
||||
Andrey Gusev (ru)
|
||||
Christian Ulrich (de)
|
||||
@ -20,4 +21,3 @@ Petr Smolik (cz)
|
||||
Tony Whyman ( )
|
||||
Ts. Petrov ( )
|
||||
Vincent Snijders (nl)
|
||||
|
||||
|
||||
9
components/lazreport/source/addons/LrDotMatrix/README.md
Normal file
9
components/lazreport/source/addons/LrDotMatrix/README.md
Normal file
@ -0,0 +1,9 @@
|
||||
# LrDotMatrix
|
||||
Component for dot matrix printing with LazReport
|
||||
|
||||
A report sent to a dot-matrix printer will be printed very slowly.
|
||||
LrDotMatrix allows the creation of special reports intended for dot-matrix printers, where only standard font symbols and no graphic elements are output; this results in a faster printing speed.
|
||||
|
||||
|
||||
|
||||
<img alt="Logo" src="https://github.com/groupsc10/LrDotMatrix/blob/master/image/dot.png">
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 630 B |
@ -0,0 +1 @@
|
||||
lazres ..\source\lr_dotmatrix.res TlrDMReport.png
|
||||
@ -0,0 +1,46 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="lr_dotmatrix_pack"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<Author Value="heliosroots"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="source"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="lazreport for dot matrix printer"/>
|
||||
<Version Minor="1" Release="1" Build="30"/>
|
||||
<Files Count="3">
|
||||
<Item1>
|
||||
<Filename Value="source/lr_dotmatrix_filter.pas"/>
|
||||
<UnitName Value="lr_dotmatrix_filter"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="source/lr_dotmatrix_dlg.pas"/>
|
||||
<UnitName Value="lr_dotmatrix_dlg"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="source/lr_dotmatrix.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="lr_dotmatrix"/>
|
||||
</Item3>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="lazreport"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
@ -0,0 +1,21 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit lr_dotmatrix_pack;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
lr_dotmatrix_filter, lr_dotmatrix_dlg, lr_dotmatrix, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('lr_dotmatrix', @lr_dotmatrix.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('lr_dotmatrix_pack', @Register);
|
||||
end.
|
||||
@ -0,0 +1,238 @@
|
||||
{*
|
||||
* The MIT License (MIT)
|
||||
*
|
||||
* Copyright (c) 2020 Grupo SC10
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to deal
|
||||
* in the Software without restriction, including without limitation the rights
|
||||
* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
* copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included
|
||||
* in all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
* SOFTWARE.
|
||||
*}
|
||||
unit lr_dotmatrix;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes,
|
||||
Forms,
|
||||
Controls,
|
||||
LResources,
|
||||
// lazreport
|
||||
LR_Class,
|
||||
LR_Prntr,
|
||||
LR_View,
|
||||
LR_Const,
|
||||
// lr_dotmatrix
|
||||
lr_dotmatrix_filter,
|
||||
lr_dotmatrix_dlg;
|
||||
|
||||
type
|
||||
|
||||
{ TlrDMReport }
|
||||
|
||||
TlrDMReport = class(TfrReport)
|
||||
private
|
||||
fDotMatrixReport: boolean;
|
||||
function GetDotMatrixConfig: TlrDMConfig;
|
||||
procedure SetDotMatrixConfig(aValue: TlrDMConfig);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure PrintPreparedReport(const aPageNumbers: string; aCopies: integer);
|
||||
procedure ShowPreparedReport;
|
||||
procedure ShowReport;
|
||||
published
|
||||
property DotMatrixConfig: TlrDMConfig read GetDotMatrixConfig write SetDotMatrixConfig;
|
||||
property DotMatrixReport: boolean read fDotMatrixReport write fDotMatrixReport;
|
||||
end;
|
||||
|
||||
{ TlrDMPreview }
|
||||
|
||||
TlrDMPreview = class(TfrPreviewForm)
|
||||
procedure PrintBtnClick(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
public
|
||||
fDoc: Pointer; // => hack
|
||||
procedure Show_Modal(aDoc: Pointer);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R lr_dotmatrix.res}
|
||||
|
||||
function IfThen(aCondition: boolean; const aFalseReturn: string; const aTrueReturn: string): string;
|
||||
begin
|
||||
if (aCondition) then
|
||||
begin
|
||||
Result := aTrueReturn;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := aFalseReturn;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('LazReport', [TlrDMReport]);
|
||||
end;
|
||||
|
||||
{ TlrDMReport }
|
||||
|
||||
function TlrDMReport.GetDotMatrixConfig: TlrDMConfig;
|
||||
begin
|
||||
Result := vlrDMConfig;
|
||||
end;
|
||||
|
||||
procedure TlrDMReport.SetDotMatrixConfig(aValue: TlrDMConfig);
|
||||
begin
|
||||
vlrDMConfig.Assign(aValue);
|
||||
end;
|
||||
|
||||
constructor TlrDMReport.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
fDotMatrixReport := True;
|
||||
// Register dotmatix filter
|
||||
frRegisterExportFilter(TlrDMFilter, 'Draft file' + ' (*.drf)', '*.drf');
|
||||
end;
|
||||
|
||||
procedure TlrDMReport.PrintPreparedReport(const aPageNumbers: string; aCopies: integer);
|
||||
var
|
||||
vLoop: integer;
|
||||
begin
|
||||
if (fDotMatrixReport) then
|
||||
begin
|
||||
CurReport := Self;
|
||||
MasterReport := Self;
|
||||
Terminated := False;
|
||||
PrepareReport;
|
||||
for vLoop := 0 to (aCopies - 1) do
|
||||
begin
|
||||
ExportTo(TlrDMFilter, './tmp.drf');
|
||||
end;
|
||||
Terminated := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inherited PrintPreparedReport(aPageNumbers, aCopies);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDMReport.ShowPreparedReport;
|
||||
var
|
||||
vPreview: TlrDMPreview;
|
||||
begin
|
||||
if (fDotMatrixReport) then
|
||||
begin
|
||||
CurReport := Self;
|
||||
MasterReport := Self;
|
||||
DocMode := dmPrinting;
|
||||
if (EMFPages.Count > 0) then
|
||||
begin
|
||||
vPreview := TlrDMPreview.Create(nil);
|
||||
vPreview.BorderIcons := vPreview.BorderIcons - [biMinimize];
|
||||
vPreview.Caption := IfThen((Title = ''), (SPreview), (SPreview + ' - ' + Title));
|
||||
vPreview.Show_Modal(Self);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inherited ShowPreparedReport;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDMReport.ShowReport;
|
||||
begin
|
||||
if (PrepareReport) then
|
||||
begin
|
||||
ShowPreparedReport;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inherited ShowReport;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TlrDMPreview }
|
||||
|
||||
procedure TlrDMPreview.PrintBtnClick(Sender: TObject);
|
||||
begin
|
||||
if (TlrDMReport(fDoc).DotMatrixReport) then
|
||||
begin
|
||||
lrDMDlg := TlrDMDlg.Create(nil);
|
||||
try
|
||||
// Auto new page
|
||||
lrDMDlg.chkOptionsAutoNewPage.Checked := vlrDMConfig.AutoNewPage;
|
||||
lrDMDlg.edtOptionsAutoNewPageLines.Value := vlrDMConfig.AutoNewPageLines;
|
||||
|
||||
// Line spacing
|
||||
vlrDMConfig.AddingLineSpacingTo(lrDMDlg.cboOptionsLineSpacing.Items);
|
||||
lrDMDlg.cboOptionsLineSpacing.ItemIndex := Ord(vlrDMConfig.LineSpacing);
|
||||
lrDMDlg.edtOptionsLineSpacingCustom.Value := vlrDMConfig.LineSpacingCustomValue;
|
||||
|
||||
// List printer
|
||||
lrDMDlg.cboPrinter.Items.Assign(Prn.Printers);
|
||||
lrDMDlg.cboPrinter.ItemIndex := Prn.PrinterIndex;
|
||||
|
||||
// Show dialog
|
||||
if lrDMDlg.ShowModal = mrOk then
|
||||
begin
|
||||
// Auto new page
|
||||
vlrDMConfig.AutoNewPage := lrDMDlg.chkOptionsAutoNewPage.Checked;
|
||||
vlrDMConfig.AutoNewPageLines := lrDMDlg.edtOptionsAutoNewPageLines.Value;
|
||||
|
||||
// Line spacing
|
||||
vlrDMConfig.LineSpacing := TlrDMLineSpacing(Ord(lrDMDlg.cboOptionsLineSpacing.ItemIndex));
|
||||
vlrDMConfig.LineSpacingCustomValue:= lrDMDlg.edtOptionsLineSpacingCustom.Value;
|
||||
|
||||
// Printer Index
|
||||
Prn.PrinterIndex := lrDMDlg.cboPrinter.ItemIndex;
|
||||
// Print
|
||||
TlrDMReport(fDoc).PrintPreparedReport('', lrDMDlg.edtCopies.Value);
|
||||
end;
|
||||
finally
|
||||
lrDMDlg.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inherited PrintBtnClick(Sender);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDMPreview.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
|
||||
begin
|
||||
if (ssCtrl in Shift) and (Chr(Key) = 'P') and (PrintBtn.Visible) then
|
||||
begin
|
||||
PrintBtnClick(nil);
|
||||
end
|
||||
else
|
||||
begin
|
||||
inherited FormKeyDown(Sender, Key, Shift);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDMPreview.Show_Modal(aDoc: Pointer);
|
||||
begin
|
||||
fDoc := aDoc;
|
||||
inherited Show_Modal(aDoc);
|
||||
end;
|
||||
|
||||
end.
|
||||
Binary file not shown.
@ -0,0 +1,216 @@
|
||||
object lrDMDlg: TlrDMDlg
|
||||
Left = 618
|
||||
Height = 550
|
||||
Top = 251
|
||||
Width = 645
|
||||
AutoSize = True
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Print'
|
||||
ClientHeight = 550
|
||||
ClientWidth = 645
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.4.2.0'
|
||||
object lblPrinter: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 10
|
||||
Width = 88
|
||||
BorderSpacing.Bottom = 5
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Printer:'
|
||||
ParentColor = False
|
||||
end
|
||||
object cboPrinter: TComboBox
|
||||
AnchorSideLeft.Control = lblPrinter
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = lblPrinter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 108
|
||||
Height = 35
|
||||
Top = 10
|
||||
Width = 527
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Right = 10
|
||||
ItemHeight = 0
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
end
|
||||
object lblCopies: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = lblPrinter
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 77
|
||||
BorderSpacing.Bottom = 5
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Copies:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edtCopies: TSpinEdit
|
||||
AnchorSideLeft.Control = lblCopies
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = lblCopies
|
||||
Left = 97
|
||||
Height = 33
|
||||
Top = 48
|
||||
Width = 100
|
||||
MinValue = 1
|
||||
TabOrder = 1
|
||||
Value = 1
|
||||
end
|
||||
object grpOptions: TGroupBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = lblCopies
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 10
|
||||
Height = 194
|
||||
Top = 86
|
||||
Width = 625
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Options'
|
||||
ClientHeight = 169
|
||||
ClientWidth = 621
|
||||
TabOrder = 2
|
||||
object chkOptionsAutoNewPage: TCheckBox
|
||||
AnchorSideLeft.Control = grpOptions
|
||||
AnchorSideTop.Control = grpOptions
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 10
|
||||
Width = 166
|
||||
BorderSpacing.Bottom = 5
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Auto new page'
|
||||
TabOrder = 0
|
||||
end
|
||||
object lblOptionsAutoNewPageLines: TLabel
|
||||
AnchorSideLeft.Control = grpOptions
|
||||
AnchorSideTop.Control = chkOptionsAutoNewPage
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 50
|
||||
Width = 253
|
||||
BorderSpacing.Bottom = 5
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Lines of auto new page:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edtOptionsAutoNewPageLines: TSpinEdit
|
||||
AnchorSideLeft.Control = lblOptionsAutoNewPageLines
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = chkOptionsAutoNewPage
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = grpOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = grpOptions
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 273
|
||||
Height = 33
|
||||
Top = 50
|
||||
Width = 338
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Right = 10
|
||||
BorderSpacing.Bottom = 10
|
||||
TabOrder = 1
|
||||
end
|
||||
object lblOptionsLineSpacing: TLabel
|
||||
AnchorSideLeft.Control = grpOptions
|
||||
AnchorSideTop.Control = lblOptionsAutoNewPageLines
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 88
|
||||
Width = 154
|
||||
BorderSpacing.Bottom = 5
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Lines Spacing:'
|
||||
ParentColor = False
|
||||
end
|
||||
object cboOptionsLineSpacing: TComboBox
|
||||
AnchorSideLeft.Control = lblOptionsLineSpacing
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = lblOptionsLineSpacing
|
||||
AnchorSideRight.Control = grpOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 174
|
||||
Height = 35
|
||||
Top = 88
|
||||
Width = 437
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Right = 10
|
||||
ItemHeight = 0
|
||||
OnChange = cboOptionsLineSpacingChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 2
|
||||
end
|
||||
object lblOptionsLineSpacingCustom: TLabel
|
||||
AnchorSideLeft.Control = grpOptions
|
||||
AnchorSideTop.Control = lblOptionsLineSpacing
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 126
|
||||
Width = 286
|
||||
BorderSpacing.Around = 10
|
||||
Caption = 'Line Spacing Custom Value:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edtOptionsLineSpacingCustom: TSpinEdit
|
||||
AnchorSideLeft.Control = lblOptionsLineSpacingCustom
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = lblOptionsLineSpacingCustom
|
||||
AnchorSideRight.Control = grpOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 306
|
||||
Height = 33
|
||||
Top = 126
|
||||
Width = 305
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Right = 10
|
||||
MinValue = 1
|
||||
TabOrder = 3
|
||||
Value = 1
|
||||
end
|
||||
end
|
||||
object btnOK: TBitBtn
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = grpOptions
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 10
|
||||
Height = 33
|
||||
Top = 290
|
||||
Width = 32
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 10
|
||||
Caption = '&OK'
|
||||
ModalResult = 1
|
||||
TabOrder = 3
|
||||
end
|
||||
object btnCancel: TBitBtn
|
||||
AnchorSideLeft.Control = btnOK
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = grpOptions
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Owner
|
||||
Left = 52
|
||||
Height = 33
|
||||
Top = 290
|
||||
Width = 76
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 10
|
||||
Caption = '&Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
@ -0,0 +1,91 @@
|
||||
{*
|
||||
* The MIT License (MIT)
|
||||
*
|
||||
* Copyright (c) 2020 Grupo SC10
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to deal
|
||||
* in the Software without restriction, including without limitation the rights
|
||||
* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
* copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included
|
||||
* in all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
* SOFTWARE.
|
||||
*}
|
||||
unit lr_dotmatrix_dlg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
FileUtil,
|
||||
Forms,
|
||||
Controls,
|
||||
Graphics,
|
||||
Dialogs,
|
||||
StdCtrls,
|
||||
Spin,
|
||||
Buttons;
|
||||
|
||||
type
|
||||
|
||||
{ TlrDMDlg }
|
||||
|
||||
TlrDMDlg = class(TForm)
|
||||
// buttons
|
||||
btnOK: TBitBtn;
|
||||
btnCancel: TBitBtn;
|
||||
cboOptionsLineSpacing: TComboBox;
|
||||
lblOptionsLineSpacing: TLabel;
|
||||
lblOptionsLineSpacingCustom: TLabel;
|
||||
// printer
|
||||
lblPrinter: TLabel;
|
||||
cboPrinter: TComboBox;
|
||||
// copie
|
||||
lblCopies: TLabel;
|
||||
edtCopies: TSpinEdit;
|
||||
// page
|
||||
grpOptions: TGroupBox;
|
||||
chkOptionsAutoNewPage: TCheckBox;
|
||||
lblOptionsAutoNewPageLines: TLabel;
|
||||
edtOptionsAutoNewPageLines: TSpinEdit;
|
||||
edtOptionsLineSpacingCustom: TSpinEdit;
|
||||
procedure cboOptionsLineSpacingChange(Sender: TObject);
|
||||
end;
|
||||
|
||||
var
|
||||
lrDMDlg: TlrDMDlg;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TlrDMDlg }
|
||||
|
||||
procedure TlrDMDlg.cboOptionsLineSpacingChange(Sender: TObject);
|
||||
begin
|
||||
if (cboOptionsLineSpacing.ItemIndex = 0) then
|
||||
begin
|
||||
edtOptionsLineSpacingCustom.Enabled := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
edtOptionsLineSpacingCustom.Enabled := False;
|
||||
edtOptionsLineSpacingCustom.Value := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -0,0 +1,523 @@
|
||||
{*
|
||||
* The MIT License (MIT)
|
||||
*
|
||||
* Copyright (c) 2020 Grupo SC10
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to deal
|
||||
* in the Software without restriction, including without limitation the rights
|
||||
* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
* copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included
|
||||
* in all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
* SOFTWARE.
|
||||
*}
|
||||
unit lr_dotmatrix_filter;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Classes,
|
||||
// lazreport
|
||||
LR_Class,
|
||||
LR_Prntr;
|
||||
|
||||
const
|
||||
//LPI
|
||||
standartLPI = 5;
|
||||
|
||||
// DPI
|
||||
horizontalDPI = (93 / 1.015); // Horizontal DPI, 91 DPI default (used by lazreport)
|
||||
verticalDPI = (93 / 1.022); // Vertical DPI, 91 DPI default (used by lazreport))
|
||||
|
||||
// ESC command index
|
||||
cmdReset = 0;
|
||||
cmdCR = 1; // Carriage return(return to start of line)
|
||||
cmdLF = 2; // Line feed
|
||||
cmdFF = 3; // Form feed(new line)
|
||||
cmdSpace = 4;
|
||||
cmdBoldON = 5;
|
||||
cmdBoldOFF = 6;
|
||||
cmdItalicsON = 7;
|
||||
cmdItalicsOFF = 8;
|
||||
cmdUnderlineON = 9;
|
||||
cmdUnderlineOFF = 10;
|
||||
cmdExpandedON = 11;
|
||||
cmdExpandedOFF = 12;
|
||||
cmd10CPI = 13;
|
||||
cmd20CPI = 14;
|
||||
cmd6LPI = 15;
|
||||
cmd8LPI = 16;
|
||||
cmdCustomLPI = 17;
|
||||
cmdMax = 17; // command max
|
||||
|
||||
type
|
||||
TlrDMLineSpacing = (lsCustomLPI, ls6LPI, ls8LPI);
|
||||
|
||||
{ TlrDMConfig }
|
||||
|
||||
TlrDMConfig = class(TPersistent)
|
||||
private
|
||||
fAutoNewPage: boolean;
|
||||
fAutoNewPageLines: integer;
|
||||
fLineSpacing: TlrDmLineSpacing;
|
||||
fLineSpacingCustomValue: integer;
|
||||
public
|
||||
ESCCode: array[0..cmdMax] of string;
|
||||
constructor Create;
|
||||
procedure AddingLineSpacingTo(aDestination: TStrings);
|
||||
published
|
||||
property AutoNewPage: boolean read fAutoNewPage write fAutoNewPage; // AutoNewPage false = inject
|
||||
property AutoNewPageLines: integer read fAutoNewPageLines write fAutoNewPageLines;
|
||||
property LineSpacing: TlrDmLineSpacing read fLineSpacing write fLineSpacing;
|
||||
property LineSpacingCustomValue: integer read fLineSpacingCustomValue write fLineSpacingCustomValue;
|
||||
end;
|
||||
|
||||
{ TlrDMFilter }
|
||||
|
||||
TlrDMFilter = class(TfrExportFilter)
|
||||
private
|
||||
// Margins
|
||||
fMarginLeft: integer;
|
||||
fMarginTop: integer;
|
||||
fMarginRight: integer;
|
||||
fMarginBottom: integer;
|
||||
// Page client area
|
||||
fPageHeight: integer;
|
||||
fPageWidth: integer;
|
||||
// Lines
|
||||
fNumberOfLines: integer;
|
||||
protected
|
||||
procedure WriteStr(const aData: string); virtual; overload;
|
||||
procedure WriteStr(const aData: string; aAlignment: TAlignment; aNewLength: integer; aFillChar: char = ' '); virtual; overload;
|
||||
procedure WriteCmd(aData: integer; const aParameter: string = ''); virtual;
|
||||
function CheckView(aView: TfrView): boolean; override;
|
||||
public
|
||||
procedure OnBeginDoc; override;
|
||||
procedure OnBeginPage; override;
|
||||
procedure OnEndPage; override;
|
||||
procedure OnEndDoc; override;
|
||||
procedure OnText(x, y: integer; const Text: string; View: TfrView); override;
|
||||
end;
|
||||
|
||||
var
|
||||
vlrDMConfig: TlrDMConfig;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
|
||||
function ConvertAccents(const aData: string): string;
|
||||
var
|
||||
vChar, vCharPrevious: string;
|
||||
begin
|
||||
Result := '';
|
||||
for vChar in aData do
|
||||
begin
|
||||
case vChar of
|
||||
#194:
|
||||
begin
|
||||
vCharPrevious := vChar;
|
||||
Continue;
|
||||
end;
|
||||
#195:
|
||||
begin
|
||||
vCharPrevious := vChar;
|
||||
Continue;
|
||||
end;
|
||||
end;
|
||||
case vCharPrevious of
|
||||
#194:
|
||||
begin
|
||||
case vChar of
|
||||
#186: Result += '*'; // º
|
||||
#170: Result += '*'; // ª
|
||||
else
|
||||
Result += vChar;
|
||||
end;
|
||||
vCharPrevious := #0;
|
||||
end;
|
||||
#195:
|
||||
begin
|
||||
case vChar of
|
||||
#160..#164: Result += 'a'; // áàãâä
|
||||
#128..#132: Result += 'A'; // ÁÀÃÂÄ
|
||||
#168..#171: Result += 'e'; // éèêë
|
||||
#136..#139: Result += 'E'; // ÉÈÊË
|
||||
#172..#175: Result += 'i'; // íìîï
|
||||
#140..#143: Result += 'I'; // ÍÌÎÏ
|
||||
#178..#182: Result += 'o'; // óòõôö
|
||||
#146..#150: Result += 'O'; // ÓÒÕÔÖ
|
||||
#185..#188: Result += 'u'; // úùûü
|
||||
#153..#156: Result += 'U'; // ÚÙÛÜ
|
||||
#167: Result += 'c'; // ç
|
||||
#135: Result += 'C'; // Ç
|
||||
else
|
||||
Result += vChar;
|
||||
end;
|
||||
vCharPrevious := #0;
|
||||
end;
|
||||
else
|
||||
Result += vChar;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function PadR(const aData: string; aNewLength: integer; aFillChar: char): string;
|
||||
var
|
||||
vLength: integer;
|
||||
begin
|
||||
vLength := Length(aData);
|
||||
if (vLength < aNewLength) then
|
||||
begin
|
||||
Result := StringOfChar(aFillChar, aNewLength - vLength) + aData;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := RightStr(aData, aNewLength);
|
||||
end;
|
||||
end;
|
||||
|
||||
function PadL(const aData: string; aNewLength: integer; aFillChar: char): string;
|
||||
var
|
||||
vLength: integer;
|
||||
begin
|
||||
vLength := Length(aData);
|
||||
if (vLength < aNewLength) then
|
||||
begin
|
||||
Result := aData + StringOfChar(aFillChar, aNewLength - vLength);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := LeftStr(aData, aNewLength);
|
||||
end;
|
||||
end;
|
||||
|
||||
function PadC(const aData: string; aNewLength: integer; aFillChar: char): string;
|
||||
var
|
||||
vLength: integer;
|
||||
begin
|
||||
vLength := (aNewLength - Length(aData)) div 2;
|
||||
if (vLength > 0) then
|
||||
begin
|
||||
Result := StringOfChar(aFillChar, vLength) + aData + StringOfChar(aFillChar, vLength);
|
||||
end;
|
||||
// when length(Result) is an odd number
|
||||
Result := PadR(Result, aNewLength, aFillChar);
|
||||
end;
|
||||
|
||||
{ TlrDMConfig }
|
||||
|
||||
constructor TlrDMConfig.Create;
|
||||
begin
|
||||
//EPSON
|
||||
ESCCode[cmdReset] := #27#64;
|
||||
ESCCode[cmdCR] := #13;
|
||||
ESCCode[cmdLF] := #10;
|
||||
ESCCode[cmdFF] := #12;
|
||||
ESCCode[cmdSpace] := #32;
|
||||
ESCCode[cmdBoldON] := #27#69;
|
||||
ESCCode[cmdBoldOFF] := #27#70;
|
||||
ESCCode[cmdItalicsON] := #27#52;
|
||||
ESCCode[cmdItalicsOFF] := #27#53;
|
||||
ESCCode[cmdUnderlineON] := #27#45#1;
|
||||
ESCCode[cmdUnderlineOFF] := #27#45#0;
|
||||
ESCCode[cmdExpandedON] := #27#87#1;
|
||||
ESCCode[cmdExpandedOFF] := #27#87#0;
|
||||
ESCCode[cmd10CPI] := #27#80#18;
|
||||
ESCCode[cmd20CPI] := #27#77#15;
|
||||
ESCCode[cmd6LPI] := #27#48;
|
||||
ESCCode[cmd8LPI] := #27#50;
|
||||
ESCCode[cmdCustomLPI] := #27#65;
|
||||
end;
|
||||
|
||||
procedure TlrDMConfig.AddingLineSpacingTo(aDestination: TStrings);
|
||||
const
|
||||
vArray: array[TlrDMLineSpacing] of string = ('CustomLPI', '6LPI', '8LPI');
|
||||
var
|
||||
vItem: string;
|
||||
begin
|
||||
for vItem in vArray do
|
||||
begin
|
||||
aDestination.Add(vItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TlrDMFilter }
|
||||
|
||||
procedure TlrDMFilter.WriteStr(const aData: string);
|
||||
var
|
||||
Written: integer = 0;
|
||||
begin
|
||||
Prn.Printer.Write(Pointer(aData)^, Length(aData), Written);
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.WriteStr(const aData: string; aAlignment: TAlignment; aNewLength: integer; aFillChar: char);
|
||||
begin
|
||||
case aAlignment of
|
||||
taCenter:
|
||||
begin
|
||||
WriteStr(PadC(ConvertAccents(aData), aNewLength, aFillChar));
|
||||
end;
|
||||
taLeftJustify:
|
||||
begin
|
||||
WriteStr(PadL(ConvertAccents(aData), aNewLength, aFillChar));
|
||||
end;
|
||||
taRightJustify:
|
||||
begin
|
||||
WriteStr(PadR(ConvertAccents(aData), aNewLength, aFillChar));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.WriteCmd(aData: integer; const aParameter: string);
|
||||
begin
|
||||
WriteStr(vlrDMConfig.ESCCode[aData] + aParameter);
|
||||
end;
|
||||
|
||||
function TlrDMFilter.CheckView(aView: TfrView): boolean;
|
||||
begin
|
||||
{ TODO -oheliosroots : gtLine }
|
||||
Result := aView.Typ in [gtMemo];
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.OnBeginDoc;
|
||||
begin
|
||||
Prn.Printer.RawMode := True;
|
||||
Prn.Printer.BeginDoc;
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.OnBeginPage;
|
||||
begin
|
||||
{%Region capturing metrics of the current page}
|
||||
// Margim
|
||||
fMarginBottom := CurPage.BottomMargin;
|
||||
fMarginLeft := CurPage.LeftMargin;
|
||||
fMarginRight := CurPage.RightMargin;
|
||||
fMarginTop := CurPage.TopMargin;
|
||||
|
||||
// Page client area
|
||||
fPageHeight := (fMarginBottom - fMarginTop);
|
||||
fPageWidth := (fMarginRight - fMarginLeft);
|
||||
|
||||
// Number of lines
|
||||
fNumberOfLines := round(fPageHeight / verticalDPI * standartLPI);
|
||||
{%EndRegion}
|
||||
|
||||
// Clear buffer
|
||||
ClearLines;
|
||||
// Fill lines in buffer
|
||||
Lines.Count := fNumberOfLines;
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.OnEndPage;
|
||||
|
||||
function ConverFontSizeToCPI(aFontSize: integer): integer;
|
||||
begin
|
||||
if (aFontSize < 10) then
|
||||
begin
|
||||
Result := 20;
|
||||
end
|
||||
else
|
||||
if (aFontSize > 15) then
|
||||
begin
|
||||
Result := 5;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := 10;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteHorizontalCompression(const aCPI: integer);
|
||||
begin
|
||||
if (aCPI = 5) then
|
||||
begin
|
||||
WriteCmd(cmdExpandedON);
|
||||
WriteCmd(cmd10CPI);
|
||||
end
|
||||
else
|
||||
if (aCPI = 20) then
|
||||
begin
|
||||
WriteCmd(cmdExpandedOFF);
|
||||
WriteCmd(cmd20CPI);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteCmd(cmdExpandedOFF);
|
||||
WriteCmd(cmd10CPI);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteVerticalCompression(aLineSpacing: TlrDmLineSpacing; aLineSpacingCustomValue: integer);
|
||||
begin
|
||||
case aLineSpacing of
|
||||
ls6LPI:
|
||||
begin
|
||||
WriteCmd(cmd6LPI);
|
||||
end;
|
||||
ls8LPI:
|
||||
begin
|
||||
WriteCmd(cmd8LPI);
|
||||
end;
|
||||
lsCustomLPI:
|
||||
begin
|
||||
WriteCmd(cmdCustomLPI, Char(aLineSpacingCustomValue));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteCharacterDecoration(const aFontStyle: integer);
|
||||
begin
|
||||
// Italics
|
||||
if (aFontStyle and $1) <> 0 then
|
||||
begin
|
||||
WriteCmd(cmdItalicsON);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteCmd(cmdItalicsOFF);
|
||||
end;
|
||||
// Bold
|
||||
if (aFontStyle and $2) <> 0 then
|
||||
begin
|
||||
WriteCmd(cmdBoldON);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteCmd(cmdBoldOFF);
|
||||
end;
|
||||
// Underline
|
||||
if (aFontStyle and $4) <> 0 then
|
||||
begin
|
||||
WriteCmd(cmdUnderlineON);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteCmd(cmdUnderlineOFF);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
vLoop, vCurrentCPI, vSpaceBetweenWords: integer;
|
||||
vTextRec: PfrTextRec = nil;
|
||||
begin
|
||||
// Start(Reset) the printer
|
||||
WriteCmd(cmdReset);
|
||||
// Vertical compression
|
||||
WriteVerticalCompression(vlrDMConfig.LineSpacing, vlrDMConfig.LineSpacingCustomValue);
|
||||
//WriteCmd(cmdCustomLPI, char(16)); { TODO -oheliosroots : check line break }
|
||||
// Buffer
|
||||
for vLoop := 0 to (Lines.Count - 1) do
|
||||
begin
|
||||
vTextRec := PfrTextRec(Lines[vLoop]);
|
||||
vSpaceBetweenWords := 0;
|
||||
while vTextRec <> nil do // Words
|
||||
begin
|
||||
// remove left margim
|
||||
vTextRec^.X := vTextRec^.X - fMarginLeft;
|
||||
|
||||
{%Region default}
|
||||
// Set default character decoration
|
||||
WriteCharacterDecoration(0);
|
||||
// Set default CPI
|
||||
vCurrentCPI := ConverFontSizeToCPI(10);
|
||||
// Set default horizonal compression
|
||||
WriteHorizontalCompression(vCurrentCPI);
|
||||
// Write space between words
|
||||
WriteStr(' ', taLeftJustify, Round((vTextRec^.X - vSpaceBetweenWords) / horizontalDPI * vCurrentCPI));
|
||||
// Recalculate space between words
|
||||
vSpaceBetweenWords := (vTextRec^.X + vTextRec^.W);
|
||||
{%EndRegion}
|
||||
|
||||
{%Region}
|
||||
// Set character decoration
|
||||
WriteCharacterDecoration(vTextRec^.FontStyle);
|
||||
// Get current CPI
|
||||
vCurrentCPI := ConverFontSizeToCPI(vTextRec^.FontSize);
|
||||
// Set horizonal compression
|
||||
WriteHorizontalCompression(vCurrentCPI);
|
||||
// Write word
|
||||
WriteStr(vTextRec^.Text, vTextRec^.Alignment, round((vTextRec^.W / horizontalDPI) * vCurrentCPI));
|
||||
{%EndRegion}
|
||||
|
||||
// Next word
|
||||
vTextRec := vTextRec^.Next;
|
||||
end;
|
||||
// Advances one line
|
||||
WriteCmd(cmdCR);
|
||||
WriteCmd(cmdLF);
|
||||
end;
|
||||
// Auto new page
|
||||
if (vlrDMConfig.AutoNewPage) then
|
||||
begin
|
||||
// Hop on the perforation
|
||||
for vLoop := 1 to vlrDMConfig.AutoNewPageLines do
|
||||
begin
|
||||
WriteCmd(cmdCR);
|
||||
WriteCmd(cmdLF);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Advances(Inject) one page
|
||||
WriteCmd(cmdFF);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.OnEndDoc;
|
||||
begin
|
||||
Prn.Printer.EndDoc;
|
||||
Prn.Printer.RawMode := False;
|
||||
end;
|
||||
|
||||
procedure TlrDMFilter.OnText(x, y: integer; const Text: string; View: TfrView);
|
||||
var
|
||||
vTextRec: PfrTextRec = nil;
|
||||
vRow: integer;
|
||||
begin
|
||||
// Area restrictions
|
||||
if (View = nil) or (y < fMarginTop) or (y > fMarginBottom) or
|
||||
(x < fMarginLeft) or (x + round(View.Width) > fMarginRight) then
|
||||
begin
|
||||
Exit;
|
||||
end;
|
||||
// Row position
|
||||
vRow := round(((y - fMarginTop) / verticalDPI) * standartLPI);
|
||||
// Row restrictions
|
||||
if (vRow < 0) or (vRow > fNumberOfLines) then
|
||||
begin
|
||||
Exit;
|
||||
end;
|
||||
// Add row in buffer
|
||||
NewRec(View, Text, vTextRec);
|
||||
if (View is TfrMemoView) then // Bug in procedure NewRec: ===>> {Alignment := Alignment}
|
||||
begin
|
||||
vTextRec^.Alignment := (View as TfrMemoView).Alignment;
|
||||
end;
|
||||
AddRec(vRow, vTextRec);
|
||||
end;
|
||||
|
||||
initialization
|
||||
vlrDMConfig := TlrDMConfig.Create;
|
||||
vlrDMConfig.AutoNewPage := True;
|
||||
vlrDMConfig.AutoNewPageLines := 0;
|
||||
vlrDMConfig.LineSpacing := lsCustomLPI;
|
||||
vlrDMConfig.LineSpacingCustomValue := 14;
|
||||
|
||||
finalization
|
||||
vlrDMConfig.Free;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user