Weisser Hintergrund trotz FillRect mit anderer Farbe?

[Phoenix]

Hi,

ich hab ein eigenes Control.
Dieses Zeichnet sich in einer überschriebenen Paint-Routine selber: Erst Hintergrund (Farbe), dann Vordergrund (Text), dann Rahmen.

Delphi-Quellcode:

procedure TMyCustomPanel.Paint;
var Rect: TRect;
begin
  Rect := GetClientRect;

  doPaintBackground(Rect);
  doPaintBorder(Rect);
  doPaintText;
end;

procedure TMyCustomPanel.doPaintBackground(const ARect: TRect);
begin
  if not ParentBackground then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(ARect);
  end;
end;

Das Funktioniert einwandfrei. Das Control ist hinterher hellgrün mit schwarzem Text und der Rahmen hat auch die richtige Farbe.

Nun habe ich eine Ableitung davon, die zusätzlich ein Hintergrundbild haben kann.

Alte Version:

Delphi-Quellcode:

procedure TMyPanelAbleitung.doPaintBackground(const ARect: TRect);
begin
  inherited;  // hier WIRD das obere Paint ausgeführt 

  // draw background image if availabe
  if Assigned(FBackgroundBitmap) then
  begin
    BitBlt(Canvas.Handle,
           ARect.Left + 2,
           ARect.Top + 2,
           FBackgroundBitmap.Width,
           FBackgroundBitmap.Height,
           FBackgroundBitmap.Canvas.Handle,
           0,
           0,
           SRCCOPY
    );
  end;
end;

Tja. Nun ist das ganze Control aber leider innen weiss - mit dem gezeichneten Bild. Rahmen und Text passen weiterhin - aber der vorher gezeichnete hellgrüne Hintergrund ist futsch und mit Weiss überzeichnet.

Die aktuelle Version benutzt folgenden Code: http://www.delphipraxis.net/internal...t.php?t=30824:

Delphi-Quellcode:

procedure TMyPanelAbleitung.doPaintBackground(const ARect: TRect);
var BlendFunction: TBlendFunction;
begin
  inherited;

  // draw background image if availabe
  if Assigned(FBackgroundBitmap) then
  begin
    BlendFunction.AlphaFormat := 0;
    BlendFunction.AlphaFormat := 0;
    BlendFunction.BlendFlags := 0;
    BlendFunction.BlendOp := AC_SRC_OVER;
    BlendFunction.SourceConstantAlpha := 100; // 0 .. 255 (255 = volle Sichtbarkeit)

    TryAlphaBlend(Canvas.Handle,
           ARect.Left + 2,
           ARect.Top + 2,
           FBackgroundBitmap.Width,
           FBackgroundBitmap.Height,
           FBackgroundBitmap.Canvas.Handle,
           0,
           0,
           FBackgroundBitmap.Width,
           FBackgroundBitmap.Height,
           BlendFunction
    );
  end;
end;

Nun wird das Bild halt Transparent aufs Weiss gezeichnet - nix vom Hellgrünen über.

Wo ist der Hintergrund hin, den ich in der Basisklasser definitiv einwandfrei zeichne?

[Phoenix]

*KlammheimlichdieUhrumeineStundevorstell*

Hat irgendwer ne Idee? Das wär ein wenig dringlich und ich hab absolut keine Ahnung woran das liegen könnte.

[SirThornberry]

bist du schon mit dem Debugger rein gesteppt?
ich vermute das Rect stimmt nicht.
Versuche probehalber mal anstelle von:
inherited; // hier WIRD das obere Paint ausgeführt einfach
inherited doPaintBackground(ARect); // hier WIRD das obere Paint ausgeführt Wie gesagt würde ich als erstes mit dem Debugger an die Sache ran gehen und schauen ob auch alles fein abgearbeitet wird mit den richtigen Parametern.

Im übrigen rate ich von der Windows-Alphablend-Funktion ab sobald AC_SRC_ALPHA verwendet wird.

[Phoenix]

Sagen wir es mal so:

Ich habe Controls, bei denen ist FBackgroundBitmap nil. Da wird auch nur inherited aufgerufen, und die bekommen die richtige Hintergrundfarbe. Das wird alles richtig ausgeführt. Kann ich Dir zu 100% bestätigen.

Wenn ich im Debugger hergehe, und bei einem Control mit Hintergrundbild hergehe, und sowohl vor dem inherited als auch hinterher hergehe, und das zugewiesene FBackgroundBitmap auf nil setze, dann hat auch dieses Control den richtigfarbenen Hintergrund.

Sobald ich anfange, das Bild zu zeichnen, wird der Hintergrund wieder in Weiss übermalt. Und das, obwohl ich nur einen 20x20 Pixel Bereich mit dem Bitmap bemale. Der Rest wird nicht angerührt, ist hinterher aber dennoch weiss

[SirThornberry]

funktioniert es mit einem stretchblt? nicht das die Alphablendfunktion dort was vermurkst.
Und versuch mal AlphaBlend direkt aufzurufen (aus der Unit Windows) ohne dieses dynamische Laden durch die TryAlphaBlend. Nicht das durch das dynamische Laden unsyncron wird.

[Edit]
Was mich an den TryAlphaBlend noch stört: Wenn AlphaBlend nicht verfügbar ist wird nur ein BitBlt ausgeführt obwohl ein StretchBlt richtig wäre (schließlich stretcht AlphaBlend auch)

[Phoenix]

Stretchblt kann ich nicht verwenden. Dann wird das Bild irgendwie krisselig. BitBlt hatte ich vorher drin, und das geht auch nicht

