Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Impresión
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 02-03-2012
panpered panpered is offline
Registrado
NULL
 
Registrado: mar 2012
Posts: 3
Poder: 0
panpered Va por buen camino
Exclamation Necesito imprimir tickets en impresora de impacto


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)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;


{ 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.

Última edición por Casimiro Notevi fecha: 02-03-2012 a las 01:59:44. Razón: Poner etiquetas [delphi] [/delphi]
Responder Con Cita
  #2  
Antiguo 02-03-2012
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.257
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo?, gracias por tu colaboración.

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



.
Responder Con Cita
  #3  
Antiguo 02-03-2012
panpered panpered is offline
Registrado
NULL
 
Registrado: mar 2012
Posts: 3
Poder: 0
panpered Va por buen camino
Question La impresora imprime la mitad del lado izquierdo pero el lado derecho no


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.
Responder Con Cita
  #4  
Antiguo 02-03-2012
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.257
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por panpered Ver Mensaje
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?
Responder Con Cita
  #5  
Antiguo 03-03-2012
panpered panpered is offline
Registrado
NULL
 
Registrado: mar 2012
Posts: 3
Poder: 0
panpered Va por buen camino
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.
Responder Con Cita
  #6  
Antiguo 03-03-2012
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.257
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
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.
Responder Con Cita
  #7  
Antiguo 04-03-2012
Avatar de ElKurgan
[ElKurgan] ElKurgan is offline
Miembro Premium
 
Registrado: nov 2005
Posts: 1.237
Poder: 20
ElKurgan Va camino a la fama
Cita:
Empezado por Casimiro Notevi Ver Mensaje
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
Responder Con Cita
  #8  
Antiguo 14-03-2012
lcarrasco lcarrasco is offline
Miembro
NULL
 
Registrado: oct 2010
Posts: 15
Poder: 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
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
imprimir en impresora de tickets en con reportbuilder ingmichel Impresión 4 25-07-2012 00:33:22
imprimir acentos en impresora de tickets Er_Manué Impresión 3 18-04-2012 23:03:19
¿como imprimir a impresora (tickets)en delphi 2010 win32? JXJ Varios 5 22-09-2010 20:13:22
Imprimir Tickets con impresora Epson rcor Impresión 1 03-11-2006 15:35:22
Imprimir tickets en una impresora que esta conectada al USB Juan_Carlos_P Impresión 1 24-08-2005 15:53:23


La franja horaria es GMT +2. Ahora son las 00:57:55.


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
Copyright 1996-2007 Club Delphi