Bitmap einer CheckBox liefern

[FriFra]

Diese Funktion liefert ein Bitmap einer CheckBox.

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

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 GetCheckBoxBitmap(Checked, Hot: boolean; BgColor: TColor): TBitmap;
const
  CtrlState: array[Boolean] of Integer = (DFCS_BUTTONCHECK,
    DFCS_BUTTONCHECK or DFCS_CHECKED);
var
  CBRect: TRect;
{$IFDEF VER150}
  Details: TThemedElementDetails;
{$ENDIF}
  BgOld: TColor;
  ChkBmp: TBitmap;
  ThemeOK: boolean;
  x, x2, y: integer;
begin
  Result := nil;
  try
    Result := TBitmap.Create;
    ChkBmp := TBitmap.Create;
    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 = True then
          begin
            if Hot = True then
              Details := ThemeServices.GetElementDetails(tbCheckBoxCheckedHot)
            else
              Details :=
                ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
          end
          else
          begin
            if Hot = True then
              Details :=
                ThemeServices.GetElementDetails(tbCheckBoxUncheckedHot)
            else
              Details :=
                ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal);
          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 ThemeOK = False 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;
    end;
  finally
  end;
end;

[Edit=Sakura]Delphi-TAGS eingesetzt[/Edit]
[Edit=FriFra]Problembehandlung für Win2003[/Edit]
[Edit=FriFra]Compilerdirektive für ältere Delphi Versionen[/Edit]

[edit=flomei]Wir "räumen auf", daher Titel geändert... Mfg, flomei[/edit]