0
0 Comments

I hate the title of this question. Anyway:

If you call TForm.Show with a custom theme (Windows10 Dark in this case), then close that form, then change the theme to the system Windows theme, then change back to the Windows10 Dark theme, and finally call TForm.Show on that form again, the border renders incorrectly and certain controls do not render properly, like a TComboBox.

I have a test project below, and a "fix" of sorts. But I do not like my fix and the reason for this question is that I do not really understand what is happening here that causes the form to render incorrectly only if it was hidden while the theme changed, and only if the theme is changed away from, and then back to, Windows10 Dark.

My fix is to track the theme change. If the condition I describe above occurs, I intercept the CM_SHOWINGCHANGED message, ignore it, then force the window to be recreated and then process the inherited CM_SHOWINGCHANGED. It is a very brittle fix and obviously not the way to go, so I am hoping someone can show me what is actually happening so I can fix it "for real."

Incidentally, I have submitted this as a bug to Embarcadero already. https://quality.embarcadero.com/browse/RSP-33977

Here is the test code. You’ll need to add Windows10 Dark to the application’s styles, obviously.

unit Unit22;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Unit23, Vcl.Themes;

type
  TForm22 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    RadioGroup1: TRadioGroup;
    ButtonShow: TButton;
    Memo1: TMemo;
    procedure ButtonShowClick(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FAllowChange: Boolean;
  public
    { Public declarations }
  end;

var
  Form22: TForm22;

implementation

{R *.dfm}  procedure TForm22.ButtonShowClick(Sender: TObject); begin   Form23.Show; end;  procedure TForm22.FormShow(Sender: TObject); begin   if StyleServices.Name = 'Windows10 Dark' then     RadioGroup1.ItemIndex := 1   else     RadioGroup1.ItemIndex := 0;   FAllowChange := True; end;  procedure TForm22.RadioGroup1Click(Sender: TObject); begin   if not FAllowChange then     exit;   if RadioGroup1.ItemIndex = 0 then     TStyleManager.SetStyle('Windows');   if RadioGroup1.ItemIndex = 1 then     TStyleManager.SetStyle('Windows10 Dark'); end;  end.  </pre></div><!-- /wp:codemirror-blocks/code-block --> <!-- wp:paragraph -->Unit 22 DPR:<!-- /wp:paragraph --> <!-- wp:codemirror-blocks/code-block {"showPanel":false,"languageLabel":"no","mode":"clike","mime":"text\/x-c++src"} --> 			<div class="wp-block-codemirror-blocks-code-block code-block"><pre>object Form22: TForm22   Left = 0   Top = 0   ActiveControl = Memo1   Caption = 'Form22'   ClientHeight = 305   ClientWidth = 511   Color = clBtnFace   Font.Charset = DEFAULT_CHARSET   Font.Color = clWindowText   Font.Height = -11   Font.Name = 'Tahoma'   Font.Style = []   OldCreateOrder = False   OnShow = FormShow   PixelsPerInch = 96   TextHeight = 13   object Panel1: TPanel     Left = 0     Top = 0     Width = 511     Height = 305     Align = alClient     BevelEdges = []     BevelOuter = bvNone     Caption = 'Panel1'     ShowCaption = False     TabOrder = 0     object ComboBox1: TComboBox       Left = 16       Top = 8       Width = 145       Height = 21       Style = csDropDownList       ItemIndex = 0       TabOrder = 0       Text = 'one'       Items.Strings = (         'one'         'two'         'three')     end     object RadioGroup1: TRadioGroup       Left = 16       Top = 48       Width = 185       Height = 105       Caption = 'RadioGroup1'       Items.Strings = (         'windows'         'dark')       TabOrder = 1       OnClick = RadioGroup1Click     end     object ButtonShow: TButton       Left = 16       Top = 159       Width = 75       Height = 25       Caption = 'ButtonShow'       TabOrder = 2       OnClick = ButtonShowClick     end     object Memo1: TMemo       Left = 207       Top = 8       Width = 274       Height = 281       Lines.Strings = (         'Always start in dark.'         ''         'Steps to reproduce:'         '1.'#9'Click ButtonShow.'         '2.'#9'Close the window that opened.'         '3.'#9'Click Windows (change to system them).'         '4.'#9'Click Dark (change back to dark VCL style).'         '5.'#9'Click ButtonShow again. The controls are '         'not properly painted. Combobox text is black and form '         'is wrong until resize.'         ''         'Hacky fix:'         '1.'#9'Click ButtonShow.'         '2.'#9'Check the '#8220'Fix'#8221' button in the window that '         'opened, then close it.'         '3.'#9'Click Windows (change to system)'         '4.'#9'Click Dark (change back to vcl dark)'         '5.'#9'Click ButtonShow. See comments in source.'         '')       ReadOnly = True       TabOrder = 3     end   end end </pre></div><!-- /wp:codemirror-blocks/code-block --> <!-- wp:paragraph -->Unit23:<!-- /wp:paragraph --> <!-- wp:codemirror-blocks/code-block {"showPanel":false,"languageLabel":"no","mode":"clike","mime":"text\/x-c++src"} --> 			<div class="wp-block-codemirror-blocks-code-block code-block"><pre>unit Unit23;  interface  uses   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Themes;  type   TForm23 = class(TForm)     Panel1: TPanel;     ComboBox1: TComboBox;     ComboBox2: TComboBox;     ComboBox3: TComboBox;     Button1: TButton;     CheckBox1: TCheckBox;     procedure Button1Click(Sender: TObject);   private     { Private declarations }     FFixing: Boolean;     FNeedFix: String;     FShowedStyle: String;   protected     procedure DoShow; override;   public     { Public declarations }     procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED;     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;   end;  var   Form23: TForm23;  implementation  {R *.dfm}

procedure TForm23.Button1Click(Sender: TObject);
begin
  PostMessage(Handle, CM_RECREATEWND, 0, 0);
end;

procedure TForm23.CMShowingChanged(var Message: TMessage);
var
  DoFix: Boolean;
begin
  if not Showing then
    inherited
  else
  begin
    // if the theme changed away from dark, then back to dark, while we were
    // not visible, then we need to force the window to be recreated again
    // before showing.

    // This is a really bad hack but basically I am just preventing the
    // normal response to CMShowingChanged and then setting up a message
    // queue that will recreate the window and then process the CM_SHOWINGCHANGED
    // message again. This will probably break the universe but it appears to work
    // in this test.

    FShowedStyle := StyleServices.Name;
    Panel1.Caption := FShowedStyle;
    DoFix := not FFixing and (FNeedFix <> '') and (FNeedFix = FShowedStyle);
    FNeedFix := '';

    if DoFix and CheckBox1.Checked then
    begin
      FFixing := True;
      // SendMessage(Handle, WM_SETREDRAW, Winapi.Windows.WPARAM(LongBool(False)), 0);
      PostMessage(Handle, CM_RECREATEWND, 0, 0);
      // PostMessage(Handle, CM_SHOWINGCHANGED, Message.WParam, Message.LParam);
      // do not allow inherited.
    end else
    begin
      FFixing := False;
      inherited;
    end;
  end;
end;

procedure TForm23.CMStyleChanged(var Message: TMessage);
begin
  FNeedFix := FShowedStyle;
  inherited;
end;

procedure TForm23.DoShow;
var
  DoFix: Boolean;
begin
  inherited;
  exit;
end;

end.

Unit23 DPR:

object Form23: TForm23
  Left = 0
  Top = 0
  Caption = 'Form23'
  ClientHeight = 253
  ClientWidth = 360
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 360
    Height = 253
    Align = alClient
    Alignment = taRightJustify
    BevelEdges = []
    BevelOuter = bvNone
    Caption = 'Panel1'
    TabOrder = 0
    object ComboBox1: TComboBox
      Left = 16
      Top = 32
      Width = 145
      Height = 21
      Style = csDropDownList
      ItemIndex = 0
      TabOrder = 0
      Text = 'one'
      Items.Strings = (
        'one'
        'two'
        'three')
    end
    object ComboBox2: TComboBox
      Left = 16
      Top = 59
      Width = 145
      Height = 21
      Style = csDropDownList
      ItemIndex = 1
      TabOrder = 1
      Text = 'two'
      Items.Strings = (
        'one'
        'two'
        'three')
    end
    object ComboBox3: TComboBox
      Left = 16
      Top = 86
      Width = 145
      Height = 21
      Style = csDropDownList
      ItemIndex = 2
      TabOrder = 2
      Text = 'three'
      Items.Strings = (
        'one'
        'two'
        'three')
    end
    object Button1: TButton
      Left = 16
      Top = 136
      Width = 75
      Height = 25
      Caption = 'RecreateWnd'
      TabOrder = 3
      OnClick = Button1Click
    end
    object CheckBox1: TCheckBox
      Left = 16
      Top = 167
      Width = 273
      Height = 17
      Caption = 'Fix with CM_SHOWINGCHANGED hack'
      TabOrder = 4
    end
  end
end
Anonymous Changed status to publish May 14, 2021