Printers4Lazarus: improved Carbon implementation, fixed current printer updating

git-svn-id: trunk@13170 -

components/printers/carbon/carbonprinters.inc

@@ -121,6 +121,15 @@ begin
   OSError(PMSessionGetCurrentPrinter(PrintSession, Result), Self, 'GetCurrentPrinter', 'PMSessionGetCurrentPrinter');
 end;
 
+function TCarbonPrinter.GetCurrentPrinterName: String;
+var
+  P: PMPrinter;
+begin
+  Result := '';
+  P := GetCurrentPrinter;
+  if P <> nil then Result := CFStringToStr(PMPrinterGetName(P));
+end;
+
 procedure TCarbonPrinter.BeginPage;
 begin
   if FBeginDocumentStatus = noErr then
@@ -151,6 +160,27 @@ begin
   end;
 end;
 
+procedure TCarbonPrinter.FindDefaultPrinter;
+var
+  P: PMPrinter;
+  I, C: CFIndex;
+begin
+  if OSError(PMServerCreatePrinterList(kPMServerLocal, FPrinterArray),
+    Self, 'DoEnumPrinters', 'PMServerCreatePrinterList') then Exit;
+
+  C := CFArrayGetCount(FPrinterArray);
+  for I := 0 to C - 1 do
+  begin
+    P := CFArrayGetValueAtIndex(FPrinterArray, I);
+
+    if PMPrinterIsDefault(P) then
+    begin
+      FDefaultPrinter := CFStringToStr(PMPrinterGetName(P));
+      Break;
+    end;
+  end;
+end;
+
 procedure TCarbonPrinter.BeginEnumPrinters(Lst: TStrings);
 var
   P: PMPrinter;
@@ -166,10 +196,11 @@ begin
     P := CFArrayGetValueAtIndex(FPrinterArray, I);
     PrinterName := CFStringToStr(PMPrinterGetName(P));
 
-    if PMPrinterIsDefault(P) then
+    //DebugLn(DbgS(I) + ' ' + PrinterName);
-      Lst.Insert(0, PrinterName)
+    if PrinterName = FDefaultPrinter then
+      Lst.InsertObject(0, PrinterName, TObject(I))
     else
-      Lst.Add(PrinterName);
+      Lst.AddObject(PrinterName, TObject(I));
   end;
 end;
 
@@ -215,6 +246,11 @@ begin
   CreatePrintSettings;
   FPageFormat := CreatePageFormat('');
   FPrinterContext := TCarbonPrinterContext.Create;
+  
+  FindDefaultPrinter;
+  UpdatePrinter;
+  //DebugLn('Current ' + GetCurrentPrinterName);
+  //DebugLn('Default ' + FDefaultPrinter);
 end;
 
 destructor TCarbonPrinter.Destroy;
@@ -255,6 +291,26 @@ begin
     DoSetPaperName(DoGetDefaultPaperName);
 end;
 
+procedure TCarbonPrinter.UpdatePrinter;
+var
+  S: TStringList;
+  P: String;
+begin
+  ValidatePrintSettings;
+  
+  P := GetCurrentPrinterName;
+  
+  S := TStringList.Create;
+  try
+    DoEnumPrinters(S);
+    //DebugLn('UpdatePrinter ' + P + ' ' + DbgS(S.IndexOf(P)));
+    PrinterIndex := S.IndexOf(P);
+  finally
+    S.Free;
+  end;
+  Validate;
+end;
+
 function TCarbonPrinter.GetXDPI: Integer;
 begin
   Result := 72;
@@ -270,6 +326,7 @@ begin
   inherited DoBeginDoc;
   
   //DebugLn('TCarbonPrinter.DoBeginDoc ' + DbgS(Printing));
+  Validate;
 
   FBeginDocumentStatus := PMSessionBeginCGDocument(PrintSession, PrintSettings, PageFormat);
   OSError(FBeginDocumentStatus, Self, 'DoBeginDoc', 'PMSessionBeginCGDocument', '', kPMCancel);
@@ -362,6 +419,8 @@ begin
   
   FPageFormat := CreatePageFormat(AName);
   DoSetOrientation(O);
+  
+  ValidatePageFormat;
 end;
 
 function TCarbonPrinter.DoGetPaperRect(AName: string; var APaperRc: TPaperRect): Integer;
@@ -421,15 +480,13 @@ begin
     Result := S.IndexOf(AName);
     if Result >= 0 then
     begin
+      //DebugLn('DoSetPrinter ' + DbgS(Result));
       //DebugLn('TCarbonPrinter.DoSetPrinter ' + AName + ' ' + DbgS(PrintSession) + ' ' + DbgS(Printers.Objects[Result]));
-      P := PMPrinter(CFArrayGetValueAtIndex(FPrinterArray, Result));
+      P := PMPrinter(CFArrayGetValueAtIndex(FPrinterArray, Integer(S.Objects[Result])));
       PMRetain(PMObject(P));
       if OSError(PMSessionSetCurrentPMPrinter(PrintSession, P),
         Self, 'DoSetPrinter', 'PMSessionSetCurrentPMPrinter') then
           raise EPrinter.CreateFmt('The system is unable to select printer "%s"!', [AName]);
-
-      ValidatePageFormat;
-      ValidatePrintSettings;
     end;
   finally
     EndEnumPrinters;

components/printers/carbon/carbonprinters_h.inc

