Tem dois tipos de funções que eu tenho. Para gerar código I25 e EAN13. As duas
utilizam um componente imagem
Procedure I25CriaCodBarra(Cod : String; Imagem : TCanvas);
Const
digitos : array['0'..'9'] of string[5]= ('00110', '10001',
'01001', '11000',
'00101', '10100',
'01100', '00011',
'10010', '01010');
Var
Numero : String;
Cod1 : Array[1..1000] Of Char;
Cod2 : Array[1..1000] Of Char;
Codigo : Array[1..1000] Of Char;
Digito : String;
c1,c2 : Integer;
x,y,z,h : LongInt;
a,b,c,d : TPoint;
I : Boolean;
Begin
Numero := Cod;
For x := 1 to 1000 Do
Begin
Cod1 [x] := #0;
Cod2 [x] := #0;
Codigo[x] := #0;
End
;
c1 := 1;
c2 := 1;
x := 1;
For y := 1 to Length(Numero) div 2 do
Begin
Digito := Digitos[Numero[x ]];
For z := 1 to 5 do
Begin
Cod1[c1] := Digito[z];
Inc(c1);
End
;
Digito := Digitos[Numero[x+1]];
For z := 1 to 5 do
Begin
Cod2[c2] := Digito[z];
Inc(c2);
End
;
Inc(x,2);
End
;
y := 5;
Codigo[1] := '0';
Codigo[2] := '0';
Codigo[3] := '0';
Codigo[4] := '0'; { Inicio do Codigo }
For x := 1 to c1-1 do
begin
Codigo[y] := Cod1[x]; Inc(y);
Codigo[y] := Cod2[x]; Inc(y);
end
;
Codigo[y] := '1'; Inc(y); { Final do Codigo }
Codigo[y] := '0'; Inc(y);
Codigo[y] := '0';
Imagem.Pen .Width := 1;
Imagem.Brush.Color := ClWhite;
Imagem.Pen .Color := ClWhite;
a.x := 1; a.y := 0;
b.x := 1; b.y := 79;
c.x := 2000; c.y := 79;
d.x := 2000; d.y := 0;
Imagem.Polygon([a,b,c,d]);
Imagem.Brush.Color := ClBlack;
Imagem.Pen .Color := ClBlack;
x := 0;
i := True;
for y:=1 to 1000 do
begin
If Codigo[y] <> #0 Then
Begin
If Codigo[y] = '0' then
h := 1
Else
h := 3
;
a.x := x; a.y := 0;
b.x := x; b.y := 79;
c.x := x+h-1; c.y := 79;
d.x := x+h-1; d.y := 0;
If i Then Imagem.Polygon([a,b,c,d]);
i := Not(i);
x := x + h;
End
;
end
;
end;
Function EAN13Calculadv(codigo:string):string;
var
i,sp,si,d,dv:word;
s:single;
begin
if length(codigo)>12 then codigo:=copy(codigo,1,12);
sp:=0;
si:=0;
for i:=1 to length(codigo) do
begin
d:=strtoint( copy(codigo,i,1) );
if odd(length(codigo)+1-i) then si:=si+d*7 else sp:=sp+d*9;
end
;
s:=(sp+si)/10;
dv:=Trunc(10*frac(s));
if codigo='' then
EAN13Calculadv := ''
else
EAN13Calculadv := codigo+inttostr(dv)
;
end;
procedure EAN13DesenhaBarras(SequenciaHexa: string; Imagem: TCanvas);
var
X, Y, H: LongInt;
A, B, C, D: TPoint;
I: Boolean;
begin
Imagem.Brush.Color := ClWhite;
Imagem.Pen.Color := ClBlack;
x := 10;
i := True;
for y := 1 to Length(SequenciaHexa) do
begin
if SequenciaHexa[y] = '0' then
Imagem.Pen.Color := ClWhite
else
Imagem.Pen.Color := ClBlack
;
h := 1;
a.x := x;
a.y := 0;
b.x := x;
b.y := 50;
c.x := x + h - 1;
c.y := 50;
d.x := x + h - 1;
d.y := 0;
case Y of
1..3, 46..50, 93..95:
begin
b.y := 55;
c.y := 55;
end
;
end;
Imagem.Polygon([A, B, C, D]);
i := not (i);
x := x + h;
end
;
end;
procedure EAN13CriaCodBarra(CodBarras: string; Imagem: TCanvas);
const
TabelaA: array[0..9] of string[7] = ('0001101', '0011001',
'0010011', '0111101',
'0100011', '0110001',
'0101111', '0111011',
'0110111', '0001011');
TabelaB: array[0..9] of string[7] = ('0100111', '0110011',
'0011011', '0011011',
'0011101', '0111001',
'0000101', '0010001',
'0001001', '0010111');
TabelaC: array[0..9] of string[7] = ('1110010', '1100110',
'1101100', '1000010',
'1011100', '1001110',
'1010000', '1000100',
'1001000', '1110100');
TabAux: array[0..9] of string[6] = ('AAAAAA', 'AABABB',
'AABBAB', 'AABBBA',
'ABAABB', 'ABBAAB',
'ABBBAA', 'ABABAB',
'ABABBA', 'ABBABA');
var
Codigo: string;
Formato: string;
PegaDaTabela: string;
DecimoTerceiroDig: Byte;
Cont: Byte;
begin
CodBarras := '7' + EAN13Calculadv(CodBarras);
Formato := '';
Codigo := CodBarras;
DecimoTerceiroDig := StrToIntDef(CodBarras[1], 0);
{----------------------------------------------------------------------------}
{ Tendo o 13º dígito definido, posso definir o padrão de impressão das barras}
{ no primeiro conjunto de 6 dígitos baseado na tabela Auxiliar. }
{----------------------------------------------------------------------------}
PegaDaTabela := TabAux[DecimoTerceiroDig] + 'CCCCCC';
Formato := Formato + '101'; //--> Barra Auxiliar de Guarda 'Esquerda'
for Cont := 1 to Length(PegaDaTabela) do
begin
case PegaDaTabela[Cont] of
'A': Formato := Formato + TabelaA[StrToInt(Codigo[Cont + 1])];
'B': Formato := Formato + TabelaB[StrToInt(Codigo[Cont + 1])];
'C': Formato := Formato + TabelaC[StrToInt(Codigo[Cont + 1])];
end;
if Cont = 6 then
Formato := Formato + '01010' //--> Barra Auxiliar de Guarda 'Central'
;
end
;
Formato := Formato + '101'; //--> Barra Auxiliar de Guarda 'Direita'
//------ Desenha o código alfa-numérico na imagem
Imagem.Font.Size := 10;
Imagem.Brush.Color := ClWhite;
Imagem.Pen.Color := ClBlack;
Imagem.TextOut(02, 51, Copy(CodBarras, 01, 01));
Imagem.TextOut(13, 51, Copy(CodBarras, 02, 06));
Imagem.TextOut(60, 51, Copy(CodBarras, 08, 06));
//------ Desenha as barras na imagem
EAN13DesenhaBarras(Formato, Imagem);
end;
Espero ter ajudado
Fabrício Pinheiro França
----- Original Message -----
From: fmansi2001
To: [email protected]
Sent: Tuesday, November 08, 2005 12:02 PM
Subject: [delphi-br] Código de Barras
Galera;
Estou precisando de um componente ou função que gere códigos de barras
em Delphi/Kylix para impressões em modo texto. Ex.: Nota Fiscal
Alguém sabe me informar onde posso encontrar, já procurei na net e não
achei só encontrei para modo gráfico.
Obrigado
Francisco Mansi
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Yahoo! Grupos, um serviço oferecido por:
PUBLICIDADE
------------------------------------------------------------------------------
Links do Yahoo! Grupos
a.. Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
b.. Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
c.. O uso que você faz do Yahoo! Grupos está sujeito aos Termos do Serviço
do Yahoo!.
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
