Delphi 6 Image transparente

Bonjour,

après de nombreux essai infructueux, j'ai trouve ce code ci-dessous qui permet de dessiner sur un compossant une image transparente :

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
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
// DrawTransparentBitmap:
// adapted from TExplorerButton by Fabrice Deville
 
procedure DrawTransparentBitmap(dc:HDC; bmp: TBitmap; xStart,yStart: Integer; cTransparentColor: LongInt);
var
   bm: TBitmap;
   cColor: TColorRef;
   bmAndBack, bmAndObject, bmAndMem, bmSave, oldBmp: HBITMAP;
   bmBackOld, bmObjectOld, bmMemOld, bmSaveOld, hBmp: HBITMAP;
   hdcMem, hdcBack, hdcObject, hdcTemp, hdcSave: HDC;
   ptSize: TPoint;
   temp_bitmap: TBitmap;
begin
     temp_bitmap := TBitmap.Create;
     temp_bitmap.Assign(bmp);
     try
          hBmp := temp_bitmap.Handle;
          hdcTemp := CreateCompatibleDC(dc);
          oldBmp := SelectObject(hdcTemp, hBmp);
 
          GetObject(hBmp, SizeOf(bm), @bm);
          ptSize.x := bmp.Width;
          ptSize.y := bmp.Height;
 
          hdcBack   := CreateCompatibleDC(dc);
          hdcObject := CreateCompatibleDC(dc);
          hdcMem    := CreateCompatibleDC(dc);
          hdcSave   := CreateCompatibleDC(dc);
 
          bmAndBack   := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
 
          bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
 
          bmAndMem    := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);
          bmSave      := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);
 
          bmBackOld   := SelectObject(hdcBack, bmAndBack);
          bmObjectOld := SelectObject(hdcObject, bmAndObject);
          bmMemOld    := SelectObject(hdcMem, bmAndMem);
          bmSaveOld   := SelectObject(hdcSave, bmSave);
 
          SetMapMode(hdcTemp, GetMapMode(dc));
 
          BitBlt(hdcSave, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
 
          cColor := SetBkColor(hdcTemp, cTransparentColor);
 
          BitBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
 
          SetBkColor(hdcTemp, cColor);
 
          BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);
          BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, xStart, yStart, SRCCOPY);
          BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
          BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
          BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCPAINT);
          BitBlt(dc, xStart, yStart, ptSize.x, ptSize.y, hdcMem, 0, 0, SRCCOPY);
          BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcSave, 0, 0, SRCCOPY);
 
          DeleteObject(SelectObject(hdcBack, bmBackOld));
          DeleteObject(SelectObject(hdcObject, bmObjectOld));
          DeleteObject(SelectObject(hdcMem, bmMemOld));
          DeleteObject(SelectObject(hdcSave, bmSaveOld));
 
          SelectObject(hdcTemp, oldBmp);
 
          DeleteDC(hdcMem);
          DeleteDC(hdcBack);
          DeleteDC(hdcObject);
          DeleteDC(hdcSave);
          DeleteDC(hdcTemp);
     finally
            temp_bitmap.Free;
     end;
end;

Ce code fonctionne à merveille.
Maintenant, je veux que lorsque le composante est inactif (Enabled := False) l'image soit grisée.
J'ai donc créé le code ci-dessous :

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 DrawDisabledBitmap(DC:HDC; xStart, yStart: Integer; bmp: TBitmap; cTransparentColor: LongInt);
var X, Y : Integer ;
    MonoBmp : TBitmap ;
    DisabledColor : LongInt ;
begin
    MonoBmp := TBitmap.Create() ;
 
    MonoBmp.Height := bmp.Height ;
    MonoBmp.Width := bmp.Width ;
 
    DisabledColor := GetSysColor(COLOR_BTNSHADOW) ;
 
    for Y := 0 to bmp.Height - 1 do
    begin
        for X := 0 to bmp.Width - 1 do
        begin
 
            if Bmp.Canvas.Pixels[X, Y] <> cTransparentColor
            then begin
                MonoBmp.Canvas.Pixels[X, Y] := DisabledColor
            end
            else begin
                { (Bmp.Canvas.Pixels[X-1, Y] = -1) car si c'est la primère colone }
                if (Bmp.Canvas.Pixels[X-1, Y] = cTransparentColor) or (Bmp.Canvas.Pixels[X-1, Y] = -1)
                then
                    MonoBmp.Canvas.Pixels[X, Y] := Bmp.Canvas.Pixels[X, Y]
                else
                    MonoBmp.Canvas.Pixels[X, Y] := clWhite ;
            end ;
        end ;
    end ;
 
    if (MonoBmp.Height > 0) and (MonoBmp.Width > 0)
    then begin
        BitBlt(DC, xStart, yStart, MonoBmp.Width, MonoBmp.Height,
               MonoBmp.Canvas.Handle, 0, 0, SRCCOPY);
 
        DrawTransparentBitmap(dc, MonoBmp, xStart, yStart, cTransparentColor);
        MonoBmp.Free ;        
    end ;
end ;

Oui mais voilà, ma couleur de transparence apparait !
Incompréhensible.
Si je copie dans paint l'image obtenu et que je la passe en fixe ça fonctionne. Quelqu'un à une idée ?

Merci d'avance

[31/08/2007 - 20h37] Je viens d'avoir une idée. Il suffit de dessiner point par point sur le DC mais comment fait-on ?

Je viens d'essayer ce code (c'est moi qui l'ai fait depuis un exemple) et ça ne fonctionne pas. Quelqu'un peut-il m'expliquer ?

Merci d'avance.

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
    procedure DrawOurStuff(DrawDC: HDC);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
const
  NUM_SHAPES = 4000;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.DrawOurStuff(DrawDC: HDC);
var
  i: Integer;
  OldPen, DrawPen: HPEN;
begin
  // Create our pen to draw with. It will be a solid line style, of width 1 and
  // a completely random colour
  DrawPen := CreatePen(PS_SOLID, 1, RGB(Random(256), Random(256), Random(256)));
 
  // Select our new pen into the DC, so lines will be drawn using it. Store
  // the old pen too
  OldPen := SelectObject(DrawDC, DrawPen);
 
  // Draw our lines
  for i := 0 to NUM_SHAPES - 1 do
    LineTo(DrawDC, 10, 10);
 
  // Select the old pen back again so Windows doesn't complain
  SelectObject(DrawDC, OldPen);
 
  // and kill the pen we created
  DeleteObject(DrawPen);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var dc : HDC ;
begin
   dc:=GetDC(Handle);
    DrawOurStuff(DC) ;
end;
 
 
end.

Est-il possible de convertire un HBITMAP en TBitmap ?

Pour la longueur d'un texte, j'ai touvé http://www.developpez.com/delphi/faq...imensionstexte

Est-ce parce qu'il manque CreateSolidBrush(RGB(rouge, vert, bleu)); que ça ne fonctionne pas ?

J'ai trouvé min erreur !
Erreur de débutant.
Il fallait enlever :
Code:

1 2 BitBlt(DC, xStart, yStart, MonoBmp.Width, MonoBmp.Height, MonoBmp.Canvas.Handle, 0, 0, SRCCOPY);
Désolé de vous avoir dérangé.

Sinon, pour dessiner pixel par pixel :

Code:

SetPixel(DC, X, Y, Bmp.Canvas.Pixels[X, Y])