paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 10:39:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implemented printer RawMode Access

Browse Source 
git-svn-id: trunk@9929 -
This commit is contained in:
jesus 2006-09-18 19:48:02 +00:00
parent 1e3c848d1a
commit 6128f10523
9 changed files with 341 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/printers/printersdlgs.pp
View File

@ -74,10 +74,12 @@ procedure Register;
implementation
{$IFDEF UNIX}
uses Controls, udlgSelectPrinter,udlgpropertiesprinter, FileUtil, StrUtils;
{$I ./unix/cupsprndialogs.inc}
{$ENDIF}
{$IFDEF MSWindows}
uses Windows, WinUtilPrn, InterfaceBase, Win32Int, LCLIntf,LCLType,WinVer;
{$I win32/winprndialogs.inc}
{$ENDIF}

52
components/printers/unix/cupsprinters.inc
View File

@ -16,6 +16,18 @@ begin
Result:=72;
end;
//write count bytes from buffer to raw mode stream
function TCUPSPrinter.Write(const Buffer; Count: Integer; var Written: Integer
): Boolean;
begin
result := False;
CheckRawMode(True);
if not Assigned(FRawModeStream) then
FRawModeStream := TMemoryStream.Create;
Written := FRawModeStream.Write(Buffer, Count);
Result := True;
end;
constructor TCUPSPrinter.Create;
begin
inherited Create;
@ -26,10 +38,15 @@ begin
fcupsPPD :=nil;
fcupsOptions :=nil;
fcupsNumOpts :=0;
FRawModeStream:=nil;
end;
destructor TCUPSPrinter.destroy;
begin
if assigned(fRawModeStream) then
fRawModeStream.Free;
FreeOptions;
if Assigned(fcupsHttp) then
@ -402,7 +419,7 @@ var
end;
var
NewOutputFileName: String;
Extension: String;
begin
if FBeginDocCount>0 then
raise Exception.Create('TCUPSPrinter.DoBeginDoc already called. Maybe you forgot an EndDoc?');
@ -414,10 +431,16 @@ begin
and (not TryTemporaryPath('/var/tmp/')) then
NewPath:='';
NewOutputFileName:=AppendPathDelim(NewPath)
+'OutPrinter_'+FormatDateTime('yyyymmmddd-hhnnss',Now)+'.ps';
TPostscriptPrinterCanvas(Canvas).OutputFileName:=NewOutputFileName;
if RawMode then
Extension:='.raw'
else
Extension:='.ps';
fRawModeFileName:=AppendPathDelim(NewPath)
+'OutPrinter_'+FormatDateTime('yyyymmmddd-hhnnss',Now)+Extension;
if not RawMode then
TPostscriptPrinterCanvas(Canvas).OutputFileName:=fRawModeFileName;
end;
//If not aborted, send PostScript file to printer.
@ -429,12 +452,21 @@ begin
Exclude(FStates,cpsPaperRectValid);
//exit;
if not aAborded then
PrintFile(TPostscriptPrinterCanvas(Canvas).OutPutFileName);
if RawMode then begin
DeleteFile(TPostscriptPrinterCanvas(Canvas).OutPutFileName);
TPostscriptPrinterCanvas(Canvas).OutPutFileName:='';
if not aAborded and assigned(fRawModeStream) then begin
fRawModeStream.SaveToFile(FRawModeFileName);
PrintFile(FRawModeFileName);
DeleteFile(FRawModeFileName);
end;
end else begin
if not aAborded then
PrintFile(TPostscriptPrinterCanvas(Canvas).OutPutFileName);
DeleteFile(TPostscriptPrinterCanvas(Canvas).OutPutFileName);
TPostscriptPrinterCanvas(Canvas).OutPutFileName:='';
end;
end;
procedure TCUPSPrinter.DoResetPrintersList;

3
components/printers/unix/cupsprinters_h.inc
View File

