printers, fixed AV when printing under windows

git-svn-id: trunk@13448 -
This commit is contained in:
jesus 2007-12-23 20:00:33 +00:00
parent 3aff619e70
commit bdd543cc78
6 changed files with 25 additions and 31 deletions

View File

@ -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

View File

@ -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'
+'th'#3'S'#1#18'HorzScrollBar.Page'#3'R'#1#18'VertScrollBar.Page'#3#250#1#13
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3' '#1#6'Height'#3#251#1#3'Top'#3#142#0#5'W'
+'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'
+'idth'#3#13#1#7'Caption'#6'/This sample show how to use the printer dialogs'
+'topCenter'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'Top'#2#8#5'W'
+'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

View File

@ -1,20 +1,22 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<PathDelim Value="\"/>
<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>

View File

@ -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;
UpdateDevMode(i);
Result:=i;
end;
end;

View File

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

View File

@ -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';