@@ -25,10 +25,12 @@ type
     FPrinterContext: TCarbonPrinterContext;
     FPrinterArray: CFArrayRef;
     FPaperArray: CFArrayRef;
+    FDefaultPrinter: String;
     
     procedure CreatePrintSession;
     procedure CreatePrintSettings;
     function GetCurrentPrinter: PMPrinter;
+    function GetCurrentPrinterName: String;
     
     function CreatePageFormat(APaper: String): PMPageFormat;
     
@@ -38,6 +40,7 @@ type
     procedure BeginPage;
     procedure EndPage;
     
+    procedure FindDefaultPrinter;
     procedure BeginEnumPrinters(Lst: TStrings);
     procedure EndEnumPrinters;
     procedure BeginEnumPapers(Lst: TStrings);
@@ -73,11 +76,13 @@ type
     procedure RawModeChanging; override;
   public
     procedure Validate;
+    procedure UpdatePrinter;
   public
     constructor Create; override;
     destructor Destroy; override;
     function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; override;
     // Warning not portable functions here
+    property CurrentPrinterName: String read GetCurrentPrinterName;
     property PrintSession: PMPrintSession read FPrintSession;
     property PrintSettings: PMPrintSettings read FPrintSettings;
     property PageFormat: PMPageFormat read FPageFormat;

components/printers/carbon/carbonprndialogs.inc

@@ -22,7 +22,7 @@ begin
       CarbonPrinter.PageFormat, Result),
     Self, SExecute, 'PMSessionPageSetupDialog') then Exit;
 
-  CarbonPrinter.Validate;
+  if Result then CarbonPrinter.Validate;
 end;
 
 
@@ -53,6 +53,8 @@ begin
   if Printer.Printers.Count <= 0 then Exit;
   
   CarbonPrinter := Printer as TCarbonPrinter;
+  //DebugLn('TPrintDialog.Execute ' + CarbonPrinter.CurrentPrinterName);
+  
   if OSError(PMCreatePrintSettings(DialogSettings),
     Self, SExecute, 'PMCreatePrintSettings') then Exit;
   try
@@ -65,10 +67,10 @@ begin
       Self, SExecute, 'PMSetPageRange');
     OSError(PMSetFirstPage(DialogSettings, FromPage, False), Self, SExecute, 'PMSetFirstPage');
     OSError(PMSetLastPage(DialogSettings, ToPage, False), Self, SExecute, 'PMSetLastPage');
-  
+
     if OSError(PMSessionPrintDialog(CarbonPrinter.PrintSession, CarbonPrinter.PrintSettings, CarbonPrinter.PageFormat, Result),
       Self, SExecute, 'PMSessionPrintDialog') then Exit;
-      
+
     if Result then
     begin
       PrintRange := prSelection;
@@ -89,6 +91,8 @@ begin
     
       if OSError(PMCopyPrintSettings(DialogSettings, CarbonPrinter.PrintSettings),
         Self, SExecute, 'PMCopyPrintSettings') then Exit;
+        
+      CarbonPrinter.UpdatePrinter;
     end;
   finally
     PMRelease(PMObject(DialogSettings));

components/printers/printer4lazarus.lpk

@@ -16,8 +16,7 @@
       </CodeGeneration>
       <Other>
         <CustomOptions Value="-dUseCache
-
+-dNativePrint"/>
-"/>
         <CompilerPath Value="$(CompPath)"/>
         <CreateMakefileOnBuild Value="True"/>
       </Other>
@@ -150,11 +149,11 @@
     <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="2">
       <Item1>
-        <PackageName Value="FCL"/>
+        <PackageName Value="LCL"/>
-        <MinVersion Major="1" Valid="True"/>
       </Item1>
       <Item2>
-        <PackageName Value="LCL"/>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
       </Item2>
     </RequiredPkgs>
     <UsageOptions>

components/printers/printersdlgs.pp

@@ -83,7 +83,7 @@ uses Controls, udlgSelectPrinter, udlgPropertiesPrinter, FileUtil;
 
     {$ELSE}
     
-uses Controls, CarbonProc, FPCMacOSAll;
+uses Controls, CarbonProc, FPCMacOSAll, LCLProc;
 {$I carbonprndialogs.inc}
 
     {$ENDIF}

lcl/interfaces/carbon/carbonproc.pp

@@ -92,6 +92,7 @@ function RoundFixed(const F: Fixed): Integer;
 function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
 function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
 function ParamsToCarbonRect(const AParams: TCreateParams): FPCMacOSAll.Rect;
+function ParamsToRect(const AParams: TCreateParams): TRect;
 
 type
   CGRectArray = Array of CGRect;
@@ -681,6 +682,19 @@ begin
   Result.Bottom := AParams.Y + AParams.Height;
 end;
 
+{------------------------------------------------------------------------------
+  Name:    ParamsToRect
+  Params:  AParams - Creation parameters
+  Returns: TRect from creation parameters
+ ------------------------------------------------------------------------------}
+function ParamsToRect(const AParams: TCreateParams): TRect;
+begin
+  Result.Left := AParams.X;
+  Result.Top := AParams.Y;
+  Result.Right := AParams.X + AParams.Width;
+  Result.Bottom := AParams.Y + AParams.Height;
+end;
+
 {------------------------------------------------------------------------------
   Name:    ExcludeRect
   Params:  A - Source rectangle