How to change the default printer from Delphi.

Abstract: Using Windows API calls to change the default printer.

Changing the default printer in Windows 2000 requires changing the registry key HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device This can be done from Delphi using Windows API calls.

Below is an entire unit you can copy. Start a new application and add 2 TButtons, 1 TLabel and 1 TListBox. Save and compile. Then replace all of the code in your Unit1 with the code below. Then be sure to double click each button to set the event handler.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  MAXPRINTERBUFFER = 8000;
  MAXPRINTERNAME = 500;
  MAXPRINTERINFO = 50;

type
  TPrinterBuffer = array[0..MAXPRINTERBUFFER - 1] of char;
  TForm1 = class(TForm)
  ListBox1: TListBox;
  Button2: TButton;
  Button1: TButton;
  Label1: TLabel;
procedure Button2Click(Sender: TObject);
procedure GetPrinterNames;
function ParseNames(const namebuffer: TPrinterBuffer; var startPos: integer): string;
function SetPrinter(const PrinterName : String) : boolean;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  Form1: TForm1;
  printerNames: TStringList;
  defaultPrinter: integer;

implementation

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
var
  x : integer;
begin
  try
  for x := 0 to printerNames.Count -1 do begin
    If ListBox1.Selected[x] then begin
      if (SetPrinter(ListBox1.Items.Strings[x]))
      then label1.Caption := 'Printer set to ' + ListBox1.Items.Strings[x]
      else label1.Caption := 'Printer not set';
    end;
  end;
  except
    label1.Caption := 'An error occured while setting the printer';
  end;
end;

procedure TForm1.GetPrinterNames;
var
  buffer: TPrinterBuffer;
  currPos: integer;
  printerName: string;
begin
  printerNames.Free;
  printerNames := TStringList.Create;
  if GetProfileString(PChar('PrinterPorts'), nil, '', buffer, MAXPRINTERBUFFER) > 0 then
  begin
    currPos := 0;
    while (true) do
      begin
        printerName := ParseNames(buffer, currPos);
        if printerName <> '' then
        printerNames.Add(printerName)
    else
      break;
    end;
  end;
end;

function TForm1.ParseNames(const namebuffer: TPrinterBuffer;
var startPos: integer): string;
var
  i, j, NameLength: integer;
  str: string;
begin
  result := '';
  if (startPos > High(namebuffer)) or (namebuffer[startPos] = Chr(0))  

  then
    exit;
  for i := startPos to High(namebuffer) do begin
    if namebuffer[i] = Chr(0) 

    then begin
      nameLength := i - startPos;
      SetLength(str, nameLength);
      for j := 0 to nameLength - 1 do
      str[j+1] := namebuffer[startPos + j];
      result := str;
      startPos := i + 1;
      break;
    end;
  end;
end;

function TForm1.SetPrinter(const PrinterName: String): boolean;
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
  Result := True;
end;
finally
  FreeMem( dum1 );
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetPrinterNames;
  Listbox1.Items.AddStrings(PrinterNames);
end;

end.


This sample is for Windows 2000 or NT but you should be able to adapt this code to your needs. The call to SendMessage notifies any other apps that are running that the default printer has changed. Sometimes this can cause the app to "freeze" because it is waiting for a reply from each app (which it may never get) so the code is commented out here. You can determine whether you need it or not.

Server Response from: ETNASC02