我最近偶然发现了一种非常奇怪的行为。当我在程序中使用 TActionMainMenuBar(或 TActionToolBar)、编译并运行,然后启动 Photoshop CS5 或 Internet Explorer 9 时,ActionMainMenuBar(和 ActionToolBar)会丢失其所有设置。指定颜色图中定义的颜色消失,字体设置也丢失。有人以前见过这个并知道解决方法吗?
D2007 Pro(应用所有更新)、D2010 Pro(应用所有更新)、Vista Home Premium 32 位、NVidia GForce 8600 GT,已安装最新驱动程序。
重现步骤:
如果先启动 Photoshop 或 IE,然后再启动 Delphi 程序,则不会发生任何情况。在 IDE 的设计模式下也存在该错误。一位开发人员同事已经通过 Win7 Pro 32 位和 ATI Radeon 9800 Pro 确认了他的系统所描述的行为。
感谢任何意见/解决方案
菲尔
PS:使用 Photoshop CS3 不会产生此错误
这是重现问题的另一种方法:
Perform(WM_SETTINGCHANGE, 0, 0);
。
现在我们知道
WM_SETTINGCHANGE
广播可能会导致问题,我们可能想知道启动 IE 是否会产生相同的结果:
type
TForm1 = class(TForm)
..
protected
procedure WMSettingChange(var Message: TWMSettingChange);
message WM_SETTINGCHANGE;
..
procedure TForm1.WMSettingChange(var Message: TWMSettingChange);
begin
Memo1.Lines.Add(IntToHex(Message.Flag, 4) + ', ' + Message.Section);
inherited;
end;
运行应用程序并启动 IE 后,几秒钟后,备忘录中会出现以下内容:
0000,软件\Microsoft\Internet Explorer\SearchScopes
我不知道 IE 在每次启动时必须对我们的表单(以及所有其他顶级窗口)说些什么,而且我不知道它是否在地球上的每个 Windows 盒子上或只是你和我的 Windows 盒子上都这样做,但是显然
ActionMainMenuBar
不擅长处理它。
获胜控件(表单),接收到
WM_WININICHANGE
,执行 CM_WININICHANGE
,并在收到它后向其所有控件广播相同的内容。下面是菜单栏的处理方式:
procedure TCustomActionMainMenuBar.CMWininichange(var Message: TWMWinIniChange);
begin
inherited;
RequestAlign;
Font.Assign(Screen.MenuFont);
end;
认为系统菜单字体可能已更改(代码应该在消息中查找“WindowsThemeElement”或“WindowMetrics”部分,但无论如何..),它是从刷新的
Screen.MenuFont
重新分配的。问题是,我们并没有完全使用它。
此外,ColorMap 通过调用其
CM_WININICHANGE
方法重置其颜色来响应 UpdateColors
。这甚至被记录在案:
当 ActionBand 组件收到 CM_WININICHANGE 消息时,会自动调用UpdateColors。
type
// Derive your own ColorMap that would reset its own colors.
// This is an interposer for simplicity..
TTwilightColorMap = class(actncolormaps.TTwilightColorMap)
public
procedure UpdateColors; override;
published
property Color default clGreen;
property FontColor default clYellow;
property MenuColor default $4488FF;
// reintroduce as many property as necessary, probably all is necessary..
end;
TForm1 = class(TForm)
..
private
FSaveMenuFont: TFont; // will hold initial main menu bar's font settings
protected
procedure WMSettingChange(var Message: TWMSettingChange);
message WM_SETTINGCHANGE;
end;
..
procedure TForm1.FormCreate(Sender: TObject);
begin
FSaveMenuFont := TFont.Create;
FSaveMenuFont.Assign(ActionMainMenuBar1.Font);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FSaveMenuFont.Destroy;
end;
procedure TForm1.WMSettingChange(var Message: TWMSettingChange);
begin
inherited;
// The below are the *section*s that really changing system settings
// would notify that I'm aware of, there may be more...
if (Message.Section <> 'WindowsThemeElement')
or (Message.Section <> 'WindowMetrics') then
ActionMainMenuBar1.Font.Assign(FSaveMenuFont)
else
// Develop your logic here. The system menu font might really have been
// changed. You can get it from Screen.MenuFont. But then if we had been
// using the system font, the control already applies the change by default.
end;
procedure TTwilightColorMap.UpdateColors;
begin
inherited;
// Reset your colors, note that system colors might have been
// changed or not. If changed, they should be reflected in 'cl..' constants.
Color := clGreen;
FontColor := clYellow;
MenuColor := $4488FF;
end;
找到了!问题是每次 IE9 或 Photoshop CS5 启动/关闭时,ActionMainMenuBar1 的 Colormap 属性都会重置为 ActionMainMenuBar1.DefaultColormap。我会接受 Sertac 的解决方案作为答案,因为它为我指明了解决此问题的正确方向。
这是最终的代码。现在(据我所知)它可以在 IE9 和 Photoshop CS5 上完美运行。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActnMan, ActnColorMaps, ActnList, ToolWin, ActnCtrls, ActnMenus,
StdCtrls;
type
TForm1 = class(TForm)
ActionManager1: TActionManager;
ActionMainMenuBar1: TActionMainMenuBar;
Action1: TAction;
Action2: TAction;
Action3: TAction;
Action4: TAction;
TwilightColorMap1: TTwilightColorMap;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ActionMainMenuBar1GetControlClass(Sender: TCustomActionBar;
AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
protected
procedure WMSettingChange(var Message: TWMSettingChange); message WM_SETTINGCHANGE;
private
{ Private declarations }
FSaveMenuFont: TFont; // will hold initial main menu bar's font settings
FSaveColormap: TTwilightColormap;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Fixing paint issue when IE9 was run and closed again
procedure TForm1.ActionMainMenuBar1GetControlClass(Sender: TCustomActionBar;
AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ActionMainMenuBar1.ColorMap.Assign(FSaveColormap);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSaveMenuFont := TFont.Create;
FSaveMenuFont.Assign(ActionMainMenuBar1.Font);
FSaveColormap := TTwilightColormap.Create(Self);
FSaveColormap.Assign(ActionMainMenuBar1.Colormap);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FSaveMenuFont.Destroy;
FSaveColormap.Destroy;
end;
procedure TForm1.WMSettingChange(var Message: TWMSettingChange);
begin
inherited;
// Memo1.Lines.Add(IntToHex(Message.Flag, 4) + ', ' + Message.Section);
ActionMainMenuBar1.Font.Assign(FSaveMenuFont);
// In case Photoshop CS5 was run and closed before
ActionMainMenuBar1.ColorMap.Assign(FSaveColormap);
end;
end.
再次感谢大家的帮助。
Вce гораздо проще。 Добавьте в проект этот юнит.
FColorMap := TAXPColorMap.Create(自己);
FActionManager.Style := AXPStyle;
unit CustomStyleActionsUnit;
interface
uses
Vcl.Graphics, Vcl.ActnMan, Vcl.Themes,
Vcl.ActnColorMaps, Vcl.XPStyleActnCtrls, Vcl.PlatformDefaultStyleActnCtrls;
type
TAXPColorMap = class(TXPColorMap)
public
procedure UpdateColors; override;
end;
TAXPStyleActionBars = class(TXPStyleActionBars)
public
function GetColorMapClass(ActionBar: TCustomActionBar): TCustomColorMapClass; override;
end;
var
AXPStyle: TAXPStyleActionBars;
implementation
procedure TAXPColorMap.UpdateColors;
begin
inherited;
Color := clWhite;
end;
function TAXPStyleActionBars.GetColorMapClass(ActionBar: TCustomActionBar): TCustomColorMapClass;
begin
if TStyleManager.IsCustomStyleActive then
Result := PlatformDefaultStyle.GetColorMapClass(ActionBar)
else
Result := TAXPColorMap;
end;
initialization
AXPStyle := TAXPStyleActionBars.Create;
finalization
AXPStyle.Free;
end.