mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 01:19:37 +02:00
printers, fixed AV when printing under windows
git-svn-id: trunk@13448 -
This commit is contained in:
parent
3aff619e70
commit
bdd543cc78
@ -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
|
||||
|
@ -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
|
||||
|
@ -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>
|
||||
|
@ -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;
|
||||
|
@ -44,7 +44,7 @@ Type
|
||||
procedure SetDC;
|
||||
procedure ClearDC;
|
||||
procedure FreeDC;
|
||||
procedure UpdateDevMode;
|
||||
procedure UpdateDevMode(APrinterIndex:Integer);
|
||||
|
||||
protected
|
||||
//function GetDefaultPrinter : String;
|
||||
|
@ -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';
|
||||
|
Loading…
Reference in New Issue
Block a user