Ich brauch kein Alphablend - ich dachte das wäre eine Lösung weil es mit einem einfachen BitBlt (siehe 'Alte Version' im OP) eben auch nicht ging.

[SirThornberry]

merkwürdig, ich hatte damit nie probleme. Auf welchem Pixelformat steht dein bitmap? klappt es wenn du das umstellst? Und klappt es wenn du vor das BitBlt in der überschriebenen Methode das FillRect machst? (ich weiß das dies nicht die Lösung sein soll - es geht mir darum heraus zu finden woran das liegen kann da ich das Problem noch nie hatte)

[jfheins]

Also bei mir funktioniert das einigermaßen gut ...

Ich habe folgenden Code:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TMyCustomPanel = class (TPanel)
  public
    procedure doPaintBackground(const ARect: TRect); virtual;
    procedure doPaintBorder(const ARect: TRect);
    procedure Paint; override;
  end;

  TMyPicturePanel = class (TMyCustomPanel)
  public
    FBackgroundBitmap: TBitmap;
    procedure doPaintBackground(const ARect: TRect); override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TMyCustomPanel.doPaintBorder(const ARect: TRect);
begin
  if not ParentBackground then
  begin
    Canvas.Brush.Color := clBlue;
    Canvas.FrameRect(ARect);
  end;
end;

procedure TMyCustomPanel.Paint;
var Rect: TRect; 
begin 
  Rect := GetClientRect; 
                    
  doPaintBackground(Rect);
  doPaintBorder(Rect);
end;

procedure TMyCustomPanel.doPaintBackground(const ARect: TRect);
begin
  if not ParentBackground then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(ARect);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TMyCustomPanel.Create(self) do
  begin
    Parent := self;
    Top := 10;
    Left := 10;
    Height := 50;
    Width := 50;
    ParentBackground := false;
    Color := clRed;
  end;

  with TMyPicturePanel.Create(self) do
  begin
    Parent := self;
    Top := 80;
    Left := 10;
    Height := 50;
    Width := 50;
    ParentBackground := false;
    Color := clMaroon;
    FBackgroundBitmap := TBitmap.Create();
    FBackgroundBitmap.Width := 30;
    FBackgroundBitmap.Height := 30;
    FBackgroundBitmap.Canvas.CopyRect(Rect(0, 0, 30, 30), Image1.Canvas, Rect(0, 0, 30, 30));
  end;
end;

{ TMyPicturePanel }

//procedure TMyPicturePanel.doPaintBackground(const ARect: TRect);
//begin
//  inherited;
//
//  if Assigned(FBackgroundBitmap) then
//  begin 
//    BitBlt(Canvas.Handle,
//           ARect.Left + 2,
//           ARect.Top + 2,
//           FBackgroundBitmap.Width,
//           FBackgroundBitmap.Height,
//           FBackgroundBitmap.Canvas.Handle,
//           0,
//           0,
//           SRCCOPY
//    ); 
//  end;
//end;



{ TMyPicturePanel }

var Hmsimg32: THandle = 0; 


// Funktion fürs AlphaBlending, bei Fehlschlag einfaches Copy 
// Gründe fürs Fehlschlagen: 
// kein Win98/2000/XP 
// Kein Source 32bit 
// ... 
function TryAlphaBlend(DC: HDC; p2, p3, p4, p5: Integer; 
  DC6: HDC; p7, p8, p9, p10: Integer; p11: TBlendFunction): Boolean; 
var F: function(DC: HDC; p2, p3, p4, p5: Integer; 
                DC6: HDC; p7, p8, p9, p10: Integer; 
                p11: TBlendFunction): BOOL; stdcall; 
begin 
  Result := False; 
  if Hmsimg32 = 0 then 
    Hmsimg32 := LoadLibrary(msimg32); 
  if Hmsimg32 <> 0 then 
  begin 
    @F := GetProcAddress(Hmsimg32, 'AlphaBlend'); 
    if @F <> nil then 
      Result := F(DC, p2, p3, p4, p5, DC6, p7, p8, p9, p10, p11); 
  end; 

  if not Result then 
    Result := BitBlt(DC, p2, p3, p4, p5, DC6, p7, p8, SRCCOPY); 
end; // TryAlphaBlend

procedure TMyPicturePanel.doPaintBackground(const ARect: TRect);
var BlendFunction: TBlendFunction; 
begin 
  inherited; 

  // draw background image if availabe 
  if Assigned(FBackgroundBitmap) then 
  begin 
    BlendFunction.AlphaFormat := 0; 
    BlendFunction.AlphaFormat := 0; 
    BlendFunction.BlendFlags := 0; 
    BlendFunction.BlendOp := AC_SRC_OVER; 
    BlendFunction.SourceConstantAlpha := 100; // 0 .. 255 (255 = volle Sichtbarkeit) 

    TryAlphaBlend(Canvas.Handle, 
           ARect.Left + 2, 
           ARect.Top + 2, 
           FBackgroundBitmap.Width, 
           FBackgroundBitmap.Height, 
           FBackgroundBitmap.Canvas.Handle, 
           0, 
           0, 
           FBackgroundBitmap.Width, 
           FBackgroundBitmap.Height, 
           BlendFunction 
    ); 
  end;
end;

end.

Beide Möglichkeiten funktionieren, bei der ersten isses halt nicht halbtransparent, sondern deckend, aber der Hintergrund bleibt bei beiden Funktionen farbig ... (Ich kann dir auch nochmal das Projekt schicken, wenn du mir nicht glaubst )

[Phoenix]

Ich glaub Dir nicht

[jfheins]

Ok, dann gebe ich dir mal das ganze Projekt

Alles eingetütet, zum sofort ausprobieren