... ein Bitmap eines RadioButton erhalten

[FriFra]

Diese Funktion liefert ein Bitmap eines RadioButton.

Parameter:
Checked = RadioButton ausgewählt
Hot = RadioButton aktiv (funktioniert nur unter XP und bewirkt z.B. unter Luna einen hellroten Rand)
BgColor = Hintergrundfarbe des RadioButton

Wichtig:
Die Bitmap sollte nach Ausführung der Funktion wieder freigegeben werden!
XP-Styles werden erst ab Delphi7 unterstützt.

Delphi-Quellcode:

{$IFDEF VER150}
uses
  Themes;
{$ENDIF}

function GetRadioButtonBitmap(Checked, Hot: Boolean; BgColor: TColor): TBitmap;
const
  CtrlState: array[Boolean] of Integer = (DFCS_BUTTONRADIO,
    DFCS_BUTTONRADIO or DFCS_CHECKED);
var
  CBRect: TRect;
{$IFDEF VER150}
  Details: TThemedElementDetails;
{$ENDIF}
  ChkBmp: TBitmap;
  ThemeOK: Boolean;
  x, y: Integer;
begin
  Result := nil;
  try
    Result := TBitmap.Create;
    ChkBmp := TBitmap.Create;
    try
      ThemeOK := False;
      with Result do
      begin
        Width := 16;
        Height := 16;
        with Canvas do
        begin
          Brush.Color := BgColor;
          FillRect(ClipRect);
          ChkBmp.Assign(Result);
          CBRect := ClipRect;
          CBRect.Top := 1;
          CBRect.Left := 1;
{$IFDEF VER150}
          if ThemeServices.ThemesAvailable then
          begin
          //ab WinXP
            if Checked then
            begin
              if Hot = True then
                Details := ThemeServices.GetElementDetails(tbRadioButtonCheckedHot)
              else
                Details :=
                  ThemeServices.GetElementDetails(tbRadioButtonCheckedNormal);
            end
            else
            begin
              if Hot then
                Details :=
                  ThemeServices.GetElementDetails(tbRadioButtonUncheckedHot)
              else
                Details :=
                  ThemeServices.GetElementDetails(tbRadioButtonUncheckedNormal);
            end;
            ThemeServices.DrawElement(Handle, Details, CBRect);
          //Prüfen ob es tatsächlich geklappt hat (Win2003 liefert leere Images!)
            for x := 15 downto 0 do
              for y := 15 downto 0 do
                if ChkBmp.Canvas.Pixels[x, y] <> Pixels[x, y] then
                begin
                  ThemeOK := True;
                  Break;
                end;
          end;
{$ENDIF}
          if not ThemeOK then
          begin
          //alles vor WinXP
            CBRect.Left := ClipRect.Left + 2;
            CBRect.Right := ClipRect.Right - 1;
            CBRect.Top := ClipRect.Top + 2;
            CBRect.Bottom := ClipRect.Bottom - 1;
            DrawFrameControl(Handle, CBRect, DFC_BUTTON, CtrlState[Checked]);
          end;
        end; // with Canvas
      end; // with Result
    finally
      ChkBmp.Free;
    end;
  finally
  end;
end;

Beispielaufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  rbBitmap: TBitmap;
begin
  rbBitmap := GetRadioButtonBitmap(True, True, clBtnFace);
  Image1.Picture.Bitmap.Assign(rbBitmap);
  rbBitmap.Free;
end;

[Edit=Sakura]Delphi-TAGS gesetzt.[/Edit]
[Edit=FriFra]Problembehandlung Win2003[/Edit]
[Edit=FriFra]Compilerdirektive für ältere Delphi Versionen[/Edit]
[Edit=toms]Memory Leak: ChkBmp wurde nicht freigegeben und Beispielaufruf hinzugefügt[/Edit]