problème pour centrer une image

**Basile le disciple** · 22/06/2013, 18h52

Bonjours à tous

Voilà, j'ai un gros problème quand je centre une image et que je veux balayer cette même image avec ScanLine(je ne suis pas très clair mais pour plus d'informations voici un lien :http://www.developpez.net/forums/d13...avec-scanline/) : cela me donne un effet indésirable quand je redimensionne ma fiche.

Voici mon 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
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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, axCtrls, Jpeg;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Déclarations privées }
    we,he : integer;
    col,colprec : TColor;
    bmpmemoire,bmp : TBitmap;
    function BMP24fromFile(const nomFichierImg: string): tBitMap;
    function TripletoColor(RGBTriple : PRGBTriple) : TColor;
    procedure fond(bitmap : TBitmap;color : TColor);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
const
tab : array[0..37] of TColor = ($98316F,$983170,$98306F,$97316F,$98316E,$98326F,$99316F,$97306E,$993271,$98316D,$982F6F,$96316F,$962F6E,$982F70,$982F71,$982E6F,$982E70,$982E71,$9A2E70,$9A306E,$9A316E,$9A2F6E,$9A2E6E,$982E6D,$982F6D,$98306D,$992F6D,$99306D,$99316D,$9A2F6D,$9A306D,$9A316D,$992E6D,$9A2E6D,$99326F,$98326E,$983270,$98326D);
 
implementation
 
{$R *.dfm}
 
function TForm1.TripletoColor(RGBTriple : PRGBTriple) : TColor;
begin
  result:=rgb(RGBTriple.rgbtRed,RGBTriple.rgbtGreen,RGBTriple.rgbtBlue);
end;
 
function TForm1.BMP24fromFile(const nomFichierImg: string): tBitMap; // ajouter axCtrls et Jpeg dans le uses pour TOleGraphic , pas besoin de GIFImage
//const FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var OleGraphic: TOleGraphic; FS: TFileStream;
   img: tImage; pl: tPanel;
begin
  OleGraphic := TOleGraphic.Create;
  FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
  img := tImage.Create(pl); //<- petit inconvénient : nécessite un AOwner
  // et on peut ignorer l'[Avertissement] ... La variable 'pl' n'est peut-être pas initialisée
  // ça marche quand-même.
  try
    OleGraphic.LoadFromStream(FS);
    img.Picture.Assign(OleGraphic);
    Result := tBitmap.create;
    with Result do
    begin PixelFormat := pf24Bit;
      Width := img.Picture.Width;
      Height := img.Picture.Height;
      Canvas.Draw(0, 0, img.Picture.Graphic);
    end;
  finally
    fs.Free;
    img.free;
    OleGraphic.Free;
  end;
end; // BMP24fromFile
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Position:=PoScreenCenter;
  FormStyle:=fsStayOnTop;
  Width:=Screen.Width;
  Height:=Screen.Height;
  bmpmemoire:=bmp24fromFile('C:\Users\valentin\Desktop\géoval\Europe.EMF');
  we:=bmpMemoire.Width;
  he:=bmpMemoire.Height;
  bmp:=TBitmap.Create;
  With bmp do
  begin
    Width:=bmpMemoire.Width;
    Height:=bmpMemoire.Height;
    Paintbox1.Width:=Width;
    Paintbox1.Height:=Height;
  end;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  bmp.Canvas.StretchDraw(Paintbox1.ClientRect,bmpmemoire);
  Paintbox1.Canvas.StretchDraw(Paintbox1.ClientRect,bmp);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  With Paintbox1 do
  begin
    Width:=round(self.ClientWidth*self.ClientHeight*we/(1264*986));//ma résolution d'écran étant 1264 sur 986
    Height:=round(self.ClientHeight*self.ClientWidth*he/(1264*986));
    Top:=self.ClientHeight div 2-Height div 2;
    Left:=self.ClientWidth div 2-Width div 2;
    bmpmemoire.Width:=width;
    bmpmemoire.Height:=height;
    Invalidate;
  end;
end;
 
procedure TForm1.fond(bitmap : TBitmap;color : TColor);
var y : integer;
    p : pRGBTriple;
