Trocando o tamanho do papel

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;