Discussion :

[Charly910]

Bonjour,

j'affiche un Jpeg dans un TImage et j'essaye d’éclaircir l'image avec la fonction Eclaircir trouvée sur Phidels.com :

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
{ ========================================================================== }
type
  TRGBArray = ARRAY[0..0] OF TRGBTriple; // élément de bitmap (API windows)
  pRGBArray = ^TRGBArray; // type pointeur vers tableau 3 octets 24 bits
 
Procedure TF_Image2.Eclaircir(Var Bmp1 :TBitMap) ;
var
  x, y : integer;   // colonnes, lignes
  Row : Prgbarray;  // pointeur scanline
  R,G,B : integer;  // les 3 couleurs
begin
  For y := 0 to bmp1.height-1 do   // attention au -1
  begin
    row := Bmp1.scanline[y];      // scanline
    for x := 0 to bmp1.width-1 do // attention au -1
    begin
      R := (Row[x].rgbTred * 10) div 100;
      G := (Row[x].rgbTgreen * 10) div 100;
      B := (Row[x].rgbTblue * 10) div 100;
      if R > 255 then R := 255 else if R < 0 then R := 0;
      if G > 255 then G := 255 else if G < 0 then G := 0;
      if B > 255 then B := 255 else if B < 0 then B := 0;
      row[x].rgbtred := R;
      row[x].rgbtgreen := G;
      row[x].rgbtblue := B;
    end;
  end;
end;
{ ========================================================================== }
procedure TF_Image2.Btn_EclaircirClick(Sender: TObject);
Var
  B : TBitmap ;
Begin
  B := TBitmap.Create;
  B.PixelFormat := pf32bit ;
  B.Assign(Image1.Picture.Bitmap);
  Eclaircir(B) ;
  Image1.Picture.Bitmap := B;
  B.Free ;
End ;
{ ========================================================================== }

Au premier Clic sur le bouton Btn_Eclaircir rien ne se passe au second clic une partie de l'image devient noire.

Je dois mal appeler cette fonction ? j'ai aussi essayé avec image1.Picture.Graphic sans succès.

Merci pour votre aide

A+
Charly

PS : je peux zipper l'appli qui utilise ce code si besoin ...

[ALWEBER]

Essaye avec un bmp

[Jipété]

Salut,

j'affiche un Jpeg dans un TImage et j'essaye d’éclaircir l'image avec la fonction Eclaircir trouvée sur Phidels.com :

T'aurais dû mettre le lien, parce que quand je vois ça,

Code :

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

1
2
3
      R := (Row[x].rgbTred * 10) div 100;
      G := (Row[x].rgbTgreen * 10) div 100;
      B := (Row[x].rgbTblue * 10) div 100;

je ne peux m'empêcher de simplifier -->

Code :

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

1
2
3
      R := Row[x].rgbTred   div 10;
      G := Row[x].rgbTgreen div 10;
      B := Row[x].rgbTblue  div 10;

et c'est bien ce que je constate dans un test rapide.

Au premier Clic sur le bouton Btn_Eclaircir rien ne se passe au second clic une partie de l'image devient noire.

T'es sûr ?

Mon test rapide a répondu au premier clic en fonçant l'image -- et on s'en doutait en voyant le code simplifié.

[Charly910]

Merci à vous deux,

@Alweber : oui, je pense qu'avec un btimap cela doit fonctionner, mais justement c'est un jpeg que je veux charger ...

@Jipété : je teste avec ta simplification. Voici le lien

A+
Charly

[Charly910]

Voici le code modifié, mais toujours le même problème

Image2.zip

A+
Charly

[Paul TOTH]

pour commencer j'inverserais ces deux lignes

Code :

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

1
2
3
 
  B.PixelFormat := pf32bit ;
  B.Assign(Image1.Picture.Bitmap)

car Assign() va remplacer le PixelFormat, et la fonction Eclaircir attend un bitmap 32Bits...s'il est en 24 ça ne fonctionne pas

[Charly910]

Merci Paul,

mais du coup, la partie noire apparait au premier clic ...

A+
Charly

[Jipété]

@Jipété : je teste avec ta simplification. Voici le lien