begin
  bitmap.PixelFormat := pf24Bit;
  p := bitmap.ScanLine[bitmap.Height - 1];
  for y := 0 to bitmap.Width * bitmap.Height - 1 do
  begin
    if tripletocolor(p) = col then
    begin
      p^.rgbtBlue := getBvalue(color);
      p^.rgbtGreen := getGvalue(color);
      p^.rgbtRed := getRvalue(color);
    end;
    inc(p);
  end;
end;
 
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var i : integer;
begin
  col := getPixel(bmpmemoire.Canvas.Handle, x, y);
  if col=colPrec then EXIT;
  bmp.Canvas.StretchDraw(Paintbox1.ClientRect,bmpmemoire);Paintbox1.Canvas.StretchDraw(Paintbox1.ClientRect,bmp);
  for i := 0 to 37 do
  begin
    if (col = tab[i]) then
    begin
      fond(bmp,clblue);
      break;
    end else
    begin
     if col <> clblue then bmp.Canvas.StretchDraw(Paintbox1.ClientRect,bmpmemoire);
     end;
  end;
  Paintbox1.Canvas.StretchDraw(Paintbox1.ClientRect,bmp);
  colPrec:=col;
end;
 
end.

et voici l'adresse où j'ai posté mon image : même lien/réponse 37(en fichier zip)

Je suppose que c'est la dimension du bmp qui fait ça mais je n'ai pas réussi à le redimensionner sans bug!!

**Ph. B.** · 22/06/2013, 22h54

Bonjour,

Envoyé par Basile le disciple

Je suppose que c'est la dimension du bmp qui fait ça mais je n'ai pas réussi à le redimensionner sans bug!!

C'est surtout de modifier les mauvaises variables qui fait que tout est en vrac !

Voila quelques modifications que j'ai faite sur votre code : correction et petites améliorations.

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
procedure TForm1.FormCreate(Sender: TObject);
begin
  Position := PoScreenCenter;
  FormStyle := fsStayOnTop;
  // Width:=Screen.Width;
  // Height:=Screen.Height;
  WindowState := wsMaximized;
 
  bmpmemoire := bmp24fromFile('C:\Users\valentin\Desktop\géoval\Europe.EMF');
  we := bmpMemoire.Width;
  he := bmpMemoire.Height;
 
  bmp := TBitmap.Create;
  With bmp do
  begin
    Width := bmpMemoire.Width;
    Height := bmpMemoire.Height;
    // Aucun intérêt, ce sera modifié au resize !
    //Paintbox1.Width := Width;
    //Paintbox1.Height := Height;
  end;
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  with Paintbox1 do
  begin
    //ma résolution d'écran étant 1264 sur 986
    // Screen.Width et Screen.Height permettent d'obtenir cette information !
    // Width := round(self.ClientWidth * self.ClientHeight * we / (1264 * 986));
    // Height := round(self.ClientHeight * self.ClientWidth * he / (1264 * 986));
    Width := round(self.ClientWidth * self.ClientHeight * we / (Screen.Width * Screen.Height));
    Height := round(self.ClientHeight * self.ClientWidth * he / (Screen.Width * Screen.Height));
    // Top := self.ClientHeight div 2 - Height div 2;
    // Left := self.ClientWidth div 2 - Width div 2;
    Top := (Self.ClientHeight - Height) div 2;
    Left := (Self.ClientWidth - Width) div 2;
 
    // ERREUR !
    //bmpmemoire.Width := Width;
    //bmpmemoire.Height := Height;
    bmp.Width := Width;
    bmp.Height := Height;
 
    Invalidate;
  end;
end;

Ensuite, votre redimensionnement du Paintbox débordera en plein écran, il y a encore des ajustements à faire sur le calcul de PaintBox1.Width et PaintBox1.Height. Mais je n'ai pas compris la "règle de trois" que vous appliquez !

En conclusion, il ne s'agit pas de dire, j'ai un problème, cela ne marche pas, mais aussi de décrire ce que vous voulez en théorie faire !

**Basile le disciple** · 23/06/2013, 11h38

Merci tout d'abord pour votre réponse.

En fait, ce que je veux concrètement, c'est ça :

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,axctrls,JPEG;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    bmp,bmpmemoire : TBitmap;
    col,colprec : TColor;
    procedure fond(bitmap : TBitmap;color : TColor);
    function TripletoColor(RGBTriple :  pRGBTriple) : TColor;
    function BMP24fromFile(const nomFichierImg: string): tBitMap;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
