Fabrício, Gostei do seu código de barras, mas estou com um problema: Uso o qr406 pro, ele exibe o código de barras no qrimage, mas na hora de imprimir não sai nada.
Já viu isso acontecer? Sabe como resolver? Obrigado. Levi -----Mensagem original----- De: delphi-br@yahoogrupos.com.br [mailto:[EMAIL PROTECTED] Em nome de Fabrício Pinheiro França Enviada em: terça-feira, 8 de novembro de 2005 21:51 Para: delphi-br@yahoogrupos.com.br Assunto: Re: [delphi-br] Código de Barras 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: delphi-br@yahoogrupos.com.br 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 >>>>> Links do Yahoo! Grupos _______________________________________________________ Yahoo! Acesso Grátis: Internet rápida e grátis. Instale o discador agora! http://br.acesso.yahoo.com/ -- <<<<< 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
