Komponenten-Style für das Betriebssystem anpassen

Frühlingsrolle · Verfasst: Fr 09.02.18 11:15

Hallo Forum

Problemstellung:
Eine Komponente (von TCustomControl abgeleitet) zeichnet mit der Funktion DrawFrameControl(), je nach Auswahl, einen RadioButton oder eine CheckBox:

delphi_cr_style

Das Aussehen ist leider nicht "Win7-gerecht". Wie oder womit bekomm' ich den "passenden" Style für das jeweilige Betriebssystem hin? Mit dem XP-Manifest geht es schonmal nicht!

Nachtrag

Hab's doch noch über die WinAPI gelöst:
- OpenThemeData()
- CloseThemeData()
- DrawThemeBackground()
- Parts and States

markieren

WinAPI Import

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:

type
  HTHEME = THandle;

const
  { DrawThemeBackground() iPartId }
  BP_RADIOBUTTON = 2;
  BP_CHECKBOX = 3;
  { DrawThemeBackground() iStateId - CHECKBOX & RADIOBUTTON }
  STATE_ID_UNCHECKEDNORMAL = 1;
  STATE_ID_UNCHECKEDHOT = 2;
  STATE_ID_UNCHECKEDPRESSED = 3;
  STATE_ID_UNCHECKEDDISABLED = 4;
  STATE_ID_CHECKEDNORMAL = 5;
  STATE_ID_CHECKEDHOT = 6;
  STATE_ID_CHECKEDPRESSED = 7;
  STATE_ID_CHECKEDDISABLED = 8;
  STATE_ID_MIXEDNORMAL = 9;     // CHECKBOX only
  STATE_ID_MIXEDHOT = 10;       // CHECKBOX only
  STATE_ID_MIXEDPRESSED = 11;   // CHECKBOX only
  STATE_ID_MIXEDDISABLED = 12;  // CHECKBOX only

  UX_THEME = 'UxTheme.dll';

function OpenThemeData(hWnd: HWND; pszClassList: PWideChar): HTHEME; stdcall;
  external UX_THEME name 'OpenThemeData';

function CloseThemeData(hTheme: HTHEME): HRESULT; stdcall;
  external UX_THEME name 'CloseThemeData';

function DrawThemeBackground(hTheme: HTHEME; hdc: HDC;
  iPartId, iStateId: Integer; pRect, pClipRect: PRect): HRESULT; stdcall;
  external UX_THEME name 'DrawThemeBackground';

Der folgende Code ist ein wenig "statisch" ausgelegt, d.h. das Steuerelement ist permanent auf "Checked" gesetzt, um das Gezeichnete schneller zu testen:

markieren

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:

uses
  Classes, Controls, Windows, Graphics;

type
  TBoxType = (btCheck, btRadio);

  TfrCheckRadioControl = class(TCustomControl)
  private
    FBoxType: TBoxType;
    FHTheme: HTHEME;
  protected
    procedure Paint; override;
    procedure DrawBox(ASize: Word);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BoxType: TBoxType read FBoxType write FBoxType;
  end;

implementation

constructor TfrCheckRadioControl.Create(AOwner: TComponent);
begin
  inherited;
  Parent := TWinControl(AOwner);
  // ...
  FHTheme := OpenThemeData(Handle, 'BUTTON');
end;

destructor TfrCheckRadioControl.Destroy;
begin
  // ...
  CloseThemeData(FHTheme);
  inherited;
end;

procedure TfrCheckRadioControl.Paint;
begin
  // ...
  DrawBox(12);
end;

procedure TfrCheckRadioControl.DrawBox(ASize: Word); // provisorisch
var
  r: TRect;
  box: DWord;
  partID, stateID: Integer;
begin
  r := Rect(0, 3, ASize, ASize + 3);

  if FBoxType = btCheck then
  begin
    box := DFCS_BUTTONCHECK;
    partID := BP_CHECKBOX;
  end else
  begin
    box := DFCS_BUTTONRADIO;
    partID := BP_RADIOBUTTON;
  end;

  stateID := STATE_ID_CHECKEDNORMAL;

  DrawFrameControl(Canvas.Handle, r, DFC_BUTTON, box or DFCS_CHECKED);   // zeichnet das alte Theme
  DrawThemeBackground(FHTheme, Canvas.Handle, partID, stateID, @r, nil); // zeichnet das neue Theme
end;

Zum Vergleich:

delphi_cr_style2

Das Thema hat sich erledigt !!!

Einloggen, um Attachments anzusehen!

_________________
„Politicians are put there to give you the idea that you have freedom of choice. You don’t. You have no choice. You have owners. They own you. They own everything." (George Denis Patrick Carlin)

Frühlingsrolle · Verfasst: Do 08.03.18 17:39

Mit dem "modernen" Theme, welches mit der DrawThemeBackground() Funktion gezeichnet wird, hab ich noch meine Schwierigkeiten.

Dabei reagiere ich auf die Nachrichten CM_MOUSEENTER(= $B019) / CM_MOUSELEAVE(= $B020) und setze die Variable FMouseEntered je nachdem auf true / false.
In meiner DrawBoxXP() Methode, wo die Box im modernen Theme gezeichnet wird, frage ich FMouseEntered ab und setze für die DrawThemeBackground() Funktion entsprechende iStateId-Werte:

markieren

Delphi-Quelltext

1:
2:
3:
4:

STATE_ID_CHECKEDHOT       // selektierte (blau-hinterlegte) Box, wenn FMouseEntered = true
STATE_ID_UNCHECKEDHOT     // de-selektierte (blau-hinterlegte) Box, wenn FMouseEntered = true
STATE_ID_CHECKEDNORMAL    // selektierte (grau-hinterlegte) Box, wenn FMouseEntered = false
STATE_ID_UNCHECKEDNORMAL  // de-selektierte (grau-hinterlegte) Box, wenn FMouseEntered = false

