Impressão no Win2000 e XP
Caros amigos tenho a seguinte rotina abaixo para selecionar a impressora para impressão, funciona muito bem em windows 98 mais não funciona no 2000 e no XP alguem pode me ajudar?????????????
procedure TfrmRelPedidos.FormShow(Sender: TObject);
var i : integer;
Padrao: String;
Device: Array[0..127] Of Char;
Driver: Array[0..127] Of Char;
Port : Array[0..127] Of Char;
DeviceMode: THandle;
begin
inherited;
CbBoxImpressoras.Items.Clear;
for i:= 1 to Printer.Printers.Count do
begin
if pos(´LPT´, printer.Printers.Strings[i-1]) > 0 then
CbBoxImpressoras.Items.Add(´LPT1´)
else if pos(´\\´, printer.Printers.Strings[i-1]) > 0 then
CbBoxImpressoras.Items.Add(copy(printer.Printers.Strings[i-1],pos(´\\´,
printer.Printers.Strings[i-1]),length(printer.Printers.Strings[i-1]) -
pos(´\\´, printer.Printers.Strings[i-1]) + 1));
if pos(´USB´, printer.Printers.Strings[i-1]) > 0 then
cbBoxImpressoras.Items.Add(´EPUSB1´);
end;
CbBoxImpressoras.ItemIndex := Printer.PrinterIndex; //Seleciona no Combo a Impressão padrão
If (CbBoxImpressoras.ItemIndex = Printer.PrinterIndex) And (CbBoxImpressoras.ItemIndex = imprPadrao) Then
Begin
Padrao := ´Impressora Padrão, pronta para imprimir!´;
IsPadrao := True;
End
Else
Padrao := ´Impressora pronta para imprimir!´;
If PrinterOnLine Then
Begin
If (IsPadrao = True) Then
LbStatus.Font.Color := clRed
Else
LbStatus.Font.Color := clBlue;
LbStatus.Caption := Padrao
End;
Else
ShowMessage(´A Impressora não está pronta, verifique-a!´);
Printer.GetPrinter(Device, Driver, Port, DeviceMode);
LbTipo.Caption := Device;
LbOnde.Caption := Port;
LbComentario.Caption := Driver;
rgSelecaoClick(Sender);
gridpeds.SetFocus;
end;
procedure TfrmRelPedidos.CbBoxImpressorasChange(Sender: TObject);
Var
Padrao: String;
FDevice: Array[0..127] Of Char;
FDriver: Array[0..127] Of Char;
FPort : Array[0..127] Of Char;
DeviceMode: THandle;
begin
inherited;
IsPadrao := False;
Printer.PrinterIndex := CbBoxImpressoras.ItemIndex;
Printer.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
SetPrinter(StrPas(FDevice));
If (CbBoxImpressoras.ItemIndex = Printer.PrinterIndex) And (CbBoxImpressoras.ItemIndex = imprPadrao) Then
Begin
Padrao := ´Impressora Padrão, pronta para imprimir!´;
IsPadrao := True;
End
Else
Begin
Padrao := ´Impressora pronta para imprimir!´;
IsPadrao := False;
End;
If PrinterOnLine Then //*** Verificando se a impressora está ativa ***
Begin
If (IsPadrao = True) Then
LbStatus.Font.Color := clRed
Else
LbStatus.Font.Color := clBlue;
LbStatus.Caption := Padrao;
End;
Else
ShowMessage(´A Impressora não está pronta, verifique-a!´);
LbTipo.Caption := StrPas(FDevice);
LbOnde.Caption := FPort;
end;
procedure TfrmRelPedidos.CbBoxImpressorasDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
OffSet: Integer;
begin
inherited;
offset := 0;
With (Control As TComboBox).Canvas Do
Begin
FillRect(Rect);
Bitmap := TBitmap(CbBoxImpressoras.Items.Objects[Index]);
If (Bitmap <> Nil) Then
Begin
{Use BrushCopy para alcançar efeitos especiais como fazer
a imagem copiada parcialmente transparente.}
//Borda Esquerda, Borda Superior do Bitmap
BrushCopy(Bounds(Rect.Left+2, Rect.Top+2, Bitmap.Width+1, Bitmap.Height+1),
Bitmap, Bounds(0, 0, Bitmap.Width+1, Bitmap.Height+1), clOlive);
//Borda do FundoW, Borda do FundoH //Cor a deixar transparente
OffSet := Bitmap.Width + 8; //Espaço entre o Bitmap e o Texto
End;
TextOut(Rect.Left + OffSet, Rect.Top, CbBoxImpressoras.Items[Index]);
End;
end;
procedure TfrmRelPedidos.CbBoxImpressorasMeasureItem(Control: TWinControl;
Index: Integer; var Height: Integer);
begin
inherited;
Height := 18;
end;
procedure TfrmRelPedidos.ImPrinterPadClick(Sender: TObject);
begin
inherited;
//O código abaixo deve ser informado no evento OnClick do componente
ImPrinterPad.Enabled := False;
Try
//Verifica se o listbox tem algo selecionado
If (CbBoxImpressoras.ItemIndex >= 0) Then
Begin
//Ajusta impressora atual do programa
Printer.PrinterIndex := CbBoxImpressoras.ItemIndex;
//Faz a atual virar default
FazPrnAtualVirarPadrao;
End;
Finally
ImPrinterPad.Enabled := True;
imprPadrao := Printer.PrinterIndex;
LbStatus.Caption := ´Impressora Padrão, pronta para imprimir!´;
LbStatus.Font.Color := clRed;
MessageDlg(´A impressora selecionada está como Padrão!´, mtInformation, [mbOk], 0);
End;
end;
procedure TfrmRelPedidos.SetPrinter(sPrinterName: String);
Var
iPrinterIndex, i: Integer;
FDevice: Array[0..127] Of Char;
FDriver: Array[0..127] Of Char;
FPort : Array[0..127] Of Char;
DeviceMode: THandle;
begin
If (sPrinterName = ´´) Then
Exit;
iPrinterIndex := -1;
For i := 0 To (Printer.Printers.Count - 1) Do
Begin
Printer.PrinterIndex := i;
Printer.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
If (UpperCase(sPrinterName) = UpperCase(StrPas(FDevice))) Then
Begin
iPrinterIndex := i; //Impressora encontrada
Break;
End;
End;
If (iPrinterIndex = -1) Then
Begin
MessageDlg(Format(´Impressora ´¬s´ não disponível!´, [sPrinterName]), mtError, [mbOk], 0);
Printer.PrinterIndex := iPrinterIndex;
CbBoxImpressoras.ItemIndex := Printer.PrinterIndex;
End;
end;
procedure TfrmRelPedidos.SetPrinterPage(Width, Height: Integer);
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 TfrmRelPedidos.FormShow(Sender: TObject);
var i : integer;
Padrao: String;
Device: Array[0..127] Of Char;
Driver: Array[0..127] Of Char;
Port : Array[0..127] Of Char;
DeviceMode: THandle;
begin
inherited;
CbBoxImpressoras.Items.Clear;
for i:= 1 to Printer.Printers.Count do
begin
if pos(´LPT´, printer.Printers.Strings[i-1]) > 0 then
CbBoxImpressoras.Items.Add(´LPT1´)
else if pos(´\\´, printer.Printers.Strings[i-1]) > 0 then
CbBoxImpressoras.Items.Add(copy(printer.Printers.Strings[i-1],pos(´\\´,
printer.Printers.Strings[i-1]),length(printer.Printers.Strings[i-1]) -
pos(´\\´, printer.Printers.Strings[i-1]) + 1));
if pos(´USB´, printer.Printers.Strings[i-1]) > 0 then
cbBoxImpressoras.Items.Add(´EPUSB1´);
end;
CbBoxImpressoras.ItemIndex := Printer.PrinterIndex; //Seleciona no Combo a Impressão padrão
If (CbBoxImpressoras.ItemIndex = Printer.PrinterIndex) And (CbBoxImpressoras.ItemIndex = imprPadrao) Then
Begin
Padrao := ´Impressora Padrão, pronta para imprimir!´;
IsPadrao := True;
End
Else
Padrao := ´Impressora pronta para imprimir!´;
If PrinterOnLine Then
Begin
If (IsPadrao = True) Then
LbStatus.Font.Color := clRed
Else
LbStatus.Font.Color := clBlue;
LbStatus.Caption := Padrao
End;
Else
ShowMessage(´A Impressora não está pronta, verifique-a!´);
Printer.GetPrinter(Device, Driver, Port, DeviceMode);
LbTipo.Caption := Device;
LbOnde.Caption := Port;
LbComentario.Caption := Driver;
rgSelecaoClick(Sender);
gridpeds.SetFocus;
end;
procedure TfrmRelPedidos.CbBoxImpressorasChange(Sender: TObject);
Var
Padrao: String;
FDevice: Array[0..127] Of Char;
FDriver: Array[0..127] Of Char;
FPort : Array[0..127] Of Char;
DeviceMode: THandle;
begin
inherited;
IsPadrao := False;
Printer.PrinterIndex := CbBoxImpressoras.ItemIndex;
Printer.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
SetPrinter(StrPas(FDevice));
If (CbBoxImpressoras.ItemIndex = Printer.PrinterIndex) And (CbBoxImpressoras.ItemIndex = imprPadrao) Then
Begin
Padrao := ´Impressora Padrão, pronta para imprimir!´;
IsPadrao := True;
End
Else
Begin
Padrao := ´Impressora pronta para imprimir!´;
IsPadrao := False;
End;
If PrinterOnLine Then //*** Verificando se a impressora está ativa ***
Begin
If (IsPadrao = True) Then
LbStatus.Font.Color := clRed
Else
LbStatus.Font.Color := clBlue;
LbStatus.Caption := Padrao;
End;
Else
ShowMessage(´A Impressora não está pronta, verifique-a!´);
LbTipo.Caption := StrPas(FDevice);
LbOnde.Caption := FPort;
end;
procedure TfrmRelPedidos.CbBoxImpressorasDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
OffSet: Integer;
begin
inherited;
offset := 0;
With (Control As TComboBox).Canvas Do
Begin
FillRect(Rect);
Bitmap := TBitmap(CbBoxImpressoras.Items.Objects[Index]);
If (Bitmap <> Nil) Then
Begin
{Use BrushCopy para alcançar efeitos especiais como fazer
a imagem copiada parcialmente transparente.}
//Borda Esquerda, Borda Superior do Bitmap
BrushCopy(Bounds(Rect.Left+2, Rect.Top+2, Bitmap.Width+1, Bitmap.Height+1),
Bitmap, Bounds(0, 0, Bitmap.Width+1, Bitmap.Height+1), clOlive);
//Borda do FundoW, Borda do FundoH //Cor a deixar transparente
OffSet := Bitmap.Width + 8; //Espaço entre o Bitmap e o Texto
End;
TextOut(Rect.Left + OffSet, Rect.Top, CbBoxImpressoras.Items[Index]);
End;
end;
procedure TfrmRelPedidos.CbBoxImpressorasMeasureItem(Control: TWinControl;
Index: Integer; var Height: Integer);
begin
inherited;
Height := 18;
end;
procedure TfrmRelPedidos.ImPrinterPadClick(Sender: TObject);
begin
inherited;
//O código abaixo deve ser informado no evento OnClick do componente
ImPrinterPad.Enabled := False;
Try
//Verifica se o listbox tem algo selecionado
If (CbBoxImpressoras.ItemIndex >= 0) Then
Begin
//Ajusta impressora atual do programa
Printer.PrinterIndex := CbBoxImpressoras.ItemIndex;
//Faz a atual virar default
FazPrnAtualVirarPadrao;
End;
Finally
ImPrinterPad.Enabled := True;
imprPadrao := Printer.PrinterIndex;
LbStatus.Caption := ´Impressora Padrão, pronta para imprimir!´;
LbStatus.Font.Color := clRed;
MessageDlg(´A impressora selecionada está como Padrão!´, mtInformation, [mbOk], 0);
End;
end;
procedure TfrmRelPedidos.SetPrinter(sPrinterName: String);
Var
iPrinterIndex, i: Integer;
FDevice: Array[0..127] Of Char;
FDriver: Array[0..127] Of Char;
FPort : Array[0..127] Of Char;
DeviceMode: THandle;
begin
If (sPrinterName = ´´) Then
Exit;
iPrinterIndex := -1;
For i := 0 To (Printer.Printers.Count - 1) Do
Begin
Printer.PrinterIndex := i;
Printer.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
If (UpperCase(sPrinterName) = UpperCase(StrPas(FDevice))) Then
Begin
iPrinterIndex := i; //Impressora encontrada
Break;
End;
End;
If (iPrinterIndex = -1) Then
Begin
MessageDlg(Format(´Impressora ´¬s´ não disponível!´, [sPrinterName]), mtError, [mbOk], 0);
Printer.PrinterIndex := iPrinterIndex;
CbBoxImpressoras.ItemIndex := Printer.PrinterIndex;
End;
end;
procedure TfrmRelPedidos.SetPrinterPage(Width, Height: Integer);
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;
Fernando Marroco
Curtidas 0