Merci.

En suivant le lien on constate que l'auteur a écrit ça :

Nous choisissons ici pf24bit à cause de sa compatibilité avec le format JPG

ce qui n'est pas dans ton code et risque de poser souci, mais Paul l'a déjà écrit (et je ne m'aventure pas trop, étant sous Linux et Lazarus).

Ceci étant, si tu pars d'un TImage.Picture.Bitmap, il s'agit d'un bitmap, issu de la conversion (transparente pour toi) de ton Jpeg en Bmp pour affichage.
Ça devrait fonctionner au premier clic, en assombrissement (peut-être que l'auteur s'est pris les doigts dans le clavier et a mélangé deux sujets ?)

Et pour l'éclaircir, tu peux tenter R := Row[x].rgbTred + 20; et pareil pour les deux autres couleurs, plus les tests en cas de dépassement de 255.

[Charly910]

ça y est , j'ai trouvé :

la modif de Paul est la bonne et le code mets tout les pixels en noir ! c'est normal

si on fait

Code :

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

1
2
3
      R := Round(Row[x].rgbTred   * 1.2);
      G := Round(Row[x].rgbTgreen * 1.2);
      B := Round(Row[x].rgbTblue  * 1.2);

ça éclairci bien l'image !

Merci à tous les trois

A+
Charly

[Cirec]

Bonjour,

j'arrive après la bataille
avec un code simplifié qui fait les deux (éclaircir ou assombrir)

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
procedure TF_Image2.Eclaircir2(var Bmp1: TBitMap; Percent: Integer);
  function Clamp(const aValue: Integer; const aMin, aMax: Integer): Integer;
  begin
    Result := aValue;
    if aValue > aMax then Result := aMax else if aValue < aMin then Result := aMin;
  end;
var
  X: Integer; //
  PStart: Cardinal; // Adresse de départ
  PLen: Integer; // Taille des données (Nombre de Pixels)
  aPercent: Extended;
begin
  if Bmp1.Empty then Exit;
  Bmp1.PixelFormat := pf32bit; // on s'assure d'avoir le bon format
  PLen := Bmp1.Width * Bmp1.Height;
  PStart := Cardinal(Bmp1.Scanline[Bmp1.Height - 1]);
  aPercent := Percent / 100 + 1;
  for X := 0 to PLen - 1 do
    with PRGBQuad(PStart)^ do
    begin
      rgbRed := Clamp(Round(rgbRed * aPercent), 0, 255);
      rgbBlue := Clamp(Round(rgbBlue * aPercent), 0, 255);
      rgbGreen := Clamp(Round(rgbGreen * aPercent), 0, 255);
      Inc(PStart, SizeOf(TRGBQuad));
    end;
end;

j'ai pas mis de limites à Percent mais je pense qu'elles se situent entre -50..50
Donnez une valeur positive à Percent et l'image sera éclaircie
ou une valeur négative pour l'assombrir

Cordialement,

@+

[Charly910]

Bonjour Cirec,

merci pour ta solution.

Au lieu de Clamp, tu peux directement utiliser Max(Min(aValue), aMax), aMin) ?

Sinon j'utilise celle ci qui ne marche pas mal pour éclaircir ou assombrir :

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
Procedure TF_Image2.Lightness(Var clip: TBitmap; Amount: Integer);
Var
  p0: pbytearray;
  r, g, b, x, y: Integer;
Begin
  For y := 0 To clip.Height - 1 Do
  Begin
    p0 := clip.scanline[y];
    For x := 0 To clip.Width - 1 Do
    Begin
      r := p0[x * 3];
      g := p0[x * 3 + 1];
      b := p0[x * 3 + 2];
      p0[x * 3] := Max(Min((r + ((255 - r) * Amount) Div 255), 255), 0);
      p0[x * 3 + 1] := Max(Min((g + ((255 - g) * Amount) Div 255), 255), 0);
      p0[x * 3 + 2] := Max(Min((b + ((255 - b) * Amount) Div 255), 255), 0);
    End;
  End;
End;

Je vais tester la tienne.

A+
Charly

[Charly910]

