Necesito imprimir tickets en impresora de impacto

[panpered]

:confused::confused::confused:
El siguiente código lo obtuve hace años de Internet y me ha funcionado muy bien para imprimir tickets en impresoras de impacto bajo las versiones desde Delphi 7 hasta Delphi 2007; sin embargo, ya no me funciona en Delphi 2010. Alguien sabe cómo corregirla para que funcione también en Delphi 2010?

De antemano gracias,

Edwin Raúl



unit AREPrinter;
{$B-}

interface

uses
Windows, SysUtils, Classes;

type
TAREPrinter = class(TComponent)
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
private
fDocumentTitle: string;
fPrinterName: string;
fPrinterHandle: DWord;
fLevel: Integer;
UsedLine:Integer;
ActiveLine:string;
// 0 - printer closed
// 1 - printer open
// 2 - job started
// 3 - page started
public
function SetToDefaultPrinter:Boolean;
function BeginDoc:Boolean;
function EndDoc:Boolean;
function Abort:Boolean;
function Write(const Buffer; Count:Longint):DWord;
function WriteStr(const text:string):Boolean;
function WriteLn(const line:string):Boolean;
function NextPage:Boolean;
function CR:Boolean;
function LF:Boolean;
function PrintSay(PosY:Integer; PosX:Integer; const linea:string):Boolean;
function Translate(const line:string):String;
published
property PrinterName:string read fPrinterName write fPrinterName;
property DocumentTitle:string read fDocumentTitle write fDocumentTitle;
end;

procedure Register;

implementation

uses
WinSpool;


procedure Register;
begin
RegisterComponents('Alexis', [TAREPrinter]);
end;


{ TAREPrinter }
(***********************************************************************************)
constructor TAREPrinter.Create(AOwner: TComponent);
begin
inherited;
fDocumentTitle:= '';
fPrinterName:= '';
fLevel:= 0;
UsedLine:=0;
ActiveLine:='';
end;

destructor TAREPrinter.Destroy;
begin
if (fLevel>0) then Abort;
inherited;
end;

(***********************************************************************************)
function TAREPrinter.SetToDefaultPrinter:Boolean;
var str: array[0..79]of Char;
function FetchStr(s:string):string;
var i: Integer;
begin
s:= TrimLeft(s);
i:= Pos(',',s);
if i=0
then Result:= s
else Result:= Copy(s, 1, i-1);
end;
begin
GetProfileString('windows', 'device', '', str, SizeOf(str)-1);
fPrinterName:= FetchStr(str);
Result:= (fPrinterName<>'');
end;

(***********************************************************************************)
function TAREPrinter.BeginDoc: Boolean;
var DocInfo: TDocInfo1;
begin
if (fLevel=0) then begin // open printer
if (fPrinterName='') then SetToDefaultPrinter;
if (fPrinterName<>'') and OpenPrinter(PChar(fPrinterName), fPrinterHandle, nil)
then fLevel:= 1;
end;
if (fLevel=1) then begin // start new job
with DocInfo do begin
pDocName:= PChar(fDocumentTitle);
pOutputFile:= nil;
pDatatype:= 'RAW';
end;
if (StartDocPrinter(fPrinterHandle, 1, @DocInfo)<>0)
then fLevel:= 2;
end;
if (fLevel=2) then // start new page
if StartPagePrinter(fPrinterHandle)
then fLevel:= 3;
Result:= (fLevel=3);
end;

function TAREPrinter.EndDoc: Boolean;
begin
if length(ActiveLine)>0 then WriteStr(ActiveLine);
ActiveLine:='';
if (fLevel=3) then
if EndPagePrinter(fPrinterHandle) then fLevel:= 2;
if (fLevel=2) then
if EndDocPrinter(fPrinterHandle) then fLevel:= 1;
if (fLevel=1) then
if ClosePrinter(fPrinterHandle) then fLevel:= 0;
Result:= (fLevel=0);
end;

