1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
|
procedure TForm1.Button1Click(Sender: TObject);
Var ImgBmp :TBitmap;
CouleurMax : TColor;
Ix : Integer;
StrBin, StrBinary : String;
NbrPixel : Integer;
LargCalc, CalcErr, MesureErr : Byte;
StrBinMes, Str0 : String;
NbrDeLigne : Integer;
//Pour memoir le Code barre est composé de 95 lignes
begin
ImgBmp := TBitmap.Create;
CouleurMax := 8224125; //RGB 32,32,32 C := R * 65536 + G * 256 + B; ou C := R shl 16 + G shl 8 + B; C(Word) RGB (Byte)
StrBin := '';
NbrDeLigne := 95; //95 pour un EAN-13
//66 pour un Ean-8
ImgBmp.PixelFormat := Pf24Bit;
ImgBmp.Width := ImgCodeB.Width;
ImgBmp.Height := 1; //On garde juste 1 pixel de haut
ImgBmp.Canvas.Draw(0,-(ImgCodeB.Height Div 2),ImgCodeB.Picture.Graphic);
Image1.Picture.Bitmap := ImgBmp; //juste pour voir le resultat
//On recherche les bornes de debut et de fin
For Ix := 1 To ImgBmp.Width Do
begin
If (GetPixel(Image1.Canvas.Handle ,Ix,0) < CouleurMax) Then //Point "noir"
StrBin := StrBin + '1'
Else
begin
If StrBin <> '' Then StrBin := StrBin + '0';
end;
end;
//On libert l'image devenue inutile
ImgBmp.Free;
//On supprime tout ce qui n'est pas 1 en fin de serie (image non noir)
While Rightstr(StrBin,1) <> '1' Do StrBin := LeftStr(StrBin,Length(StrBin)-1);
//On calcule la largeur d'un trait
//le Code barre est composé de 95 lignes a ce que j'ai pu en voir, du moins pour la norme EAN-13
NbrPixel := length(StrBin);
LargCalc := NbrPixel Div NbrDeLigne;
//On peut egalement calculer l'erreur qui existe
CalcErr := NbrPixel Mod NbrDeLigne; //CalcErr contient le nombre de pixel en trop
//On lit le nombre de pixel de couleur identique a la suite
StrBinary := '';
repeat
Str0 := LeftStr(StrBin,1); //Couleur du 1er de la serie
If Str0 = '0' Then
Ix := Pos('1',StrBin)
Else
Ix := Pos('0',StrBin);
//On sumul d'avoir trouver une lettre supplementaire a la fin de la chaine
If Ix = 0 Then Ix := Length(StrBin)+1;
Str0 := LeftStr(StrBin,Ix - 1);
//Str0 contient une serie de 0 ou de 1.
//On div pour optenir le nombre de Bits "rééls" sans tenir
// comptedes erreurs du a la resolution du scan
StrBinary := StrBinary + DupeString(leftStr(Str0,1),Length(Str0) div LargCalc);
//On peut egalement conptabilisé l'erreur "corrigée"
Inc(MesureErr,Length(Str0) Mod LargCalc);
//On reduit StrBin en supprimant la partie qui vient d'etre traitée
StrBin := RightStr(StrBin,Length(StrBin)-Length(Str0));
Until StrBin = '';
If CalcErr = MesureErr Then
begin
//On a bien eu le nombre de pixel en trop prevu
end
Else
begin
//Il y a un delta entre la correction effective et celle prevu!
end;
Edit2.Text := StrBinary; //Juste pour voir
//Maintenant il faut traiter la chaine StrBinary
//Elle contient le code binaire du CodeBarre
//Voir ce lien .. ou d'autres au choix pour le decryptage
//http://www.gomaro.ch/Specifications/EAN13.htm
//Le meme principe peut etre fait pour les autre type de code barre
//la partie lecture graphique etant la meme seule le nbrDeLigne changera
//et bien sur le traitement qui reste a faire qui lui aussi dependra du type
//de code barre lut
end; |
Partager