J'ai essayé :

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
{ ========================================================================== }
procedure TF_Image2.Btn_EclaircirClick(Sender: TObject);
Var
  B : TBitmap ;
Begin
  B := TBitmap.Create;
  B.Assign(Image1.Picture.Bitmap);
  B.PixelFormat := pf24bit ;
  Eclaircir2(B, 20);
  Image1.Picture.Bitmap := B;
  If Assigned(B) Then B.Free ;
  Lbl_Img.Caption := Format('Taille affichée : L = %d x H = %d pixels', [Image1.Width, Image1.Height]) ;
end;
{ ========================================================================== }
procedure TF_Image2.Eclaircir2(var Bmp1: TBitMap; Percent: Integer);
  function Clamp(const aValue: Integer; const aMin, aMax: Integer): Integer;
  begin
    Result := aValue;
    if aValue > aMax then Result := aMax else if aValue < aMin then Result := aMin;
  end;
var
  X: Integer; //
  PStart: Cardinal; // Adresse de départ
  PLen: Integer; // Taille des données (Nombre de Pixels)
  aPercent: Extended;
begin
  if Bmp1.Empty then Exit;
  PLen := Bmp1.Width * Bmp1.Height;
  PStart := Cardinal(Bmp1.Scanline[Bmp1.Height - 1]);
  aPercent := Percent / 100 + 1;
  for X := 0 to PLen - 1 do
    with PRGBQuad(PStart)^ do
    begin
      rgbRed := Clamp(Round(rgbRed * aPercent), 0, 255);
      rgbBlue := Clamp(Round(rgbBlue * aPercent), 0, 255);
      rgbGreen := Clamp(Round(rgbGreen * aPercent), 0, 255);
      Inc(PStart, SizeOf(TRGBQuad));
    end;
end;
{ ========================================================================== }

J'ai une violation d'accès sur la ligne

Code :

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

rgbRed := Clamp(Round(rgbRed * aPercent), 0, 255);

(ou la précédente ?)

A+
Charly

[Cirec]

J'ai essayé :

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
{ ========================================================================== }
procedure TF_Image2.Btn_EclaircirClick(Sender: TObject);
Var
  B : TBitmap ;
Begin
  B := TBitmap.Create;
  B.Assign(Image1.Picture.Bitmap);
  B.PixelFormat := pf24bit ;
  Eclaircir2(B, 20);
  Image1.Picture.Bitmap := B;
  If Assigned(B) Then B.Free ;
  Lbl_Img.Caption := Format('Taille affichée : L = %d x H = %d pixels', [Image1.Width, Image1.Height]) ;
end;
{ ========================================================================== }
procedure TF_Image2.Eclaircir2(var Bmp1: TBitMap; Percent: Integer);
  function Clamp(const aValue: Integer; const aMin, aMax: Integer): Integer;
  begin
    Result := aValue;
    if aValue > aMax then Result := aMax else if aValue < aMin then Result := aMin;
  end;
var
  X: Integer; //
  PStart: Cardinal; // Adresse de départ
  PLen: Integer; // Taille des données (Nombre de Pixels)
  aPercent: Extended;
begin
  if Bmp1.Empty then Exit;
  Bmp1.PixelFormat := pf32bit; // on s'assure d'avoir le bon format           {  <----------- ICI -----------------}
  PLen := Bmp1.Width * Bmp1.Height;
  PStart := Cardinal(Bmp1.Scanline[Bmp1.Height - 1]);
  aPercent := Percent / 100 + 1;
  for X := 0 to PLen - 1 do
    with PRGBQuad(PStart)^ do
    begin
      rgbRed := Clamp(Round(rgbRed * aPercent), 0, 255);
      rgbBlue := Clamp(Round(rgbBlue * aPercent), 0, 255);
      rgbGreen := Clamp(Round(rgbGreen * aPercent), 0, 255);
      Inc(PStart, SizeOf(TRGBQuad));
    end;
end;
{ ========================================================================== }

J'ai une violation d'accès sur la ligne

Code :

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

rgbRed := Clamp(Round(rgbRed * aPercent), 0, 255);

(ou la précédente ?)

A+
Charly

