Autor Beitrag
FriFra
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 557

Win XP Prof, Win XP Home,Win Server 2003,Win 98SE,Win 2000,Win NT4,Win 3.11,Suse Linux 7.3 Prof,Suse Linux 8.0 Prof
D2k5 Prof, D7 Prof, D5 Standard, D3 Prof, K3 Prof
BeitragVerfasst: Do 29.05.03 16:34 
ein Bitmap einer CheckBox erhalten?

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.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
{$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;

_________________
Michael
(principal certified lotus professional - developer)


Zuletzt bearbeitet von FriFra am Do 29.05.03 19:43, insgesamt 5-mal bearbeitet