printers, fixed AV when printing under windows

git-svn-id: trunk@13448 -

components/printers/samples/dialogs/frmselprinter.lfm

@@ -1,7 +1,7 @@
 object Form1: TForm1
-  Left = 190
+  Left = 288
   Height = 507
-  Top = 30
+  Top = 142
   Width = 339
   HorzScrollBar.Page = 338
   VertScrollBar.Page = 506
@@ -13,9 +13,9 @@ object Form1: TForm1
   Position = poDesktopCenter
   object Label1: TLabel
     Left = 16
-    Height = 13
+    Height = 14
     Top = 8
-    Width = 269
+    Width = 230
     Caption = 'This sample show how to use the printer dialogs'
     ParentColor = False
   end

components/printers/samples/dialogs/frmselprinter.lrs

@@ -1,12 +1,12 @@
 { This is an automatically generated lazarus resource file }
 
 LazarusResources.Add('TForm1','FORMDATA',[
-  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#190#0#6'Height'#3#251#1#3'Top'#2#30#5'Wid'
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3' '#1#6'Height'#3#251#1#3'Top'#3#142#0#5'W'
-  +'th'#3'S'#1#18'HorzScrollBar.Page'#3'R'#1#18'VertScrollBar.Page'#3#250#1#13
+  +'idth'#3'S'#1#18'HorzScrollBar.Page'#3'R'#1#18'VertScrollBar.Page'#3#250#1#13
   +'ActiveControl'#7#7'Button2'#7'Caption'#6#5'Form1'#12'ClientHeight'#3#251#1
   +#11'ClientWidth'#3'S'#1#8'OnCreate'#7#10'FormCreate'#8'Position'#7#15'poDesk'
-  +'topCenter'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#13#3'Top'#2#8#5'W'
+  +'topCenter'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'Top'#2#8#5'W'
-  +'idth'#3#13#1#7'Caption'#6'/This sample show how to use the printer dialogs'
+  +'idth'#3#230#0#7'Caption'#6'/This sample show how to use the printer dialogs'
   +#11'ParentColor'#8#0#0#7'TButton'#7'Button2'#4'Left'#2#8#6'Height'#2#27#3'To'
   +'p'#2'3'#5'Width'#3'@'#1#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#27'E'
   +'xecute TPrinterSetupDialog'#7'OnClick'#7#12'Button2Click'#8'TabOrder'#2#0#0

components/printers/samples/dialogs/selectprinter.lpi

@@ -1,20 +1,22 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
+    <PathDelim Value="\"/>
-    <Version Value="5"/>
+    <Version Value="6"/>
     <General>
       <Flags>
         <SaveClosedFiles Value="False"/>
+        <SaveOnlyProjectUnits Value="True"/>
       </Flags>
-      <SessionStorage Value="None"/>
+      <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
+      <IconPath Value=".\"/>
       <TargetFileExt Value=".exe"/>
       <Title Value="selectprinter"/>
     </General>
     <PublishOptions>
       <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
       <IgnoreBinaries Value="False"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
       <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@@ -22,7 +24,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="2">
@@ -34,7 +36,7 @@
         <MinVersion Build="1" Valid="True"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="4">
+    <Units Count="2">
       <Unit0>
         <Filename Value="selectprinter.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -47,20 +49,13 @@
         <ResourceFilename Value="frmselprinter.lrs"/>
         <UnitName Value="frmselprinter"/>
       </Unit1>
-      <Unit2>
-        <Filename Value="../../../../../../../lazarus/components/PRINTERS/WIN32/winprndialogs.inc"/>
-        <IsPartOfProject Value="True"/>
-      </Unit2>
-      <Unit3>
-        <Filename Value="../../../../../../../lazarus/components/PRINTERS/LINUX/cupsprndialogs.inc"/>
-        <IsPartOfProject Value="True"/>
-      </Unit3>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="5"/>
+    <PathDelim Value="\"/>
     <SearchPaths>
-      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>

components/printers/win32/winprinters.inc

@@ -187,13 +187,13 @@ end;
 
 
 // Based on MS Article Q167345
-procedure TWinPrinter.UpdateDevMode;
+procedure TWinPrinter.UpdateDevMode(APrinterIndex:Integer);
 var
   PDev: TPrinterDevice;
   dwRet: Integer;
 begin
   // now we have a right FPrinterHandle, get current printer settings
-  PDev := TPrinterDevice(Printers.Objects[PrinterIndex]);
+  PDev := TPrinterDevice(Printers.Objects[APrinterIndex]);
 
   // allocate a new Devmode
   if (Pdev.DevMode=nil) then begin
@@ -256,7 +256,7 @@ begin
     Inf.cbSize:=SizeOf(Inf);
     Inf.lpszDocName:=PChar(Title);
 
-    StartDoc(fDC,Inf);
+    StartDoc(fDC,@Inf);
     StartPage(fDC);
     
   end;
@@ -595,9 +595,7 @@ begin
     if not OpenPrinter(PChar(PDev.Name),fPrinterHandle, nil) then
       raise EPrinter.CreateFmt('OpenPrinter exception : %s',
                                    [SysErrorMessage(GetlastError)]);
-
+    UpdateDevMode(i);
-    UpdateDevMode;
-
     Result:=i;
   end;
 end;

components/printers/win32/winprinters_h.inc

@@ -44,7 +44,7 @@ Type
     procedure SetDC;
     procedure ClearDC;
     procedure FreeDC;
-    procedure UpdateDevMode;
+    procedure UpdateDevMode(APrinterIndex:Integer);
 
   protected
     //function GetDefaultPrinter : String;

components/printers/win32/winutilprn.pas

@@ -183,6 +183,7 @@ type
      ImageableArea: TRect;
   end;
 
+  PDocInfo = ^TDocInfo;
   TDocInfo = packed record
     cbSize      : Integer;
     lpszDocName : PChar;
@@ -323,7 +324,7 @@ function CommDlgExtendedError: DWORD; stdcall; external 'comdlg32.dll'  name 'Co
 function CreateIC(lpszDriver, lpszDevice, lpszOutput: PChar; lpdvmInit: PDeviceMode): HDC; stdcall; external 'gdi32.dll' name 'CreateICA';
 function CreateDC(lpszDriver, lpszDevice, lpszOutput: PChar; lpdvmInit: PDeviceMode): HDC; stdcall; external 'gdi32.dll' name 'CreateDCA';
 function DeleteDC(DC: HDC): BOOL; stdcall; external 'gdi32.dll' name 'DeleteDC';
-function StartDoc(DC: HDC; Inf : TDocInfo): Integer; stdcall; external 'gdi32.dll' name 'StartDocA';
+function StartDoc(DC: HDC; Inf : PDocInfo): Integer; stdcall; external 'gdi32.dll' name 'StartDocA';
 function EndDoc(DC: HDC): Integer; stdcall;  external 'gdi32.dll' name 'EndDoc';
 function StartPage(DC: HDC): Integer; stdcall; external 'gdi32.dll' name 'StartPage';
 function EndPage(DC: HDC): Integer; stdcall; external 'gdi32.dll' name 'EndPage';