Configurar Impressora

procedure TForm1.SetPrinterPage(Width, Height : LongInt);
var
  Device : array[0..255] of char;
  Driver : array[0..255] of char;
  Port : array[0..255] of char;
  hDMode : THandle;
  PDMode : PDEVMODE;
begin
  Printer.GetPrinter(Device, Driver, Port, hDMode);
  If hDMode <> 0 then
  begin
  pDMode := GlobalLock( hDMode );
  If pDMode <> nil then
  begin
  pDMode^.dmPaperSize := DMPAPER_USER;
  pDMode^.dmPaperWidth := Width;
  pDMode^.dmPaperLength := Height;
  pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;
  GlobalUnlock( hDMode );
  end;
  end;
end; 

procedure MudaTamPapel(PaperSize, Comp, Alt: integer);
var
ADevice, ADriver, APort: array[0..255] of char;
DeviceMode: THandle;
M: PDevMode;
s: string;
begin
// Força o uso de Printer. Se esta linha for removida, a primeira
// invocação falha. Bug da VCL
S := Printer.Printers[Printer.PrinterIndex];
// Pega dados da impressora atual
Printer.GetPrinter(ADevice, ADriver, APort, DeviceMode);
// Pega um ponteiro para DEVMODE
M := GlobalLock(DeviceMode);
try
if M <> nil then
begin
// Muda tamanho do papel
M^.dmFields := DM_PAPERSIZE;
if PaperSize = DMPAPER_USER then
M^.dmFields := M^.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
M^.dmPaperLength := Alt;
M^.dmPaperWidth := Comp;
M^.dmPaperSize := PaperSize;//
// Atualiza
Printer.SetPrinter(ADevice, ADriver, APort, DeviceMode);
end;
finally
GlobalUnlock(DeviceMode);
end;
end;
 
function ImpressoraCorrente: string;
begin
Result := Printer.Printers[Printer.PrinterIndex];
end;
 
procedure TForm1.AtualizaPrn;
begin
StaticText1.Caption := ImpressoraCorrente;
end;
 
procedure TForm1.MostraTamPapel;
var
ADevice, ADriver, APort: array[0..255] of char;
DeviceMode: THandle;
M: PDevMode;
s: string;
begin
// Força o uso de Printer. Se esta linha for removida, a primeira
// invocação falha. Bug da VCL
S := Printer.Printers[Printer.PrinterIndex];
// Pega dados da impressora atual
Printer.GetPrinter(ADevice, ADriver, APort, DeviceMode);
// Pega um ponteiro para DEVMODE
M := GlobalLock(DeviceMode);
if M <> nil then
MostraDevMode(M^);
end;
 
function TForm1.PegaTamanhoPapel(dmPaperSize: word): string;
begin
Result := ´Desconhecido´;
// Verifica ALGUNS TAMANHOS POSSÍVEIS. Existem outros, veja DEVMODE
case dmPaperSize of
DMPAPER_USER: Result := ´Definido pelo usuário´;
DMPAPER_LETTER: Result := ´Letter, 8 1/2- by 11-inches´;
DMPAPER_LEGAL: Result := ´Legal, 8 1/2- by 14-inches´;
DMPAPER_A4: Result := ´A4 Sheet, 210- by 297-millimeters´;
end;
end;
 
procedure TForm1.MostraDevMode(const M: TDevMode);
begin
// Mostra o valor de alguns campos
with M do
begin
// Mostra nome da impressora
Memo1.Lines.Add(´Nome:´ + dmDeviceName);
// Verifica se campo tamanho do papel esta preenchido e mostra
if dmFields and DM_PAPERSIZE <> 0 then
Memo1.Lines.Add(PegaTamanhoPapel(dmPaperSize));
if dmFields and DM_PAPERLENGTH <> 0 then
Memo1.Lines.Add(Format(´Altura:¬d´, [dmPaperLength]));
if dmFields and DM_PAPERWIDTH <> 0 then
Memo1.Lines.Add(Format(´Comprimento:¬d´, [dmPaperWidth]));
end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
P: TPrinterSetupDialog;
begin
P := TPrinterSetupDialog.Create(self);
try
P.Execute;
finally
P.Free;
end;
AtualizaPrn;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
begin
MudaTamPapel(DMPAPER_LETTER, 0, 0);
MostraTamPapel;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
MudaTamPapel(DMPAPER_USER, StrToInt(EdComp.Text), StrToInt(EdAlt.Text));
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
Printer.Title := ´Teste de filha´;
Printer.BeginDoc;
Printer.EndDoc;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
begin
MostraTamPapel;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
AtualizaPrn;
end;

Uses
qrprntr
 
var
Form1: TForm1;
cPaperSize : TQRPaperSize;
nLength : Extended;
 
implementation
{$R *.DFM}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
cPapersize := QuickRep1.Page.PaperSize;
nLength := QuickRep1.Page.Length;
QuickRep1.Preview;
end;
 
procedure TForm1.QuickRep1BeforePrint(Sender: TQuickRep;
var PrintReport: Boolean);
begin
QuickRep1.Page.PaperSize := cPaperSize;
QuickRep1.Page.Length := nLength;
end;