lazarus/components/printers/unix/framepagesetup.pas

341 lines
9.1 KiB
ObjectPascal

{
*****************************************************************************
This file is part of the Printer4Lazarus package
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit framePageSetup;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
// LCL
LCLIntf, LCLProc, LResources, Controls, Graphics, Forms, ExtCtrls, StdCtrls,
Spin, Printers,
// Printers
CupsLCL, Printer4LazStrConst;
type
{ TframePageSetup }
TframePageSetup = class(TFrame)
cbPaper: TComboBox;
cbSource: TComboBox;
Label1: TLabel;
panMargins: TPanel;
txtLeft: TFloatSpinEdit;
txtTop: TFloatSpinEdit;
txtRight: TFloatSpinEdit;
txtBottom: TFloatSpinEdit;
gpPaper: TGroupBox;
gpOrientation: TGroupBox;
gpMargins: TGroupBox;
lblSource: TLabel;
lblPaper: TLabel;
lblLeft: TLabel;
lblRight: TLabel;
lblTop: TLabel;
lblBottom: TLabel;
pbPreview: TPaintBox;
panSetup: TPanel;
panPreview: TPanel;
radLandscape: TRadioButton;
radPortrait: TRadioButton;
procedure cbPaperChange(Sender: TObject);
procedure pbPreviewPaint(Sender: TObject);
procedure radPortraitClick(Sender: TObject);
procedure txtLeftChange(Sender: TObject);
private
function NToInches: double;
procedure RotateMargins(AOrder: boolean);
public
UnitInches: boolean;
EnablePreview: boolean;
EnableMargins: boolean;
EnablePapers: boolean;
EnableOrientation: boolean;
CurPageWidth: double;
CurPageHeight: double;
procedure Initialize(AEnablePreview, AEnableMargins, AEnablePapers,
AEnableOrientation: boolean);
procedure UpdatePageSize;
procedure UpdateMaxValues;
procedure SetDefaultMinMargins;
end;
implementation
{$R framepagesetup.lfm}
{ TframePageSetup }
function TframePageSetup.NToInches: double;
begin
if UnitInches then
Result:= 1
else
Result:= 1/25.4;
end;
procedure TframePageSetup.RotateMargins(AOrder: boolean);
var
m_l, m_t, m_r, m_b: double;
begin
m_l:= txtLeft.Value;
m_t:= txtTop.Value;
m_r:= txtRight.Value;
m_b:= txtBottom.Value;
if AOrder then
begin
txtLeft.Value:= m_b;
txtTop.Value:= m_l;
txtRight.Value:= m_t;
txtBottom.Value:= m_r;
end
else
begin
txtLeft.Value:= m_t;
txtTop.Value:= m_r;
txtRight.Value:= m_b;
txtBottom.Value:= m_l;
end;
// same way must change MinValues
m_l:= txtLeft.MinValue;
m_t:= txtTop.MinValue;
m_r:= txtRight.MinValue;
m_b:= txtBottom.MinValue;
if AOrder then
begin
txtLeft.MinValue:= m_b;
txtTop.MinValue:= m_l;
txtRight.MinValue:= m_t;
txtBottom.MinValue:= m_r;
end
else
begin
txtLeft.MinValue:= m_t;
txtTop.MinValue:= m_r;
txtRight.MinValue:= m_b;
txtBottom.MinValue:= m_l;
end;
end;
procedure TframePageSetup.pbPreviewPaint(Sender: TObject);
const
cTopBottomMargin = 8;
cPadding = 6;
cShadowSize = 4;
cDimLineHeight = 12;
cDimLineTail = 3;
var
rc: TRect;
txtHeight, fHeight, fWidth, fx, fy, vCenter: Integer;
FUnitsStr, str: string;
begin
if not EnablePreview then
exit;
if UnitInches then
FUnitsStr := p4lrsAbbrevUnitsInches
else
FUnitsStr := p4lrsAbbrevUnitsMm;
with pbPreview, Canvas do
begin
Pen.Color := clBlack;
txtHeight := TextHeight('A');
// center
vCenter := Height div 2;
// adjust center
if CurPageHeight > CurPageWidth then;
vCenter := vCenter - (txtHeight + cDimLineHeight + cPadding) div 2;
// compute height/width
fHeight := Height - cTopBottomMargin * 2 - txtHeight - cDimLineHeight - cPadding;
if CurPageHeight > CurPageWidth then
fWidth := Round(CurPageWidth / CurPageHeight * fHeight)
else
begin
fWidth := fHeight;
fHeight := Round(CurPageHeight / CurPageWidth * fWidth);
end;
// draw paper and shadow
fx := (Width - fWidth) div 2;
fy := vCenter - (fHeight div 2);
Brush.Color := clGrayText;
Pen.Style := psClear;
rc := Rect(fx, fy, fx + fWidth, fy + fHeight);
rc.Offset(cShadowSize, cShadowSize);
Rectangle(rc);
Brush.Color := clWhite;
Pen.Style := psSolid;
rc.Offset(-cShadowSize, -cShadowSize);
Rectangle(rc);
// draw margins
rc.Left := rc.Left + Round(txtLeft.Value * fWidth / CurPageWidth);
rc.Top := rc.Top + Round(txtTop.Value * fHeight / CurPageHeight);
rc.Right := rc.Right - Round(txtRight.Value * fWidth / CurPageWidth);
rc.Bottom := rc.Bottom - Round(txtBottom.Value * fHeight / CurPageHeight);
Pen.Color := clGray;
Pen.Style := psDot;
Rectangle(rc);
// bottom dimension line
Pen.Color := clBlack;
Pen.Style := psSolid;
fy := fy + fHeight + cPadding + cDimLineHeight div 2;
Line(fx, fy, fx + fWidth, fy);
Line(fx, fy - cDimLineTail, fx, fy + cDimLineTail + 1);
fx := fx + fWidth - 1;
Line(fx, fy - cDimLineTail, fx, fy + cDimLineTail + 1);
// bottom dimension text
Brush.Style := bsClear;
str := FormatFloat(',0.00 ', CurPageWidth) + FUnitsStr;
fy := fy + cDimLineHeight div 2;
TextOut((Width - TextWidth(str)) div 2, fy, str);
// left dimension line
fy := vCenter - (fHeight div 2);
fx := (Width - fWidth) div 2 - cPadding - cDimLineHeight div 2;
Line(fx, fy, fx, fy + fHeight);
Line(fx - cDimLineTail, fy, fx + cDimLineTail + 1, fy);
fy := fy + fHeight - 1;
Line(fx - cDimLineTail, fy, fx + cDimLineTail + 1, fy);
// left dimension text
Brush.Style := bsClear;
str := FormatFloat(',0.00 ', CurPageHeight) + FUnitsStr;
fy := fy - fHeight div 2 - txtHeight div 2;
TextOut(fx - cDimLineHeight div 2 - TextWidth(str), fy, str);
end;
end;
procedure TframePageSetup.radPortraitClick(Sender: TObject);
begin
RotateMargins(radPortrait.Checked);
if radPortrait.Checked then
Printer.Orientation := poPortrait
else
Printer.Orientation := poLandsCape;
UpdatePageSize;
end;
procedure TframePageSetup.txtLeftChange(Sender: TObject);
begin
pbPreview.Invalidate;
end;
procedure TframePageSetup.cbPaperChange(Sender: TObject);
begin
if Printer.PaperSize.DefaultPapers then
begin
if cbPaper.ItemIndex>=0 then
Printer.PaperSize.PaperName := cbPaper.Items[cbPaper.ItemIndex];
end else
Printer.PaperSize.PaperName := GetCupsComboKeyValue(cbPaper);
UpdatePageSize;
end;
procedure TframePageSetup.UpdatePageSize;
var
FLastPageWidth, FLastPageHeight: Double;
begin
if not EnablePreview then
exit;
with Printer.PaperSize.PaperRect do
begin
// save last size
FLastPageWidth := CurPageWidth;
FLastPageHeight := CurPageHeight;
CurPageWidth := (PhysicalRect.Right-PhysicalRect.Left)/Printer.XDPI/NToInches;
CurPageHeight := (PhysicalRect.Bottom-PhysicalRect.Top)/Printer.YDPI/NToInches;
end;
// revert to last size if invalid (custom?)
if (CurPageWidth <= 0) or (CurPageHeight <= 0) then
begin
CurPageWidth := FLastPageWidth;
CurPageHeight := FLastPageHeight;
end;
UpdateMaxValues;
end;
procedure TframePageSetup.UpdateMaxValues;
procedure DoSetMax(Ctl: TFloatSpinEdit; Value: double);
begin
// because of TCustomFloatSpinEdit.GetLimitedValue
// we cannot set MinValue=MaxValue, all validation will break
if Ctl.MinValue > Value-0.2 then
Ctl.MinValue := Value-0.2;
Ctl.MaxValue := Value;
end;
const
cMul = 0.45; // max margin is almost 1/2 of page size
begin
DoSetMax(txtLeft, CurPageWidth * cMul);
DoSetMax(txtRight, CurPageWidth * cMul);
DoSetMax(txtTop, CurPageHeight * cMul);
DoSetMax(txtBottom, CurPageHeight * cMul);
end;
procedure TframePageSetup.Initialize(AEnablePreview, AEnableMargins, AEnablePapers,
AEnableOrientation: boolean);
begin
EnablePreview:= AEnablePreview;
EnableMargins:= AEnableMargins;
EnablePapers:= AEnablePapers;
EnableOrientation:= AEnableOrientation;
cbPaper.Items.Clear;
cbSource.Items.Clear;
cbPaper.ItemIndex := -1;
cbSource.ItemIndex := -1;
SetupCupsCombo(cbSource, nil, 'InputSlot');
SetupCupsCombo(cbPaper, nil, 'PageSize');
if (cbPaper.Items.Count=0) then
begin
// no cups printer papers, use default ones
cbPaper.Items := Printer.PaperSize.SupportedPapers;
cbPaper.ItemIndex:= cbPaper.Items.IndexOf(Printer.PaperSize.PaperName);
end;
cbPaper.Enabled := EnablePapers;
cbSource.Enabled := EnablePapers;
//TODO: support reverse variants too?
gpOrientation.Enabled := EnableOrientation;
case Printer.Orientation of
poPortrait,poReversePortrait:
radPortrait.Checked := true;
poLandscape,poReverseLandscape:
radLandscape.Checked := true;
end;
gpMargins.Enabled := EnableMargins;
panPreview.Visible:= EnablePreview;
if EnablePreview then
UpdatePageSize;
end;
procedure TframePageSetup.SetDefaultMinMargins;
begin
with Printer.PaperSize.PaperRect do
begin
txtLeft.MinValue := (WorkRect.Left-PhysicalRect.Left)/Printer.XDPI/NToInches;
txtTop.MinValue := (WorkRect.Top-PhysicalRect.Top)/Printer.YDPI/NToInches;
txtRight.MinValue := (PhysicalRect.Right-WorkRect.Right)/Printer.XDPI/NToInches;
txtBottom.MinValue := (PhysicalRect.Bottom-WorkRect.Bottom)/Printer.YDPI/NToInches;
end;
end;
end.