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!!