@ -87,6 +87,8 @@ type
fCachePaperRect: TPaperRect;
fCachePaperRectResult: Integer;
FBeginDocCount: Integer;
fRawModefileName: string;
fRawModeStream: TMemoryStream;
function GetCupsRequest : Pipp_t;
procedure DoCupsConnect;
@ -119,6 +121,7 @@ type
function GetXDPI: Integer; override;
function GetYDPI: Integer; override;
function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; override;
{-------------------------------------------------
SPECIFIC CUPS METHODS OR PROPERTIES

60
components/printers/unix/cupsprndialogs.inc
View File

@ -1,5 +1,3 @@
uses Controls, udlgSelectPrinter,udlgpropertiesprinter, FileUtil;
{ TPrinterSetupDialog }
@ -16,11 +14,45 @@ begin
end;
end;
function GetNumber(FromLeft: boolean; s:ansistring; aDefault: Integer): Integer;
var
i: Integer;
res: string;
begin
if FromLeft then
i := 1
else
i := Length(s);
Res := '';
while (i>0)and(i<=Length(s)) do
begin
if s[i] in ['0'..'9'] then begin
if Fromleft then
Res:=Res+S[i]
else
Res:=S[i]+Res;
end else begin
if Res<>'' then
break;
end;
if FromLeft then
Inc(i)
else
Dec(i);
end;
Result := StrToIntDef(Res, aDefault);
end;
{ TPrintDialog }
function TPrintDialog.Execute: Boolean;
Var Dlg : TdlgSelectPrinter;
Var
Dlg : TdlgSelectPrinter;
s : String;
i : Integer;
begin
Dlg:=TdlgSelectPrinter.Create(nil);
Dlg.Options := Self.Options;
@ -38,6 +70,28 @@ begin
try
Dlg.btnPreview.Visible:=False;
Result:=(Dlg.ShowModal=mrOk);
if Result then begin
// TDlgSelectPrinter will setup directoy cups printer options
// yet, TPrintDialog should return information about user choice
// modifying fields accordingly.
// Page range. This migth get really complex because it's free enty
// textbox. To fill FromPage and ToPage we will use some
// simple rules.
i := pos('-', Dlg.edRange.Text);
if i<>0 then begin
FromPage := GetNumber(False, copy(Dlg.edRange.Text, 1, i-1), FromPage);
ToPage := GetNumber(True, copy(Dlg.edRange.Text, i+1, 255), ToPage);
if ToPage<FromPage then begin
i := ToPage;
ToPage := FromPage;
FromPage := i;
end;
end else begin
Self.FromPage := GetNumber(True, copy(Dlg.edRange.Text, i+1, 255), Self.FromPage);
Self.ToPage := Self.FromPage;
end;
end;
finally
Dlg.Free;
end;

197
components/printers/win32/winprinters.inc
View File

@ -26,13 +26,14 @@ constructor TWinPrinter.Create;
begin
inherited Create;
fLastHandleType:=0; //None
fLastHandleType:=htNone;
fPrinterHandle :=0; //None
end;
destructor TWinPrinter.Destroy;
begin
ClearDC;
DoResetPrintersList;
if fPrinterHandle<>0 then
@ -41,6 +42,13 @@ begin
inherited Destroy;
end;
function TWinPrinter.Write(const Buffer; Count: Integer;
var Written: Integer): Boolean;
begin
CheckRawMode(True);
result := WritePrinter(FPrinterHandle, @Buffer, Count, @Written);
end;
function TWinPrinter.GetHandlePrinter : HDC;
begin
SetIC;
@ -50,19 +58,27 @@ end;
procedure TWinPrinter.SetHandlePrinter(aValue : HDC);
begin
CheckRawMode(False);
if aValue <> fDC then
begin
ClearDC;
fDC := aValue;
if Assigned(Canvas) then Canvas.Handle:=fDC;
fLastHandleType:=2;
fLastHandleType:=htDC;
end;
end;
procedure TWinPrinter.RawModeChanging;
begin
// if old mode was standard free DC if it was created
if not RawMode and (fDC<>0) then
FreeDC;
end;
function TWinPrinter.GetXDPI: Integer;
begin
Result:=72;
if (Printers.Count>0) then
if (Printers.Count>0) and not RawMode then
begin
SetDC;
Result:=GetDeviceCaps(fDC, LOGPIXELSX);
@ -72,7 +88,7 @@ end;
function TWinPrinter.GetYDPI: Integer;
begin
Result:=72;
if (Printers.Count>0) then
if (Printers.Count>0) and not RawMode then
begin
SetDC;
Result:=GetDeviceCaps(fDC,LOGPIXELSY);
@ -82,7 +98,7 @@ end;
procedure TWinPrinter.SetIC;
var PDev : TPrinterDevice;
begin
if (fLastHandleType=0) and (Printers.Count>0) then
if (fLastHandleType=htNone) and (Printers.Count>0) then
begin
PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]);
@ -94,17 +110,22 @@ begin
PChar(PDev.Port),PDev.DevMode);
if fDC=0 then
raise EPrinter.Create(Format('Invalid printer (DC=%d Driver=%s Device=%s Port=%s)',[fDC,Pdev.Driver,PDev.Device,PDev.Port]));
raise EPrinter.Create(
Format('Invalid printer (DC=%d Driver=%s Device=%s Port=%s)',
[fDC,Pdev.Driver,PDev.Device,PDev.Port]));
if Assigned(Canvas) then
Canvas.Handle:=fDC;
fLastHandleType:=1;
fLastHandleType:=htIC;
end;
end;
procedure TWinPrinter.SetDC;
var PDev : TPrinterDevice;
begin
if (fLastHandleType<>2) and (Printers.Count>0) then
if (fLastHandleType<>htDC) and (Printers.Count>0) then
begin
ClearDC;
PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]);
@ -114,7 +135,8 @@ begin
//if the Printername or share is longer than 32 chars, this will return 0
fDC:=CreateDC(nil,PChar(Printers[PrinterIndex]),nil, PDev.DevMode);
if fDC=0 then
fDC:=CreateDC(PChar('WINSPOOL'),PChar(Printers[PrinterIndex]),nil,PDev.DevMode);
fDC:=CreateDC(PChar('WINSPOOL'),PChar(Printers[PrinterIndex]),nil,
PDev.DevMode);
{Workaround (hack) for Lexmark 1020 JetPrinter (Mono)}
if fDC=0 then
@ -123,28 +145,44 @@ begin
fDC:=CreateDC(pChar('WINSPOOL'),PChar(PDev.Driver),nil,PDev.DevMode);
except on E:Exception do
raise EPrinter.Create(Format('CreateDC exception: %s (LastError : %s,DC=%d Driver="%s" Device="%s" Port="%s")',[E.Message,SysErrorMessage(GetLastError),fDC,Pdev.Driver,Printers[PrinterIndex],PDev.Port]));
raise EPrinter.Create(Format('CreateDC Exception:"%s" (Error:"%s", '+
'DC=%d Driver="%s" Device="%s" Port="%s")', [E.Message,
SysErrorMessage(GetLastError),fDC, Pdev.Driver,
Printers[PrinterIndex],PDev.Port]));
end;
if fDC=0 then
raise EPrinter.Create(Format('Invalid printer (Error : %s,DC=%d Driver="%s" Device="%s" Port="%s")',[SysErrorMessage(GetLastError),fDC,Pdev.Driver,Printers[PrinterIndex],PDev.Port]));
raise EPrinter.Create(Format('Invalid printer (Error:%s, '+
'DC=%d Driver="%s" Device="%s" Port="%s")',
[SysErrorMessage(GetLastError),fDC,Pdev.Driver,Printers[PrinterIndex],
PDev.Port]));
if Assigned(Canvas) then
Canvas.Handle:=fDC;
fLastHandleType:=2;
fLastHandleType:=htDC;
end;
end;
procedure TWinPrinter.ClearDC;
begin
if not RawMode then
FreeDC
end;
procedure TWinPrinter.FreeDC;
begin
if Assigned(Canvas) then
Canvas.Handle:=0;
if fDC<>0 then
begin
DeleteDC(fDC);
fDc := 0;
end;
fLastHandleType:=0;
fLastHandleType:=htNone;
end;
@ -183,47 +221,89 @@ begin
end;
procedure TWinPrinter.DoBeginDoc;
var Inf: TDocInfo;
var
Inf: TDocInfo;
Doc1: DOC_INFO_1;
begin
inherited DoBeginDoc;
if fPrinterHandle=0 then
raise EPrinter.Create('Printer handle not defined');
SetDC;
Canvas.Handle:=fDC;
Canvas.Refresh;
if RawMode then begin
FillChar(Inf,SizeOf(Inf),0);
Inf.cbSize:=SizeOf(Inf);
Inf.lpszDocName:=PChar(Title);
Doc1.DocName := pchar(Title);
Doc1.OutputFile := nil;
Doc1.DataType := 'RAW';
if StartDocPrinter(FPrinterHandle, 1, @Doc1)=0 then begin
ClosePrinter(FPrinterHandle);
FPrinterHandle:=0;
end else
if StartPagePrinter(FPrinterHandle)=0 then begin
EndDocPrinter(FPrinterHandle);
ClosePrinter(FPrinterHandle);
FPrinterHandle:=0;
end;
end else begin
StartDoc(fDC,Inf);
StartPage(fDC);
SetDC;
Canvas.Handle:=fDC;
Canvas.Refresh;
FillChar(Inf,SizeOf(Inf),0);
Inf.cbSize:=SizeOf(Inf);
Inf.lpszDocName:=PChar(Title);
StartDoc(fDC,Inf);
StartPage(fDC);
end;
end;
procedure TWinPrinter.DoNewPage;
begin
inherited DoNewPage;
if RawMode then begin
EndPage(fDC);
StartPage(fDC);
Canvas.Refresh;
EndPagePrinter(FPrinterHandle);
StartPagePrinter(FPrinterHandle);
end else begin
EndPage(fDC);
StartPage(fDC);
Canvas.Refresh;
end;
end;
procedure TWinPrinter.DoEndDoc(aAborded: Boolean);
begin
inherited DoEndDoc(aAborded);
EndPage(fDC);
if not aAborded then
WinUtilPrn.EndDoc(fDC);
if RawMode then begin
EndPagePrinter(FPrinterHandle);
EndDocPrinter(FPrinterHandle);
{
ClosePrinter(FPrinterHandle);
FPrinterHandle:=0;
}
end else begin
EndPage(fDC);
if not aAborded then
WinUtilPrn.EndDoc(fDC);
end;
end;
procedure TWinPrinter.DoAbort;
begin
inherited DoAbort;
AbortDoc(fDC);
if RawMode then
AbortPrinter(FPrinterHandle)
else
AbortDoc(fDC);
end;
//Enum all defined printers. First printer it's default
@ -260,7 +340,8 @@ begin
end
else
begin
GetProfileString(PChar('windows'),PChar('device'),PChar(''),DefaultPrinter,SizeOf(DefaultPrinter));
GetProfileString(PChar('windows'),PChar('device'),PChar(''),
DefaultPrinter,SizeOf(DefaultPrinter));
if pos(',',DefaultPrinter)<>0 then
DefaultPrinter:=Copy(DefaultPrinter,1,Pos(',',DefaultPrinter)-1);
end;
@ -298,8 +379,8 @@ begin
// have not extra settings at all.
//
// PDev.DevMode:=PPRINTER_INFO_2(InfoPrt)^.PDevMode^;
PDev.Device:= TmpDevMode^.dmDeviceName; //PDev.DevMode.dmDeviceName;
PDev.DefaultPaper:=TmpDevMode^.dmPaperSize; //PDev.DevMode.dmPaperSize;
PDev.Device:= TmpDevMode^.dmDeviceName;
PDev.DefaultPaper:=TmpDevMode^.dmPaperSize;
end
else begin
PDev.Device:='';
@ -363,7 +444,9 @@ begin
PaperC:=0;
Count := DeviceCapabilities(PChar(Pdev.Name),PCHar(PDev.Port),
DC_PAPERNAMES,nil,nil);
if Count<=0 then raise EPrinter.CreateFmt('DoEnumPapers<DC_PAPERNAMES> error : %d, (%s)',[GetLastError,SysErrorMessage(GetLastError)]);
if Count<=0 then
raise EPrinter.CreateFmt('DoEnumPapers<DC_PAPERNAMES> error : %d, (%s)',
[GetLastError,SysErrorMessage(GetLastError)]);
GetMem(Buffer,64*Count);
try
PaperC:=DeviceCapabilities(PChar(Pdev.Name),PCHar(PDev.Port),
@ -381,9 +464,12 @@ begin
FillChar(ArPapers,SizeOf(ArPapers),0);
PaperC:=DeviceCapabilities(PChar(Pdev.Name),PCHar(PDev.Port),
DC_PAPERS,@ArPapers,nil);
if PaperC<=0 then raise EPrinter.CreateFmt('DoEnumPapers<DC_PAPERS> error : %d, (%s)',[GetLastError,SysErrorMessage(GetLastError)]);
for i:=0 to PaperC-1 do
Lst.Objects[i]:=TObject(ptrint(ArPapers[i]));
if PaperC<=0 then
raise EPrinter.CreateFmt('DoEnumPapers<DC_PAPERS> error : %d, (%s)',
[GetLastError,SysErrorMessage(GetLastError)]);
for i:=0 to PaperC-1 do
Lst.Objects[i]:=TObject(ptrint(ArPapers[i]));
end;
end;
@ -410,10 +496,11 @@ begin
if (Printers.Count>0) then
begin
PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]);
i:=PaperSize.SupportedPapers.IndexOfObject(TObject(ptrint(PDev.DefaultPaper)));
if i<>-1 then
Result:=PaperSize.SupportedPapers.Strings[i];
with PaperSize.SupportedPapers do begin
i:=IndexOfObject(TObject(ptrint(PDev.DefaultPaper)));
if i<>-1 then
Result:= Strings[i];
end;
end;
end;
@ -431,14 +518,15 @@ begin
end;
end;
function TWinPrinter.DoGetPaperRect(aName: string; var aPaperRc: TPaperRect): Integer;
function TWinPrinter.DoGetPaperRect(aName: string;
var aPaperRc: TPaperRect): Integer;
var NSize, i : Integer;
PDev : TPrinterDevice;
ArSizes : Array[0..255] of TPoint;
begin
Result:=Inherited DoGetPaperRect(aName,aPaperRc);
if (Printers.Count>0) then
if (Printers.Count>0) and not RawMode then
begin
// Information for physical sizes can be obtained for any paper supported
// by the printer, the same is not true for printable paper size, this can
@ -497,14 +585,18 @@ begin
if i<>-1 then
begin
ClearDC;
if FPrinterHandle<>0 then
ClosePrinter(FPrinterHandle);
PDev:=TPrinterDevice(Printers.Objects[i]);
if fPrinterHandle<>0 then
ClosePrinter(fPrinterHandle);
if not OpenPrinter(PChar(PDev.Name),fPrinterHandle, nil) then
raise EPrinter.CreateFmt('OpenPrinter exception : %s',[SysErrorMessage(GetlastError)])
else
UpdateDevMode;
Result:=i;
raise EPrinter.CreateFmt('OpenPrinter exception : %s',
[SysErrorMessage(GetlastError)]);
UpdateDevMode;
Result:=i;
end;
end;
@ -569,7 +661,8 @@ begin
try
if not GetPrinter(fPRinterHandle,4,InfoPrt,Size,Size)
then
raise EPrinter.CreateFmt('GetPrinterType failed : %s',[SysErrorMessage(GetLastError)]);
raise EPrinter.CreateFmt('GetPrinterType failed : %s',
[SysErrorMessage(GetLastError)]);
if PPRINTER_INFO_4(InfoPrt)^.Attributes = PRINTER_ATTRIBUTE_NETWORK then
Result := ptNetwork;
finally
@ -591,7 +684,8 @@ begin
try
if not GetPrinter(fPrinterHandle,2,InfoPrt,Size,Size)
then
raise EPrinter.CreateFmt('GetPrinterState failed : %s',[SysErrorMessage(GetLastError)]);
raise EPrinter.CreateFmt('GetPrinterState failed : %s',
[SysErrorMessage(GetLastError)]);
Jobs := PPRINTER_INFO_2(InfoPrt)^.cJobs;
Status := PPRINTER_INFO_2(InfoPrt)^.Status;
@ -637,7 +731,8 @@ begin
if (Printers.Count>0) then
begin
PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]);
Count := DeviceCapabilities(PChar(Pdev.Name),PCHar(PDev.Port),DC_COPIES,nil,PDev.DevMode);
Count := DeviceCapabilities(PChar(Pdev.Name),PCHar(PDev.Port),
DC_COPIES,nil,PDev.DevMode);
Result := (Count>1);
end;
end;

