Weisser Hintergrund trotz FillRect mit anderer Farbe?

[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 )