Hallo,
das CheckBox.Color keine Wirkung hat, ist ja bekannt.

Lösung 1: andere Komponente
Lösung 2: CheckBox ohne Caption + Label davor
Lösung 3: WM_CTLCOLOR überschreiben

Lösung 3 klappt bei mir irgendwie nicht

Die Methode wird gar nicht aufgerufen!
Ich bin mir sicher, dass ich das schon mal geschafft hatte.

Weiss jemand Rat?

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit101;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm101 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
  private
    { Private-Deklarationen }
    procedure WMCTLColor(var msg: TWMCtlColor); message WM_CTLCOLOR;
  public
    { Public-Deklarationen }
  end;

var
  Form101: TForm101;

implementation

{$R *.dfm}

{ TForm101 }

procedure TForm101.WMCTLColor(var msg: TWMCtlColor);
begin
  inherited ;

  //SetTextColor(Msg.wParam,RGB(0,$80,0));
  //Exit;


  if msg.ChildWnd=CheckBox2.Handle then
  begin
    msg.Result := CreateSolidBrush(RGB(255, 255, 0));
  end;
  
end;

end.

Leg dir halt einfach ein Panel hinter die Checkbox.
oder mach ein Composit-Control aus Panel + Checkbox als TMyCheckboxWithColor

Hier steht, dass die Nachricht nur in 16-bit Windows verwendet wurde und durch andere ersetzt ist:

https://msdn.microsoft.com/de-de/lib...(v=vs.85).aspx

Hallo,

ja, schon bemerkt.

    procedure WMCTLColor(var msg: TWMCtlColorStatic); message WM_CTLCOLORSTATIC; Aber was muss ich machen, um jetzt die Farbe zu ändern.
Ich bekomme immer Bereichsfehler.
Das kann doch nicht sooo schwer sein, verd...

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm101.WMCTLColor(var msg: TWMCtlColorStatic);
begin
  inherited ;

  //SetTextColor(Msg.ChildDC,RGB(0,$80,0));
  //Exit;

  //SetTextColor(Msg.wParam,RGB(0,$80,0));


  if msg.ChildWnd=CheckBox2.Handle then
  begin
    //msg.Result := CreateSolidBrush(RGB(0, 0, 0));
    //SetTextColor(Msg.ChildDC,RGB(0,$80,0)); // <<-- Bereichsfehler !

    msg.Result := GetStockObject(NULL_BRUSH);
  end;

end;

Hm,
alles sehr merkwürdig.

aktueller Stand mit TMessage
Ohne das try except immer noch ein Bereichsfehler

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm101.WMCTLColor(var msg: TMessage);
var
  MyDC: HDC;
begin
  inherited ;

  //SetTextColor(Msg.ChildDC,RGB(0,$80,0));
  //Exit;

  //SetTextColor(Msg.wParam,RGB(0,$80,0));


  //if msg.ChildWnd=CheckBox2.Handle then
  if msg.lParam=CheckBox2.Handle then
  begin
    try
    //SetTextColor(Msg.ChildDC,RGB(0,$80,0));
      //SetTextColor(Msg.ChildDC,ColorToRGB(clRed));
      //msg.Result := CreateSolidBrush(RGB(0, $80, 0));
      //msg.Result := CreateSolidBrush(ColorToRGB(clRed));
      //msg.Result := CreateSolidBrush(RGB(255, 0, 0));

      MyDC := HDC(msg.wParam);

      //SetTextColor(MyDC, ColorToRGB(clRed));

      msg.Result := CreateSolidBrush(ColorToRGB(clRed));

    //msg.Result := GetStockObject(NULL_BRUSH);
    except

    end;
  end;
end;

Ich könnte mir vorstellen, dass das nicht zusammen mit Windows-Themes funktioniert.

Hallo,
ja daran lag es u.a.
vielleicht braucht ja jemand auch die Lösung unten.

Der Bereichsfehler kam daher, dass ich immer RGB-Werte erzeugen wollte,
das SetTextColor klappt aber auch mit den TColor-Werten direkt.

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit101;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm101 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WMCTLColor(var msg: TWMCtlColorStatic); message WM_CTLCOLORSTATIC;
  public
    { Public-Deklarationen }
  end;

var
  Form101: TForm101;

implementation

{$R *.dfm}

uses
  UxTheme;

{ TForm101 }

procedure TForm101.FormCreate(Sender: TObject);
begin
  SetWindowTheme(CheckBox2.Handle, '', '');
  // SetWindowTheme(CheckBox2.Handle, nil, nil); ist falsch !
end;

procedure TForm101.WMCTLColor(var msg: TWMCtlColorStatic);
begin
  inherited ;

  if msg.ChildWnd=CheckBox2.Handle then
  begin
    SetTextColor(Msg.ChildDC,clRed);
  end;
end;

end.