Application-defined exception/ Besoin d'aide svp

**Sebss2** · 23/01/2013, 19h29

Bonjour,
Je suis débutant sur delphi et je code en pascal.

Dans un pixel il y a 16,7millions et quelques de couleurs. Mais je dispose de 16 couleurs.
Je m'arrache actuellement les cheveux sur un programme qui a pour but de lire chaque pixel d'une image1 et de ramener dans l'image2 la couleur parmi les 16 dont je dispose qui se rapproche le plus de la couleur de l'image 1.

J'ai finis de coder mais le programme me sors cette erreur: 'application-defined exception (code 0xc00000fd) at 0x7472e284' quand je clique sur le bouton qui execute ce code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
101
102
Function ColorToR (pix:Tcolor):Tcolor;
begin
Result:=(pix)and($000000FF);
end;

Function ColortoV (pix:Tcolor):tcolor;
begin
result:=(pix)and($0000FF00);
end;

Function ColortoB (pix:Tcolor):Tcolor;
begin
result:=(pix)and($00FF0000);
end;

type
  Tretenu = array[1..16] of Tcolor;
  Tselectrouge= array[1..16] of Tcolor;
  Tselectvert= array[1..16] of Tcolor;
  Tselectbleu= array[1..16] of Tcolor;
  Tpix = array[1..16] of Tcolor;

var
x,y,p1,p2,p3,ok:integer;
a,b:extended;
marge:integer;
compteur:integer;
selectr: Tselectrouge;
selectb: Tselectbleu;
selectv: Tselectvert;
retenu: Tretenu;
pix: Tpix;