re,

la violation d'accès vient du fait que tu es en pf24Bit alors que le code
est prévu pour du pf32Bit. J'ai mis le code à jour il suffit d'ajouter cette ligne
Bmp1.PixelFormat := pf32bit; // on s'assure d'avoir le bon format en début de code

Code :

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

1
2
3
4
5
6
...
begin
  if Bmp1.Empty then Exit;
  Bmp1.PixelFormat := pf32bit; // on s'assure d'avoir le bon format           {  <----------- ICI -----------------}
  PLen := Bmp1.Width * Bmp1.Height;
...

Au lieu de Clamp, tu peux directement utiliser Max(Min(aValue), aMax), aMin) ?

oui je sais, il y avait aussi la fonction "EnsureRange" de l'unité Math mais j'aime bien rapatrier les fonctions
au plus près du code utilisé surtout en cas de nombreux appels, ce qui est le cas ici.
ce sont des habitudes pas certain que ça aide niveau rapidité d'exécution !!

j'ai pas encore testé la procedure Lightness(Var clip: TBitmap; Amount: Integer)
mais ce sera fait dans la soirée

Cordialement
@+

[Cirec]

re,

oui les résultats sont pas mal du tout, il faut juste donner une valeur plus grande
à "Amount" pour voir un résultat mais l'effet est bon

j'en ai profité pour en faire une version qui devrait être plus rapide:

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
procedure TF_Image2.Lightness(var Bmp1: TBitMap; Amount: Integer);
var
  X: Integer; //
  PStart: Cardinal; // Adresse de départ
  PLen: Integer; // Taille des données (Nombre de Pixels)
begin
  if Bmp1.Empty then Exit;
  Bmp1.PixelFormat := pf32bit; // on s'assure d'avoir le bon format
  PLen := Bmp1.Width * Bmp1.Height;
  PStart := Cardinal(Bmp1.Scanline[Bmp1.Height - 1]);
  for X := 0 to PLen - 1 do
    with PRGBQuad(PStart)^ do
    begin
      rgbRed := EnsureRange(rgbRed + ((255 - rgbRed) * Amount) div 255, 0, 255);
      rgbGreen := EnsureRange(rgbGreen + ((255 - rgbGreen) * Amount) div 255, 0, 255);
      rgbBlue := EnsureRange(rgbBlue + ((255 - rgbBlue) * Amount) div 255, 0, 255);
      Inc(PStart, SizeOf(TRGBQuad));
    end;
end;

Désolé j'peux pas m'en empêcher

Cordialement,

[Edit] modification du code shr 8 ---> div 255
l'assombrissement ne fonctionnait plus [/Edit]
@+

[Jipété]

Bonsoir,

2 lignes me chiffonnent :

Code :

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

1
2
3
4
5
6
7
procedure TF_Image2.Lightness(var Bmp1: TBitMap; Amount: Integer);
  //...
begin
  if Bmp1.Empty then Exit;
  Bmp1.PixelFormat := pf32bit; // on s'assure d'avoir le bon format
  //...
end;

Elles devraient àmha être dans la procédure d'appel :
on fait le test de la première ligne et on n'appelle pas la procédure Lightness si le Bmp1 est empty : encore plus rapide,
Si le Bmp1 est valide alors on assigne son PixelFormat et on appelle la proc.

[ALWEBER]

Pour exemple une unité de 1998

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
 
interface
uses
  SysUtils,Graphics,jpeg,GifImage ;
 
type
  TImagerie = Object
          Bitmap1 : TBitmap ;   // image BMP 24 Bits
          BitmapSauvegarde2 : TBitmap ;   // sauvegarde image
          BitmapTemp3 : TBitmap ;   // sauvegarde image
          Sauvegarde : Boolean ;
          NomFichier : String ; // Nom complet du fichier chargé
          TbSpectre1 : Array [0..255] of integer ;
          // l'indice du tableau correspond à la couleur
          // la valeur au nombre d'occurences de la couleur
          Procedure Initialise ;
          Procedure Assombrir ;
          Procedure ChargementImage ( NomFichier1 : string ) ;
          Procedure Contraste ;
          Procedure Eclaircir ;
          Procedure Gomme(s1 : smallint) ;
          Procedure Spectre ;
          Procedure SauvegardeMemoireTmp ;
          Procedure SauvegardeMemoire ;
          Procedure RestaureMemoire ;
          function TailleFichier : Integer ;
          Procedure Termine ;
       End ;
 
