Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Impresión (https://www.clubdelphi.com/foros/forumdisplay.php?f=4)
-   -   Necesito imprimir tickets en impresora de impacto (https://www.clubdelphi.com/foros/showthread.php?t=77865)

panpered 02-03-2012 00:43:06
Necesito imprimir tickets en impresora de impacto
 
: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



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;
      // 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 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.

Casimiro Notevi 02-03-2012 00:58:40
Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo?, gracias por tu colaboración.

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



.

panpered 02-03-2012 22:22:00
La impresora imprime la mitad del lado izquierdo pero el lado derecho no
 
: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 02-03-2012 22:50:24
Cita:
Empezado por panpered (Mensaje 426743)
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 03-03-2012 21:22:16
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 03-03-2012 21:28:29
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 04-03-2012 17:45:26
Cita:
Empezado por Casimiro Notevi (Mensaje 426785)
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 14-03-2012 19:14:36
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.


La franja horaria es GMT +2. Ahora son las 06:01:51.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi