TCheckBox.Color über WM_CTLCOLOR

[hoika]

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?

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.

[Bernhard Geyer]

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

[CarlAshnikov]

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

[hoika]

Hallo,

ja, schon bemerkt.

Delphi-Quellcode:

    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...

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;

[hoika]

Hm,
alles sehr merkwürdig.

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

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;

[uligerhardt]

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

[hoika]

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.

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.

[hoika]

Hallo,
und hier das fertige Endprodukt mit dynamisch erzeugter CheckBox3.
Tag=1 bedeutet "rote Schrift"

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);
var
  CheckBox3: TCheckBox;
begin
  SetWindowTheme(CheckBox2.Handle, '', '');

  CheckBox3 := TCheckBox.Create(Self);
  CheckBox3.Parent := Self;
  CheckBox3.Caption := 'CheckBox3';
  CheckBox3.Tag := 1;
  CheckBox3.Name := 'CheckBox3';
  SetWindowTheme(CheckBox3.Handle, '', '');
end;

procedure TForm101.WMCTLColor(var msg: TWMCtlColorStatic);
var
  sCompText: array[0..255] of Char;
  Comp: TComponent;
  CheckBox: TCheckBox;
begin
  inherited ;

  //if msg.ChildWnd=CheckBox2.Handle then
  begin
    SendMessage(msg.ChildWnd, WM_GETTEXT, SizeOf(sCompText), Integer(@sCompText[0]));

    if sCompText<>'' then
    begin
      Comp := FindComponent(sCompText);
      if Comp<>nil then
      begin
        if Comp is TCheckBox then
        begin
          CheckBox := TCheckBox(Comp);
          if CheckBox.Tag=1 then
          begin
            SetTextColor(Msg.ChildDC,clRed);
          end;
        end;
      end;
    end;
  end;
end;

end.