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
| // F2 dans F1 Via 2 BitMaps ====================================================
function RepAppli: string; // renvoie Repertoire de l''application avec \ terminal
begin RepAppli := ExtractFilePath(Application.ExeName); end;
function ColorToRGBQuad(cl: tColor): tRGBQuad;
begin with Result do begin
rgbRed := GetRValue(cl);
rgbGreen := GetGValue(cl);
rgbBlue := GetBValue(cl);
end;
end;
type
TRGBQuadArray = array[0..0] of TRGBQuad; // élément de bitmap (API windows)
pRGBQuadArray = ^TRGBQuadArray; // type pointeur vers tableau 4 octets 32 bits
tSLQ = array of pRGBQuadArray;
var SLQF1, SLQF2: tSLQ;
procedure InitSLQ(const Bmp: tBitMap; var SL: tSLQ);
// Intialisation des Scanlines
var H, W, x, y: integer;
begin
Setlength(SL, 0);
Bmp.PixelFormat := pf32Bit; // Effacer les anciens Alpha
H := Bmp.Height; W := Bmp.Width;
Setlength(SL, H);
for y := 0 to H - 1 do SL[y] := BMP.ScanLine[y];
for y := 0 to H - 1 do
for x := 0 to W - 1 do SL[y, x].rgbReserved := 0;
end;
function F2DansF1_Bmp(var BmpF1, BmpF2: tBitMap; clF1, clF2, clUnion: tColor): boolean;
// BmpF1 et BmpF2 = 2 BitMap's de même taille
// clF1 et clF2 = Couleurs des silhouettes des formes F1 et F2
// clUnion = Couleur de l'union éventuelle de F1 et de F2
var x, y, W, H, nbPtF2, nbPtDans: integer; PixelDans: boolean; clQuadF1, clQuadF2, clQuadU: tRGBQuad;
begin
InitSLQ(BmpF1, SLQF1); InitSLQ(BmpF2, SLQF2);
clQuadF1 := ColorToRGBQuad(clF1); clQuadF2 := ColorToRGBQuad(clF2);
clQuadU := ColorToRGBQuad(clUnion);
W := BmpF1.Width; H := BmpF1.Height; nbPtDans := 0;
// Comptage du nombre total de Pixels de F2 :
nbPtF2 := 0;
for y := 0 to H - 1 do begin
for x := 0 to W - 1 do begin
if (SLQF2[y, x].rgbBlue = clQuadF2.rgbBlue)
and (SLQF2[y, x].rgbGreen = clQuadF2.rgbGreen)
and (SLQF2[y, x].rgbRed = clQuadF2.rgbRed) then inc(nbPtF2);
end;
end;
// Comptage du nombre de Pixels de F2 dans F1 et changement de couleur :
for y := 0 to H - 1 do begin
for x := 0 to W - 1 do begin
if (SLQF1[y, x].rgbBlue = clQuadF1.rgbBlue)
and (SLQF1[y, x].rgbGreen = clQuadF1.rgbGreen)
and (SLQF1[y, x].rgbRed = clQuadF1.rgbRed)
and (SLQF2[y, x].rgbBlue = clQuadF2.rgbBlue)
and (SLQF2[y, x].rgbGreen = clQuadF2.rgbGreen)
and (SLQF2[y, x].rgbRed = clQuadF2.rgbRed)
then begin // x,y = Pixel d'union F2 dans F1
inc(nbPtDans);
SLQF1[y, x].rgbBlue := clQuadU.rgbBlue;
SLQF1[y, x].rgbGreen := clQuadU.rgbGreen;
SLQF1[y, x].rgbRed := clQuadU.rgbRed;
end;
end;
end;
Result := (nbPtDans=nbPtF2);
end;
procedure TForm1.bVia2BmpClick(Sender: TObject);
var BmpF1, BmpF2: tBitMap;
begin
BmpF1 := tBitMap.Create; BmpF2 := tBitMap.Create;
BmpF1.LoadFromFile(RepAppli + 'F2DansF1Rouge.bmp');
BmpF2.LoadFromFile(RepAppli + 'F2DansF1Bleu.bmp');
if F2DansF1_Bmp(BmpF1, BmpF2, clRed, clBlue, clYellow)
then TracerTexte(BmpF1, Point(220, 145), 'Astroïde dans Ellipse', clGreen)
else TracerTexte(BmpF1, Point(220, 145), 'Astroïde hors Ellipse', clRed);
image1.Picture.Bitmap.Assign(BmpF1);
image1.Invalidate;
end; |
Partager