const
   Europe : array[0..37] of string = ('Russie','Biélorussie','Ukraine','Moldavie','Roumanie','Bulgarie','Macédoine','Grèce','Finlande','Estonie','Lettonie','Lituanie','Pologne','Slovaquie','Hongrie','Croatie','Bosnie Herzegovine','Serbie','Monténégro','Albanie','Suède','Norvège','Danemark','Allemagne','République Tchèque','Autriche','Slovénie','Suisse','Italie','Islande','Irlande','Royaume-Uni','Pays-Bas','Belgique','Luxembourg','France','Espagne','Portugal');
   tab : array[0..37] of TColor = ($98316F,$983170,$98306F,$97316F,$98316E,$98326F,$99316F,$97306E,$993271,$98316D,$982F6F,$96316F,$962F6E,$982F70,$982F71,$982E6F,$982E70,$982E71,$9A2E70,$9A306E,$9A316E,$9A2F6E,$9A2E6E,$982E6D,$982F6D,$98306D,$992F6D,$99306D,$99316D,$9A2F6D,$9A306D,$9A316D,$992E6D,$9A2E6D,$99326F,$98326E,$983270,$98326D);
   max : integer = 37;
 
implementation
 
{$R *.dfm}
 
function TForm1.BMP24fromFile(const nomFichierImg: string): tBitMap; // ajouter axCtrls et Jpeg dans le uses pour TOleGraphic , pas besoin de GIFImage
const FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var OleGraphic: TOleGraphic; FS: TFileStream; ext: string;
  JPEGImage: TJPEGImage; img: tImage; pl: tPanel;
begin
  if not FileExists(nomFichierImg) then begin
    showMessage(nomFichierImg + ' : n''existe pas'); Result := nil; EXIT;
  end;
  ext := UpperCase(ExtractFileExt(nomFichierImg));
  if (ext = '') or (pos(ext, FormatsSupportes) = 0) then
  begin showMessage(ext + ' = Format non supporté par BMP24fromFile');
    Result := nil; EXIT;
  end;
  if ext = '.BMP' then begin
    Result := tBitmap.create;
    Result.PixelFormat := pf24Bit;
    Result.LoadFromFile(nomFichierImg);
    EXIT;
  end;
  if ext = '.JPG' then begin
    try
      JPEGImage := TJPEGImage.Create;
      Result := TBitmap.Create;
      Result.PixelFormat := pf24Bit;
      try // test de chargement
        JPEGImage.LoadFromFile(nomFichierImg);
        JPEGImage.DIBNeeded;
        Result.Assign(JPEGImage);
      finally
        JPEGImage.Free;
      end;
    except
      Result := nil;
    end;
    EXIT;
  end;
  OleGraphic := TOleGraphic.Create;
  FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
  img := tImage.Create(pl); //<- petit inconvénient : nécessite un AOwner
  // et on peut ignorer l'[Avertissement] ... La variable 'pl' n'est peut-être pas initialisée
  // ça marche quand-même.
  try
    OleGraphic.LoadFromStream(FS);
    img.Picture.Assign(OleGraphic);
    Result := tBitmap.create;
    with Result do
    begin PixelFormat := pf24Bit;
      Width := img.Picture.Width;
      Height := img.Picture.Height;
      Canvas.Draw(0, 0, img.Picture.Graphic);
    end;
  finally
    fs.Free;
    img.free;
    OleGraphic.Free;
  end;
end; // BMP24fromFile
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 DoubleBuffered := true;
  bmpmemoire := BMP24fromFile('C:\Users\valentin\Desktop\géoval\europe.EMF');
  ClientWidth:=bmpmemoire.Width;
  ClientHeight:=bmpmemoire.Height;
  PaintBox1.Width := bmpmemoire.Width;
  PaintBox1.Height := bmpmemoire.Height;
  bmp := TBitmap.Create;
  bmp.Assign(bmpmemoire);
  colprec:=clwhite;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Paintbox1.Canvas.Draw(0,0,bmp);
end;
 
procedure TForm1.fond(bitmap : TBitmap;color : TColor);
var y : integer;
    p : pRGBTriple;