6
components/printers/win32/winprinters_h.inc
View File

@ -29,19 +29,21 @@ uses
Classes, SysUtils,Printers,LCLType,{Forms,}Windows;//,dialogs;
Type
THandleType = (htNone, htIC, htDC);
{ TWinPrinter }
TWinPrinter = class(TPrinter)
private
//fDefaultPrinter : String;
fLastHandleType : Byte; //0=None 1=IC 2=DC
fLastHandleType : THandleType;
fDC : HDC;
fPrinterHandle : THandle;
procedure SetIC;
procedure SetDC;
procedure ClearDC;
procedure FreeDC;
procedure UpdateDevMode;
protected
@ -75,10 +77,12 @@ Type
function GetCanRenderCopies : Boolean;override;
function GetHandlePrinter : HDC;
procedure SetHandlePrinter(aValue : HDC);
procedure RawModeChanging; override;
public
constructor Create; override;
destructor Destroy; override;
function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; override;
//Warning not portable functions here
procedure AdvancedProperties;

21
components/printers/win32/winprndialogs.inc
View File

@ -1,6 +1,4 @@
{%MainUnit ../printersdlgs.pp}
Uses
Windows,WinUtilPrn, InterfaceBase, Win32Int, LCLIntf,LCLType,WinVer;
{ TPageSetupDialog }
@ -173,7 +171,10 @@ begin
begin
lStructSize:=SizeOf(lpp);
hInstance:=LCLType.HInstance;
Flags := PD_RETURNDC;
if Printer.RawMode then
Flags := 0
else
Flags := PD_RETURNDC;
if Collate then Flags := Flags or PD_COLLATE;
case PrintRange of
prPageNums : Flags := Flags or PD_PAGENUMS;
@ -225,12 +226,13 @@ begin
Result:=True;
if lpp.hDevMode<>0 then
// printer might have changed, check if new printer
// support extended device modes
PDev:=TPrinterDevice(Printer.Printers.Objects[Printer.PrinterIndex]);
if (lpp.hDevMode<>0) and (Pdev.DevMode<>nil) then
begin
DevMode:=PDeviceMode(GlobalLock(lpp.hDevMode));
try
//Set the properties for the selected printer
PDev:=TPrinterDevice(Printer.Printers.Objects[Printer.PrinterIndex]);
CopyMemory(PDev.DevMode,DevMode,PDev.DevModeSize);
if Printer.PaperSize.SupportedPapers.IndexOfObject(TObject(ptrint(DevMode^.dmPaperSize))) <> -1
@ -243,10 +245,13 @@ begin
else
Copies := nCopies;
Printer.Copies := Copies;
TWinPrinter(Printer).Handle := hDC;
if not Printer.RawMode then
TWinPrinter(Printer).Handle := hDC;
finally
GlobalUnlock(lpp.hDevMode);
end;
end;
end;
PrintRange := prAllPages;

