为什么隐藏的表单和控件在切换主题两次后停止正确绘制？

如何解决为什么隐藏的表单和控件在切换主题两次后停止正确绘制？

我讨厌这个问题的标题。总之：

如果您使用自定义主题（在本例中为 Windows10 Dark）调用 TForm.Show，则关闭该表单，然后将主题更改为系统 Windows 主题，然后更改回 Windows10 Dark 主题，最后调用 TForm。再次在该表单上显示，边框呈现不正确，某些控件呈现不正确，例如 TComboBox。

我在下面有一个测试项目，以及各种“修复”。但我不喜欢我的修复，这个问题的原因是我真的不明白这里发生了什么导致表单错误呈现只有当主题改变时它被隐藏，并且只有当主题是从 Windows10 Dark 改回，然后又改回了 。

我的解决方法是跟踪主题更改。如果发生我上面描述的情况，我会拦截 CM_SHOWINGCHANGED 消息，忽略它，然后强制重新创建窗口，然后在下一次处理继承的 CM_SHOWINGCHANGED。这是一个非常脆弱的修复，显然不是要走的路，所以我希望有人能告诉我实际发生了什么，这样我就可以“真正地”修复它。

顺便说一下，我已经将此作为错误提交给 Embarcadero。 https://quality.embarcadero.com/browse/RSP-33977

这是测试代码。显然，您需要将 Windows10 Dark 添加到应用程序的样式中。

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.

第 22 单元 DPR：

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

单元 23：

unit Unit23;

interface

uses
  Winapi.Windows,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);
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,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