Creo que encontre la falla, prueba con el siguiente codigo:
Código Delphi
[-]
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;
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;
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 if (fPrinterName = '') then
SetToDefaultPrinter;
if (fPrinterName <> '') and OpenPrinter(PChar(fPrinterName), fPrinterHandle,
@PrinterDefaults) 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): 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.