14
components/printers/win32/winutilprn.pas
View File

@ -190,6 +190,13 @@ type
lpszDatatype: PChar;
fwType : DWORD;
end;
PDOC_INFO_1 = ^DOC_INFO_1;
DOC_INFO_1 = packed record
DocName : PChar;
OutputFile : PChar;
DataType : PChar;
end;
PPRINTER_INFO_1 = ^_PRINTER_INFO_1;
_PRINTER_INFO_1 = packed Record
@ -323,6 +330,13 @@ function EndPage(DC: HDC): Integer; stdcall; external 'gdi32.dll' name 'EndPage'
function AbortDoc(DC: HDC): Integer; stdcall; external 'gdi32.dll' name 'AbortDoc';
function GlobalFree(HMem: HGlobal): HGlobal; stdcall; external 'kernel32.dll' name 'GlobalFree';
function StartDocPrinter(hPrinter:THANDLE; Level:DWORD; DocInfo:PByte):DWORD; stdcall; external LibWinSpool name 'StartDocPrinterA';
function StartPagePrinter(hPrinter:THANDLE):DWORD; stdcall; external LibWinSpool name 'StartPagePrinter';
function EndDocPrinter(hprinter:THANDLE):BOOL; stdcall; external LibWinSpool name 'EndDocPrinter';
function EndPagePrinter(hprinter:THANDLE):BOOL; stdcall; external LibWinSpool name 'EndPagePrinter';
function AbortPrinter(hPrinter:THANDLE):BOOL; stdcall; external LibWinSpool name 'AbortPrinter';
function WritePrinter(hPrinter:THANDLE; Buffer:Pointer; Count:DWord; Written:PDWORD):BOOL; stdcall; external LibWinSpool name 'WritePrinter';
implementation
{ TPrinterDevice }