begin
    bitmap.PixelFormat := pf24Bit;
    p := bitmap.ScanLine[bitmap.Height - 1];
    for y := 0 to bitmap.Width * bitmap.Height - 1 do
    begin
      if tripletocolor(p) = col then
      begin
        p^.rgbtBlue := getBvalue(color);
        p^.rgbtGreen := getGvalue(color);
        p^.rgbtRed := getRvalue(color);
      end;
      inc(p);
    end;
end;
 
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  var i : integer;
begin
  col := getPixel(bmpmemoire.Canvas.Handle, x, y);
  if col=colPrec then EXIT;
  bmp.Assign(bmpmemoire); Paintbox1.Invalidate;
  for i := 0 to max do
  begin
    if (col = tab[i]) then
    begin
      Caption:=europe[i];
      fond(bmp,clblue);
      break;
    end else
    begin
     if col <> clblue then bmp.Assign(bmpmemoire);
     Caption:='Form1';
     end;
  end;
  Paintbox1.Invalidate;
  colPrec:=col;
end;
 
function TForm1.TripletoColor(RGBTriple : PRGBTriple) : TColor;
begin
  result:=rgb(RGBTriple.rgbtRed,RGBTriple.rgbtGreen,RGBTriple.rgbtBlue);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
  bmpmemoire.Free;
end;
 
end.

Mais je veux que l'image soit centrée et qu'elle se redimensionne en fonction de la dimension de la fiche.

Sinon, l'image est la même qu'avant.

J'ai essayé ce que vous m'avez mis mais quand je passe sur l'image avec la souris, cela colorie celle-ci en décalé.(Comme avant). Sinon, le redimensionnement marche!!!

**Ph. B.** · 23/06/2013, 15h00

Bonjour,

Envoyé par Basile le disciple

J'ai essayé ce que vous m'avez mis mais quand je passe sur l'image avec la souris, cela colorie celle-ci en décalé.(Comme avant). Sinon, le redimensionnement marche!!!

Effectivement, je n'ai examiné et corrigé que ce qui était précisé en titre...

Une petite remarque, un objet peut être créé sans indiquer un propriétaire, cad en utilisant nil. Cela évite de déclarer une variable inutilisée et d'ailleurs non initialisée, donc égale à nil.
Cela donne dans le code :

Code :

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

1
2
3
4
5
6
7
8
9
10
var
  img: tImage;
begin
  //...
  img := tImage.Create(nil);
  try
   //...
  finally
    img.free;
  end;

Ne pas oublier que la gestion de la mémoire alloué à l'objet est de votre responsabilité, donc de gérer sa libération, ce que vous avez fait...

**Ph. B.** · 23/06/2013, 17h46

Re !

Envoyé par Basile le disciple

Mais je veux que l'image soit centrée et qu'elle se redimensionne en fonction de la dimension de la fiche.

Sinon, l'image est la même qu'avant.

J'ai essayé ce que vous m'avez mis mais quand je passe sur l'image avec la souris, cela colorie celle-ci en décalé.(Comme avant). Sinon, le redimensionnement marche!!!

Le coloriage se fait mal car vous récupérez des coordonnées du bitmap affiché qui subit une réduction ou un agrandissement et que vous utilisez ces coordonnées telles quelles pour déterminer sur quel pays vous êtes sans appliquer de coefficient correcteur !

Donc, on va reprendre le problème depuis le début et s'intéresser d'abord au redimensionnement de la PaintBox en fonction de la taille du bitmap chargé en mémoire. Pour cela, on va faire un peu de mathématiques (de la règle de trois essentiellement !

)
Soient :

W et H les largeur et hauteur utiles de la fenêtre
Wb et Hb les largeur et hauteur du bitmap en mémoire
Wp et Hp les largeur et hauteur de la PaintBox, valeurs que l'on souhaite déterminer, qui soient proportionnelles à celles du bitmap en mémoire et au plus égales à celles de la fenêtre.
Lp et Tp les coordonnées du point supérieur gauche de la PaintBox, valeurs que l'on souhaite déterminer et dépendantes des deux précédentes

On va calculer le coefficient de réduction/agrandissement à appliquer au bitmap en prenant la plus petite des valeurs de rapport suivantes : W / Wb et H / Hb
On va mémoriser ce coefficient car il va servir :

immédiatement pour redimensionner la paintbox
ultérieurement pour définir sur quel pays se trouve la souris

