mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-12 06:22:36 +02:00
448 lines
12 KiB
ObjectPascal
448 lines
12 KiB
ObjectPascal
(*
|
|
udlgpropertiesprinter.pp
|
|
------------
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Author : Olivier Guilbaud (OG)
|
|
|
|
Abstract:
|
|
Printer properties dialog.
|
|
This code makes it possible to modify the properties of a printer.
|
|
|
|
history
|
|
oct 01 2003 OG - Creation
|
|
sept 07 2004 OG - Use new Printer Media property
|
|
sept 29 2004 OG - Modify for use new CUPSPrinters unit
|
|
mar 08 2005 OG - Modifications for Printer4Lazarus pakage
|
|
|
|
*)
|
|
unit uDlgPropertiesPrinter;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
|
|
StdCtrls, Buttons, Printers, CupsLCL, OsPrinters in '../osprinters.pas', LCLProc,
|
|
CupsDyn;
|
|
|
|
type
|
|
|
|
{ Tdlgpropertiesprinter }
|
|
|
|
Tdlgpropertiesprinter = class(TForm)
|
|
btnCancel1: TBUTTON;
|
|
btnOk: TBUTTON;
|
|
cbPaperSize: TCOMBOBOX;
|
|
cbResolution: TComboBox;
|
|
cbPaperType: TCOMBOBOX;
|
|
cbPaperSrc: TCOMBOBOX;
|
|
cbBanStart: TCOMBOBOX;
|
|
cbBanEnd: TCOMBOBOX;
|
|
gbOrientation: TGROUPBOX;
|
|
gbBanners: TGROUPBOX;
|
|
gbPagesSheet: TGROUPBOX;
|
|
imgPageSheet: TIMAGE;
|
|
imgOrientation: TIMAGE;
|
|
labBanStart: TLABEL;
|
|
labBanEnd: TLABEL;
|
|
labPaperSrc: TLABEL;
|
|
labResolution: TLabel;
|
|
labPaperType: TLABEL;
|
|
labPaperSize: TLABEL;
|
|
pgAdvanced: TTabSheet;
|
|
Notebook1: TPageControl;
|
|
pgGeneral: TTabSheet;
|
|
pgMargins: TTabSheet;
|
|
Panel1: TPANEL;
|
|
rbSheet1: TRADIOBUTTON;
|
|
rbSheet2: TRADIOBUTTON;
|
|
rbSheet4: TRADIOBUTTON;
|
|
rbrev_portrait: TRADIOBUTTON;
|
|
rbrev_Landscape: TRADIOBUTTON;
|
|
rbLandscape: TRADIOBUTTON;
|
|
rbPortrait: TRADIOBUTTON;
|
|
sb: TScrollBox;
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure rbPortraitCLICK(Sender: TObject);
|
|
procedure cbPaperSizeKEYPRESS(Sender: TObject; var Key: Char);
|
|
procedure dlgpropertiesprinterCREATE(Sender: TObject);
|
|
procedure dlgpropertiesprinterSHOW(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
procedure RefreshInfos;
|
|
|
|
function number_up_supported: string;
|
|
procedure SetupOptions;
|
|
procedure SetupAdvancedOptions({%H-}Data: Ptrint);
|
|
|
|
public
|
|
{ public declarations }
|
|
procedure InitProperties;
|
|
end;
|
|
|
|
var
|
|
dlgpropertiesprinter: Tdlgpropertiesprinter;
|
|
|
|
implementation
|
|
|
|
{$R udlgpropertiesprinter.lfm}
|
|
{$R printerprop.res}
|
|
|
|
Type
|
|
THackCUPSPrinter=Class(TCUPSPrinter);
|
|
|
|
procedure Tdlgpropertiesprinter.dlgpropertiesprinterSHOW(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
RefreshInfos;
|
|
end;
|
|
|
|
procedure Tdlgpropertiesprinter.cbPaperSizeKEYPRESS(Sender: TObject;
|
|
var Key: Char);
|
|
begin
|
|
if Sender=nil then ;
|
|
Key:=#0;
|
|
end;
|
|
|
|
function Tdlgpropertiesprinter.number_up_supported: string;
|
|
Var Lst : TStringList;
|
|
begin
|
|
Lst:=TStringList.Create;
|
|
try
|
|
THackCUPSPrinter(Printer).GetEnumAttributeString('number-up-supported',Lst);
|
|
Result:=Lst.CommaText;
|
|
finally
|
|
Lst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure Tdlgpropertiesprinter.SetupOptions;
|
|
var
|
|
Lst : TStringList;
|
|
i : Integer;
|
|
pOr : TPrinterOrientation;
|
|
St : String;
|
|
begin
|
|
|
|
{$IFDEF DebugCUPS}
|
|
THackCUPSPrinter(Printer).DebugOptions;
|
|
{$ENDIF}
|
|
|
|
SetupCupsCombo(cbPaperSize, nil, 'PageSize');
|
|
SetupCupsCombo(cbPaperType, nil, 'MediaType');
|
|
if not cbPaperType.Enabled then begin
|
|
cbPaperType.Items.Add('Not Available');
|
|
cbPaperType.ItemIndex:=0;
|
|
end;
|
|
SetupCupsCombo(cbPaperSrc, nil, 'InputSlot');
|
|
SetupCupsCombo(cbResolution, nil, 'Resolution');
|
|
st := THackCUPSPrinter(Printer).GetResolutionOption;
|
|
if not cbResolution.Enabled then begin
|
|
cbResolution.Items.Add(st);
|
|
cbResolution.ItemIndex:=0;
|
|
end;
|
|
|
|
//Enum banners
|
|
Lst:=TStringList.Create;
|
|
try
|
|
THackCUPSPrinter(Printer).GetEnumAttributeString('job-sheets-supported',Lst);
|
|
gbBanners.Enabled:=(Lst.Count>0);
|
|
if gbBanners.Enabled then
|
|
begin
|
|
|
|
if Lst.IndexOf('none')<0 then
|
|
Lst.Insert(0, 'none');
|
|
|
|
cbBanStart.Items.Assign(Lst);
|
|
cbBanEnd.Items.Assign(Lst);
|
|
|
|
Lst.Clear;
|
|
St := THackCUPSPrinter(Printer).cupsGetOption('job-sheets');
|
|
if St='' then
|
|
THackCUPSPrinter(Printer).GetEnumAttributeString('job-sheets-default',Lst)
|
|
else
|
|
Lst.CommaText := St;
|
|
|
|
gbBanners.Enabled:= (Lst.Count=2);
|
|
if gbBanners.Enabled then
|
|
begin
|
|
cbBanStart.ItemIndex:= cbBanStart.Items.IndexOf(Lst[0]);
|
|
cbBanStart.Tag:=cbBanStart.ItemIndex;
|
|
cbBanEnd.ItemIndex:=cbBanEnd.Items.IndexOf(Lst[1]);
|
|
cbBanEnd.Tag:=cbBanEnd.ItemIndex;
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
Lst.Free;
|
|
end;
|
|
|
|
//Initialization of paper orientation
|
|
pOr:=Printer.Orientation;
|
|
rbPortrait.Checked :=(pOr=poPortrait);
|
|
rbLandscape.Checked :=(pOr=poLandscape);
|
|
rbRev_Portrait.Checked :=(pOr=poReversePortrait);
|
|
rbRev_Landscape.Checked :=(pOr=poReverseLandscape);
|
|
gbOrientation.Tag := ord(pOr);
|
|
|
|
//Initialization of Number pages per sheet
|
|
gbPagesSheet.Enabled:=(number_up_supported<>'');
|
|
if gbPagesSheet.Enabled then
|
|
begin
|
|
St:=THackCUPSPrinter(Printer).cupsGetOption('number-up');
|
|
i:=StrToIntDef(St,THackCUPSPrinter(Printer).GetAttributeInteger('number-up-default',0));
|
|
rbSheet2.Checked:=(i=2);
|
|
rbSheet4.Checked:=(i=4);
|
|
rbSheet1.Checked:=((i=1) or (i>4));
|
|
end;
|
|
|
|
Application.QueueAsyncCall(@SetupAdvancedOptions, 0);
|
|
end;
|
|
|
|
// TODO: do this in a frame to make printer properties dialog
|
|
procedure Tdlgpropertiesprinter.SetupAdvancedOptions(Data: PtrInt);
|
|
var
|
|
Group: pppd_group_t;
|
|
Option: pppd_option_t;
|
|
c,g,k,y: Integer;
|
|
lab: TLabel;
|
|
Bevel: TBevel;
|
|
Combo: TCombobox;
|
|
|
|
function CheckOption: boolean;
|
|
begin
|
|
// TODO: handle PPD_UI_PICKMANY options with checkgroup
|
|
// TODO: not tested PPD_UI_BOOLEAN, ppd spec recommeds checkbox
|
|
result :=
|
|
(Option^.ui <> PPD_UI_PICKMANY) and
|
|
(strcomp('PageSize', Option^.keyword)<>0) and
|
|
(strcomp('PageRegion', Option^.keyword)<>0) and
|
|
(strcomp('MediaType', Option^.keyword)<>0) and
|
|
(strcomp('Resolution', Option^.keyword)<>0) and
|
|
(strcomp('InputSlot', Option^.keyword)<>0);
|
|
end;
|
|
|
|
begin
|
|
if (THackCUPSPrinter(Printer).CupsPPD=nil) or
|
|
(THackCUPSPrinter(Printer).CupsPPD^.num_groups=0)
|
|
then
|
|
exit;
|
|
|
|
y := C_SPACE-C_GROUPSPACE;
|
|
|
|
g := 0;
|
|
Group := THackCUPSPrinter(Printer).CupsPPD^.groups;
|
|
while (Group<>nil) and (g<THackCUPSPrinter(Printer).CupsPPD^.num_groups) do
|
|
begin
|
|
|
|
// count options per group
|
|
c := 0;
|
|
k := 0;
|
|
Option := Group^.options;
|
|
while (Option<>nil) and (c<Group^.num_options) do
|
|
begin
|
|
if CheckOption then
|
|
inc(K);
|
|
Inc(Option);
|
|
Inc(c);
|
|
end;
|
|
|
|
if k>0 then
|
|
begin
|
|
// add group's caption
|
|
Inc(Y, C_GROUPSPACE);
|
|
|
|
// todo: use exclusively anchor options to do layout
|
|
lab := TLabel.Create(Self);
|
|
lab.Parent := sb;
|
|
lab.Font.Style:=lab.font.style + [fsBold];
|
|
lab.Top := Y;
|
|
lab.Caption := group^.text;
|
|
lab.BorderSpacing.Around:=C_SPACE;
|
|
|
|
Bevel := TBevel.Create(Self);
|
|
Bevel.Parent := sb;
|
|
Bevel.Shape := bsTopLine;
|
|
Bevel.Top:= y + lab.Height div 2;
|
|
Bevel.Height:= C_SPACE div 2;
|
|
Bevel.BorderSpacing.Around := C_SPACE;
|
|
Bevel.AnchorSideLeft.Control := lab;
|
|
Bevel.AnchorSideLeft.Side := asrBottom;
|
|
Bevel.width := sb.Width - C_SPACE;
|
|
Bevel.anchors := [akLeft, akTop, akRight];
|
|
|
|
inc(y, Lab.Height);
|
|
|
|
// add options
|
|
c := 0;
|
|
Option := Group^.options;
|
|
while (Option<>nil) and (c<Group^.num_options) do
|
|
begin
|
|
|
|
if CheckOption then
|
|
begin
|
|
y := y + C_SPACE;
|
|
|
|
lab := TLabel.Create(Self);
|
|
lab.Parent := sb;
|
|
lab.Layout:=tlCenter;
|
|
lab.AutoSize := false;
|
|
lab.Top := Y;
|
|
lab.Width:=220;
|
|
lab.BorderSpacing.Around:=C_SPACE;
|
|
lab.AnchorSideLeft.Control := sb;
|
|
lab.Caption := Option^.text;
|
|
|
|
combo := TCombobox.Create(self);
|
|
combo.Parent := sb;
|
|
combo.Style:= csDropDownList;
|
|
combo.Top:= y + lab.Height div 2;
|
|
combo.BorderSpacing.Around := C_SPACE;
|
|
combo.AnchorSideLeft.Control := lab;
|
|
combo.AnchorSideLeft.Side := asrBottom;
|
|
combo.AnchorSideRight.Control := sb;
|
|
combo.AnchorSideRight.Side := asrBottom;
|
|
combo.anchors := [akLeft, akTop, akRight];
|
|
|
|
lab.Height:= combo.height;
|
|
|
|
SetupCupsCombo(Combo, Option);
|
|
|
|
inc(y, combo.height + C_SPACE );
|
|
end;
|
|
|
|
Inc(Option);
|
|
Inc(C);
|
|
end; // option
|
|
|
|
end; // valid group
|
|
|
|
inc(group);
|
|
inc(g);
|
|
end; // group
|
|
|
|
// final space
|
|
with TPanel.Create(Self) do begin
|
|
SetBounds(C_SPACE, y+C_SPACE, 1, C_SPACE);
|
|
BevelOuter := bvNone;
|
|
Parent := sb;
|
|
end;
|
|
|
|
end;
|
|
|
|
//Initialization
|
|
procedure Tdlgpropertiesprinter.dlgpropertiesprinterCREATE(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
Notebook1.PageIndex:=0;
|
|
SetupOptions;
|
|
end;
|
|
|
|
procedure Tdlgpropertiesprinter.rbPortraitCLICK(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
RefreshInfos;
|
|
end;
|
|
|
|
procedure Tdlgpropertiesprinter.FormDestroy(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
end;
|
|
|
|
procedure Tdlgpropertiesprinter.RefreshInfos;
|
|
var St : string;
|
|
begin
|
|
//image orientation
|
|
St:='portrait';
|
|
if rbLandscape.Checked then St:='landscape';
|
|
if rbrev_Landscape.Checked then St:='rev_landscape';
|
|
if rbrev_portrait.Checked then St:='rev_portrait';
|
|
imgOrientation.Picture.PixMap.TransparentColor:=clNone;
|
|
imgOrientation.Picture.PixMap.LoadFromResourceName(HInstance, St);
|
|
imgOrientation.Picture.PixMap.Transparent:=True;
|
|
|
|
//image "Pages per sheet"
|
|
St:='pagesheet_1';
|
|
if rbSheet2.Checked then St:='pagesheet_2';
|
|
if rbSheet4.Checked then St:='pagesheet_4';
|
|
imgPageSheet.Picture.PixMap.TransparentColor:=clNone;
|
|
imgPageSheet.Picture.PixMap.LoadFromResourceName(HInstance, St);
|
|
imgPageSheet.Picture.PixMap.Transparent:=True;
|
|
end;
|
|
|
|
//Set the options for the selected printer
|
|
procedure Tdlgpropertiesprinter.InitProperties;
|
|
var
|
|
St: string;
|
|
i: Integer;
|
|
|
|
function GetSelOrientation: TPrinterOrientation;
|
|
begin
|
|
if rbLandscape.Checked then
|
|
result := poLandscape
|
|
else
|
|
if rbRev_Portrait.Checked then
|
|
result := poReversePortrait
|
|
else
|
|
if rbRev_Landscape.Checked then
|
|
result := poReverseLandscape
|
|
else
|
|
result := poPortrait;
|
|
end;
|
|
|
|
begin
|
|
|
|
{$IFDEF DebugCUPS}
|
|
THackCupsPrinter(Printer).DebugOptions;
|
|
{$ENDIF}
|
|
|
|
CheckCupsComboChanges(cbResolution);
|
|
CheckCupsComboChanges(cbPaperSize);
|
|
CheckCupsComboChanges(cbPaperType);
|
|
CheckCupsComboChanges(cbPaperSrc);
|
|
|
|
//Orientation
|
|
if gbOrientation.Enabled and (gbOrientation.Tag<>Ord(GetSelOrientation)) then
|
|
Printer.Orientation := GetSelOrientation;
|
|
|
|
//Page per sheet
|
|
if gbPagesSheet.Enabled then
|
|
begin
|
|
St:='0';
|
|
if rbSheet1.Checked then St:='1';
|
|
if rbSheet2.Checked then St:='2';
|
|
if rbSheet4.Checked then St:='4';
|
|
if THackCUPSPrinter(Printer).GetAttributeInteger('number-up-default',0)<>StrToInt(St) then
|
|
THackCUPSPrinter(Printer).cupsAddOption('number-up',St);
|
|
end;
|
|
|
|
//Banners
|
|
if gbBanners.Enabled and
|
|
(
|
|
(cbBanStart.Tag<>cbBanStart.ItemIndex) or
|
|
(cbBanEnd.Tag<>cbBanEnd.ItemIndex)
|
|
) then
|
|
begin
|
|
St:=cbBanStart.Text+','+cbBanEnd.Text;
|
|
THackCUPSPrinter(Printer).cupsAddOption('job-sheets',St);
|
|
end;
|
|
|
|
// check advanced options
|
|
for i := 0 to sb.ControlCount-1 do
|
|
if sb.Controls[i] is TCombobox then
|
|
CheckCupsComboChanges(TCombobox(sb.Controls[i]));
|
|
|
|
{$IFDEF DebugCUPS}
|
|
THackCupsPrinter(Printer).DebugOptions;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end.
|