66
lcl/printers.pas
View File

@ -133,6 +133,7 @@ type
fAborted : Boolean; //Abort process
//fCapabilities: TPrinterCapabilities;
fPaperSize : TPaperSize;
fRawMode : Boolean;
function GetCanvas: TCanvas;
procedure CheckPrinting(Value: Boolean);
@ -147,6 +148,7 @@ type
procedure SetCopies(AValue: Integer);
procedure SetOrientation(const AValue: TPrinterOrientation);
procedure SetPrinterIndex(AValue: integer);
procedure SetRawMode(const AValue: boolean);
protected
procedure SelectCurrentPrinterOrDefault;
@ -178,6 +180,8 @@ type
function GetCanRenderCopies : Boolean; virtual;
function GetXDPI: Integer; virtual;
function GetYDPI: Integer; virtual;
procedure CheckRawMode(const Value: boolean; Msg:string='');
procedure RawModeChanging; virtual;
public
constructor Create; virtual;
destructor Destroy; override;
@ -188,6 +192,8 @@ type
procedure NewPage;
procedure Refresh;
procedure SetPrinter(aName : String);
function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; virtual;
property PrinterIndex : integer read GetPrinterIndex write SetPrinterIndex;
property PaperSize : TPaperSize read GetPaperSize;
@ -208,6 +214,7 @@ type
property CanRenderCopies : Boolean read GetCanRenderCopies;
property XDPI : Integer read GetXDPI;
property YDPI : Integer read GetYDPI;
property RawMode: boolean read FRawMode write SetRawMode;
end;
var
@ -279,15 +286,20 @@ begin
//If not selected printer, set default printer
SelectCurrentPrinterOrDefault;
Canvas.Refresh;
fPrinting := True;
fAborted := False;
fPageNumber := 1;
TPrinterCanvas(Canvas).BeginDoc;
if not FRawMode then begin
Canvas.Refresh;
TPrinterCanvas(Canvas).BeginDoc;
end;
//Call the specifique Begindoc
DoBeginDoc;
// Set font resolution
Canvas.Font.PixelsPerInch := YDPI;
if not FRawMode then
Canvas.Font.PixelsPerInch := YDPI;
end;
//End the current document
@ -296,7 +308,8 @@ begin
//Check if Printer print otherwise, exception
CheckPrinting(True);
TPrinterCanvas(Canvas).EndDoc;
if not FRawMode then
TPrinterCanvas(Canvas).EndDoc;
DoEndDoc(fAborted);
@ -310,8 +323,8 @@ procedure TPrinter.NewPage;
begin
CheckPrinting(True);
Inc(fPageNumber);
TPrinterCanvas(Canvas).NewPage;
if not RawMode then
TPrinterCanvas(Canvas).NewPage;
DoNewPage;
end;
@ -389,9 +402,18 @@ begin
end
end;
function TPrinter.Write(const Buffer; Count:Integer; var Written: Integer): Boolean;
begin
result := False;
end;
//Return an Canvas object
function TPrinter.GetCanvas: TCanvas;
begin
Result := nil;
CheckRawMode(False, 'Canvas not allowed in Raw Mode');
if not Assigned(fCanvas) then
begin
if not Assigned(GetCanvasRef) then
@ -415,6 +437,24 @@ begin
end;
end;
procedure TPrinter.CheckRawMode(const Value:boolean; msg:string ='');
begin
if FRawMode<>Value then
begin
if msg='' then
if Value then
Msg:='Printer is in Raw Mode'
else
Msg:='Printer is not in Raw Mode';
raise EPrinter.Create(msg);
end;
end;
procedure TPrinter.RawModeChanging;
begin
//
end;
//Get current copies number
function TPrinter.GetCopies: Integer;
Var i : Integer;
@ -546,6 +586,15 @@ begin
raise EPrinter.Create('No printers defined !');
end;
procedure TPrinter.SetRawMode(const AValue: boolean);
begin
if AValue<>FRawMode then begin
CheckPrinting(False);
RawModeChanging;
FRawMode := AValue;
end;
end;
//If not Printer selected, Select the default printer
procedure TPrinter.SelectCurrentPrinterOrDefault;
begin
@ -556,7 +605,10 @@ end;
//Specify here the Canvas class used by your TPrinter object
function TPrinter.GetCanvasRef: TPrinterCanvasRef;
begin
Result:=TPrinterCanvas;
if FRawMode then
result := nil
else
Result:=TPrinterCanvas;
end;