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
Código Delphi
[-]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;
public
function SetToDefaultPrinter:Boolean;
function BeginDoc:Boolean;
function EndDoc:Boolean;
function Abort:Boolean;
function Write(const Buffer; Count:Longint)
Word;
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;
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 if (fPrinterName='') then SetToDefaultPrinter;
if (fPrinterName<>'') and OpenPrinter(PChar(fPrinterName), fPrinterHandle, nil)
then fLevel:= 1;
end;
if (fLevel=1) then begin 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 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 PosXthen
begin
writestr(ActiveLine);
writeStr(#13);
ActiveLine:='';
end;
while length(ActiveLine)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.
Necesito imprimir tickets en impresora de impacto
La impresora imprime la mitad del lado izquierdo pero el lado derecho no
Mode Lineal
