Reputation: 763
I am attempting to change the default printer in the on change event of a combo box that list the printer index. I use "Printers" to get the printer index but the actual printing is done with proprietary print code that allows for direct to pdf printing and easier page layout. I am trying to use the below code to change the default printer and then my print code will print to that printer. However the program becomes unresponsive without any errors or program not responding messages when this line of code executes:
SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0,LongInt(cs1));
Here is the full function.
function TMainFrm.SetDefaultPrinter(const PrinterName: string): boolean;
// Printername is bv: '\\MYPRINTER\HP5-k'
var
s2 : string;
dum1 : Pchar;
xx, qq : integer;
const
cs1 : pchar = 'Windows';
cs2 : pchar = 'Device';
cs3 : pchar = 'Devices';
cs4 : pchar = #0;
begin
xx := 254;
GetMem( dum1, xx);
Result := False;
try
qq := GetProfileString( cs3, pchar( PrinterName ), #0, dum1, xx);
if (qq > 0) and (trim( strpas( dum1 )) <> '') then
begin
s2 := PrinterName + ',' + strpas( dum1 );
while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0 do
WriteProfileString( cs1, cs2, #0);
WriteProfileString( cs1, cs2, pchar( s2 ));
case Win32Platform of
VER_PLATFORM_WIN32_NT :
SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0,LongInt(cs1));
VER_PLATFORM_WIN32_WINDOWS :
SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0,LongInt(cs1));
end; { case }
Result := True;
end;
finally
FreeMem( dum1 );
end;
end;
Anyone have any tips or a better way to do this?
As a side note this is not my function. It's a piece of code I picked up while searching for a solution to my problem.
Few more pieces of info:
The print job is actually a PDF being printed using
ShellExecute(Application.Handle, 'print', PChar(sPath), nil, nil, SW_HIDE);
The goal is to change the default printer to the selected printer in order to print the pdf to the desired printer and then return the printer to the original default on exit of the application
Upvotes: 1
Views: 9805
Reputation: 31
I also tried to use the "SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0,LongInt(cs1))" code block and my program was hang. So, I tried to simply write the SetDefaultPrinter as local function and then no hang occours. Here is the code that works fine for me.
function SetDefaultPrinter(const PrinterName: string): boolean;
// Printername is bv: '\\MYPRINTER\HP5-k'
var
s2 : string;
dum1 : PChar;
xx, qq : integer;
const
cs1 : pChar = 'Windows';
cs2 : pChar = 'Device';
cs3 : pChar = 'Devices';
cs4 : pChar = #0;
begin
xx := 254;
GetMem( dum1, xx);
Result := False;
try
qq := GetProfileString( cs3, pChar( PrinterName ), #0, dum1, xx);
if (qq > 0) and (trim( strpas( dum1 )) <> '') then
begin
s2 := PrinterName + ',' + strpas( dum1 );
while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0 do
WriteProfileString( cs1, cs2, #0);
WriteProfileString( cs1, cs2, pChar( s2 ));
case Win32Platform of
VER_PLATFORM_WIN32_NT :
SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(cs1));
VER_PLATFORM_WIN32_WINDOWS :
SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0,LongInt(cs1));
end; { case }
Result := True;
end;
finally
FreeMem( dum1 );
end;
end;
Upvotes: 0
Reputation: 9985
Just a brief look at this link and it appears you're mising the most critical function SetDefaultPrinterA/SetDefaultPrinterW in 'winspool.drv'
Also the broadcast message is designed to be polite to other running programs to let them know something has changed the default printer, even in the above article it doesn't seem to pay any attention to the result so you could change the call to PostMessage
Upvotes: 2
Reputation: 136441
Try using the Win32_Printer
WMI class to list the printers and the SetDefaultPrinter
method to set the default printer.
{$APPTYPE CONSOLE}
uses
SysUtils,
ActiveX,
ComObj,
Variants;
procedure ListPrinters;
const
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
FWbemObjectSet:= FWMIService.ExecQuery('SELECT DeviceID, Name FROM Win32_Printer','WQL',wbemFlagForwardOnly);
oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
while oEnum.Next(1, FWbemObject, iValue) = 0 do
begin
Writeln(Format('DeviceID %s Name %s',[FWbemObject.DeviceID,FWbemObject.Name]));
FWbemObject:=Unassigned;
end;
end;
function SetDefaultPrinter(const DeviceID:string):boolean;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObject : OLEVariant;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
FWbemObject := FWMIService.Get(Format('Win32_Printer.DeviceID="%s"',[DeviceID]));
if not VarIsClear(FWbemObject) then
Result:=FWbemObject.SetDefaultPrinter()=0
else
Result:=false;
end;
begin
try
CoInitialize(nil);
try
ListPrinters;
SetDefaultPrinter('HP LaserJet'); //here you must pass the DeviceID of one the printers listed above
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Upvotes: 3