THotbutton: Bitmap wird nicht transparent gezeichnet

[guidok]

Hallo,

das ist erst mal nur eine kleine Fingerübung und soll einen THotButton abgeben, also der Glyph soll sich beim Überfahren mit der Maus verändern. Die Glyphs werden in einer einzelnen Bitmap gehalten, die drei mal so breit als hoch ist und die Bilder für drei mögliche Zustände enthält. Unbetätigt, mit der Maus überfahren und betätigt. Funktioniert auch ganz gut, allerdings hätte ich schon gerne, das die Glyphs transparent gezeichnet werden und genau das haut nicht hin.

Delphi-Quellcode:

unit DcControls;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CommCtrl, ImgList;

type


  THotButton = class(TGraphicControl)
  private
    FGlyphList: TImageList;
    FImageList: TImageList;
    FImageIndex: Integer;
    FMouseInControl: Boolean;
    FMouseClick: Boolean;
    procedure SetImageList(Value: TImageList);
    procedure SetImageIndex(Value: Integer);
    procedure SetGlyphList;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ImageList: TImageList read FImageList write SetImageList;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    property OnClick;
  end;

implementation

constructor THotButton.Create(AOwner: TComponent);
begin
  inherited;
  FGlyphList:= TImageList.Create(self);
  FImageList:=nil;
  FImageIndex:=-1;
  FMouseInControl:=False;
  FMouseClick:=False;
end;

destructor THotButton.Destroy;
begin
  FGlyphList.Free;
  inherited;
end;

procedure THotButton.SetGlyphList;
var sbm, dbm: TBitmap;
    i: Integer;
begin
  sbm:=TBitmap.Create;
  FImageList.GetBitmap(FImageIndex,sbm);
  if sbm.Width mod sbm.Height=0 then begin
    dbm:=TBitmap.Create;
    dbm.SetSize(sbm.Width div 3,sbm.Height);
    for i:=0 to 2 do begin
      dbm.Canvas.CopyRect(Rect(0,0,dbm.Width,dbm.Height),sbm.Canvas,Rect(i*dbm.Width,0,i*dbm.Width+dbm.Width,dbm.Height));
      FGlyphList.Width:=dbm.Width;
      FGlyphList.Height:=dbm.Height;
      FGlyphList.Add(dbm,nil);
      end;
    end;
  sbm.Free;
  dbm.Free;
end;

//Es gibt 3 mögliche Stati für einen HotButton
procedure THotButton.SetImageList(Value: TImageList);
begin
  FImageList:=Value;
  if (FImageList<>nil) and (FImageIndex<>-1) then begin
    SetGlyphList;
    Height:=FGlyphList.Height;
    Width:=FGlyphList.Width;
    Repaint;
  end;
end;

procedure THotButton.SetImageIndex(Value: Integer);
begin
  FImageIndex:=Value;
  if (FImageList<>nil) and (FImageIndex<>-1) then begin
    SetGlyphList;
    Height:=FGlyphList.Height;
    Width:=FGlyphList.Width;    
    Repaint;
  end;
end;

procedure THotButton.WMLButtonDown(var Message: TWMMouse);
begin
  inherited;
  FMouseClick:=True;
  Repaint;
end;

procedure THotButton.WMLButtonUp(var Message: TWMMouse);
begin
  inherited;
  FMouseClick:=False;
  Repaint;
end;

procedure THotButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  FMouseInControl:=True;
  Repaint;
end;

procedure THotButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FMouseInControl:=False;
  Repaint;
end;

procedure THotButton.Paint;
begin
  if FGlyphList.Count=3 then
    if not FMouseInControl then begin
      ImageList_DrawEx(FGlyphList.Handle, 0, Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
    end
    else
    if not FMouseClick then begin
      ImageList_DrawEx(FGlyphList.Handle, 1, Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
    end
    else begin
      ImageList_DrawEx(FGlyphList.Handle, 2, Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
    end;
end;

end.

Vielleicht hat ja jemand einen kleinen Denkanstoß.

Danke, Guido

[bepe]

In SetGlyphList fügst du die Bilder mit Add hinzu. Versuch es mal mit AddMasked, dann kannst du eine Farbe angeben welche Transparent wird.

Delphi-Quellcode:

FGlyphList.AddMasked(dbm, clFuchsia);

Wenn du dann noch das Makro (ImageList_DrawEx) durch die Draw-Methode der ImageList ersetzt, sollte es klappen.

Delphi-Quellcode:

  if FGlyphList.Count=3 then
    if not FMouseInControl then begin
      FGlyphList.Draw(Canvas, 0, 0, 0);
    end
    else
    if not FMouseClick then begin
      FGlyphList.Draw(Canvas, 0, 0, 1);
    end
    else begin
      FGlyphList.Draw(Canvas, 0, 0, 2);
    end;

[guidok]

Hallo bepe,

ich habs probiert, aber leider hat es nicht funktioniert. Hab grad auch noch einmal geschaut, aber die Hintergrundfarbe meines Testbitmap ist definitiv schwarz.

Delphi-Quellcode:

FGlyphList.DrawingStyle:=dsTransparent;

haut leider auch nicht hin.

...

Soooo, hatte grade noch eine Idee und jetzt funktioniert es auch. Folgendes war die Lösung: Auf dem Testform habe ich ja auch eine Imagelist platziert, die das Bitmap enthält, welches zur Laufzeit dem Hotbutton zugewiesen wird.

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Testbutton:=THotButton.Create(self);
  Testbutton.Parent:=self;
  Testbutton.Top:=10;
  Testbutton.Left:=10;
  Testbutton.ImageList:=ImageList1;
  Testbutton.ImageIndex:=0;
end;

Dieses Bitmap hatte ich ganz normal zur Entwurfszeit zur Liste hinzugefügt und als TransparentColor war clBlack angewählt. In dieser Imagelist wurde es auch transparent angezeigt (Entwurfzeit). Später im Button wurde es dann nicht mehr transparent, allerdings auch nicht mit schwarzem Hintergrund, wie das Originalbitmap, angezeigt. Jetzt habe ich bei Zufügen des Bitmap (Entwurfzeit) die TransparentColor auf clNone gesetzt, in der Liste wird das Bitmap mit schwarzem Hintergrund angezeigt und im Hotbutton ist es transparent.

Guido