Ver Mensaje Individual
  #8  
Antiguo 14-03-2012
lcarrasco lcarrasco is offline
Miembro
NULL
 
Registrado: oct 2010
Posts: 15
Reputación: 0
lcarrasco Va por buen camino
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;
    // 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.
Responder Con Cita