Redimensionnement de la PaintBox :
Wp = Wb * Coef
Hp = Hb * Coef
Lp = (W - Wp) / 2
Tp = (H - Hp) / 2

Cela sera fait dans une méthode AdjustPaintBox appelée lors de l'événement OnResize de la Form. La Form aura sa propriété WindowState initialisée à wsMaximized

Reste la gestion de la souris. On récupère les coordonnées sur un bitmap réduit ou agrandi, il faut donc simplement leur appliquer le coefficient inverse pour retrouver les coordonnées réelles (celles du bitmap en mémoire).
X = X / Coef
Y = Y / Coef
Le reste du code ne change pas.

J'ai donc ajouté 2 variables globales

Code :

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

1
2
Coef: Double; // Mémoriser le coefficient de réduction ou d'agrandissement
InitialCaption: String; // Mémoriser le caption de la fenêtre et éviter un nom en dur dans le code

J'ai ajouté les méthodes

Code :

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

1
2
procedure FormResize(Sender: TObject);
procedure AdjustPaintBox;

J'ai placé la propriété wsMaximized depuis le concepteur de fiche
J'ai modifié la méthode :

Code :

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

procedure PaintBox1Paint(Sender: TObject);

J'ai remanié pour plus de lisibilité la méthode :

Code :

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

function BMP24fromFile(const nomFichierImg: string): TBitMap;

Ce qui donne au final :

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, axctrls, JPEG;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
  private
    { Déclarations privées }
    Coef: Double; // Mémoriser le coefficient de réduction ou d'agrandissement
    InitialCaption: String; // Mémoriser le caption de la fenêtre et éviter un nom en dur dans le code
    bmp, bmpmemoire: TBitmap;
    col, colprec: TColor;
    procedure AdjustPaintBox;
    procedure fond(bitmap: TBitmap; color: TColor);
    function TripletoColor(RGBTriple: pRGBTriple): TColor;
    function BMP24fromFile(const nomFichierImg: string): TBitMap;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
const
  max = 37;
  Europe: array[0..max] of string = ('Russie', 'Biélorussie', 'Ukraine',
    'Moldavie', 'Roumanie', 'Bulgarie', 'Macédoine', 'Grèce', 'Finlande',
    'Estonie', 'Lettonie', 'Lituanie', 'Pologne', 'Slovaquie', 'Hongrie',
    'Croatie', 'Bosnie Herzegovine', 'Serbie', 'Monténégro', 'Albanie', 'Suède',
    'Norvège', 'Danemark', 'Allemagne', 'République Tchèque', 'Autriche',
    'Slovénie', 'Suisse', 'Italie', 'Islande', 'Irlande', 'Royaume-Uni',
    'Pays-Bas', 'Belgique', 'Luxembourg', 'France', 'Espagne', 'Portugal');
  tab: array[0..max] of TColor = ($98316F, $983170, $98306F, $97316F, $98316E,
    $98326F, $99316F, $97306E, $993271, $98316D, $982F6F, $96316F, $962F6E,
    $982F70, $982F71, $982E6F, $982E70, $982E71, $9A2E70, $9A306E, $9A316E,
    $9A2F6E, $9A2E6E, $982E6D, $982F6D, $98306D, $992F6D, $99306D, $99316D,
    $9A2F6D, $9A306D, $9A316D, $992E6D, $9A2E6D, $99326F, $98326E, $983270,
    $98326D);
 
implementation
 
{$R *.dfm}
 
uses
  Math; // pour la fonction Min
 
function TForm1.BMP24fromFile(const nomFichierImg: string): TBitMap;
  // ajouter axCtrls et Jpeg dans le uses pour TOleGraphic, pas besoin de GIFImage
