mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 04:23:46 +02:00
500 lines
13 KiB
ObjectPascal
500 lines
13 KiB
ObjectPascal
(*
|
|
udlgSelectPrinter.pp
|
|
------------
|
|
*****************************************************************************
|
|
This file is part of the Printer4Lazarus package
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Author: Olivier Guilbaud (OG)
|
|
|
|
Abstract:
|
|
Printer select and configure dialog. This dialog box allows one to choose
|
|
a printer and to modify some options to print a file.
|
|
|
|
history
|
|
oct 24 2003 OG - Job hold and priority options.
|
|
- Add few function for convert Date time Local <-> GMT
|
|
for job-hold-until option with time specification
|
|
nov 04 2003 OG - First release
|
|
apr 19 2004 OG - Implemented More and Less button with Lazarus #212 bug
|
|
Fixed (thanks)
|
|
sep 12 2004 OG - Fix bug num copies by replace IntToStr(Trunc(edCopies.Value)))
|
|
with edCopies.Text. Idem for priority of job
|
|
sep 29 2004 OG - Modify for use new CUPSPrinters unit
|
|
dec 20 2004 OG - TPrintRange and PrintRange property from Darek
|
|
mar 08 2005 OG - Dynamique CUPS link
|
|
- Some bug compile fix
|
|
mar 08 2005 OG - Modifications for Printer4Lazarus pakage
|
|
oct 2015 - property BigMode, refactor, anchors fix
|
|
------------------------------------------------------------------------------*)
|
|
unit uDlgSelectPrinter;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Math,
|
|
// LCL
|
|
LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls,
|
|
Spin, ComCtrls, LCLType, LCLPlatformDef, InterfaceBase, Printers,
|
|
// Printers
|
|
OsPrinters, CUPSDyn;
|
|
|
|
type
|
|
|
|
{ TdlgSelectPrinter }
|
|
|
|
TdlgSelectPrinter = class(TForm)
|
|
Bevel1: TBEVEL;
|
|
btnProp: TBUTTON;
|
|
btnCancel: TBUTTON;
|
|
btnPrint: TBUTTON;
|
|
btnReduc: TBUTTON;
|
|
btnPreview: TBUTTON;
|
|
cbPrinters: TCOMBOBOX;
|
|
cbCollate: TCHECKBOX;
|
|
cbReverse: TCHECKBOX;
|
|
cbPrintToFile: TCheckBox;
|
|
edPageSet: TCOMBOBOX;
|
|
cbTasktime: TCOMBOBOX;
|
|
edRange: TEDIT;
|
|
panLabels: TPanel;
|
|
PrinterGroupbox: TGroupbox;
|
|
gbPages: TGROUPBOX;
|
|
gbCopies: TGROUPBOX;
|
|
ImgPrn: TIMAGE;
|
|
imgCollate: TIMAGE;
|
|
PrinterNameLabel: TLabel;
|
|
PrinterStateLabel: TLabel;
|
|
PrinterLocationLabel: TLabel;
|
|
PrinterDescriptionLabel: TLabel;
|
|
labComment: TLABEL;
|
|
labCUPS: TLABEL;
|
|
labPrinterName: TLabel;
|
|
PrioLabel: TLabel;
|
|
labCUPSServer: TLABEL;
|
|
labTask: TLABEL;
|
|
lanNumCopies: TLABEL;
|
|
labPage: TLABEL;
|
|
labLocation: TLABEL;
|
|
labState: TLABEL;
|
|
edTimeTask: TEDIT;
|
|
NbOpts: TPageControl;
|
|
pgAdvance: TTabSheet;
|
|
pgCopies: TTabSheet;
|
|
BtnPanel: TPanel;
|
|
rbSelection: TRadioButton;
|
|
rbRange: TRADIOBUTTON;
|
|
rbCurrentPage: TRADIOBUTTON;
|
|
rbAllPage: TRADIOBUTTON;
|
|
edCopies: TSPINEDIT;
|
|
edPriority: TSPINEDIT;
|
|
tkbPriority: TTRACKBAR;
|
|
procedure btnPrintCLICK(Sender: TObject);
|
|
procedure btnPropCLICK(Sender: TObject);
|
|
procedure btnReducCLICK(Sender: TObject);
|
|
procedure cbPrintersCHANGE(Sender: TObject);
|
|
procedure cbPrintersKEYPRESS(Sender: TObject; var Key: Char);
|
|
procedure cbReverseCLICK(Sender: TObject);
|
|
procedure cbTasktimeCHANGE(Sender: TObject);
|
|
procedure dlgSelectPrinterCREATE(Sender: TObject);
|
|
procedure dlgSelectPrinterSHOW(Sender: TObject);
|
|
procedure PrinterStateLabelChangeBounds(Sender: TObject);
|
|
procedure tkbPriorityCHANGE(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
fPropertiesSetting : Boolean;
|
|
FOptions: TPrintDialogOptions;
|
|
FBig: boolean;
|
|
FHeightInit: integer;
|
|
FHeightDec: integer;
|
|
function GetPrintRange: TPrintRange;
|
|
procedure RefreshInfos;
|
|
procedure InitPrinterOptions;
|
|
procedure SetBigMode(AValue: boolean);
|
|
procedure SetPrintRange(const AValue: TPrintRange);
|
|
property BigMode: boolean read FBig write SetBigMode;
|
|
public
|
|
{ public declaration}
|
|
constructor Create(aOwner : TComponent); override;
|
|
|
|
property PrintRange: TPrintRange read GetPrintRange write SetPrintRange;
|
|
property Options: TPrintDialogOptions read FOptions write FOptions;
|
|
end;
|
|
|
|
var
|
|
dlgSelectPrinter: TdlgSelectPrinter;
|
|
|
|
implementation
|
|
|
|
{$R udlgselectprinter.lfm}
|
|
{$R selectprinter.res}
|
|
|
|
uses
|
|
uDlgPropertiesPrinter;
|
|
|
|
Type
|
|
THackCUPSPrinter = Class(TCUPSPrinter);
|
|
|
|
//Convert an local date & time to a GMT(UTC) Date & Time
|
|
function LocalToGMTDateTime(aDate : TDateTime) : TDateTime;
|
|
begin
|
|
//TODO: Adjust for time zone and DayLight saving time
|
|
result := aDate;
|
|
end;
|
|
|
|
//Convert an GMT(UTC) Date & Time to local date & time
|
|
function GMTToLocalDateTime(aDate : TDateTime) : TDateTime;
|
|
begin
|
|
//TODO: Adjust for time zone and DayLight saving time
|
|
result := aDate;
|
|
end;
|
|
|
|
{ TdlgSelectPrinter }
|
|
|
|
constructor TdlgSelectPrinter.Create(aOwner : TComponent);
|
|
begin
|
|
Inherited Create(aOwner);
|
|
|
|
FHeightInit:=Height;
|
|
FHeightDec:=NbOpts.Height+6;
|
|
|
|
if WidgetSet.LCLPlatform = lpCarbon then
|
|
begin //Can't hide tabs with button on Carbon, so just expand dialog.
|
|
BigMode:=true;
|
|
btnReduc.Visible:=false;
|
|
end
|
|
else
|
|
BigMode:=false;
|
|
end;
|
|
|
|
|
|
procedure TdlgSelectPrinter.tkbPriorityCHANGE(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
edPriority.Value:=tkbPriority.Position;
|
|
end;
|
|
|
|
//Initialization
|
|
procedure TdlgSelectPrinter.RefreshInfos;
|
|
var St : string;
|
|
Stp : string;
|
|
n : Integer;
|
|
|
|
//Convert an GMT hour to Local hour
|
|
function GetTimeHold : string;
|
|
Var Dt : TDateTime;
|
|
begin
|
|
try
|
|
Dt:=Date+StrToTime(St);
|
|
DT:=GMTToLocalDatetime(Dt);
|
|
Result:=FormatDateTime('HH:NN:SS',Dt);
|
|
Except
|
|
Result:='00:00:00';
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
try
|
|
|
|
cbPrintToFile.Visible := (poPrintToFile in FOptions);
|
|
cbPrintToFile.Enabled := not (poDisablePrintToFile in FOptions);
|
|
rbSelection.Enabled := (poSelection in FOptions);
|
|
rbCurrentPage.Enabled := (poPageNums in FOptions);
|
|
|
|
//State
|
|
St:='';
|
|
StP:='printer';
|
|
if Printer.PrinterType=ptNetWork then
|
|
StP:=StP+'_remote';
|
|
|
|
BtnPrint.Enabled:=True;
|
|
Case Printer.PrinterState of
|
|
psReady : St:='Ready';
|
|
psPrinting : St:='Printing';
|
|
psStopped : begin
|
|
St:='Stopped';
|
|
StP:=StP+'_stopped';
|
|
BtnPrint.Enabled:=False;
|
|
end;
|
|
end;
|
|
|
|
if Printer.CanPrint then
|
|
St:=St+' (Accepting jobs)'
|
|
else
|
|
begin
|
|
St:=St+' (Rejetting jobs)';
|
|
BtnPrint.Enabled:=False;
|
|
end;
|
|
|
|
labState.Caption:=St;
|
|
|
|
//DRw image printer
|
|
imgPrn.Picture.PixMap.TransparentColor:=clNone;
|
|
imgPrn.Picture.PixMap.LoadFromResourceName(HInstance, Stp);
|
|
imgPrn.Picture.PixMap.Transparent:=True;
|
|
|
|
//cups server
|
|
labCUPSServer.Caption:=cupsServer()+':'+IntToStr(ippPort());
|
|
//
|
|
labLocation.Caption:=THackCUPSPrinter(Printer).GetAttributeString('printer-location','');
|
|
labComment.Caption :=THackCUPSPrinter(Printer).GetAttributeString('printer-info','');
|
|
|
|
//Copies
|
|
edCopies.Value:=Printer.Copies;
|
|
cbCollate.Checked:=True; //For update image
|
|
|
|
//Range setting
|
|
edRange.Enabled:=
|
|
(poPageNums in FOptions) and
|
|
THackCUPSPrinter(Printer).GetAttributeBoolean('page-ranges-supported',False);
|
|
rbRange.Enabled:=edRange.Enabled;
|
|
|
|
//Job priority
|
|
n:=THackCUPSPrinter(Printer).GetAttributeInteger('job-priority-supported',0);
|
|
edPriority.MaxValue:=n;
|
|
tkbPriority.Max:=n;
|
|
n:=THackCUPSPrinter(Printer).GetAttributeInteger('job-priority-default',0);
|
|
edPriority.Value:=n;
|
|
edPriority.Tag :=n; //Save default priority
|
|
tkbPriority.Position:=n;
|
|
|
|
//Job-Hold
|
|
edTimeTask.Enabled:=False;
|
|
edTimeTask.Text:=FormatDateTime('hh:nn:ss',Now);
|
|
St:=THackCUPSPrinter(Printer).cupsGetOption('job-hold-until');
|
|
n:=0;
|
|
if St='indefinite' then n:=1;
|
|
if St='day-time' then n:=2;
|
|
if st='evening' then n:=3;
|
|
if st='night' then n:=4;
|
|
if st='weekend' then n:=5;
|
|
if St='second-shift' then n:=6;
|
|
if St='third-shift' then n:=7;
|
|
if Pos(':',St)<>0 then
|
|
begin
|
|
n:=8;
|
|
edTimeTask.Enabled:=True;
|
|
edTimeTask.Text:=St;
|
|
end;
|
|
|
|
cbTasktime.ItemIndex:=n;
|
|
Except
|
|
end;
|
|
end;
|
|
|
|
function TdlgSelectPrinter.GetPrintRange: TPrintRange;
|
|
begin
|
|
Result:=prAllPages;
|
|
|
|
if rbCurrentPage.checked then
|
|
Result:=prCurrentPage
|
|
else
|
|
if rbRange.checked then
|
|
Result:=prPageNums;
|
|
end;
|
|
|
|
//Initialization of selected Printer options
|
|
procedure TdlgSelectPrinter.InitPrinterOptions;
|
|
Var St : string;
|
|
pOr : TPrinterOrientation;
|
|
|
|
//Convert an Local hour to GMT hour
|
|
function GetTimeHold : string;
|
|
Var Dt : TDateTime;
|
|
begin
|
|
try
|
|
Dt:=Date+StrToTime(edTimeTask.Text);
|
|
DT:=LocalToGMTDateTime(Dt);
|
|
Result:=FormatDateTime('HH:NN:SS',Dt);
|
|
Except
|
|
Result:='indefinite';
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not fPropertiesSetting then
|
|
begin
|
|
//Preserve selected orientation - isn't stored in cups options
|
|
pOr:=Printer.Orientation;
|
|
//Free current options if exists
|
|
THackCUPSPrinter(Printer).FreeOptions;
|
|
//Initialize default Options
|
|
THackCUPSPrinter(Printer).SetOptionsOfPrinter;
|
|
Printer.Orientation := pOr;
|
|
end;
|
|
|
|
//Copies
|
|
THackCUPSPrinter(Printer).cupsAddOption('copies',edCopies.Text);
|
|
if rbRange.Checked then
|
|
THackCUPSPrinter(Printer).cupsAddOption('page-ranges',edRange.Text);
|
|
if edPageSet.ItemIndex>0 then
|
|
begin
|
|
if edPageSet.ItemIndex=1 then
|
|
St:='Odd'
|
|
else
|
|
St:='Even';
|
|
THackCUPSPrinter(Printer).cupsAddOption('page-set',St);
|
|
end;
|
|
if cbCollate.Checked then
|
|
st:='separate-documents-collated-copies'
|
|
else
|
|
St:='separate-documents-uncollated-copies';
|
|
THackCUPSPrinter(Printer).cupsAddOption('multiple-document-handling',St);
|
|
if cbReverse.Checked then
|
|
THackCUPSPrinter(Printer).cupsAddOption('OutputOrder','Reverse');
|
|
|
|
//Priority job
|
|
if edPriority.Tag<>edPriority.Value then
|
|
THackCUPSPrinter(Printer).cupsAddOption('job-priority',edPriority.Text);
|
|
|
|
//Job-Hold
|
|
Case cbTasktime.ItemIndex of
|
|
1 : St:='indefinite';
|
|
2 : St:='day-time';
|
|
3 : st:='evening';
|
|
4 : st:='night';
|
|
5 : st:='weekend';
|
|
6 : St:='second-shift';
|
|
7 : St:='third-shift';
|
|
8 : St:=GetTimeHold;
|
|
else St:='no-hold';
|
|
end;
|
|
THackCUPSPrinter(Printer).cupsAddOption('job-hold-until',St);
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.SetPrintRange(const AValue: TPrintRange);
|
|
begin
|
|
case aValue of
|
|
prAllPages : rbAllPage.checked:=True;
|
|
prCurrentPage : rbCurrentPage.checked:=True;
|
|
prPageNums : rbRange.checked:=True;
|
|
end;
|
|
end;
|
|
|
|
|
|
//Initialization of screen
|
|
procedure TdlgSelectPrinter.dlgSelectPrinterSHOW(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
NbOpts.PageIndex:=0;
|
|
cbPrinters.Items.Assign(Printer.Printers);
|
|
if cbPrinters.Items.Count>0 then
|
|
cbPrinters.ItemIndex:= Printer.PrinterIndex;
|
|
RefreshInfos;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.PrinterStateLabelChangeBounds(Sender: TObject);
|
|
begin
|
|
labState.BorderSpacing.Top:=PrinterStateLabel.Top-labState.BorderSpacing.Around;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.cbTasktimeCHANGE(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
//Time is active if last item is selected
|
|
edTimeTask.Enabled:=(cbTaskTime.ItemIndex=cbTaskTime.Items.Count-1);
|
|
edTimeTask.Text:=FormatDateTime('hh:nn:ss',Now);
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.dlgSelectPrinterCREATE(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
fPropertiesSetting:=False;
|
|
NbOpts.PageIndex:=0;
|
|
end;
|
|
|
|
//Show corresponding image
|
|
procedure TdlgSelectPrinter.cbReverseCLICK(Sender: TObject);
|
|
Var St : string;
|
|
begin
|
|
if Sender=nil then ;
|
|
St:='collate';
|
|
If not cbCollate.Checked then
|
|
St:='un'+St;
|
|
if cbReverse.Checked then
|
|
St:=St+'_rev';
|
|
|
|
imgCollate.Picture.PixMap.TransparentColor:=clNone;
|
|
imgCollate.Picture.PixMap.LoadFromResourceName(HInstance, St);
|
|
imgCollate.Picture.BitMap.Transparent:=True;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.cbPrintersKEYPRESS(Sender: TObject; var Key: Char);
|
|
begin
|
|
if Sender=nil then ;
|
|
Key:=#0;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.btnReducCLICK(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
BigMode:=not BigMode;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.SetBigMode(AValue: boolean);
|
|
begin
|
|
FBig:= AValue;
|
|
NbOpts.Visible:= FBig;
|
|
|
|
Constraints.MinHeight:=0;
|
|
Constraints.MaxHeight:=0;
|
|
Height:=FHeightInit-IfThen(not FBig, FHeightDec);
|
|
Constraints.MinHeight:=Height;
|
|
Constraints.MaxHeight:=Height;
|
|
|
|
if not FBig then
|
|
btnReduc.Caption:='More >>'
|
|
else
|
|
btnReduc.Caption:='<< Less';
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.btnPrintCLICK(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
InitPrinterOptions;
|
|
end;
|
|
|
|
//Show the printer properties dialog
|
|
procedure TdlgSelectPrinter.btnPropCLICK(Sender: TObject);
|
|
var Dlg : Tdlgpropertiesprinter;
|
|
begin
|
|
if Sender=nil then ;
|
|
//Set default printer
|
|
THackCUPSPrinter(Printer).SelectCurrentPrinterOrDefault;
|
|
|
|
Dlg:=Tdlgpropertiesprinter.Create(self);
|
|
try
|
|
if Dlg.ShowModal=mrOk then
|
|
begin
|
|
Dlg.InitProperties;
|
|
fPropertiesSetting:=True;
|
|
end;
|
|
finally
|
|
Dlg.free;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.cbPrintersCHANGE(Sender: TObject);
|
|
var
|
|
tmpn: Integer;
|
|
tmpOptions: Pcups_option_t;
|
|
begin
|
|
if Sender=nil then ;
|
|
|
|
tmpn := THackCupsPrinter(Printer).CopyOptions(tmpOptions);
|
|
|
|
Printer.SetPrinter(cbPrinters.Text);
|
|
fPropertiesSetting:=False;
|
|
|
|
THackCupsPrinter(Printer).MergeOptions(tmpOptions, tmpn);
|
|
|
|
RefreshInfos;
|
|
end;
|
|
|
|
end.
|