Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Ayuda para poder general codiog EA13 (https://www.clubdelphi.com/foros/showthread.php?t=35589)

jandres 14-09-2006 23:32:52

Ayuda para poder general codiog EA13
 
Hola necesito una manito quisiera saber como puedo generar un código ean13 e revisado el foro y no e encontrado nada que pueda entender claramente como hacer lo necesito esa parte para aplicar la a un modulo y no doy pie con bola como se dice en republica dominicana tengo incluso la pantalla donde introduzco los datos solo me falta el calculo para poder general el código

Gracias una vez más por la ayuda.

josejm 15-09-2006 00:02:28

Tengo lo que necesitas.
 
Hola, creo que tengo un modulo que te puede servir, lo encontre en internet y a mi me ha solucionado el tema. Te lo mando por e-mail por ser una unit completa.

Saludos, a todos y enorabuena por el foro.

josem 15-09-2006 00:04:16

Hola:
El codigo Ean13 se compone de doce numeros + el digito verificador, con lo que se completan 13 numeros. Para calcular el digito verificador deberas separar los digitos, y multiplicar cada uno de isquierda a derecha. Primero por 3, luego por 1 y luego 3.. y asi sucesivamente. Luego deberas sumar los resultados independientes y la suma obtenida dividirla por 10.

ej:

codigo : 7 8 0 2 1 3 4 5 6 7 8 0
multiplicar: 3 1 3 1 3 1 3 1 3 1 3 1
resultado :21 +8+ 0 +2 +3 + 3 ... etc

Digito verificador = resultado div 10.

Saludos
Jose Miguel B.

josejm 15-09-2006 00:07:29

Aqui esta todo el codigo
 
Aqui tienen todo el codigo de la unit, no es muy complejo sacar algo de aqui. Este formulario genera una imagen con el codigo de barras.
Código Delphi [-]unit untgenerarcodigo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
const
EAN_izqA : array[0..9] of
PChar=('0001101','0011001','0010011','0111101','0100011','0110001','0101111','0111011','0110111','00 01011');
EAN_izqB : array[0..9] of
PChar=('0100111','0110011','0011011','0100001','0011101','0111001','0000101','0010001','0001001','00 10111');
EAN_dcha : array[0..9] of
PChar=('1110010','1100110','1101100','1000010','1011100','1001110','1010000','1000100','1001000','11 10100');
CodificaIzq : array[0..9] of
PChar=('AAAAA','ABABB','ABBAB','ABBBA','BAABB','BBAAB','BBBAA','BABAB','BABBA','BBABA');
type
Tfrmgenerarcodigo = class(TForm)
Grafico: TImage;
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
// procedimiento que codifica el número en un nº binario
procedure Codifica(num : string);
// procedimiento para dibujar el cód. de barras a partir del nº binario
procedure Dibujar(matrix : string);
// procedimiento para validar-corregir los códigos
procedure EANCorrecto(var num : string);
end;
var
frmgenerarcodigo: Tfrmgenerarcodigo;
implementation
{$R *.dfm}
procedure Tfrmgenerarcodigo.EANCorrecto(var num : string);
var
i,N : byte;
sum : integer;
flag : byte;
begin
sum:=0;
N:=Length(num)-1;
for i:=1 to N do
begin
if (i mod 2)=0 then
begin
if N=12 then
sum:=sum+StrToInt(num[i])*3
else
sum:=sum+StrToInt(num[i]);
end
else
begin
if N=12 then
sum:=sum+StrToInt(num[i])
else
sum:=sum+StrToInt(num[i])*3;
end;
end;
if sum>99 then
Flag:=10-(sum mod 100)
else
Flag:=10-(sum mod 10);
if Flag=10 then Flag:=0;
if not(StrToInt(num[N+1])=flag) then
begin
// ShowMessage('El dígito de control no es válido y será cambiado'+#13+
// 'El dígito correcto es '+IntToStr(Flag));
num:=copy(num,1,length(num)-1)+IntToStr(Flag);
end;
end;

procedure Tfrmgenerarcodigo.Codifica(num : string);
var
matrix : string;
i : integer;
begin
num:=Edit1.Text;
matrix:='';
case Length(num) of
13: begin
EANCorrecto(num);
Edit1.Text:=num;
matrix:=matrix+'x0x'; // barra inicio
matrix:=matrix+EAN_izqA[StrToInt(num[2])];
for i:=3 to 7 do
if CodificaIzq[StrToInt(num[1])][i-3]='A' then
matrix:=matrix+EAN_izqA[StrToInt(num[i])]
else
matrix:=matrix+EAN_izqB[StrToInt(num[i])];
matrix:=matrix+'0x0x0'; // barra central
matrix:=matrix+EAN_dcha[StrToInt(num[8])];
matrix:=matrix+EAN_dcha[StrToInt(num[9])];
matrix:=matrix+EAN_dcha[StrToInt(num[10])];
matrix:=matrix+EAN_dcha[StrToInt(num[11])];
matrix:=matrix+EAN_dcha[StrToInt(num[12])];
matrix:=matrix+EAN_dcha[StrToInt(num[13])];
matrix:=matrix+'x0x'; // barra final
Dibujar(Matrix);
end;
8: begin
EANCorrecto(num);
Edit1.Text:=num;
matrix:=matrix+'x0x';
matrix:=matrix+EAN_izqA[StrToInt(num[1])];
matrix:=matrix+EAN_izqA[StrToInt(num[2])];
matrix:=matrix+EAN_izqA[StrToInt(num[3])];
matrix:=matrix+EAN_izqA[StrToInt(num[4])];
matrix:=matrix+'0x0x0';
matrix:=matrix+EAN_dcha[StrToInt(num[5])];
matrix:=matrix+EAN_dcha[StrToInt(num[6])];
matrix:=matrix+EAN_dcha[StrToInt(num[7])];
matrix:=matrix+EAN_dcha[StrToInt(num[8])];
matrix:=matrix+'x0x';
Dibujar(Matrix);
end
else
// ShowMessage('LONGITUD DE CODIGO NO VALIDA CODIGO:'+Edit1.Text);
Grafico.Canvas.Brush.Color:=clWhite;
Grafico.Canvas.FillRect(Rect(0,0,Grafico.Width,Grafico.Height));
Grafico.Canvas.Pen.Color:=clBlack;
end;
end;
procedure Tfrmgenerarcodigo.Dibujar(matrix : string);
var
i : integer;
begin
Grafico.Canvas.Brush.Color:=clWhite;
Grafico.Canvas.FillRect(Rect(0,0,Grafico.Width,Grafico.Height));
Grafico.Canvas.Pen.Color:=clBlack;
for i:=1 to Length(Matrix) do
if matrix[i]='1' then
Grafico.Canvas.PolyLine([Point(10+i,10),Point(10+i,50)])
else
if matrix[i]='x' then
Grafico.Canvas.PolyLine([Point(10+i,10),Point(10+i,55)]);
if Length(Edit1.Text)=13 then
begin
Grafico.Canvas.TextOut(3,50,Edit1.Text[1]); Grafico.Canvas.TextOut(17,50,copy(Edit1.Text,2,6));
Grafico.Canvas.TextOut(63,50,copy(Edit1.Text,8,6));
end
else
if Length(Edit1.Text)=8 then
begin
Grafico.Canvas.TextOut(16,50,copy(Edit1.Text,1,4));
Grafico.Canvas.TextOut(48,50,copy(Edit1.Text,5,4));
end;
end;
procedure Tfrmgenerarcodigo.Button1Click(Sender: TObject);
begin
Codifica(Edit1.Text);
end;
end.


La franja horaria es GMT +2. Ahora son las 04:54:29.

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