"Transparenz" bei eigener Komponente

[franz]

Hi,
Ich habe hier eine Lösung für alle Komponenten, die von TWinControl abgeleitet sind. Allerdings funktioniert die Lösung nicht mit folgenden Farben, was im übrigen gar nicht so schlimm ist, da die transparente Farbe automatisch ermittelt werden kann.

clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder, clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DdkShadow, cl3Dlight, clInfoText, clInfoBk


1. Grundlagen:
Ab Windows 95 unterstützt Windows beliebige Fensterformen.

Nach Microsoft Definition ist ein Fester, unter Windows, ein Objekt, das von einer registrierten Fensterklasse abgeleitet ist und über die Eigenschaften von TWinControl verfügt:

Also sind alle von TWinControl abgeleiteten Klassen Fenster.


2. Komponente transparent machen
Komponente, die von TGraphicControl abgeleitet sind, sind bereits transparent. Mit dem folgenden Code kann man nur Komponenten transparent machen, die von TWinControl abgeleitet sind (Erklärung siehe 1. Grundlagen).


Zunächst müssen wir sicherstellen, dass wir das Steuerelement wieder zurücksetzen können. Also die Transparenz wieder entfernen:

Hinweis: Die Prozedur UndoTransparent wird von MakeTransparent (weiter unten) aufgerufen

Delphi-Quellcode:

// Transparenz rückgängig machen
procedure UndoTransparent(Control: TWinControl);
var
  HR: HRgn;
begin
  if not Assigned(Control) then
     Exit;

  HR := CreateRectRgn(0,0,Control.Width,Control.Height);
  SetWindowRgn(Control.Handle, HR, true);
end;

Nun müssen wir einen ScreenShot des Steuerelements anfertigen, damit der Inhalt des Steuerelements nicht verloren geht und wir somit am Schluss gar nicht mehr sehen würden:

Hinweis: Die Prozedur TakeControlScreenShot wird von MakeTransparent (weiter unten) aufgerufen

Delphi-Quellcode:

// ScreenShot des Steuerelements anfertigen und an das übergebene Bitmap
// übergeben
procedure TakeControlScreenShot(Control: TWinControl; var Bitmap: TBitmap);

type
  LogPal = record
    lpal : TLogPalette;
    dummy: array[0..255] of TPaletteEntry;
  end;

var
  SysPal:  LogPal;
  mImage:  TImage;
  mPal:    HPalette;
  mHDC:    HDC;
  mCanvas: TCanvas;
  mRect:   TRect;
begin
  if not Assigned(Control) then
     Exit;

  mHDC := GetWindowDC(Control.Handle);

  SysPal.lPal.palVersion    := $300;
  SysPal.lPal.palNumEntries := 256;

  GetSystemPaletteEntries(mHDC, 0, 256, SysPal.lpal.PalpalEntry);
  mPal := CreatePalette(SysPal.lpal);

  mCanvas := TCanvas.Create;
  try
    mCanvas.Handle := mHDC;
    mRect  := Rect(0, 0, Screen.Width, Screen.Height);

    mImage := TImage.Create(nil);
    try
      with mImage do
        begin
          Height := Control.Height;
          Width  := Control.Width;

          Canvas.CopyRect(mRect, mCanvas, mRect);
          ReleaseDC(GetDeskTopWindow, mHDC);
          Picture.Bitmap.Palette := mPal;
        end;

      Bitmap.Assign(mImage.Picture.Bitmap);
    finally
      mImage.Free;
    end;

    ReleaseDC(GetDeskTopWindow, mHDC);
    ReleaseDC(Control.Handle, mCanvas.Handle)
  finally
    mCanvas.Free;
  end;
end;

Jetzt kommt erst die eigentliche Prozedur, die das Steuerelement transparent macht.
Dummerweise muss zu diesem Zweck die Pixels Eigenschaft von TBitmap.Canvas verwendet werden. Mit ScanLine hat es einfach nicht funktioniert.

Hinweis: Die Prozedur MakeTransparent muss logischerweise aufgerufen werden

Delphi-Quellcode:

// Steuerelement Transparent machen
procedure MakeTransparent(Control: TWinControl; TranspColor: TColor = clNone);
var
  HR, mBuf: HRgn;
  ix, iy:   Integer;
  Bitmap:   TBitmap;
begin
  // Objekte Prüfen
  [Edit]  
     // Alter Quelltext:
     // Vorher wurde ein Bitmap an die Prozedur übergeben 
     {if (not Assigned(Control)) or (not Assigned(Bitmap)) then
        Exit;}

     // Neuer Quelltext
     // Da das Bitmap nicht mehr an die Prozedur übergeben wird
     if (not Assigned(Control)) then
         Exit;
  [/Edit] 

  // Transparenz rückgängig machen
  UndoTransparent(Control);

  // Steuerelement transparent machen
  HR     := CreateRectRgn(0,0,0,0);
  Bitmap := TBitmap.Create;
  try
    // Screen Shot des Steuerlement anfertigen
    TakeControlScreenShot(Control,Bitmap);

    // Transparente Farbe einstellen, falls nötig
    if TranspColor = clNone then
       TranspColor := Bitmap.Canvas.Pixels[0,0];

    // Sichtbaren Bereich erstellen
    for iy := 0 to Bitmap.Height-1 do
      begin
        if (iy mod 50) = 0 then
           Application.ProcessMessages;

        for ix := 0 to Bitmap.Width-1 do
          begin
            if Bitmap.Canvas.Pixels[ix,iy] <> TranspColor then
               begin
                 mBuf := CreateRectRgn(ix,iy,1+ix,1+iy);
                 try
                   CombineRgn(HR, HR, mBuf, RGN_OR);
                 finally
                   DeleteObject(mBuf);
                 end;
               end;
          end;
      end;

    // Sichtbaren Bereich dem Steuerelement zuordnen
    SetWindowRgn(Control.Handle, HR, true);
  finally
    DeleteObject(HR);
    Bitmap.Free;
  end;
end;

Aufgerufen wird das ganze folgendermaßen. Dabei wird GroupBox1 transparent gemacht.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  MakeTransparent(GroupBox1);
end;

Zunächst muss sichergestellt werden, dass das Steuerelement nicht mehr transparent ist. Danach wird es wieder transparent gemacht. Der zweite Parameter von MakeTransparent gibt die transparente Farbe an. Wenn nichts angegeben wird, wird als transparente Farbe die Farbe des ersten Pixels verwendet.

Warnung!
MakeTransparent greift auf die Eigenschaft TCanvas.Pixels zu. Dadurch kann je nach Größe des Steuerelements die Berechnung etwas dauern. Rufe NIEMALS MakeTransparent innerhalb von OnPaint auf! Sonst „steht“, unter Umständen, der Computer! Es empfiehlt sich einen Thread für das transparent machen eines Steuerelements zu verwenden.