View Issue Details

IDProjectCategoryView StatusLast Update
0026489LazarusIDEpublic2014-09-16 15:01
ReporterGabor BorosAssigned ToJesus Reyes 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindowsOS VersionXP SP3
Product Version1.3 (SVN)Product Build45874 
Target Version1.4Fixed in Version1.3 (SVN) 
Summary0026489: Out of memory
DescriptionOut of memory error when exit from the IDE
Steps To ReproduceCompile trunk with 2.6.4, "make clean all bigide".
Start Project1, close, close Lazarus. Then see a memory usage peak in Task Manager always and sometimes got out of memory message too.
If not start Project1 just start and close Lazarus the problem not appear.
TagsNo tags attached.
Fixed in Revision46235
LazTarget1.4
WidgetsetWin32/Win64
Attached Files
  • error.PNG (15,441 bytes)
    error.PNG (15,441 bytes)
  • bug_26489_trunk_46168.JPG (36,130 bytes)
    bug_26489_trunk_46168.JPG (36,130 bytes)
  • printers.zip (303,884 bytes)
  • printers_destroy.diff (14,288 bytes)
    Index: components/printers/carbon/carbonprinters.inc
    ===================================================================
    --- components/printers/carbon/carbonprinters.inc	(revision 46199)
    +++ components/printers/carbon/carbonprinters.inc	(working copy)
    @@ -282,17 +282,6 @@
       //DebugLn('Default ' + FDefaultPrinter);
     end;
     
    -destructor TCarbonPrinter.Destroy;
    -begin
    -  FPrinterContext.Free;
    -  
    -  if FPrintSettings <> nil then PMRelease(PMObject(FPrintSettings));
    -  if FPageFormat <> nil then PMRelease(PMObject(FPageFormat));
    -  if FPrintSession <> nil then PMRelease(PMObject(FPrintSession));
    -  
    -  inherited Destroy;
    -end;
    -
     function TCarbonPrinter.Write(const Buffer; Count: Integer;
       var Written: Integer): Boolean;
     begin
    @@ -307,6 +296,17 @@
       //
     end;
     
    +procedure TCarbonPrinter.DoDestroy;
    +begin
    +  FPrinterContext.Free;
    +
    +  if FPrintSettings <> nil then PMRelease(PMObject(FPrintSettings));
    +  if FPageFormat <> nil then PMRelease(PMObject(FPageFormat));
    +  if FPrintSession <> nil then PMRelease(PMObject(FPrintSession));
    +
    +  inherited DoDestroy;
    +end;
    +
     procedure TCarbonPrinter.Validate;
     var
       P: String;
    Index: components/printers/carbon/carbonprinters_h.inc
    ===================================================================
    --- components/printers/carbon/carbonprinters_h.inc	(revision 46199)
    +++ components/printers/carbon/carbonprinters_h.inc	(working copy)
    @@ -77,12 +77,12 @@
         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;
    Index: components/printers/qt/qtprinters.inc
    ===================================================================
    --- components/printers/qt/qtprinters.inc	(revision 46199)
    +++ components/printers/qt/qtprinters.inc	(working copy)
    @@ -147,11 +147,11 @@
       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;
    Index: components/printers/qt/qtprinters_h.inc
    ===================================================================
    --- components/printers/qt/qtprinters_h.inc	(revision 46199)
    +++ components/printers/qt/qtprinters_h.inc	(working copy)
    @@ -51,12 +51,12 @@
         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;
    Index: components/printers/unix/cupsprinters.inc
    ===================================================================
    --- components/printers/unix/cupsprinters.inc	(revision 46199)
    +++ components/printers/unix/cupsprinters.inc	(working copy)
    @@ -122,7 +122,7 @@
       FCupsPapersCount := -1;
     end;
     
    -destructor TCUPSPrinter.Destroy;
    +procedure TCUPSPrinter.DoDestroy;
     begin
       if assigned(fRawModeStream) then
         fRawModeStream.Free;
    @@ -132,7 +132,7 @@
       if Assigned(fcupsHttp) then
         httpClose(fcupsHttp);
     
    -  inherited destroy;
    +  inherited DoDestroy;
     end;
     
     procedure TCUPSPrinter.FreeOptions;
    Index: components/printers/unix/cupsprinters_h.inc
    ===================================================================
    --- components/printers/unix/cupsprinters_h.inc	(revision 46199)
    +++ components/printers/unix/cupsprinters_h.inc	(working copy)
    @@ -158,9 +158,9 @@
          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;
         
         {-------------------------------------------------
    Index: components/printers/win32/winprinters.inc
    ===================================================================
    --- components/printers/win32/winprinters.inc	(revision 46199)
    +++ components/printers/win32/winprinters.inc	(working copy)
    @@ -47,20 +47,6 @@
       fPrinterHandle := 0; //None
     end;
     
    -destructor TWinPrinter.Destroy;
    -begin
    -  fDestroying := true;
    -
    -  ClearDC;
    -
    -  DoResetPrintersList;
    -
    -  if fPrinterHandle <> 0 then
    -    ClosePrinter(fPrinterHandle);
    -
    -  inherited Destroy;
    -end;
    -
     function TWinPrinter.Write(const Buffer; Count: Integer;
       var Written: Integer): Boolean;
     begin
    @@ -97,10 +83,22 @@
     
     procedure TWinPrinter.PrinterSelected;
     begin
    -  if not fDestroying and (PrinterIndex >= 0) and not RawMode then
    +  if ([pfDestroying, pfRawMode]*PrinterFlags=[]) and (PrinterIndex>=0) then
         SetDC;
     end;
     
    +procedure TWinPrinter.DoDestroy;
    +begin
    +  ClearDC;
    +
    +  DoResetPrintersList;
    +
    +  if fPrinterHandle <> 0 then
    +    ClosePrinter(fPrinterHandle);
    +
    +  inherited DoDestroy;
    +end;
    +
     function TWinPrinter.GetXDPI: Integer;
     begin
       Result:=72;
    @@ -888,7 +886,7 @@
         if FPrinterHandle <> 0 then
           ClosePrinter(FPrinterHandle);
     
    -    if fDestroying then
    +    if pfDestroying in PrinterFlags then
            result := i
         else begin
           PDev := TPrinterDevice(Printers.Objects[i]);
    Index: components/printers/win32/winprinters_h.inc
    ===================================================================
    --- components/printers/win32/winprinters_h.inc	(revision 46199)
    +++ components/printers/win32/winprinters_h.inc	(working copy)
    @@ -36,7 +36,6 @@
         fLastHandleType : THandleType;
         fDC             : HDC;
         fPrinterHandle  : THandle;
    -    fDestroying     : boolean;
         procedure SetIC;
         procedure SetDC;
         procedure ClearDC;
    @@ -82,9 +81,9 @@
         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;
     
    Index: lcl/printers.pas
    ===================================================================
    --- lcl/printers.pas	(revision 46199)
    +++ lcl/printers.pas	(working copy)
    @@ -174,6 +174,15 @@
         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 @@
         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 @@
         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 @@
          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 @@
          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 @@
          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 @@
     
     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 @@
     
       DoAbort;
       
    -  fAborted:=True;
    +  Include(fFlags, pfAborted);
       EndDoc;
     end;
     
    @@ -365,12 +355,12 @@
       
       //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 @@
       DoBeginDoc;
       
       // Set font resolution
    -  if not FRawMode then
    +  if not RawMode then
         Canvas.Font.PixelsPerInch := YDPI;
     end;
     
    @@ -388,13 +378,13 @@
       //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 @@
       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 @@
     
     function TPrinter.GetCanvasClass: TPrinterCanvasRef;
     begin
    -  if FRawMode then
    +  if RawMode then
         result := nil
       else
       if FCanvasClass=nil then
    @@ -536,7 +531,7 @@
     
     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 @@
       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 @@
       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 @@
     
     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 @@
     procedure TPrinter.DoResetPrintersList;
     begin
      //Override this method
    - fPrintersValid:=false;
    +  Exclude(fFlags, pfPrintersValid);
     end;
     
     procedure TPrinter.DoResetFontsList;
    @@ -899,6 +907,33 @@
       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
    
    printers_destroy.diff (14,288 bytes)

Relationships

related to 0023026 closedJesus Reyes Program crashes if printer units are added to project under windows 64bit 

Activities

Gabor Boros

2014-07-15 12:47

reporter  

error.PNG (15,441 bytes)
error.PNG (15,441 bytes)

Jesus Reyes

2014-08-29 06:02

developer   ~0076768

I was not able to reproduce this problem.

There is something strange, though. I was not able to find a revision where line 288 of winprinters.inc corresponds to GetDefaultPrinter r45874 means your printer files should be up to date, but in the last revision of winprinters.inc line 288 corresponds to UpdateDevMode.

Maybe you have mixed sources?. If you can reproduce the problem in a stand alone project please attach it here.

Gabor Boros

2014-09-10 13:49

reporter  

bug_26489_trunk_46168.JPG (36,130 bytes)
bug_26489_trunk_46168.JPG (36,130 bytes)

Gabor Boros

2014-09-10 13:57

reporter   ~0077041

I can reproduce with trunk 46168. After copied the sources to an empty directory then make clean all bigide. See the attached image. Cannot attach a sample project because the bug appears with the project which created at IDE start.

Jesus Reyes

2014-09-10 19:49

developer   ~0077065

please package the lazarus/components/printers directory and attach it here.

Gabor Boros

2014-09-10 20:38

reporter  

printers.zip (303,884 bytes)

Gabor Boros

2014-09-10 20:40

reporter   ~0077069

Printers directory uploaded. Hope that help.

Jesus Reyes

2014-09-13 09:11

developer  

printers_destroy.diff (14,288 bytes)
Index: components/printers/carbon/carbonprinters.inc
===================================================================
--- components/printers/carbon/carbonprinters.inc	(revision 46199)
+++ components/printers/carbon/carbonprinters.inc	(working copy)
@@ -282,17 +282,6 @@
   //DebugLn('Default ' + FDefaultPrinter);
 end;
 
-destructor TCarbonPrinter.Destroy;
-begin
-  FPrinterContext.Free;
-  
-  if FPrintSettings <> nil then PMRelease(PMObject(FPrintSettings));
-  if FPageFormat <> nil then PMRelease(PMObject(FPageFormat));
-  if FPrintSession <> nil then PMRelease(PMObject(FPrintSession));
-  
-  inherited Destroy;
-end;
-
 function TCarbonPrinter.Write(const Buffer; Count: Integer;
   var Written: Integer): Boolean;
 begin
@@ -307,6 +296,17 @@
   //
 end;
 
+procedure TCarbonPrinter.DoDestroy;
+begin
+  FPrinterContext.Free;
+
+  if FPrintSettings <> nil then PMRelease(PMObject(FPrintSettings));
+  if FPageFormat <> nil then PMRelease(PMObject(FPageFormat));
+  if FPrintSession <> nil then PMRelease(PMObject(FPrintSession));
+
+  inherited DoDestroy;
+end;
+
 procedure TCarbonPrinter.Validate;
 var
   P: String;
Index: components/printers/carbon/carbonprinters_h.inc
===================================================================
--- components/printers/carbon/carbonprinters_h.inc	(revision 46199)
+++ components/printers/carbon/carbonprinters_h.inc	(working copy)
@@ -77,12 +77,12 @@
     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;
Index: components/printers/qt/qtprinters.inc
===================================================================
--- components/printers/qt/qtprinters.inc	(revision 46199)
+++ components/printers/qt/qtprinters.inc	(working copy)
@@ -147,11 +147,11 @@
   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;
Index: components/printers/qt/qtprinters_h.inc
===================================================================
--- components/printers/qt/qtprinters_h.inc	(revision 46199)
+++ components/printers/qt/qtprinters_h.inc	(working copy)
@@ -51,12 +51,12 @@
     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;
Index: components/printers/unix/cupsprinters.inc
===================================================================
--- components/printers/unix/cupsprinters.inc	(revision 46199)
+++ components/printers/unix/cupsprinters.inc	(working copy)
@@ -122,7 +122,7 @@
   FCupsPapersCount := -1;
 end;
 
-destructor TCUPSPrinter.Destroy;
+procedure TCUPSPrinter.DoDestroy;
 begin
   if assigned(fRawModeStream) then
     fRawModeStream.Free;
@@ -132,7 +132,7 @@
   if Assigned(fcupsHttp) then
     httpClose(fcupsHttp);
 
-  inherited destroy;
+  inherited DoDestroy;
 end;
 
 procedure TCUPSPrinter.FreeOptions;
Index: components/printers/unix/cupsprinters_h.inc
===================================================================
--- components/printers/unix/cupsprinters_h.inc	(revision 46199)
+++ components/printers/unix/cupsprinters_h.inc	(working copy)
@@ -158,9 +158,9 @@
      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;
     
     {-------------------------------------------------
Index: components/printers/win32/winprinters.inc
===================================================================
--- components/printers/win32/winprinters.inc	(revision 46199)
+++ components/printers/win32/winprinters.inc	(working copy)
@@ -47,20 +47,6 @@
   fPrinterHandle := 0; //None
 end;
 
-destructor TWinPrinter.Destroy;
-begin
-  fDestroying := true;
-
-  ClearDC;
-
-  DoResetPrintersList;
-
-  if fPrinterHandle <> 0 then
-    ClosePrinter(fPrinterHandle);
-
-  inherited Destroy;
-end;
-
 function TWinPrinter.Write(const Buffer; Count: Integer;
   var Written: Integer): Boolean;
 begin
@@ -97,10 +83,22 @@
 
 procedure TWinPrinter.PrinterSelected;
 begin
-  if not fDestroying and (PrinterIndex >= 0) and not RawMode then
+  if ([pfDestroying, pfRawMode]*PrinterFlags=[]) and (PrinterIndex>=0) then
     SetDC;
 end;
 
+procedure TWinPrinter.DoDestroy;
+begin
+  ClearDC;
+
+  DoResetPrintersList;
+
+  if fPrinterHandle <> 0 then
+    ClosePrinter(fPrinterHandle);
+
+  inherited DoDestroy;
+end;
+
 function TWinPrinter.GetXDPI: Integer;
 begin
   Result:=72;
@@ -888,7 +886,7 @@
     if FPrinterHandle <> 0 then
       ClosePrinter(FPrinterHandle);
 
-    if fDestroying then
+    if pfDestroying in PrinterFlags then
        result := i
     else begin
       PDev := TPrinterDevice(Printers.Objects[i]);
Index: components/printers/win32/winprinters_h.inc
===================================================================
--- components/printers/win32/winprinters_h.inc	(revision 46199)
+++ components/printers/win32/winprinters_h.inc	(working copy)
@@ -36,7 +36,6 @@
     fLastHandleType : THandleType;
     fDC             : HDC;
     fPrinterHandle  : THandle;
-    fDestroying     : boolean;
     procedure SetIC;
     procedure SetDC;
     procedure ClearDC;
@@ -82,9 +81,9 @@
     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;
 
Index: lcl/printers.pas
===================================================================
--- lcl/printers.pas	(revision 46199)
+++ lcl/printers.pas	(working copy)
@@ -174,6 +174,15 @@
     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 @@
     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 @@
     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 @@
      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 @@
      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 @@
      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 @@
 
 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 @@
 
   DoAbort;
   
-  fAborted:=True;
+  Include(fFlags, pfAborted);
   EndDoc;
 end;
 
@@ -365,12 +355,12 @@
   
   //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 @@
   DoBeginDoc;
   
   // Set font resolution
-  if not FRawMode then
+  if not RawMode then
     Canvas.Font.PixelsPerInch := YDPI;
 end;
 
@@ -388,13 +378,13 @@
   //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 @@
   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 @@
 
 function TPrinter.GetCanvasClass: TPrinterCanvasRef;
 begin
-  if FRawMode then
+  if RawMode then
     result := nil
   else
   if FCanvasClass=nil then
@@ -536,7 +531,7 @@
 
 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 @@
   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 @@
   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 @@
 
 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 @@
 procedure TPrinter.DoResetPrintersList;
 begin
  //Override this method
- fPrintersValid:=false;
+  Exclude(fFlags, pfPrintersValid);
 end;
 
 procedure TPrinter.DoResetFontsList;
@@ -899,6 +907,33 @@
   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
printers_destroy.diff (14,288 bytes)

Jesus Reyes

2014-09-13 09:16

developer   ~0077171

Well, that is weird. The line numbers partially match.

But anyway, it seems to show that it's trying to setup the printer list while the printer object is being destroyed, based on that, I made a patch (printers_destroy.diff) can you please apply it to your working copy and test it. Does it solve the problem?

(if you don't use svn, don't forget to make copies for yourself of lcl/printers.pas and directory components/printers).

Gabor Boros

2014-09-13 11:48

reporter   ~0077180

Last edited: 2014-09-13 14:58

View 2 revisions

Yes, problem was gone after applied the patch. Thank You!

Jesus Reyes

2014-09-14 19:43

developer   ~0077236

I applied a slightly modified patch

Gabor Boros

2014-09-16 15:01

reporter   ~0077303

Tested with trunk 46243.

Issue History

Date Modified Username Field Change
2014-07-15 12:47 Gabor Boros New Issue
2014-07-15 12:47 Gabor Boros File Added: error.PNG
2014-07-15 17:52 Jesus Reyes Assigned To => Jesus Reyes
2014-07-15 17:52 Jesus Reyes Status new => assigned
2014-07-15 17:58 Jesus Reyes Relationship added related to 0023026
2014-08-29 06:02 Jesus Reyes LazTarget => -
2014-08-29 06:02 Jesus Reyes Note Added: 0076768
2014-08-29 06:02 Jesus Reyes Status assigned => feedback
2014-09-10 13:49 Gabor Boros File Added: bug_26489_trunk_46168.JPG
2014-09-10 13:57 Gabor Boros Note Added: 0077041
2014-09-10 13:57 Gabor Boros Status feedback => assigned
2014-09-10 19:49 Jesus Reyes Note Added: 0077065
2014-09-10 20:38 Gabor Boros File Added: printers.zip
2014-09-10 20:40 Gabor Boros Note Added: 0077069
2014-09-13 09:11 Jesus Reyes File Added: printers_destroy.diff
2014-09-13 09:16 Jesus Reyes Note Added: 0077171
2014-09-13 09:16 Jesus Reyes Status assigned => feedback
2014-09-13 11:48 Gabor Boros Note Added: 0077180
2014-09-13 11:48 Gabor Boros Status feedback => assigned
2014-09-13 14:58 Gabor Boros Note Edited: 0077180 View Revisions
2014-09-14 19:43 Jesus Reyes Fixed in Revision => 46235
2014-09-14 19:43 Jesus Reyes LazTarget - => 1.4
2014-09-14 19:43 Jesus Reyes Note Added: 0077236
2014-09-14 19:43 Jesus Reyes Status assigned => resolved
2014-09-14 19:43 Jesus Reyes Fixed in Version => 1.3 (SVN)
2014-09-14 19:43 Jesus Reyes Resolution open => fixed
2014-09-14 19:43 Jesus Reyes Target Version => 1.4
2014-09-16 15:01 Gabor Boros Note Added: 0077303
2014-09-16 15:01 Gabor Boros Status resolved => closed