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.