FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
|
#1
|
|||
|
|||
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. |
#2
|
|||
|
|||
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. Última edición por josejm fecha: 15-09-2006 a las 00:09:58. |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
Capturar eventos en un directorio (antes para poder evitarlos ) | Wonni | API de Windows | 6 | 17-07-2006 19:48:58 |
busqueda general | majosf | Conexión con bases de datos | 1 | 21-09-2005 11:20:54 |
Requisitos para poder vender un software?? | burasu | Debates | 20 | 18-12-2004 23:52:39 |
General SQL Error | ander | SQL | 3 | 09-09-2004 16:05:07 |
que usar o como para poder imprimir? | mrmanuel | Impresión | 4 | 30-03-2004 09:20:31 |
|