implementation
 
  Procedure TImagerie.Initialise ;
  begin
    Bitmap1:= TBitmap.Create ;
    Bitmap1.PixelFormat:= pf24Bit ;
    BitmapSauvegarde2:= TBitmap.Create ;
    BitmapSauvegarde2.PixelFormat:= pf24Bit ;
    BitmapTemp3 := TBitmap.Create ;
    BitmapTemp3.PixelFormat:= pf24Bit ;
  end ;
 
  Procedure TImagerie.ChargementImage ;
  // Date : 2 déc 1998
  var
    Bitmap2 : TBitmap ;
    st2 : string ; // Extension fichier
    JPEG1 : TJPEGImage;
    gif1 : TGifImage;
  begin
    Sauvegarde := False ;
    NomFichier := NomFichier1 ;
    St2 := UpperCase(ExtractFileExt(NomFichier));
    if (st2 = '.JPG') then
    begin
      JPEG1 := TJPEGImage.Create;
      JPEG1.LoadFromFile(NomFichier);
      Bitmap1.Width := JPEG1.Width ;
      Bitmap1.Height := JPEG1.Height ;
      Bitmap1.Canvas.DRAW(0,0,JPEG1);
      JPEG1.Free;
    end
    else
    begin
      Bitmap2 := TBitmap.Create ;
      if  (st2 = '.GIF') then
      begin
        gif1 := TGIFImage.Create;
//ancien        gif1.GifConvert (NomFichier);
        gif1.LoadFromFile (NomFichier) ;
        Bitmap2.Assign(gif1.bitmap) ;
