Definir tamanho do papel

07/12/2003

0

Eu preciso imprimir algumas linhas em uma bobina de papel de 40 colunas, antes de iniciar a impressão eu sei quantas linhas serão impressas(a quantidade muda a cada impressão) e não quero desperdiçar papel, portanto gostaria de saber se existe um meio via programação de ajustar o tamanho do papel e a resolução de impressão logo antes de BeginDoc, estou utilizando o TextOut() e não Writeln(), se alguém sabe agradeceria se me informasse :( :?:


Edilcimar

Edilcimar

Responder

Posts

07/12/2003

Edilcimar

sobe


Responder

21/12/2003

Edilcimar

sobe


Responder

25/12/2003

Edilcimar

sobe


Responder

28/12/2003

Edilcimar

sobe


Responder

01/01/2004

Edilcimar

sobe


Responder

04/01/2004

Edilcimar

sobe


Responder

18/01/2004

Edilcimar

sobe


Responder

01/02/2004

Edilcimar

CONSEGUIIIIIIIIIIIIIIIIIIIIIIIIIIIII!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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;
o resto das funções vocês que se virem


Responder

01/02/2004

Edison_br

Não se empolgue muito pq esta rotina não funciona em determinados driver em Win2000 e XP.


Responder

01/02/2004

Edilcimar

Bem se esta rotina possui algum problema com algumas versões do windows, por que vc(edson br) não nos honra com o seu conhecimento colocando aqui uma rotina que funcione, afinal de contas esta pergunta está postada desde o dia 7 de dezembro


Responder

05/02/2004

Edison_br

pq eu também não tenho a solução, senão, postaria sem problemas como sempre fiz nos forum/grupos que participo.

Edison


Responder

05/02/2004

Guialberto

Olá pessoal o que vou mostrar não é de minha autoria, nem sequer testei
mas talveis possar servir.

Peguei do arquivo 800 dicas de Delphi

////////////////
560 - Troca de tamanho do papel
Como diria Pearl Jam: ´...It´s a Revolution Baby...´

Bem, agora vou mostrar como criar uma rotina para troca automatica de papel, muito útil em casos de empresas que possuem diversos tipos de ´papélis´. Você pode copiar o nosso exemplo completo agora: TamPa.zip

Acompanhe a baixo o código principal com detalhes do mesmo:

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;

Equipe GDI: Alexandre Andrade e Wagner Santos
Todos os direitos reservados 2000
Copyright © 2000 GDI - All rights reserved

//////////////////////////////////////////////////////////

[]´Guialberto


Responder

Assista grátis a nossa aula inaugural

Assitir aula

Saiba por que programar é uma questão de
sobrevivência e como aprender sem riscos

Assistir agora

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar