paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 00:49:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Printers, don't setup printer list while printer object is being destroyed, fix issue #26489

Browse Source 
git-svn-id: trunk@46235 -
This commit is contained in:
jesus 2014-09-14 17:41:24 +00:00
parent cac409bb01
commit 679d20a26e
9 changed files with 98 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/printers/carbon/carbonprinters.inc
View File

@ -282,7 +282,7 @@ begin
//DebugLn('Default ' + FDefaultPrinter);
end;
destructor TCarbonPrinter.Destroy;
procedure TCarbonPrinter.DoDestroy;
begin
FPrinterContext.Free;
@ -290,7 +290,7 @@ begin
if FPageFormat <> nil then PMRelease(PMObject(FPageFormat));
if FPrintSession <> nil then PMRelease(PMObject(FPrintSession));
inherited Destroy;
inherited DoDestroy;
end;
function TCarbonPrinter.Write(const Buffer; Count: Integer;

2
components/printers/carbon/carbonprinters_h.inc
View File

@ -77,12 +77,12 @@ type
function GetCanPrint: Boolean;override;
function GetCanRenderCopies : Boolean;override;
procedure RawModeChanging; override;
procedure DoDestroy; override;
public
procedure Validate;
procedure UpdatePrinter;
public
constructor Create; override;
destructor Destroy; override;
function Write(const {%H-}Buffer; {%H-}Count:Integer; var {%H-}Written: Integer): Boolean; override;
// Warning not portable functions here
property CurrentPrinterName: String read GetCurrentPrinterName;

4
components/printers/qt/qtprinters.inc
View File

@ -147,11 +147,11 @@ begin
CreatePrintSettings;
end;
destructor TQtPrinters.Destroy;
procedure TQtPrinters.DoDestroy;
begin
FPagesEnum.Free;
QtDefaultPrinter.endDoc;
inherited Destroy;
inherited DoDestroy;
end;
function TQtPrinters.Write(const Buffer; Count: Integer;

2
components/printers/qt/qtprinters_h.inc
View File

@ -51,12 +51,12 @@ type
function GetCanPrint: Boolean;override;
function GetCanRenderCopies : Boolean;override;
procedure RawModeChanging; override;
procedure DoDestroy; override;
public
procedure Validate;
function GetPaperSize(Const Str: String): QPrinterPageSize;
public
constructor Create; override;
destructor Destroy; override;
function Write(const {%H-}Buffer; {%H-}Count:Integer; var {%H-}Written: Integer): Boolean; override;
property ColorMode: QPrinterColorMode read GetColorMode write SetColorMode;

4
components/printers/unix/cupsprinters.inc
View File

@ -122,7 +122,7 @@ begin
FCupsPapersCount := -1;
end;
destructor TCUPSPrinter.Destroy;
procedure TCUPSPrinter.DoDestroy;
begin
if assigned(fRawModeStream) then
fRawModeStream.Free;
@ -132,7 +132,7 @@ begin
if Assigned(fcupsHttp) then
httpClose(fcupsHttp);
inherited destroy;
inherited DoDestroy;
end;
procedure TCUPSPrinter.FreeOptions;

2
components/printers/unix/cupsprinters_h.inc
View File

@ -158,9 +158,9 @@ type
function GetResolutionOption: string;
function IsOptionValueValid(AKeyword,AValue: pchar): boolean;
function PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string; IsKey:boolean): pppd_choice_t;
procedure DoDestroy; override;
public
constructor Create; override;
destructor Destroy; override;
function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; override;
{-------------------------------------------------

10
components/printers/win32/winprinters.inc
View File

@ -47,10 +47,8 @@ begin
fPrinterHandle := 0; //None
end;
destructor TWinPrinter.Destroy;
procedure TWinPrinter.DoDestroy;
begin
fDestroying := true;
ClearDC;
DoResetPrintersList;
@ -58,7 +56,7 @@ begin
if fPrinterHandle <> 0 then
ClosePrinter(fPrinterHandle);
inherited Destroy;
inherited DoDestroy;
end;
function TWinPrinter.Write(const Buffer; Count: Integer;
@ -97,7 +95,7 @@ end;
procedure TWinPrinter.PrinterSelected;
begin
if not fDestroying and (PrinterIndex >= 0) and not RawMode then
if ([pfDestroying, pfRawMode]*PrinterFlags=[]) and (PrinterIndex>=0) then
SetDC;
end;
@ -888,7 +886,7 @@ begin
if FPrinterHandle <> 0 then
ClosePrinter(FPrinterHandle);
if fDestroying then
if pfDestroying in PrinterFlags then
result := i
else begin
PDev := TPrinterDevice(Printers.Objects[i]);

3
components/printers/win32/winprinters_h.inc
View File

@ -36,7 +36,6 @@ Type
fLastHandleType : THandleType;
fDC : HDC;
fPrinterHandle : THandle;
fDestroying : boolean;
procedure SetIC;
procedure SetDC;
procedure ClearDC;
@ -82,9 +81,9 @@ Type
procedure SetHandlePrinter(aValue : HDC);
procedure RawModeChanging; override;
procedure PrinterSelected; override;
procedure DoDestroy; override;
public
constructor Create; override;
destructor Destroy; override;
function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; override;

133
lcl/printers.pas
View File

@ -174,6 +174,15 @@ type
property PaperRectOf[aName : string] : TPaperRect read PaperRectOfName;
end;
TPrinterFlags = set of
(
pfPrinting, //Printing
pfAborted, //Abort process
pfDestroying, //Printer object is being destroyed
pfPrintersValid, //fPrinters list is valid
pfRawMode //Printer is in raw mode
);
{ TPrinter }
TPrinter = class(TObject)
@ -183,17 +192,15 @@ type
fFonts : TStrings; //Accepted font by printer
fPageNumber : Integer; //Current page number
fPrinters : TStrings; //Printers names list
fPrintersValid: Boolean;
fPrinterIndex: Integer; //selected printer index
fTitle : string; //Title of current document
fPrinting : Boolean; //Printing
fAborted : Boolean; //Abort process
//fCapabilities: TPrinterCapabilities;
fPaperSize : TPaperSize;
fRawMode : Boolean;
fCanvasClass : TPrinterCanvasRef;
fBins : TStrings;
fFlags : TPrinterFlags;
function GetAborted: Boolean;
function GetCanvas: TCanvas;
procedure CheckPrinting(Value: Boolean);
function GetCanvasClass: TPrinterCanvasRef;
@ -208,6 +215,8 @@ type
function GetPrinterIndex: integer;
function GetPrinterName: string;
function GetPrinters: TStrings;
function GetPrinting: Boolean;
function GetRawMode: boolean;
procedure SetCanvasClass(const AValue: TPrinterCanvasRef);
procedure SetCopies(AValue: Integer);
procedure SetOrientation(const AValue: TPrinterOrientation);
@ -242,6 +251,8 @@ type
procedure DoSetBinName(aName: string); virtual;
function DoGetPaperRect(aName : string; Var aPaperRc : TPaperRect) : Integer; virtual;
function DoGetPrinterState: TPrinterState; virtual;
procedure DoDestroy; virtual;
function GetPrinterType : TPrinterType; virtual;
function GetCanPrint : Boolean; virtual;
function GetCanRenderCopies : Boolean; virtual;
@ -252,6 +263,8 @@ type
procedure RawModeChanging; virtual;
procedure PrinterSelected; virtual;
function DoGetDefaultCanvasClass: TPrinterCanvasRef; virtual;
property PrinterFlags: TPrinterFlags read fFlags write fFlags;
public
constructor Create; virtual;
destructor Destroy; override;
@ -279,15 +292,15 @@ type
property PageHeight: Integer read GetPageHeight;
property PageWidth: Integer read GetPageWidth;
property PageNumber : Integer read fPageNumber;
property Aborted: Boolean read fAborted;
property Printing: Boolean read FPrinting;
property Aborted: Boolean read GetAborted;
property Printing: Boolean read GetPrinting;
property Title: string read fTitle write fTitle;
property PrinterType : TPrinterType read GetPrinterType;
property CanPrint : Boolean read GetCanPrint;
property CanRenderCopies : Boolean read GetCanRenderCopies;
property XDPI : Integer read GetXDPI;
property YDPI : Integer read GetYDPI;
property RawMode: boolean read FRawMode write SetRawMode;
property RawMode: boolean read GetRawMode write SetRawMode;
property DefaultBinName: string read GetDefaultBinName;
property BinName: string read GetBinName write SetBinName;
property SupportedBins: TStrings read GetBins;
@ -317,31 +330,8 @@ end;
destructor TPrinter.Destroy;
begin
if Printing then
Abort;
fBins.free;
if Assigned(fCanvas) then
fCanvas.Free;
if Assigned(fPaperSize) then
fPaperSize.Free;
if Assigned(fPrinters) then
begin
DoResetPrintersList;
FreeAndNil(fPrinters);
end;
if Assigned(fFonts) then
begin
DoResetFontsList;
FreeAndNil(fFonts);
end;
Include(fFlags, pfDestroying);
DoDestroy;
inherited Destroy;
end;
@ -353,7 +343,7 @@ begin
DoAbort;
fAborted:=True;
Include(fFlags, pfAborted);
EndDoc;
end;
@ -365,12 +355,12 @@ begin
//If not selected printer, set default printer
SelectCurrentPrinterOrDefault;
fPrinting := True;
fAborted := False;
Include(fFlags, pfPrinting);
Exclude(fFlags, pfAborted);
fPageNumber := 1;
if not FRawMode then begin
if not RawMode then begin
Canvas.Refresh;
TPrinterCanvas(Canvas).BeginDoc;
end;
@ -378,7 +368,7 @@ begin
DoBeginDoc;
// Set font resolution
if not FRawMode then
if not RawMode then
Canvas.Font.PixelsPerInch := YDPI;
end;
@ -388,13 +378,13 @@ begin
//Check if Printer print otherwise, exception
CheckPrinting(True);
if not FRawMode then
if not RawMode then
TPrinterCanvas(Canvas).EndDoc;
DoEndDoc(fAborted);
DoEndDoc(pfAborted in fFlags);
fPrinting := False;
fAborted := False;
Exclude(fFlags, pfPrinting);
Exclude(fFlags, pfAborted);
fPageNumber := 0;
end;
@ -511,6 +501,11 @@ begin
Result:=fCanvas;
end;
function TPrinter.GetAborted: Boolean;
begin
Result := (pfAborted in fFlags);
end;
//Raise error if Printer.Printing is not Value
procedure TPrinter.CheckPrinting(Value: Boolean);
begin
@ -525,7 +520,7 @@ end;
function TPrinter.GetCanvasClass: TPrinterCanvasRef;
begin
if FRawMode then
if RawMode then
result := nil
else
if FCanvasClass=nil then
@ -536,7 +531,7 @@ end;
procedure TPrinter.CheckRawMode(const Value: boolean; Msg: string);
begin
if FRawMode<>Value then
if RawMode<>Value then
begin
if msg='' then
if Value then
@ -648,8 +643,8 @@ begin
Result:=fPrinters;
//Only 1 initialization
if not fPrintersValid then begin
fPrintersValid:=true;
if [pfPrintersValid, pfDestroying]*fFlags = [] then begin
Include(fFlags, pfPrintersValid);
DoEnumPrinters(fPrinters);
if FPrinters.Count>0 then
SelectCurrentPrinterOrDefault;
@ -657,6 +652,16 @@ begin
end;
end;
function TPrinter.GetPrinting: Boolean;
begin
result := (pfPrinting in fFlags);
end;
function TPrinter.GetRawMode: boolean;
begin
result := (pfRawMode in fFlags);
end;
procedure TPrinter.SetCanvasClass(const AValue: TPrinterCanvasRef);
begin
FCanvasClass := AValue;
@ -725,10 +730,13 @@ end;
procedure TPrinter.SetRawMode(const AValue: boolean);
begin
if AValue<>FRawMode then begin
if AValue<>RawMode then begin
CheckPrinting(False);
RawModeChanging;
FRawMode := AValue;
if AValue then
Include(fFlags, pfRawMode)
else
Exclude(fFlags, pfRawMode);
end;
end;
@ -768,7 +776,7 @@ end;
procedure TPrinter.DoResetPrintersList;
begin
//Override this method
fPrintersValid:=false;
Exclude(fFlags, pfPrintersValid);
end;
procedure TPrinter.DoResetFontsList;
@ -899,6 +907,33 @@ begin
Result:=psNoDefine;
end;
procedure TPrinter.DoDestroy;
begin
if Printing then
Abort;
fBins.free;
if Assigned(fCanvas) then
fCanvas.Free;
if Assigned(fPaperSize) then
fPaperSize.Free;
if Assigned(fPrinters) then
begin
DoResetPrintersList;
FreeAndNil(fPrinters);
end;
if Assigned(fFonts) then
begin
DoResetFontsList;
FreeAndNil(fFonts);
end;
end;
//Return the type of selected printer
function TPrinter.GetPrinterType: TPrinterType;
begin