//        gif1.BmpStream.seek(0,0);
//        Bitmap2.LoadFromStream(gif1.BmpStream);
        gif1.Free;
      end ;
      if (st2 = '.BMP') then
      begin
        Bitmap2.LoadFromFile(NomFichier) ;
      end ;
      Bitmap1.Width := Bitmap2.Width ;
      Bitmap1.Height := Bitmap2.Height ;
      Bitmap1.Canvas.Draw(0,0,Bitmap2) ;
      Bitmap2.Free;
    end ;
  end ;
 
  Procedure TImagerie.Assombrir ;
  var
    b1, x,y : integer;
    P : PByteArray;
  begin
    repeat
      for y := 0 to (Bitmap1.Height-1) do
      begin
        P := Bitmap1.ScanLine[y];
        for x := 0 to (Bitmap1.Width-1) do
        begin
          b1 := P[X*3] ;
          if b1 > 7 then
            b1 := b1 - 8
          else
            b1 := 0 ;
          P[X*3] := b1 ;
        end ;
      end ;
      Spectre ;
    until (tbSpectre1[0]*50) > (Bitmap1.Height*Bitmap1.Width) ;
  end ;
 
  Procedure TImagerie.Contraste ;
  var
    b1, x,y,x1,i1,i2,i3 : integer;
    P : PByteArray;
    Tb2,Tb3 : Array [0..255] of integer ;
  begin
    Spectre ;
    I1 := 0 ;
    for x := 0 to 255 do
      if tbSpectre1[x]>0 then
        I1 := i1 + 1 ; // Calcule nombre de couleurs
    I2 := 2560 DIV I1 ;
  // Construit partie de sinusoide dans tb2
    for X1 := 0 to 127 do
      tb2[x1] := 128 - Round (cos ((PI / 255) * X1) * 128 ) ;
    for X1 := 128 to 255 do
      tb2[x1] := 128 - Round (cos ((PI / 255) * X1) * 127 ) ;
    Fillchar (Tb3,sizeof(Tb3),0);
    I3 := 0 ;
    for x := 0 to 255 do
      if tbSpectre1[x]>0 then
      begin
        Tb3[x] := Tb2[I3 DIV 10] ;
        I3 := I3 + I2 ;
      end ;
    for y := 0 to (Bitmap1.Height-1) do
    begin
      P := Bitmap1.ScanLine[y];
      for x := 0 to (Bitmap1.Width-1) do
      begin
        b1 := tb3[P[X*3]]  ;
        P[X*3] := b1 ;
        P[(X*3)+1] := b1 ;
        P[(X*3)+2] := b1 ;
      end;
    end;
  end;
 
  Procedure TImagerie.Eclaircir ;
  var
    b1,b2, x,y : integer;
    P : PByteArray;
  begin
    repeat
      for y := 0 to (Bitmap1.Height-1) do
      begin
        P := Bitmap1.ScanLine[y];
        for x := 0 to (Bitmap1.Width-1) do
        begin
          b1 := P[X*3] ;
          if b1 < 248 then
            b1 := b1 + 8
          else
            b1 := 255 ;
          P[X*3] := b1 ;
        end ;
      end ;
      Spectre ;
      b2 := 0 ;
      for x := 0 to 255 do
        if x >= 248 then b2 := b2 + tbSpectre1[x] ;
    until (b2*5) > (Bitmap1.Height*Bitmap1.Width) ;
  end;
 
  procedure TImagerie.Gomme (s1 : smallint) ;
  var
    x,y,i : integer;
    P,P1,P2,P3 : PByteArray;
    BM2 : TBitmap ;
  begin
    BM2 := TBitmap.Create ;
    BM2.PixelFormat := Bitmap1.PixelFormat ;
    BM2.Width := Bitmap1.Width ;
    BM2.Height := Bitmap1.Height ;
    for I := 1 to s1 do
    begin
      for y := 1 to (Bitmap1.Height-2) do
      begin
        P1 := Bitmap1.ScanLine[y-1];
        P2 := Bitmap1.ScanLine[y];
        P3 := Bitmap1.ScanLine[y+1];
        P := Bm2.ScanLine[y];
        for x := 1 to (Bitmap1.Width-2) do
        begin
          P[X*3] := ((P2[X*3]*2)+P1[X*3]+P3[X*3]+P2[(X-1)*3]+P2[(X+1)*3]) Div 6 ;
          if P2[X*3]>P[X*3] then P[X*3] := P2[X*3] ;
        end ;
      end ;
      Bitmap1.Canvas.Draw(0,0,BM2) ;
    end ;
    BM2.Free ;
  end ;
 
  procedure TImagerie.Spectre ;
  var
    x,y : integer;
    P : PByteArray;
  begin
    Fillchar (TbSpectre1,sizeof(TbSpectre1),0);
    if NomFichier='' then exit ;
    for y := 0 to (Bitmap1.Height-1) do
    begin
      P := Bitmap1.ScanLine[y];
      for x := 0 to (Bitmap1.Width-1) do
        tbSpectre1 [P[X*3]] := tbSpectre1 [P[X*3]]+1 ;
    end ;
  end ;
 
  Procedure TImagerie.SauvegardeMemoireTmp ;
  begin
    if NomFichier<>'' then
    begin
      BitmapTemp3.Width := Bitmap1.Width ;
      BitmapTemp3.Height := Bitmap1.Height ;
      BitmapTemp3.Canvas.DRAW(0,0,Bitmap1);
      Sauvegarde := True ;
    end ;
  end ;
 
  Procedure TImagerie.SauvegardeMemoire ;
  begin
    if NomFichier<>'' then
    begin
      BitmapSauvegarde2.Width := Bitmap1.Width ;
      BitmapSauvegarde2.Height := Bitmap1.Height ;
      BitmapSauvegarde2.Canvas.DRAW(0,0,Bitmap1);
      Sauvegarde := True ;
    end ;
  end ;
 
  Procedure TImagerie.RestaureMemoire ;
  begin
    if Sauvegarde then
    begin
      Bitmap1.Canvas.DRAW(0,0,BitmapSauvegarde2);
      Sauvegarde := False ;
    end ;
  end ;
 
  function TImagerie.TailleFichier : Integer ;
  var
    f1: file of Byte;
  begin
    if NomFichier='' then
      TailleFichier := 0
    else
    begin
      AssignFile(f1,NomFichier);
      Reset(f1);
      TailleFichier := FileSize(f1);
      CloseFile(f1);
    end;
  end ;
 
 
  Procedure TImagerie.Termine ;
  begin
    if NomFichier='' then exit ;
    Bitmap1.Free ;
    BitmapSauvegarde2.Free ;
    BitmapTemp3.Free ;
    NomFichier := '' ;
  end ;
 
 
