Standarddrucker umstellen

[Jelly]

Ich nutze hier diesen Code, und der funktioniert bei mir:

Delphi-Quellcode:

unit PrinterSettings;

interface
uses windows, sysutils, classes, messages ;

function GetDefaultPrinterA(prnName : PAnsiChar; var bufSize : DWORD ) : BOOL; stdcall;
       external 'winspool.drv' name 'GetDefaultPrinterA';

type
 TPrinterSettings = class
  private
    function getDefaultPrinterName: string;
    procedure SetDefaultPrinterName(const Value: string);
 public
    property DefaultPrinterName : string read GetDefaultPrinterName write SetDefaultPrinterName ;
 end ;

var
 PS : TPrinterSettings ;

implementation
uses printers ;

function TPrinterSettings.getDefaultPrinterName:string;
begin
     try
        Result := Printer.Printers[Printers.Printer.PrinterIndex] ;
     except
        Result := '' ;
     end ;
end;

procedure TPrinterSettings.SetDefaultPrinterName(const Value: string);
var
  Device: array[0..255] of char; 
  Driver: array[0..255] of char; 
  Port: array[0..255] of char; 
  hDeviceMode: THandle; 
begin
  if Printer.Printers.IndexOf (Value) >= 0 then begin
      Printer.PrinterIndex :=  Printer.Printers.IndexOf (Value) ;
      Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
      StrCat( Device, ',');
      StrCat( Device, Driver );
      StrCat( Device, ',');
      StrCat( Device, Port );
      WriteProfileString( 'windows', 'device', Device );
      StrCopy( Device, 'windows' );
      SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0, longint( @Device ));
      sleep (300) ;
  end else begin

  end ;
end;



initialization
   PS := TPrinterSettings.create ;
finalization
   PS.free ;
end.

Und wenn ich schon dabei bin, dieser Code kann dann auch noch interessant sein:

Delphi-Quellcode:

unit PrinterNamesAndTrays;

interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, winspool, printers ;

procedure GetPrnBinNames(PrnName : string ; BinList: TStrings; BinNrList : TStrings);
procedure GetPrnNames(PrnList: TStrings) ;


implementation


Type
  TBinName = Array [0..23] of Char; 
  TBinNameArray = Array [1..High(Integer) div Sizeof( TBinName )] of
TBinName; 
  PBinnameArray = ^TBinNameArray; 
  TBinArray = Array [1..High(Integer) div Sizeof(Word)] of Word; 
  PBinArray = ^TBinArray; 

procedure GetPrnNames(PrnList: TStrings) ;
begin
     PrnList.assign (Printer.Printers) ;
end ;

procedure GetPrnBinNames(PrnName : string ; BinList: TStrings; BinNrList : TStrings);
Var
  Device, Driver, Port: Array [0..255] of Char; 
  hDevMode: THandle; 
  i, numBinNames, numBins, temp: Integer; 
  pBinNames: PBinnameArray; 
  pBins: PBinArray; 
begin 
//  Printer.PrinterIndex := -1;
  if PrnName = ''
  then Printer.PrinterIndex := Printer.PrinterIndex
  else Printer.PrinterIndex := Printer.Printers.IndexOf(PrnName) ;
  Printer.GetPrinter(Device, Driver, Port, hDevmode); 

  numBinNames := Winspool.DeviceCapabilities(Device, Port, DC_BINNAMES, Nil, Nil); 
    numBins := Winspool.DeviceCapabilities(Device, Port, DC_BINS, Nil, Nil); 
    if (numBins <> numBinNames) then begin 
     raise Exception.Create('DeviceCapabilities: unterschiedliche Anzahl und Namen!');
    end; // if 

  if numBinNames > 0 then begin 
    // pBins := nil; 
    GetMem(pBinNames, numBinNames * Sizeof( TBinname)); 
    GetMem(pBins, numBins * Sizeof(Word)); 
    try 
      Winspool.DeviceCapabilities(Device, Port, DC_BINNAMES, Pchar(pBinNames), nil);
      Winspool.DeviceCapabilities(Device, Port, DC_BINS, Pchar(pBins), nil);
      BinList.Clear();
      BinNrList.Clear ;
      for i:= 1 to numBinNames do begin 
        temp := pBins^[i];
        BinList.AddObject( pBinNames^[i], TObject(temp)) ;
        BinNrList.AddObject( IntToStr(temp), TObject(temp)) ;

      end; 
    finally 
      FreeMem(pBinNames); 
      if (pBins <> nil) 
       then FreeMem(pBins); 
    end; 
  end; // if 
end;

end.