mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-18 23:23:32 +02:00
595 lines
16 KiB
ObjectPascal
595 lines
16 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, Types,
|
|
// LCL
|
|
LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls,
|
|
Spin, ComCtrls, LCLType, LCLPlatformDef, InterfaceBase, Printers, LCLProc,
|
|
// Printers
|
|
Printer4LazStrConst, 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;
|
|
Label2: TLabel;
|
|
panLabels: TPanel;
|
|
PrinterGroupbox: TGroupbox;
|
|
gbPages: TGROUPBOX;
|
|
gbCopies: TGROUPBOX;
|
|
imgCollate: TIMAGE;
|
|
Label1: TLabel;
|
|
PrinterStateLabel: TLabel;
|
|
PrinterLocationLabel: TLabel;
|
|
PrinterDescriptionLabel: TLabel;
|
|
labComment: TLABEL;
|
|
labCUPS: TLABEL;
|
|
PrinterNameLabel: 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 cbPrintersDrawItem({%H-}Control: TWinControl; Index: Integer;
|
|
ARect: TRect; State: TOwnerDrawState);
|
|
procedure cbPrintersKEYPRESS(Sender: TObject; var {%H-}Key: Char);
|
|
procedure cbReverseCLICK(Sender: TObject);
|
|
procedure cbTasktimeCHANGE(Sender: TObject);
|
|
procedure dlgSelectPrinterCREATE(Sender: TObject);
|
|
procedure dlgSelectPrinterSHOW(Sender: TObject);
|
|
procedure edCopiesChange(Sender: TObject);
|
|
procedure edRangeEnter(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure tkbPriorityCHANGE(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
fPropertiesSetting : Boolean;
|
|
FOptions: TPrintDialogOptions;
|
|
FBig: boolean;
|
|
fPrinterImgs: TImageList;
|
|
FSavedPrinterIndex: Integer;
|
|
function GetPrintRange: TPrintRange;
|
|
procedure RefreshInfos;
|
|
procedure InitPrinterOptions;
|
|
procedure SetBigMode(AValue: boolean);
|
|
procedure SetPrintRange(const AValue: TPrintRange);
|
|
procedure InitPrinterList;
|
|
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);
|
|
btnReduc.Caption := p4lrsButtonMoreArrow;
|
|
|
|
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:=p4lrsJobStateReady;
|
|
psPrinting : St:=p4lrsJobStatePrinting;
|
|
psStopped : begin
|
|
St:=p4lrsJobStateStopped;
|
|
StP:=StP+'_stopped';
|
|
BtnPrint.Enabled:=False;
|
|
end;
|
|
end;
|
|
|
|
if Printer.CanPrint then
|
|
St:=St+' '+p4lrsJobStateAccepting
|
|
else
|
|
begin
|
|
St:=St+' '+p4lrsJobStateRejecting;
|
|
BtnPrint.Enabled:=False;
|
|
end;
|
|
|
|
btnPreview.Enabled := btnPrint.Enabled;
|
|
|
|
labState.Caption:=St;
|
|
|
|
//cups server
|
|
labCUPSServer.Caption:=cupsServer()+':'+IntToStr(ippPort());
|
|
//
|
|
labLocation.Caption:=THackCUPSPrinter(Printer).GetAttributeString('printer-location','');
|
|
labComment.Caption :=THackCUPSPrinter(Printer).GetAttributeString('printer-info','');
|
|
|
|
cbReverseCLICK(cbCollate); // update collate image
|
|
edCopiesChange(edCopies); // update collate/reverse states
|
|
|
|
//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
|
|
else
|
|
if rbSelection.checked then
|
|
Result:=prSelection;
|
|
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;
|
|
prSelection : rbSelection.checked:=True;
|
|
prPageNums : rbRange.checked:=True;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.InitPrinterList;
|
|
var
|
|
i, FImgIndex, FSavedIndex: Integer;
|
|
begin
|
|
// load printer images from resource
|
|
fPrinterImgs.AddResourceName(HInstance, 'printer');
|
|
fPrinterImgs.AddResourceName(HInstance, 'printer_remote');
|
|
fPrinterImgs.AddResourceName(HInstance, 'printer_remote_stopped');
|
|
fPrinterImgs.AddResourceName(HInstance, 'printer_stopped');
|
|
|
|
// add printer names to cbPrinters, with image index
|
|
FSavedIndex := Printer.PrinterIndex;
|
|
try
|
|
for i := 0 to Printer.Printers.Count - 1 do
|
|
begin
|
|
Printer.PrinterIndex := i;
|
|
// determine printer type and state
|
|
FImgIndex := 0;
|
|
if Printer.PrinterType = ptNetWork then
|
|
begin
|
|
if Printer.PrinterState = psStopped then
|
|
FImgIndex := 2
|
|
else
|
|
FImgIndex := 1;
|
|
end
|
|
else
|
|
if Printer.PrinterState = psStopped then
|
|
FImgIndex := 3;
|
|
cbPrinters.Items.AddObject(Printer.PrinterName, TObject(IntPtr(FImgIndex)));
|
|
end;
|
|
finally
|
|
Printer.PrinterIndex := FSavedIndex;
|
|
end;
|
|
if cbPrinters.Items.Count > 0 then
|
|
cbPrinters.ItemIndex := Printer.PrinterIndex;
|
|
end;
|
|
|
|
//Initialization of screen
|
|
procedure TdlgSelectPrinter.dlgSelectPrinterSHOW(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
NbOpts.PageIndex:=0;
|
|
InitPrinterList;
|
|
RefreshInfos;
|
|
{$IFDEF UNIX}
|
|
btnCancel.Left := btnPreview.Left;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.edCopiesChange(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
cbCollate.Enabled := edCopies.Value > 1;
|
|
cbReverse.Enabled := cbCollate.Enabled;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.edRangeEnter(Sender: TObject);
|
|
begin
|
|
rbRange.Checked := True;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.FormClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
if ModalResult = mrCancel then
|
|
Printer.PrinterIndex := FSavedPrinterIndex;
|
|
end;
|
|
|
|
procedure TdlgSelectPrinter.FormDestroy(Sender: TObject);
|
|
begin
|
|
fPrinterImgs.Free;
|
|
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 ;
|
|
FBig := False;
|
|
fPropertiesSetting:=False;
|
|
NbOpts.AutoSize := True;
|
|
NbOpts.PageIndex:=0;
|
|
edPageSet.Items[0]:=p4lrsAllPages;
|
|
edPageSet.Items[1]:=p4lrsPageOdd;
|
|
edPageSet.Items[2]:=p4lrsPageEven;
|
|
fPrinterImgs := TImageList.Create(Self);
|
|
FSavedPrinterIndex := Printer.PrinterIndex;
|
|
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
|
|
if FBig = AValue then
|
|
Exit;
|
|
FBig:= AValue;
|
|
NbOpts.Visible:= FBig;
|
|
|
|
AutoSize := False;
|
|
AutoSize := True;
|
|
|
|
if not FBig then
|
|
btnReduc.Caption:=p4lrsButtonMoreArrow
|
|
else
|
|
btnReduc.Caption:=p4lrsButtonLessArrow;
|
|
|
|
Application.ProcessMessages;
|
|
NbOpts.AutoSize := False;
|
|
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;
|
|
|
|
procedure TdlgSelectPrinter.cbPrintersDrawItem(Control: TWinControl;
|
|
Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
|
var
|
|
ts: TTextStyle;
|
|
begin
|
|
// setup dropdown colors
|
|
if cbPrinters.DroppedDown and not (odSelected in State) then
|
|
begin
|
|
cbPrinters.Canvas.Brush.Color := clMenu;
|
|
cbPrinters.Canvas.Font.Color := clMenuText;
|
|
cbPrinters.Canvas.FillRect(ARect);
|
|
end;
|
|
// draw image
|
|
fPrinterImgs.Draw(cbPrinters.Canvas, ARect.Left + 4,
|
|
(ARect.Top + ARect.Bottom - fPrinterImgs.Height) div 2,
|
|
IntPtr(cbPrinters.Items.Objects[Index]));
|
|
// draw text
|
|
ts.Layout := tlCenter;
|
|
ts.Alignment := taLeftJustify;
|
|
ts.Opaque := False;
|
|
ts.Clipping := True;
|
|
ts.Wordbreak := False;
|
|
ARect.Left := ARect.Left + (fPrinterImgs.Width + 8);
|
|
cbPrinters.Canvas.TextRect(ARect, ARect.Left, 0, cbPrinters.Items[Index], ts);
|
|
end;
|
|
|
|
end.
|