end.

[Andnotor]

@Cirec
Tu ne fais pas encore d'apps 64 bits, hein ? Un pointeur stocké dans un cardinal (32 bits), ça va pas le faire. Le sujet évoque D7 mais autant prendre les bonnes habitudes

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
procedure TF_Image2.Lightness(var Bmp1: TBitMap; Amount: Integer);
var
  PStart: PRGBQuad;
  ...
 
begin
  ...
  PStart := Bmp1.Scanline[Bmp1.Height - 1];
 
  for X := 0 to PLen - 1 do
    with PStart^ do
    begin
      ...
      Inc(PStart);
    end;
end;

[Charly910]

Merci à tous,

je vais garder la version Cirec modifiée par Andnotor

A+
Charly

[Cirec]

@Cirec
Tu ne fais pas encore d'apps 64 bits, hein ? Un pointeur stocké dans un cardinal (32 bits), ça va pas le faire. Le sujet évoque D7 mais autant prendre les bonnes habitudes

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
procedure TF_Image2.Lightness(var Bmp1: TBitMap; Amount: Integer);
var
  PStart: PRGBQuad;
  ...
 
begin
  ...
  PStart := Bmp1.Scanline[Bmp1.Height - 1];
 
  for X := 0 to PLen - 1 do
    with PStart^ do
    begin
      ...
      Inc(PStart);
    end;
end;

Ben non
je ne fais pas d'applications au sens ou ou vous l'entendez
ce que je veux dire c'est que je ne suis pas, contrairement à vous, du métier je pratique uniquement en privé en tant qu'autodidacte hobbyiste
de plus l'OS du PC qui me sert à Delphi est en 32bits et il me semble, si je dis pas de conneries, qu'il faut être en 64Bits pour compiler du code 64Bits.
Pour finir le tableau, j'ai fait le code avec D6 ceci explique en partie cela.


Sinon j'aime bien utiliser l'adresse du pointeur que le pointeur lui même
ce qui facilite, au besoin, la navigation avant arrière. Enfin c'est mon avis et il n'engage que moi
Bien que pour ce code, précisément, il n'y a pas de réelle utilité à cela.

Dans mes souvenirs les adresses mémoires et autre Handle étaient de type Cardinal !
je viens de vérifier dans la dernière version de Delphi que je possède et il est passé en NativeUInt --> UInt64

On 32-bit platforms, NativeUInt is equivalent to the Cardinal type. On 64-bit platforms, NativeUInt is equivalent to the UInt64 type.

et il n'y a pas d'équivalent 32Bits si ce n'est Int64 qui s'en approche et qui pourrait servir de compromis
sans aucune certitude.


@Jipété
quand tout le code se trouve dans la même unité comme ici oui on pourrait s'en passer et les faire avant l'appel
mais la procédure tend à finir dans une unité dédiée (pour moi) d'ici quelques mois je ne saurais peut être plus
que je n'ai pas de contrôle de pixelformat dans cette procédure ou l'image peut être vide ...
compte tenu du temps que coute ces deux précautions (quasi nul, je pense même qu'elles ne sont pas mesurables)
elles apportent plus qu'autre chose. Encore une fois ce n'est que mon avis ...

Cordialement,

@+

[Charly910]

Bonjour Cirec,

moi aussi je suis un autodidacte hobbyiste mais je suis loin d'avoir ton niveau ! (surtout sur les pointeurs !!)

Merci pour toutes les solutions que tu m'as apportées.

A+
Charly

PS : je navigue entre D7 et D10.3 CE, ce qui me permet de découvrir d'autres choses, et aussi de pouvoir compiler en 64 bits, ce qui est nouveau pour moi.