{%MainUnit ../osprinters.pas} {************************************************************** Implementation for winprinter ***************************************************************} uses InterfaceBase, LCLIntf, WinVer, WinUtilPrn {todo: use WinSpool when it will be released with fpc, WinSpool}; // todo: this ^ is a mess: mixed WinUtilPrn/Windows units clean... // todo: this should be a method, can not be atm because mixed units ^ function GetCurrentDevMode(out DM:PDeviceMode): Boolean; var PDev: TPrinterDevice; begin Result := false; if (Printer.Printers.Count > 0) then begin PDev := TPrinterDevice(Printer.Printers.Objects[Printer.PrinterIndex]); DM := PDev.DevMode; Result := DM <> nil; end; end; { TWinPrinter } constructor TWinPrinter.Create; begin inherited Create; fLastHandleType := htNone; fPrinterHandle := 0; //None end; destructor TWinPrinter.Destroy; begin ClearDC; DoResetPrintersList; if fPrinterHandle <> 0 then ClosePrinter(fPrinterHandle); inherited Destroy; end; function TWinPrinter.Write(const Buffer; Count: Integer; var Written: Integer): Boolean; begin CheckRawMode(True); Result := WritePrinter(FPrinterHandle, @Buffer, Count, pdword(@Written)); end; function TWinPrinter.GetHandlePrinter : HDC; begin SetIC; Result := fDC; 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 := 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; procedure TWinPrinter.PrinterSelected; begin if (PrinterIndex >= 0) and not RawMode then SetDC; end; function TWinPrinter.GetXDPI: Integer; begin Result:=72; if (Printers.Count > 0) and not RawMode then begin SetDC; Result:=windows.GetDeviceCaps(fDC, LOGPIXELSX); end; end; function TWinPrinter.GetYDPI: Integer; begin Result:=72; if (Printers.Count>0) and not RawMode then begin SetDC; Result:=windows.GetDeviceCaps(fDC,LOGPIXELSY); end; end; procedure TWinPrinter.SetIC; var PDev : TPrinterDevice; begin if (fLastHandleType=htNone) and (Printers.Count>0) then begin PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]); fDC:=CreateIC(PChar(PDev.Driver),PChar(PDev.Device), PChar(PDev.Port),PDev.DevMode); if fDC=0 then fDC:=CreateIC(PChar('WINSPOOL'),PChar(PDev.Device), 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])); if Assigned(Canvas) then Canvas.Handle:=fDC; fLastHandleType:=htIC; end; end; procedure TWinPrinter.SetDC; var PDev : TPrinterDevice; begin if (fLastHandleType<>htDC) and (Printers.Count>0) then begin ClearDC; PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]); try //Device is only 32 chars long, //if the Printername or share is longer than 32 chars, this will return 0 fDC := CreateDC(nil, PChar(PDev.Name), nil, PDev.DevMode); if fDC=0 then fDC := CreateDC(PChar('WINSPOOL'),PChar(PDev.Name), nil, PDev.DevMode); {Workaround (hack) for Lexmark 1020 JetPrinter (Mono)} if fDC=0 then fDC:=CreateDC(nil,PChar(PDev.Driver),nil, PDev.DevMode); if fDC=0 then fDC:=CreateDC(pChar('WINSPOOL'),PChar(PDev.Driver),nil,PDev.DevMode); except on E:Exception do 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])); if Assigned(Canvas) then Canvas.Handle:=fDC; 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:=htNone; end; // Based on MS Article Q167345 function TWinPrinter.UpdateDevMode(APrinterIndex:Integer): boolean; var PDev: TPrinterDevice; dwRet: Integer; begin if FPrinterHandle=0 then begin result := false; exit; end; // now we have a right FPrinterHandle, get current printer settings PDev := TPrinterDevice(Printers.Objects[APrinterIndex]); // 1. Determine the required size of the buffer from the device, // and then allocate enough memory for it. PDev.DevModeSize := DocumentProperties(0, FPrinterHandle, pchar(PDev.Name), nil, nil, 0); ReallocMem(Pdev.DevMode, PDev.DevModeSize); if PDev.DevModeSize=0 then begin result := false; exit; end; // 2. Ask the device driver to initialize the DEVMODE buffer with // the default settings. dwRet := DocumentProperties(0, FPrinterHandle, pchar(Pdev.Name), PDev.DevMode, nil, DM_OUT_BUFFER); result := (dwRet=IDOK); if not result then begin ReallocMem(PDev.Devmode, 0); exit; end; end; procedure TWinPrinter.DoBeginDoc; var Inf: TDocInfo; Doc1: DOC_INFO_1; begin inherited DoBeginDoc; if fPrinterHandle = 0 then raise EPrinter.Create('Printer handle not defined'); if RawMode then begin Doc1.pDocName := PChar(Title); if Filename <> '' then Doc1.pOutputFile := PChar(Filename) else Doc1.pOutputFile := nil; Doc1.pDataType := 'RAW'; if StartDocPrinter(FPrinterHandle, 1, PByte(@Doc1)) = 0 then begin ClosePrinter(FPrinterHandle); FPrinterHandle := 0; end else if not StartPagePrinter(FPrinterHandle) then begin EndDocPrinter(FPrinterHandle); ClosePrinter(FPrinterHandle); FPrinterHandle := 0; end; end else begin SetDC; Canvas.Handle := fDC; Canvas.Refresh; FillChar(Inf, SizeOf(Inf), 0); Inf.cbSize := SizeOf(Inf); Inf.lpszDocName := PChar(Title); if FileName <> '' then Inf.lpszOutput := PChar(Filename); StartDoc(fDC,@Inf); StartPage(fDC); end; end; procedure TWinPrinter.DoNewPage; begin inherited DoNewPage; if RawMode then begin EndPagePrinter(FPrinterHandle); StartPagePrinter(FPrinterHandle); end else begin EndPage(fDC); StartPage(fDC); Canvas.Refresh; end; end; procedure TWinPrinter.DoEndDoc(aAborded: Boolean); begin inherited DoEndDoc(aAborded); 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; if RawMode then AbortPrinter(FPrinterHandle) else AbortDoc(fDC); end; function TWinPrinter.GetDefaultPrinter: string; const MAXBUFSIZE = 512; var Needed, PrtCount: DWORD; BoolRes: BOOL; IntRes: Integer; PrintInfo2Buf: PByte; GetDefPrnFunc: function(buffer: PChar; var bufSize: DWORD): BOOL; stdcall; SpoolerHandle: HINST; begin // retrieve default printer using ms blessed method, see // see: http://support.microsoft.com/default.aspx?scid=kb;en-us;246772 Result := ''; if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then begin // Get PRINT_INFO_2 record size SetLastError(0); BoolRes := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, nil, 0, @Needed, @PrtCount); if not BoolRes and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then Exit; // Get PRINT_INFO_2 record GetMem(PrintInfo2Buf, Needed); BoolRes := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, PrintInfo2Buf, Needed, @Needed, @PrtCount); if not BoolRes then begin FreeMem(PrintInfo2Buf); Exit; end; Result := PPRINTER_INFO_2(PrintInfo2Buf)^.pPrinterName; FreeMem(PrintInfo2Buf); end else if Win32Platform=VER_PLATFORM_WIN32_NT then begin if Win32MajorVersion >=5 then begin // for Windows 2000 or later, use api GetDefaultPrinter // TODO: needs to check WindowsUnicodeSupport SpoolerHandle := LoadLibrary(LibWinSpool); if SpoolerHandle = 0 then Exit; Pointer(GetDefPrnFunc) := GetProcAddress(SpoolerHandle, 'GetDefaultPrinterA'); if GetDefPrnFunc = nil then begin FreeLibrary(SpoolerHandle); Exit; end; PrtCount := MAXBUFSIZE; SetLength(Result, PrtCount); // make room for printer name BoolRes := GetDefPrnFunc(pchar(Result), prtCount); FreeLibrary(SpoolerHandle); PrtCount := strlen(pchar(result)); SetLength(Result, PrtCount); end else begin // for NT, use GetProfileString SetLength(result, MAXBUFSIZE); IntRes := GetProfileString('windows', 'device', ',,,', PChar(result), MAXBUFSIZE); if (IntRes>0) and (pos(',',Result)<>0) then Result := copy(Result, 1, pos(',', Result)-1) else Result := ''; end; end; Result := AnsiToUTF8(Result); end; //Enum all defined printers. First printer it's default procedure TWinPrinter.DoEnumPrinters(Lst: TStrings); var Flags : DWORD; Level : DWORD; PrtCount : DWORD; Needed : DWORD; Buffer : PByte; InfoPrt : PByte; i : Integer; DefaultPrinter : string; PDev : TPrinterDevice; TmpDevMode : PDeviceMode; PrtStr : string; begin {$IFDEF NOPRINTERS} Lst.Clear; exit; {$ENDIF} DefaultPrinter := GetDefaultPrinter; Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL; Level := 2; //Evaluate buffer size Needed := 0; EnumPrinters(Flags, nil, Level, nil, 0, @Needed, @PrtCount); if Needed <> 0 then begin GetMem(Buffer, Needed); Fillchar(Buffer^, Needed, 0); try //Enumerate Printers if EnumPrinters(Flags, nil, Level, Buffer, Needed, @Needed, @PrtCount) then begin InfoPrt := Buffer; for i := 0 to PrtCount - 1 do begin if Level = 2 then begin PDev := TPrinterDevice.Create; PDev.Name := PPRINTER_INFO_2(InfoPrt)^.pPrinterName; PDev.Driver := PPRINTER_INFO_2(InfoPrt)^.pDriverName; PDev.Port := PPRINTER_INFO_2(InfoPrt)^.pPortName; TmpDevMode := PPRINTER_INFO_2(InfoPrt)^.pDevMode; if TmpDevMode <> nil then begin // the devmode structure obtained this way have two problems // 1. It's not the full devmode, because it doesn't have // the private info // 2. It's not initialized with the current settings and // have not extra settings at all. // // PDev.DevMode:=PPRINTER_INFO_2(InfoPrt)^.PDevMode^; PDev.Device := PChar(PByte(TmpDevMode^.dmDeviceName)); PDev.DefaultPaper := TmpDevMode^.dmPaperSize; end else begin PDev.Device:=''; PDev.DefaultPaper:=0; end; PrtStr := AnsiToUTF8(PDev.Name); if AnsiCompareText(PrtStr,DefaultPrinter)<>0 then Lst.AddObject(PrtStr,PDev) else begin Lst.Insert(0,PrtStr); Lst.Objects[0]:=PDev; end; Inc(InfoPrt,SizeOf(_PRINTER_INFO_2)); end; end; end; finally FreeMem(Buffer); end; end; end; procedure TWinPrinter.DoResetPrintersList; var i : Integer; Obj : TObject; begin for i:=0 to Printers.Count-1 do begin Obj:=Printers.Objects[i]; Printers.Objects[i]:=nil; Obj.Free; end; inherited DoResetPrintersList; end; procedure TWinPrinter.DoEnumPapers(Lst: TStrings); var Buffer : PChar; PaperN : String; PaperC,i : Integer; Count : Integer; PDev : TPrinterDevice; ArPapers : Array[0..255] of Word; begin inherited DoEnumPapers(Lst); if (Printers.Count>0) then begin PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]); if fPrinterHandle=0 then SetPrinter(Printers.Strings[PrinterIndex]); if fPrinterHandle=0 then raise EPrinter.Create('Printer handle not defined'); //Retreive the supported papers PaperC:=0; Count := DeviceCapabilities(PChar(Pdev.Name), PCHar(PDev.Port), DC_PAPERNAMES, nil, nil); if Count<=0 then raise EPrinter.CreateFmt('DoEnumPapers error : %d, (%s)', [GetLastError,SysErrorMessage(GetLastError)]); GetMem(Buffer,64*Count); try PaperC:=DeviceCapabilities(PChar(Pdev.Name),PCHar(PDev.Port), DC_PAPERNAMES,Buffer,nil); for i:=0 to PaperC-1 do begin PaperN:=StrPas(Buffer+i*64); Lst.Add(PaperN); end; finally FreeMem(Buffer); end; //Retreive the code of papers FillChar(ArPapers,SizeOf(ArPapers),0); PaperC:=DeviceCapabilities(PChar(Pdev.Name),PChar(PDev.Port), DC_PAPERS,PChar(@ArPapers[0]),nil); if PaperC<=0 then raise EPrinter.CreateFmt('DoEnumPapers error : %d, (%s)', [GetLastError,SysErrorMessage(GetLastError)]) else if PaperC>Lst.Count then PaperC := Lst.Count; for i:=0 to PaperC-1 do Lst.Objects[i]:=TObject(ptrint(ArPapers[i])); end; end; function TWinPrinter.DoGetPaperName: string; var i : Integer; dm : PDeviceMode; begin Result:=inherited DoGetPaperName; if GetCurrentDevMode(dm) then with PaperSize.SupportedPapers do begin i := IndexOfObject(TObject(ptrInt(dm^.dmPaperSize))); if i>=0 then result := PaperSize.SupportedPapers[i]; end; end; function TWinPrinter.DoGetDefaultPaperName: string; var i : Integer; PDev : TPrinterDevice; begin Result:=inherited DoGetDefaultPaperName; if (Printers.Count>0) then begin PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]); with PaperSize.SupportedPapers do begin i:=IndexOfObject(TObject(ptrint(PDev.DefaultPaper))); if i<>-1 then Result:= Strings[i]; end; end; end; procedure TWinPrinter.DoSetPaperName(aName: string); var i : Integer; dm : PDeviceMode; begin inherited DoSetPaperName(aName); if GetCurrentDevMode(dm) then begin i:=PaperSize.SupportedPapers.IndexOf(aName); if i<>-1 then begin ClearDC; dm^.dmPaperSize := SHORT(ptrint(PaperSize.SupportedPapers.Objects[i])); end; end; end; 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) 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 // be obtained only(?) for currently selected paper. // if DoGetPaperName=AName then begin SetDC; with aPaperRC.PhysicalRect do begin Left :=0; Top :=0; Right :=Windows.GetDeviceCaps(fDC, PHYSICALWIDTH); Bottom:=Windows.GetDeviceCaps(fDC, PHYSICALHEIGHT); end; with aPaperRC.WorkRect do begin Left :=Windows.GetDeviceCaps(fDC, PHYSICALOFFSETX); Top :=Windows.GetDeviceCaps(fDC, PHYSICALOFFSETY); Right :=Left + Windows.GetDeviceCaps(fDC, HORZRES); Bottom:=Top + Windows.GetDeviceCaps(fDC, VERTRES); end; end else begin // for other papers return at least the physical size // note: old implementation was using DeviceCapabilities function with // index DC_PAPERSIZE, unfortunately this returns dimensions in // tenths of millimeter which is wrong, we need points (not font // points, but printer "pixels" at current resolution). // PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]); //Retreive the Width and Height of aName paper FillChar(ArSizes,SizeOf(ArSizes),0); NSize:=DeviceCapabilities(PChar(Pdev.Name),PChar(PDev.Port), DC_PAPERSIZE,PChar(@ArSizes[0]),nil); i:=PaperSize.SupportedPapers.IndexOf(aName); if (i>=0) and (i0) then begin aPaperRc.PhysicalRect:=Classes.Rect(0,0,ArSizes[i].X,ArSizes[i].Y); with aPaperRC.PhysicalRect do begin // convert from tenths of millimeter to points Right := round(Right * XDPI / 254); Bottom := round(Bottom* YDPI / 254); end; aPaperRc.WorkRect := aPaperRC.PhysicalRect; end; end; Result:=1; end; end; function TWinPrinter.DoSetPrinter(aName: string): Integer; var i: Integer; PDev: TPrinterDevice; begin Result := inherited DoSetPrinter(aName); i := Printers.IndexOf(aName); if i <> -1 then begin ClearDC; if FPrinterHandle <> 0 then ClosePrinter(FPrinterHandle); PDev := TPrinterDevice(Printers.Objects[i]); if not OpenPrinter(PChar(PDev.Name), @fPrinterHandle, nil) then begin FprinterHandle := 0; raise EPrinter.CreateFmt('OpenPrinter exception : %s', [SysErrorMessage(GetlastError)]); end; if UpdateDevMode(i) then Result := i else Result := -1; end; end; function TWinPrinter.DoGetCopies: Integer; var dm: PDeviceMode; begin if GetCurrentDevMode(dm) then begin if dm^.dmCopies<>0 then result := dm^.dmCopies; end else Result:=inherited DoGetCopies; end; procedure TWinPrinter.DoSetCopies(aValue: Integer); var dm: PDeviceMode; begin inherited DoSetCopies(aValue); if (AValue>0) and GetCurrentDevMode(dm) then begin ClearDC; dm^.dmCopies := SHORT(aValue) end; end; function TWinPrinter.DoGetOrientation: TPrinterOrientation; var dm: PDeviceMode; begin Result:=inherited DoGetOrientation; if GetCurrentDevMode(dm) then begin case dm^.dmOrientation of DMORIENT_PORTRAIT : result:=poPortrait; DMORIENT_LANDSCAPE: result:=poLandscape; end; end; end; procedure TWinPrinter.DoSetOrientation(aValue: TPrinterOrientation); var dm: PDeviceMode; begin inherited DoSetOrientation(aValue); if GetCurrentDevMode(dm) then begin ClearDC; dm^.dmOrientation := Win32Orientations[aValue]; end; end; function TWinPrinter.GetPrinterType: TPrinterType; var Size: Dword; InfoPrt: Pointer; begin Result := ptLocal; //On Win9X all printers are local if Win32Platform <> VER_PLATFORM_WIN32_NT then Exit; GetPrinter(fPrinterHandle, 4, nil, 0, @Size); GetMem(InfoPrt, Size); try if not GetPrinter(fPRinterHandle, 4, InfoPrt, Size, @Size) then raise EPrinter.CreateFmt('GetPrinterType failed : %s', [SysErrorMessage(GetLastError)]); if PPRINTER_INFO_4(InfoPrt)^.Attributes = PRINTER_ATTRIBUTE_NETWORK then Result := ptNetwork; finally FreeMem(InfoPrt); end; end; function TWinPrinter.DoGetPrinterState: TPrinterState; var Size, Status, Jobs : DWord; InfoPrt: Pointer; begin Result := psNoDefine; GetPrinter(fPrinterHandle, 2, nil, 0, @Size); GetMem(InfoPrt,Size); try if not GetPrinter(fPrinterHandle, 2, InfoPrt, Size, @Size) then raise EPrinter.CreateFmt('GetPrinterState failed : %s', [SysErrorMessage(GetLastError)]); Jobs := PPRINTER_INFO_2(InfoPrt)^.cJobs; Status := PPRINTER_INFO_2(InfoPrt)^.Status; case Status of 0: Result := psReady; PRINTER_STATUS_PRINTING, PRINTER_STATUS_PROCESSING, PRINTER_STATUS_WARMING_UP, PRINTER_STATUS_WAITING, PRINTER_STATUS_IO_ACTIVE, PRINTER_STATUS_PENDING_DELETION, PRINTER_STATUS_INITIALIZING: Result := psPrinting; PRINTER_STATUS_PAPER_JAM, PRINTER_STATUS_PAPER_OUT, PRINTER_STATUS_PAPER_PROBLEM, PRINTER_STATUS_USER_INTERVENTION, PRINTER_STATUS_NO_TONER, PRINTER_STATUS_ERROR, PRINTER_STATUS_DOOR_OPEN, PRINTER_STATUS_PAGE_PUNT, PRINTER_STATUS_OUT_OF_MEMORY, PRINTER_STATUS_PAUSED: Result := psStopped; end; if (Result = psReady) and (Jobs > 0) then Result := psPrinting; finally FreeMem(InfoPrt); end; end; function TWinPrinter.GetCanPrint: Boolean; begin Result := (DoGetPrinterState <> psStopped); end; function TWinPrinter.GetCanRenderCopies: Boolean; var pDev : TPrinterDevice; Count : Integer; 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); Result := (Count>1); end else Result := inherited GetCanRenderCopies; end; procedure TWinPrinter.AdvancedProperties; var PDev: TPrinterDevice; begin if Printers.Count>0 then begin PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]); DocumentProperties( Widgetset.AppHandle, FPrinterHandle, pchar(PDev.Name), Pdev.DevMode, Pdev.DevMode, DM_OUT_BUFFER or DM_IN_BUFFER or DM_IN_PROMPT); //PrinterProperties(Widgetset.AppHandle,fPrinterHandle) end; end; initialization Printer:=TWinPrinter.Create; {end.}