function TAREPrinter.Abort: Boolean;
begin
if (fLevel>1) then
if AbortPrinter(fPrinterHandle) then fLevel:= 1;
if (fLevel=1) then
if ClosePrinter(fPrinterHandle) then fLevel:= 0;
Result:= (fLevel=0);
end;

(***********************************************************************************)
function TAREPrinter.Write(const Buffer; Count: Integer): DWord;
begin
Result:= 0;
if (fLevel=3) then
WritePrinter(fPrinterHandle, Pointer(Buffer), Count, Result);
end;

function TAREPrinter.WriteStr(const text: string): Boolean;
var len: DWord;
begin
len:= Length(text);
Result:= (Write(text,len)=len);
end;

function TAREPrinter.WriteLn(const line: string): Boolean;
begin
Result:= WriteStr(line+#10#13);
end;

function TAREPrinter.NextPage: Boolean;
begin
if ActiveLine<>'' then writeStr(ActiveLine);
Result:= WriteStr(#12);
UsedLine:=0;
ActiveLine:='';
end;

function TAREPrinter.CR: Boolean;
begin
if ActiveLine<>'' then writeStr(ActiveLine);
ActiveLine:='';
Result:= WriteStr(#13);
end;

function TAREPrinter.LF: Boolean;
begin
if ActiveLine<>'' then writeStr(ActiveLine);
ActiveLine:='';
Result:= WriteStr(#10);
UsedLine:=UsedLine+1;
end;


(***********************************************************************************)

Function TAREPrinter.PrintSay(PosY:Integer; PosX:Integer; const linea:String):Boolean;
var
a:Integer;
line:String;
begin
line:=Translate(linea);
if PosY>UsedLine then
begin
if ActiveLine<>'' then writestr(ActiveLine);
ActiveLine:='';
for a:=UsedLine to PosY-1 do
begin
WriteStr(#10);
UsedLine:=UsedLine+1;
end;
WriteStr(#13);
end;

if PosX<length(ActiveLine) then
begin
writestr(ActiveLine);
writeStr(#13);
ActiveLine:='';
end;

while length(ActiveLine)<PosX do ActiveLine:=ActiveLine+' ';
ActiveLine:=ActiveLine+line;
result:=true;
end;

Function TAREPrinter.Translate(const line:String):String;
var
i:byte;
c:char;
begin
Result:='';
for i:=1 to Length(line) do
begin
case line[i] of
'À':c:=Chr(065); 'Á':c:=Chr(065); 'Â':c:=Chr(065); 'Ã':c:=Chr(065);
'Ä':c:=Chr(142); 'Å':c:=Chr(143); 'Æ':c:=Chr(146); 'Ç':c:=Chr(128);
'È':c:=Chr(069); 'É':c:=Chr(069); 'Ê':c:=Chr(069); 'Ë':c:=Chr(069);
'Ì':c:=Chr($8C); 'Í':c:=Chr($8D); 'Î':c:=Chr($8E); 'Ï':c:=Chr($8F);

'Ð':c:=Chr($90); 'Ñ':c:=Chr($A5); 'Ò':c:=Chr($92); 'Ó':c:=Chr($93);
'Ô':c:=Chr($94); 'Õ':c:=Chr($95); 'Ö':c:=Chr(153); '×':c:=Chr(158);
'Ø':c:=Chr(157); 'Ù':c:=Chr($99); 'Ú':c:=Chr($9A); 'Û':c:=Chr(154);
'Ü':c:=Chr($9C); 'Ý':c:=Chr($9D); 'Þ':c:=Chr($9E); 'ß':c:=Chr($9F);

'à':c:=Chr($A0); 'á':c:=Chr($A0); 'â':c:=Chr(131); 'ã':c:=Chr($A3);
'ä':c:=Chr(132); 'å':c:=Chr($A5); 'æ':c:=Chr(145); 'ç':c:=Chr(135);
'è':c:=Chr($82); 'é':c:=Chr($82); 'ê':c:=Chr($AA); 'ë':c:=Chr($AB);
'ì':c:=Chr($A1); 'í':c:=Chr($A1); 'î':c:=Chr($AE); 'ï':c:=Chr($AF);

'ð':c:=Chr($E0); 'ñ':c:=Chr($A4); 'ò':c:=Chr($A2); 'ó':c:=Chr($A2);
'ô':c:=Chr(147); 'õ':c:=Chr($E5); 'ö':c:=Chr(148); '÷':c:=Chr($E7);
'ø':c:=Chr(155); 'ù':c:=Chr($A3); 'ú':c:=Chr($A3); 'û':c:=Chr(150);
'ü':c:=Chr(129); 'ý':c:=Chr($ED); 'þ':c:=Chr($EE); 'ÿ':c:=Chr(152);

'¨':c:=Chr($F0); '¸':c:=Chr($F1); 'ª':c:=Chr(166); 'º':c:=Chr(167);
'¯':c:=Chr($F4); '¿':c:=Chr(168);
'¹':c:=Chr($FC); '²':c:=Chr($49); '³':c:=Chr($69);
else c:=line[i];
end;
Result:=Result+c;
end;
end;
(***********************************************************************************)
end.

[Casimiro Notevi]

Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo (http://www.clubdelphi.com/foros/guiaestilo.php)?, gracias por tu colaboración.

Y recuerda poner entre etiquetas el código, ejemplo:

http://neftali.clubdelphi.com/images/UtilizarTAGs.png

.

[panpered]

:confused::confused::confused:
La última solución que se me ha ocurrido es borrar el dcu del archivo pas con el código descrito en mi mensaje anterior, y volver a compilarlo con Delphi 2010 para que cree nuevamente el dcu y ya imprime, nomás que la mitad del lado izquierdo sí imprime pero el lado derecho no.
Espero que alguien me ayude. Mientras tanto, seguiré intentando.

Gracias.

[Casimiro Notevi]

nomás que la mitad del lado izquierdo sí imprime pero el lado derecho no.

Eso no lo había oído nunca, ¿estará estropeada la impresora?

[panpered]

No es cuestión de la impresora porque, repito, utilizando el mismo código en Delphi 7 y Delphi 2007 funciona pero en Delphi 2010 no funciona.

[Casimiro Notevi]

Puede ser entonces que esa versión de delphi trabaja con unicode, seguramente envías caracteres de control a la impresora y no los entiende porque son diferentes, me parece que tendrás que declarar las variables que uses para ese cometido como ansistring.
Haz una búsqueda por los foros por eso términos, es un tema que se ha tratado en algunas ocasiones.
Siento no poder ayudarte más, pero yo sigo con un delphi más antiguo.

[ElKurgan]

Puede ser entonces que esa versión de delphi trabaja con unicode, seguramente envías caracteres de control a la impresora y no los entiende porque son diferentes, me parece que tendrás que declarar las variables que uses para ese cometido como ansistring.
Haz una búsqueda por los foros por eso términos, es un tema que se ha tratado en algunas ocasiones.
Siento no poder ayudarte más, pero yo sigo con un delphi más antiguo.

Si. Es problema del unicode. Reemplaza las definiciones string y char por ansistring y ansichar, para mantener la compatibilidad de codigo con versiones anteriores de del phi.

Saludos

[lcarrasco]

Creo que encontre la falla, prueba con el siguiente codigo:


unit uImpresor;
{$B-}

interface

uses
Windows, SysUtils, Classes;

type
TAREPrinter = class(TComponent)
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
private
fDocumentTitle: string;
fPrinterName: string;
fPrinterHandle: THandle; <--- Cambio principal
fLevel: Integer;
UsedLine: Integer;
ActiveLine: string;
// 0 - printer closed
// 1 - printer open
// 2 - job started
// 3 - page started
public
function SetToDefaultPrinter: Boolean;
function BeginDoc: Boolean;
function EndDoc: Boolean;
function Abort: Boolean;
function Write(const Buffer; Count: Longint): Cardinal;
function WriteStr(const text: string): Boolean;
function WriteLn(const line: string): Boolean;
function NextPage: Boolean;
function CR: Boolean;
function LF: Boolean;
function PrintSay(PosY: Integer; PosX: Integer;
const linea: string): Boolean;
function Translate(const line: string): String;
published
property PrinterName: string read fPrinterName write fPrinterName;
property DocumentTitle: string read fDocumentTitle write fDocumentTitle;
end;

procedure Register;

implementation

uses
WinSpool;

procedure Register;
begin
RegisterComponents('Alexis', [TAREPrinter]);
end;

{ TAREPrinter }
(* ********************************************************************************* *)
constructor TAREPrinter.Create(AOwner: TComponent);
begin
inherited;
fDocumentTitle := '';
fPrinterName := '';
fLevel := 0;
UsedLine := 0;
ActiveLine := '';
end;

destructor TAREPrinter.Destroy;
begin
if (fLevel > 0) then
Abort;
inherited;
end;

(* ********************************************************************************* *)
function TAREPrinter.SetToDefaultPrinter: Boolean;
var
str: array [0 .. 79] of Char;
function FetchStr(s: string): string;
var
i: Integer;
begin
s := TrimLeft(s);
i := Pos(',', s);
if i = 0 then
Result := s
else
Result := Copy(s, 1, i - 1);
end;

begin
GetProfileString('windows', 'device', '', str, SizeOf(str) - 1);
fPrinterName := FetchStr(str);
Result := (fPrinterName <> '');
end;

(* ********************************************************************************* *)
function TAREPrinter.BeginDoc: Boolean;
var
DocInfo: TDocInfo1;
PrinterDefaults: TPrinterDefaults;

begin

with PrinterDefaults do
begin
DesiredAccess := PRINTER_ACCESS_USE;
pDatatype := nil;
pDevMode := nil;
end;

if (fLevel = 0) then
begin // open printer
if (fPrinterName = '') then
SetToDefaultPrinter;
if (fPrinterName <> '') and OpenPrinter(PChar(fPrinterName), fPrinterHandle,
@PrinterDefaults) then
fLevel := 1;
end;
if (fLevel = 1) then
begin // start new job
with DocInfo do
begin
pDocName := PChar(fDocumentTitle);
pOutputFile := nil;
pDatatype := 'RAW';
end;
if (StartDocPrinter(fPrinterHandle, 1, @DocInfo) <> 0) then
fLevel := 2;
end;
if (fLevel = 2) then // start new page
if StartPagePrinter(fPrinterHandle) then
fLevel := 3;
Result := (fLevel = 3);
end;

function TAREPrinter.EndDoc: Boolean;
begin
if length(ActiveLine) > 0 then
WriteStr(ActiveLine);
ActiveLine := '';
if (fLevel = 3) then
if EndPagePrinter(fPrinterHandle) then
fLevel := 2;
if (fLevel = 2) then
if EndDocPrinter(fPrinterHandle) then
fLevel := 1;
if (fLevel = 1) then
if ClosePrinter(fPrinterHandle) then
fLevel := 0;
Result := (fLevel = 0);
end;

function TAREPrinter.Abort: Boolean;
begin
if (fLevel > 1) then
if AbortPrinter(fPrinterHandle) then
fLevel := 1;
if (fLevel = 1) then
if ClosePrinter(fPrinterHandle) then
fLevel := 0;
Result := (fLevel = 0);
end;

(* ********************************************************************************* *)
function TAREPrinter.Write(const Buffer; Count: Integer): Cardinal;
begin
Result := 0;
if (fLevel = 3) then
WritePrinter(fPrinterHandle, Pointer(Buffer), Count, Result);
end;

function TAREPrinter.WriteStr(const text: string): Boolean;
var
len: DWord;
begin
len := length(text);
Result := (Write(text, len) = len);
end;

function TAREPrinter.WriteLn(const line: string): Boolean;
begin
Result := WriteStr(line + #10#13);
end;

function TAREPrinter.NextPage: Boolean;
begin
if ActiveLine <> '' then
WriteStr(ActiveLine);
Result := WriteStr(#12);
UsedLine := 0;
ActiveLine := '';
end;

function TAREPrinter.CR: Boolean;
begin
if ActiveLine <> '' then
WriteStr(ActiveLine);
ActiveLine := '';
Result := WriteStr(#13);
end;

function TAREPrinter.LF: Boolean;
begin
if ActiveLine <> '' then
WriteStr(ActiveLine);
ActiveLine := '';
Result := WriteStr(#10);
UsedLine := UsedLine + 1;
end;

(* ********************************************************************************* *)

Function TAREPrinter.PrintSay(PosY: Integer; PosX: Integer;
const linea: String): Boolean;
var
a: Integer;
line: String;
begin
line := Translate(linea);
if PosY > UsedLine then
begin
if ActiveLine <> '' then
WriteStr(ActiveLine);
ActiveLine := '';
for a := UsedLine to PosY - 1 do
begin
WriteStr(#10);
UsedLine := UsedLine + 1;
end;
WriteStr(#13);
end;

if PosX >= 0 then
begin
WriteStr(ActiveLine);
WriteStr(#13);
ActiveLine := '';
end;

while length(ActiveLine) > 0 do
ActiveLine := ActiveLine + ' ';
ActiveLine := ActiveLine + line;
Result := true;
end;

Function TAREPrinter.Translate(const line: String): String;
var
i: byte;
c: Char;
begin
Result := '';
for i := 1 to length(line) do
begin
case line[i] of
'À':
c := Chr(065);
'Á':
c := Chr(065);
'Â':
c := Chr(065);
'Ã':
c := Chr(065);
'Ä':
c := Chr(142);
'Å':
c := Chr(143);
'Æ':
c := Chr(146);
'Ç':
c := Chr(128);
'È':
c := Chr(069);
'É':
c := Chr(069);
'Ê':
c := Chr(069);
'Ë':
c := Chr(069);
'Ì':
c := Chr($8C);
'Í':
c := Chr($8D);
'Î':
c := Chr($8E);
'Ï':
c := Chr($8F);

'Ð':
c := Chr($90);
'Ñ':
c := Chr($A5);
'Ò':
c := Chr($92);
'Ó':
c := Chr($93);
'Ô':
c := Chr($94);
'Õ':
c := Chr($95);
'Ö':
c := Chr(153);
'×':
c := Chr(158);
'Ø':
c := Chr(157);
'Ù':
c := Chr($99);
'Ú':
c := Chr($9A);
'Û':
c := Chr(154);
'Ü':
c := Chr($9C);
'Ý':
c := Chr($9D);
'Þ':
c := Chr($9E);
'ß':
c := Chr($9F);

'à':
c := Chr($A0);
'á':
c := Chr($A0);
'â':
c := Chr(131);
'ã':
c := Chr($A3);
'ä':
c := Chr(132);
'å':
c := Chr($A5);
'æ':
c := Chr(145);
'ç':
c := Chr(135);
'è':
c := Chr($82);
'é':
c := Chr($82);
'ê':
c := Chr($AA);
'ë':
c := Chr($AB);
'ì':
c := Chr($A1);
'í':
c := Chr($A1);
'î':
c := Chr($AE);
'ï':
c := Chr($AF);

'ð':
c := Chr($E0);
'ñ':
c := Chr($A4);
'ò':
c := Chr($A2);
'ó':
c := Chr($A2);
'ô':
c := Chr(147);
'õ':
c := Chr($E5);
'ö':
c := Chr(148);
'÷':
c := Chr($E7);
'ø':
c := Chr(155);
'ù':
c := Chr($A3);
'ú':
c := Chr($A3);
'û':
c := Chr(150);
'ü':
c := Chr(129);
'ý':
c := Chr($ED);
'þ':
c := Chr($EE);
'ÿ':
c := Chr(152);

'¨':
c := Chr($F0);
'¸':
c := Chr($F1);
'ª':
c := Chr(166);
'º':
c := Chr(167);
'¯':
c := Chr($F4);
'¿':
c := Chr(168);
'¹':
c := Chr($FC);
'²':
c := Chr($49);
'³':
c := Chr($69);
else
c := line[i];
end;
Result := Result + c;
end;
end;

(* ********************************************************************************* *)
end.