Fórum Trocar impressora padrâo em tempo de execução #238631

procedure TForm1.Imprime(Impressora: string);
var
  oPrinter: Printers.TPrinter;
  Indice: integer;
begin
  oPrinter := Printers.TPrinter.Create;
  try
    Indice := oPrinter.Printers.IndexOf(Impressora);
    if Indice < 0 then
    begin
      ShowMessage(Impressora + ´ não existe´);
      Exit;
    end;
    oPrinter.PrinterIndex := Indice;
    oPrinter.BeginDoc;
    oPrinter.Canvas.TextOut(10, 10, ´Impresso em ´ + oPrinter.Printers.Strings[oPrinter.PrinterIndex]);
    oPrinter.EndDoc;
  finally
    FreeAndNil(oPrinter);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Imprime(´Epson Stylus COLOR 400 ESC/P 2´);
  Imprime(´Epson Stylus COLOR 740 ESC/P 2´);
end;

//636 - Mudar Impressora padrão pelo nome
procedure SetDefaultPrinter(PrinterName: String);
var
  I: Integer;
  Device : PChar;
  Driver : Pchar;
  Port : Pchar;
  HdeviceMode: Thandle;
  aPrinter : TPrinter;
begin
  Printer.PrinterIndex := -1;
  getmem(Device, 255);
  getmem(Driver, 255);
  getmem(Port, 255); 
  aPrinter := TPrinter.create;
  for I := 0 to Printer.printers.Count-1 do
  begin
  if Printer.printers[i] = PrinterName then
  begin
  aprinter.printerindex := i;
  aPrinter.getprinter
  (device, driver, port, HdeviceMode);
  StrCat(Device, ´,´);
  StrCat(Device, Driver );
  StrCat(Device, Port );
  WriteProfileString(´windows´, ´device´, Device);
  StrCopy( Device, ´windows´ );
  SendMessage(HWND_BROADCAST, WM_WININICHANGE,
  0, Longint(@Device));
  end;
  end;
  Freemem(Device, 255);
  Freemem(Driver, 255);
  Freemem(Port, 255);
  aPrinter.Free;
end;