unit PrinterSettings;
interface
uses windows, sysutils, classes, dialogs, messages ;
function GetDefaultPrinterA(prnName : PAnsiChar;
var bufSize : DWORD ) : BOOL;
stdcall;
external '
winspool.drv'
name '
GetDefaultPrinterA';
type
TMyPrinterSettings =
class
private
function getDefaultPrinterName:
string;
procedure SetDefaultPrinterName(
const Value:
string);
public
property DefaultPrinterName :
string read GetDefaultPrinterName
write SetDefaultPrinterName ;
end ;
var
PS : TMyPrinterSettings ;
implementation
uses printers ;
function TMyPrinterSettings.getDefaultPrinterName:
string;
var
lprnName: PAnsiChar;
lBufSize: DWord;
begin
GetMem(lprnName, 1000);
try
GetDefaultPrinterA(lprnName, lBufSize);
Result := lprnName;
finally
FreeMem(lprnName);
end;
end;
procedure TMyPrinterSettings.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 := TMyPrinterSettings.create ;
finalization
PS.free ;
end.