const
  FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var
  ext: string;
  //
  function LoadBMP: TBitmap;
  begin
    Result := TBitmap.Create;
    Result.PixelFormat := pf24Bit;
    Result.LoadFromFile(nomFichierImg);
  end;
  //
  function LoadJPEG: TBitmap;
  var
    JPEGImage: TJPEGImage;
  begin
    Result := TBitmap.Create;
    try
      JPEGImage := TJPEGImage.Create;
      Result.PixelFormat := pf24Bit;
      try // test de chargement
        JPEGImage.LoadFromFile(nomFichierImg);
        JPEGImage.DIBNeeded;
        Result.Assign(JPEGImage);
      finally
        JPEGImage.Free;
      end;
    except
      Result.Free;
      Result := nil;
    end;
  end;
  //
  function LoadOleGraphic: TBitmap;
  var
    OleGraphic: TOleGraphic;
    FS: TFileStream;
    Img: TImage;
  begin
    OleGraphic := TOleGraphic.Create;
    FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
    Img := TImage.Create(nil);
    try
      OleGraphic.LoadFromStream(FS);
      Img.Picture.Assign(OleGraphic);
      Result := TBitmap.create;
      with Result do
      begin
        PixelFormat := pf24Bit;
        Width := Img.Picture.Width;
        Height := Img.Picture.Height;
        Canvas.Draw(0, 0, Img.Picture.Graphic);
      end;
    finally
      FS.Free;
      Img.free;
      OleGraphic.Free;
    end;
  end;
  //
begin
  Result := nil;
  if not FileExists(nomFichierImg) then
  begin
    ShowMessage(nomFichierImg + ' : n''existe pas');
  end
  else
  begin
    ext := UpperCase(ExtractFileExt(nomFichierImg));
    if (ext = '') or (Pos(ext, FormatsSupportes) = 0) then
    begin
      ShowMessage(ext + ' = Format non supporté par BMP24fromFile');
    end
    else if ext = '.BMP' then
      Result := LoadBMP
    else if ext = '.JPG' then
      Result := LoadJPEG
    else
      Result := LoadOleGraphic;
  end;
end; // BMP24fromFile
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  bmpmemoire := BMP24fromFile('C:\Users\valentin\Desktop\géoval\europe.EMF');
  //
  AdjustPaintBox;
  //
  bmp := TBitmap.Create;
  bmp.Assign(bmpmemoire);
  colprec := clwhite;
  //
  InitialCaption := Caption;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Paintbox1.Canvas.StretchDraw(Rect(0, 0, PaintBox1.Width, PaintBox1.Height), bmp);
end;
 
procedure TForm1.fond(bitmap: TBitmap; color: TColor);
var
  y: integer;
  p: pRGBTriple;
begin
  bitmap.PixelFormat := pf24Bit;
  p := bitmap.ScanLine[bitmap.Height - 1];
  for y := 0 to bitmap.Width * bitmap.Height - 1 do
  begin
    if tripletocolor(p) = col then
    begin
      p^.rgbtBlue := getBvalue(color);
      p^.rgbtGreen := getGvalue(color);
      p^.rgbtRed := getRvalue(color);
    end;
    inc(p);
  end;
end;
 
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  i: Integer;
begin
  // Transposer les coordonnées
  X := Round(X / Coef);
  Y := Round(Y / Coef);
  // Faire la recherche
  col := GetPixel(bmpmemoire.Canvas.Handle, X, Y);
  if col = colPrec then
    Exit;
  bmp.Assign(bmpmemoire);
  Paintbox1.Invalidate;
  for i := 0 to max do
  begin
    if (col = tab[i]) then
    begin
      Caption := europe[i];
      fond(bmp, clblue);
      break;
    end
    else
    begin
      if col <> clblue then
        bmp.Assign(bmpmemoire);
      Caption := InitialCaption; // 'Form1';
    end;
  end;
  Paintbox1.Invalidate;
  colPrec := col;
end;
 
function TForm1.TripletoColor(RGBTriple: PRGBTriple): TColor;
begin
  result := RGB(RGBTriple.rgbtRed, RGBTriple.rgbtGreen, RGBTriple.rgbtBlue);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
  bmpmemoire.Free;
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  AdjustPaintBox;
end;
 
procedure TForm1.AdjustPaintBox;
begin
  // Coefficient de réduction ou d'agrandissement à appliquer à la paintbox en
  // fonction du bitmap image en mémoire
  Coef := Min(ClientWidth / bmpmemoire.Width, ClientHeight / bmpmemoire.Height);
  // Redimensionnement du PaintBox
  PaintBox1.Width := Round(bmpmemoire.Width * Coef);
  PaintBox1.Height := Round(bmpmemoire.Height * Coef);
  PaintBox1.Left := (ClientWidth - PaintBox1.Width) div 2;
  PaintBox1.Top := (ClientHeight - PaintBox1.Height) div 2;
end;
 
end.