Das Problem hierbei ist, dass sich die Box garnicht verändert, weder wenn die Maus drauf ist, noch wenn sie nicht drauf ist.
Klicke ich auf die Box oder auf die Komponente selbst, wird die Box je nachdem de/selektiert und verbleibt im blauen Hintergrund (STATE_ID_CHECKEDHOT bzw. STATE_ID_UNCHECKEDHOT), und ich weiss nicht warum. :nixweiss:

markieren

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:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:

uses
  Classes, Controls, Graphics, Windows, Messages;

type
  TBoxType = (btCheck, btRadio);

  TfrCheckRadioControl = class(TCustomControl)
  private
    FBoxType: TBoxType;
    FChecked: Boolean;
    FHTheme: HTHEME;
    FMouseEntered: Boolean;    // stellt fest, ob die Maus auf der Komponente ist
  protected
    function DrawBoxXP(ASize: Byte; AChecked: Boolean = false): Boolean;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Checked: Boolean read FChecked write SetChecked;
  end;

implementation

constructor TfrCheckRadioControl.Create(AOwner: TComponent);
begin
  inherited;
  Parent := TWinControl(AOwner);
  FBoxType := btCheck;
  FHTheme := OpenThemeData(Handle, 'BUTTON');
end;

destructor TfrCheckRadioControl.Destroy;
begin
  CloseThemeData(FHTheme);
  inherited;
end;

function TfrCheckRadioControl.DrawBoxXP(ASize: Word;
  AChecked: Boolean = false): Boolean;
var
  rBox: TRect;
  partID, stateID: Integer;
  hRes: HRESULT;
begin
  if FBoxType = btCheck then
    partID := BP_CHECKBOX else
    partID := BP_RADIOBUTTON;

  if FMouseEntered then   // mit dieser Abfrage fängt das Problem an
  begin
    if AChecked then
      stateID := STATE_ID_CHECKEDHOT else
      stateID := STATE_ID_UNCHECKEDHOT;
  end else
  begin
    if AChecked then
      stateID := STATE_ID_CHECKEDNORMAL else
      stateID := STATE_ID_UNCHECKEDNORMAL;
  end;

  case BoxAlignment of

    baTop:
      rBox := Rect((Width - ASize) div 2, 0,
                   ASize + (Width - ASize) div 2, ASize);
    baRight:
      rBox := Rect(Width - ASize, (Height - ASize) div 2,
                   Width, ASize + (Height - ASize) div 2);
    baBottom:
      rBox := Rect((Width - ASize) div 2, Height - ASize,
                   ASize + (Width - ASize) div 2, Height);
    else
      rBox := Rect(0, (Height - ASize) div 2,
                   ASize, ASize + (Height - ASize) div 2);
  end;

  hRes := DrawThemeBackground(FHTheme, Canvas.Handle,
                              partID, stateID, @rBox, nil);

  result := hRes = S_OK;
end;

procedure TfrCheckRadioControl.Paint;
begin
  DrawBoxXP(13, Checked);
end;

procedurE TfrCheckRadioControl.WndProc(var Message: TMessage);
begin
  case Message.Msg of

    CM_MOUSEENTER:
    begin
      FMouseEntered := true;
      //Caption := 'D';          // weise ich z.B. der Caption etwas zu, wird alles wie gewünscht gezeichnet
    end;

    CM_MOUSELEAVE:
    begin
      FMouseEntered := false;
      //Caption := 'L';          // hier ebenso
    end;

    WM_KEYDOWN:
      if Message.WParam in [VK_SPACE, VK_RETURN] then
      begin
        SetFocus;
        Checked := not Checked;
      end;
 
    WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
    begin
      SetFocus;
      Checked := not Checked;
    end;

  end;
  inherited;
end;

procedure TfrCheckRadioControl.SetChecked(Value: Boolean);
begin
  FChecked := Value;
  Invalidate;
end;

Die Variable FMouseEntered habe ich zum testen auch mal public gesetzt und abgefragt. Sie hat mir die "richtigen" Werte geliefert, sobald die Maus auf der Komponente war / die Komponente verlassen hat. An dem liegt es schonmal nicht.
Dennoch erfolgt kein "vollständiges Neuzeichnen". Die Selektion wird wohl dargestellt, jedoch nicht der Zustand "HOT" oder "NORMAL", wenn die Maus auf der Komponente (nicht mehr) drauf ist.

Kann mir da jemand helfen? :gruebel:

Der Quelltext ist hier auf das Mindeste reduziert. Die WinAPI Funktionen und Konstanten sind im ersten Beitrag vorzufinden, gleich im ersten Codeabschnitt.

_________________
„Politicians are put there to give you the idea that you have freedom of choice. You don’t. You have no choice. You have owners. They own you. They own everything." (George Denis Patrick Carlin)

FinnO · Verfasst: Do 08.03.18 22:43

Ohne jegliche Ahnung: Hast du mal überlegt Invalidate auch aufzurufen, wenn du FMouseEntered änderst? Meinetwegen kannst du das ja auch in einem Setter machen...

Frühlingsrolle · Verfasst: Fr 09.03.18 03:43

Das war die Lösung. :zustimm:

Entweder ruft man Invalidate() auf, nachdem der Variable FMouseEntered etwas zugewiesen wurde, oder FMouseEntered ist eine Eigenschaft, der im Setter Invalidate() aufgerufen wird.

Hab vielen Dank, FinnO!

_________________
„Politicians are put there to give you the idea that you have freedom of choice. You don’t. You have no choice. You have owners. They own you. They own everything." (George Denis Patrick Carlin)

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme