Convertir bitmap couleur en monochrome ?

Version imprimable

26/12/2008, 14h32
Laskar

Convertir bitmap couleur en monochrome ?

Bonjour,

Je cherche un bout de code qui me permettrait de transformer une bitmap couleur (24 bits / pixel) en bitmap monochrome (1 bit / pixel).
Si je recopie la bitmap couleur dans une bitmap monochrome en changeant le format de pixel, je n'ai pas le choix du seuil. Il faut que tous les pixels blancs ($FF $FF $FF) restent blancs et que tous les autres passent en noir.
La difficulté est que 3 octets couleur doivent générer 1 bit en monochrome. Les différents essais que j'ai effectués m'ont filé la migraine :aie: :?
Un peu d'aide ?

Merci.

Salut,

Voiçi une fonction qui renvoie un BitMap avec pixelFormat:=pf1bit à partir d'un BitMap polychrome :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
function BmpMonochrome(Bmp : tBitMap) : tBitMap;
var      x,y : integer; cl : tColor;
begin    Result:=tBitMap.Create;
         With Result do
         begin width:=Bmp.width; height:=Bmp.height;
               pixelFormat:=pf1bit;         //<- 1 bit / pixel
               canvas.Brush.Color:=clBlack; //<- on initialise avec du noir
               canvas.FillRect(canvas.ClipRect);
         end;
         for y:=0 to Bmp.Height-1 do
         begin for x:=0 to Bmp.Width-1 do
               begin cl:=bmp.canvas.pixels[x,y];
                     if cl=clWhite then Result.canvas.pixels[x,y]:=clWhite;
                     // on ne laisse passer que le blanc
               end;
          end;
end;

Et le code d'utilisation :

Code:

1
2
3
4
5
procedure TForm1.btnMonochromeClick(Sender: TObject);
var       BmpResultat : tBitMap;
begin     BmpResultat:=BmpMonochrome(Image1.picture.BitMap);
          Image2.picture.BitMap:=BmpResultat;
end;

A+ :D

salut

tu peut affiner la mise en noir est blanc selon la couleur

Code:

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 GetRGBColor(Color: TColor;
                                out R: Integer; out G: Integer; out B: Integer);
var
  RGBColor: Integer;
begin
  RGBColor := ColorToRGB(Color);
  R := RGBColor Mod 256;
  G := (RGBColor div 256) Mod 256;
  B := (RGBColor div 256) div 256;
end;
 
 
function BmpMonochrome(Bmp : tBitMap) : tBitMap;
var
  x,y : integer;
  cl : tColor;
  Grayscale: Real;
  R, G, B: Integer;
begin
  Result:=tBitMap.Create;
  With Result do
  begin
    width:=Bmp.width; height:=Bmp.height;
    pixelFormat:=pf1bit;         //<- 1 bit / pixel
    canvas.Brush.Color:=clBlack; //<- on initialise avec du noir
    canvas.FillRect(canvas.ClipRect);
  end;
 
  for y:=0 to pred(Bmp.Height) do
  begin
    for x:=0 to pred(Bmp.Width) do
    begin
      cl:=bmp.canvas.pixels[x,y];
      GetRGBColor(cl, R, G, B);
      Grayscale := (0.299 * R) + (0.587 * G) + (0.114 * B);
      if GrayScale < 196 then
        Result.canvas.pixels[x,y]:= clWhite;// 1;
    end;
  end;
end;

@+ Phil

Merci à vous deux.
Le code que vous fournissez fonctionne presque J'ai du l'adapter pour créer un masque à partir d'un fichier couleur représentant un sprite.
Voici mon code (en gras les valeurs que j'ai adaptée) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Procedure TForm1.CreateMsk(bm_Sprite, bm_Mask : TBitmap); var x,y : integer; cl : TColor; begin With bm_Mask do begin width := bm_Sprite.width; height := bm_Sprite.height; pixelFormat := pf1bit; //<- 1 bit / pixel canvas.Brush.Color := clWhite; //<- blanc canvas.FillRect(canvas.ClipRect); end; for y := 0 to bm_Sprite.Height-1 do begin for x := 0 to bm_Sprite.Width-1 do begin cl := bm_Sprite.canvas.pixels[x,y]; if cl = clWhite then bm_Mask.canvas.pixels[x,y] := clBlack; end; end; end;
Je peux ensuite utiliser le masque ainsi créé avec la fonction GDI PlgBlt :

Code:

PlgBlt(img_Fond.Canvas.Handle, TabPoint, bm_Sprite.Canvas.Handle, 0,0 , Largeur, Hauteur, bm_Mask.Handle,0,0);

ou encore avec MaskBlt :

Code:

MaskBlt(img_Fond.Canvas.Handle, 10, 10, Largeur, Hauteur, bm_Sprite.Canvas.Handle, 0,0, bm_Mask.Handle, 0, 0, MAKEROP4(SRCCOPY, $00AA0029));

Tout fonctionne à merveille.

Encore merci à vous :yaisse2:

27/12/2008, 21h32
ero-sennin

Merci de bien vouloir mettre le tag :resolu: si tout est OK ;)