begin
  pix[1]:=blanc.Canvas.Pixels[1,1];
  pix[2]:=grisclair.Canvas.Pixels[1,1];
  pix[3]:=grisfonce.Canvas.Pixels[1,1];
  pix[4]:=noir.Canvas.Pixels[1,1];
  pix[5]:=bleu.Canvas.Pixels[1,1];
  pix[6]:=bleuclair.Canvas.Pixels[1,1];
  pix[7]:=bleufonce.Canvas.Pixels[1,1];
  pix[8]:=vertclair.Canvas.Pixels[1,1];
  pix[9]:=vertfonce.Canvas.Pixels[1,1];
  pix[10]:=violet.Canvas.Pixels[1,1];
  pix[11]:=violetclair.Canvas.Pixels[1,1];
  pix[12]:=rose.Canvas.Pixels[1,1];
  pix[13]:=orange.Canvas.Pixels[1,1];
  pix[14]:=jaune.Canvas.Pixels[1,1];
  pix[15]:=rouge.Canvas.Pixels[1,1];
  pix[16]:=marron.Canvas.Pixels[1,1];
  marge:=127;
  compteur:=0;
  ok:=0;
  For x:=1 to 500 do
  begin
    For y:=1 to 250 do
    begin
      while ok=0 do
      begin                                            {selections des pix qui ont le même niveau de rouge que le pixel[x,y] de l'image1 à une marge près}
      a:=integer(colortor(image1.Canvas.Pixels[x,y]))+marge;
      b:=integer(colortor(image1.Canvas.Pixels[x,y]))-marge;
      If b<0 then b:=0;
      If a>255 then a:=255;
      For p1:=1 to 16 do
        begin
          If (integer(colortor(pix[p1]))<a) and (integer(colortor(pix[p1]))>b) then selectr[p1]:=pix[p1];
        end;
      a:=integer(colortov(image1.Canvas.Pixels[x,y]))+(marge*256);          {selections des pix qui ont le même niveau de vert que le pixel[x,y] de l'image1 à une marge près}
      b:=integer(colortov(image1.Canvas.Pixels[x,y]))-(marge*256);
      If b<256 then b:=256;
      If a>65280 then a:=65280;
      For p2:=1 to 16 do
        begin
          If (integer(colortov(pix[p2]))<a) and (integer(colortov(pix[p2]))>b) then selectv[p2]:=pix[p2];
        end;
      a:=integer(colortob(image1.Canvas.Pixels[x,y]))+(marge*65536);         {selections des pix qui ont le même niveau de bleu que le pixel[x,y] de l'image1 à une marge près}
      b:=integer(colortob(image1.Canvas.Pixels[x,y]))-(marge*65536);
      If b<65536 then b:=65536;
      If a>16711680 then a:=16711680;
      For p3:=1 to 16 do
        begin
          If (integer(colortob(pix[p3]))<a) and (integer(colortob(pix[p3]))>b) then selectb[p3]:=pix[p3];
        end;
      For p1:=1 to 16 do      {on ne retient que les pix qui ont été sélectionné dans les trois niveaux, rouge vert et bleu}
      begin
        For p2:=1 to 16 do
        begin
          For p3:=1 to 16 do
          begin
          If (selectr[p1]=selectv[p2]) and (selectr[p1]=selectb[p3]) then
            begin
              compteur:=compteur+1;
              retenu[compteur]:=selectr[p1];
            end;
          end;
        end;
      end;
      If compteur=1 then ok:=1 else marge:=marge-1;     { Tant qu'il ne reste pas plus qu'un pix, on recommence en diminuant la marge}      end;
      image2.Canvas.pixels[x,y]:=retenu[1];
    end;
  end;
end;

Je cherche de l'aide. Svp. Merci.

**Linkin** · 24/01/2013, 10h46

En mode à pas pas, as-tu trouvé la ligne d'erreur?

Toutes les variables sont-elles bien initialisées?

PS: plutôt qu'utiliser des conversions en entier et les fonctions maison, j'opterais plutôt pour GetRValue(Color),GetGValue(Color),GetBValue(Color)

Edit: orthographe

**Andnotor** · 24/01/2013, 11h40

Si l'image fait 500 pixels de large, la boucle doit aller de 0 à 499. Idem pour la hauteur.

**Sebss2** · 24/01/2013, 12h27

Merci pour vos réponses,

Le mode pas-à-pas sors directement l'erreur 'application-defined exception' sans indiquer de ligne de code, idem pour le mode pas-à-pas approfondi. C'est assez bizarre.

Les variables sont bien initialisées.

Etes vous sur que la boucle doit aller de 0 à 499 pour les pixels d'une image? J'ai déjà manipulé des images en partant toujours de 1 pour mes boucles et je n'ai jamais rencontré de problème à ce niveau là.

**Andnotor** · 24/01/2013, 12h43

Envoyé par Sebss2

Etes vous sur que la boucle doit aller de 0 à 499 pour les pixels d'une image?

Certain

Pour t'en convaincre, dans l'événement OnPaint de ta fiche, colore ce pixel et tu verra que tu es à 1 pixel des bords.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Pixels[1,1] := clRed;
end;

Est-ce que Image1 est bien chargé avec un bitmap ? Les autres formats ne seront pas supportés.
Et Image2 ?

**Sebss2** · 24/01/2013, 18h00

Oui les images sont bien toutes les deux en bitmap. Je vais changer mes boucles pour les faire partir de 0 et je regarde si le pb est résolu.

**Sebss2** · 24/01/2013, 18h09

Non cela ne fonctionne toujours pas, voici un screen de l'erreur:

**Andnotor** · 24/01/2013, 18h31

Où est ce code ? Dans l'exe ou dans une DLL ?

**Sebss2** · 24/01/2013, 22h23

J'ai bien peur de ne pas comprendre votre question.
C'est une application avec une seule form, il y a trois boutons. Le code que j'ai posté est dans la procedure Onclick d'un des boutons.

Je vous remercie beaucoup de continuer à m'aider et pour vos réponses rapides.

**Dr.Who** · 25/01/2013, 01h32

N'utilise pas Pixel mais Scanline !

Astuce magique pour mapper une couleur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
type
  PRGB = ^TRGB;
  TRGB = packed record
    case byte of
      0:(Color: Integer);
      1:(R,G,B: byte);
  end;
  TRGBRow = array[0..0] of TRGB;
  PRGBRow = ^TRGBRow;

PRGBRow s'utilise avec Scanline.

voici un exemple pour une couleur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
type
  PRGB = ^TRGB;
  TRGB = packed record
    case byte of
      0:(Color: Integer);
      1:(R,G,B: byte);
  end;
 
function RGBCompare(A, B: TRGB; const Tolerance: single = 0.02): boolean;
var dR, dG, dB, T_max, T_min: single;
begin
  T_max := 1+Tolerance;
  T_min := 1-Tolerance;
  dR    := A.R/B.R;
  dG    := A.G/B.G;
  dB    := A.B/B.B;
  result := ((dR >= T_min) and (dR <= T_max)) and
            ((dG >= T_min) and (dG <= T_max)) and
            ((dB >= T_min) and (dB <= T_max));
end;
 
procedure TForm15.FormCreate(Sender: TObject);
var A,B,C,D: TRGB;
begin
  A.Color := $98593b;
  B.Color := $442299;
  C.Color := $98503f;
  D.Color := $97583c;
  Shape1.Brush.Color := A.Color;
  Shape2.Brush.Color := B.Color;
  Shape3.Brush.Color := C.Color;
  Shape4.Brush.Color := D.Color;
  Label2.Caption     := boolToStr(RGBCompare(A, B) ,true);
  Label3.Caption     := boolToStr(RGBCompare(A, C) ,true);
  Label4.Caption     := boolToStr(RGBCompare(A, D) ,true);
end;

tu notera que seule C et D sont "proche" de A, mais seul D est à moins de 2% d'écart de A, bien que C soit un peu moins dans les vert, visuellement on ne note pas la différence entre A et D, mais entre A et C oui. B est totalement différent de A.

et pour compter les couleurs proches de 1 ou plusieurs autres dans une image :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
type
  TCounter = array of integer;
 
function CountColorInPic(aBitmap: TBitmap; aColors: array of TRGB): TCounter;
var P : PRGBRow;
    Y, X, N, L: integer;
begin
  aBitmap.PixelFormat := pf32bit;
  L := Length(aColors);
  setLength(result, L);
  for N := 0 to L- 1 do
    result[N] := 0;
 
  for Y := 0 to aBitmap.Height - 1 do
  begin
    P := aBitmap.ScanLine[Y];
    for X := 0 to aBitmap.Width - 1 do
      for N := 0 to L - 1 do
        if RGBCompare(P^[X], aColors[N]) then
          inc(result[N]);
  end;
end;
 
function CountColorInCanvas(aCanvas: TCanvas; aColors: array of TRGB): TCounter;
var bmp : TBitmap;
begin
  bmp := TBitmap.Create;
  try
    bmp.Width := aCanvas.ClipRect.Right-aCanvas.ClipRect.Left;
    bmp.Height:= aCanvas.ClipRect.Bottom-aCanvas.ClipRect.Top;
    bmp.PixelFormat := pf32bit;
    aCanvas.CopyRect(bmp.Canvas.ClipRect, bmp.Canvas, aCanvas.ClipRect);
 
    result := CountColorInPic(bmp, aColors);
  finally
    bmp.Free;
  end;
end;

**Sebss2** · 25/01/2013, 11h25

Merci pour votre réponse,

Tout ça est bien loin de mon niveau. J'ai compris que la moitié de votre code et même avec l'aide de delphi j'ai du mal. Je vais continuer de chercher à comprendre.

A tout hasard savez vous pourquoi j'obtiens l'erreur postée plus haut avec mon code?

**Linkin** · 25/01/2013, 16h17

Le problème est sur le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
                retenu[compteur] := selectr[p1];

Compteur est incrémenté et dépasse la taille du tableau.
De plus tu n'utilises que la première valeur dans ton code.

Si tu n veux pas avoir de couleur personnalisée, tu peux laisser le bitmap faire le travail à ta place:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
var
  lBitmap: TBitmap;
begin
  lBitmap := TBitmap.Create;
  lBitmap.Assign(ImageSrc.Picture.Graphic);
  lBitmap.PixelFormat := pf4bit;
  Image2.Picture.Assign(lBitmap);
  lBitmap.free;
end;

**Linkin** · 25/01/2013, 16h43

J'ai essayé de simplifier ton code pour s'y retrouver plus facilement (je n'ai pas vraiment testé la validité du résultat):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
type
  Tpix = array [1 .. 16] of Tcolor;
  TpixCompare = array [1 .. 16] of boolean;
 
procedure TForm8.Button1Click(Sender: TObject);
var
  x, y: integer;
  pix: Tpix;
var
  lBitmap: TBitmap;
begin
  lBitmap := TBitmap.Create;
  lBitmap.Assign(ImageSrc.Picture.Graphic);
 
  pix[1] := clWhite;
  pix[2] := clLtGray;
  pix[3] := clDkGray;
  pix[4] := clBlack;
  pix[5] := clBlue;
  pix[6] := TColors.Lightblue;
  pix[7] := TColors.Darkblue;
  pix[8] := TColors.Lightgreen;
  pix[9] := TColors.Darkgreen;
  pix[10] := clPurple;
  pix[11] := TColors.Blueviolet;;
  pix[12] := TColors.Pink;
  pix[13] := TColors.Orange;
  pix[14] := clYellow;
  pix[15] := clRed;
  pix[16] := clMaroon;
  Image2.Picture.Assign(ImageSrc.Picture);
  For x := 0 to lBitmap.Width - 1 do
  begin
    For y := 0 to lBitmap.Height - 1 do
    begin
      lBitmap.Canvas.Pixels[x, y] :=
        getNearestColor(pix, lBitmap.Canvas.Pixels[x, y]);
    end;
  end;
  Image2.Picture.Assign(lBitmap);
  lBitmap.free;
end;
 
function TForm8.getColorMargin(pColorComponent: Byte; pMargin: integer): Byte;
begin
  if pMargin + pColorComponent > 255 then
    Result := 255
  else if pMargin + pColorComponent < 0 then
    Result := 0
  else
    Result := pColorComponent + pMargin;
end;
 
function TForm8.getNearestColor(pColorList: Tpix; pColor: Tcolor): Tcolor;
var
  i: integer;
  ok: boolean;
  marge: integer;
begin
  marge := 127;
  result:= clBlack;
  ok := false;
  while (not ok) do
  begin
    if marge < 0 then
    begin
      ok:=true;
      result:= clBlack;
    end
    else
    begin
      For i := Low(pColorList) to High(pColorList) do
      begin
      { selections des pix qui ont le même niveau de rouge que le pixel[x,y] de l'image1 à une marge près }
        If (GetGValue(pColorList[i]) < getColorMargin(GetGValue(pColor),  marge)) and
           (GetGValue(pColorList[i]) > getColorMargin(GetGValue(pColor), -marge)) and
      { selections des pix qui ont le même niveau de vert que le pixel[x,y] de l'image1 à une marge près }
            (GetRValue(pColorList[i]) < getColorMargin(GetRValue(pColor),  marge)) and
            (GetRValue(pColorList[i]) > getColorMargin(GetRValue(pColor), -marge)) and
      { selections des pix qui ont le même niveau de bleu que le pixel[x,y] de l'image1 à une marge près }
            (GetBValue(pColorList[i]) < getColorMargin(GetBValue(pColor),  marge)) and
            (GetBValue(pColorList[i]) > getColorMargin(GetBValue(pColor), -marge)) then
        begin
          Result := pColorList[i];
          ok := true;
        end;
      end;
    { Tant qu'il ne reste pas plus qu'un pix, on recommence en diminuant la marge }
      marge := marge - 1;
    end;
  end;
end;

Mais pour un traitement plus rapide il faut passer par Scanline, comme indiqué précedemment.

**Sebss2** · 25/01/2013, 19h01

Merci beaucoup, je vais tester tout ça. Si ça marche j'indiquerai que la discussion est résolue. Je vais aussi me pencher de plus près sur scanline.

Application-defined exception/ Besoin d'aide svp

Langage Delphi

Discussions similaires

Partager

Partager