使禁用的菜单和工具栏图像看起来更好？

Posted 2023-04-13

技术标签:

【中文标题】使禁用的菜单和工具栏图像看起来更好？【英文标题】：Make Disabled Menu and Toolbar Images look better? 【发布时间】：2011-08-25 13:43:20 【问题描述】：

请查看随附的屏幕截图，该屏幕截图说明了我的一个程序中的 TToolBar：

请注意工具栏的最后两张图片，它们已被禁用。它们被绘制成禁用的方式并不是很吸引人，实际上在 Delphi IDE 中有些图像看起来是一样的。

我遇到的问题是我希望我的应用程序看起来更干净。禁用项的绘制方式看起来不太好。 TToolBar 允许设置禁用的 TImageList，我尝试将图像设为黑白，但它们看起来不正确，并且宁愿不必总是将图像设为黑白（时间和精力）。这个问题也出现在我的菜单和弹出菜单中，无论如何都不允许禁用图像。

有没有办法让残障物品看起来更好看？

如果可能的话，我宁愿不要使用 3rd Party Controls。我知道绝地组件允许菜单等禁用图像，但更喜欢一种不使用第三方组件的方法，如果可能的话，我更喜欢使用标准问题 VCL，特别是有时我使用 TActionMainMenuBar 来绘制办公风格菜单，当 DrawingStyle 设置为渐变时与 TToolBar 匹配。

编辑

我已经接受了 RRUZ 的回答，是否也可以接受 David 的回答，两者都是非常好的答案，如果可能的话希望在他们之间分享答案。

谢谢。

【问题讨论】：

我认为这样很好。任何“改进”都会使用户感到困惑。例如，当使用下面建议的'IDE fix' 比较 Delphi IDE 的默认外观和新外观时，我发现默认外观要好得多。在第一个屏幕截图中，我可以立即识别禁用的工具栏按钮和菜单项，但在第二个屏幕截图中，我需要思考近一秒钟才能确定按钮/项目是启用还是禁用。这很糟糕...... 【参考方案1】：

以前我写了一个补丁来修复这个行为。关键是修补TCustomImageList.DoDraw 函数的代码，使用的技术类似于delphi-nice-toolbar 应用程序使用的技术，但在这种情况下，我们修补内存中的函数，而不是修补bpl IDE。

只需将此单元包含在您的项目中

unit uCustomImageDrawHook;

interface

uses
  Windows,
  SysUtils,
  Graphics,
  ImgList,
  CommCtrl,
  Math;

implementation

type
  TJumpOfs = Integer;
  PPointer = ^Pointer;

  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;
    Addr: PPointer;
  end;


  TCustomImageListHack = class(TCustomImageList);

var
  DoDrawBackup   : TXRedirCode;

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: DWORD;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: Cardinal;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;


procedure Bitmap2GrayScale(const BitMap: TBitmap);
type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;
var
  x, y, Gray: Integer;
  Row       : PRGBArray;
begin
  BitMap.PixelFormat := pf24Bit;
  for y := 0 to BitMap.Height - 1 do
  begin
    Row := BitMap.ScanLine[y];
    for x := 0 to BitMap.Width - 1 do
    begin
      Gray             := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
      Row[x].rgbtRed   := Gray;
      Row[x].rgbtGreen := Gray;
      Row[x].rgbtBlue  := Gray;
    end;
  end;
end;


//from ImgList.GetRGBColor
function GetRGBColor(Value: TColor): DWORD;
begin
  Result := ColorToRGB(Value);
  case Result of
    clNone:
      Result := CLR_NONE;
    clDefault:
      Result := CLR_DEFAULT;
  end;
end;


procedure New_Draw(Self: TObject; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
var
  MaskBitMap : TBitmap;
  GrayBitMap : TBitmap;
begin
  with TCustomImageListHack(Self) do
  begin
    if not HandleAllocated then Exit;
    if Enabled then
      ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0, GetRGBColor(BkColor), GetRGBColor(BlendColor), Style)
    else
    begin
      GrayBitMap := TBitmap.Create;
      MaskBitMap := TBitmap.Create;
      try
        GrayBitMap.SetSize(Width, Height);
        MaskBitMap.SetSize(Width, Height);
        GetImages(Index, GrayBitMap, MaskBitMap);
        Bitmap2GrayScale(GrayBitMap);
        BitBlt(Canvas.Handle, X, Y, Width, Height, MaskBitMap.Canvas.Handle, 0, 0, SRCERASE);
        BitBlt(Canvas.Handle, X, Y, Width, Height, GrayBitMap.Canvas.Handle, 0, 0, SRCINVERT);
      finally
        GrayBitMap.Free;
        MaskBitMap.Free;
      end;
    end;
  end;
end;

procedure HookDraw;
begin
  HookProc(@TCustomImageListHack.DoDraw, @New_Draw, DoDrawBackup);
end;

procedure UnHookDraw;
begin
  UnhookProc(@TCustomImageListHack.DoDraw, DoDrawBackup);
end;


initialization
 HookDraw;
finalization
 UnHookDraw;
end.

结果是

【讨论】：

如果 Embarcadero 可以在他们的代码库中解决这个问题，那不是很好吗？！我还是觉得很难区分禁用项和启用项... @Craig 看起来很重要。您是否注意到菜单实现中的错误，即突出显示的字形（即热轨道）与突出显示在其他地方时的绘制方式不同。 qc.embarcadero.com/wc/qcmain.aspx?d=86876 非常好！恕我直言，比饱和图像更好的是使用 alpha 代替 Options.fState := ILS_ALPHA; Options.Frame := 100; 必须修改 n : DWORD; n：红衣主教；为 n : SIZE_T 以便在 XE4 下编译。【参考方案2】：

我 submitted a QC report 一年多以前的一个相关问题，但那是关于菜单的。我从未见过 TToolbar 的这个，因为它是公共控件的包装器，并且绘图由 Windows 处理。

但是，您看到的图像显然是 VCL 调用 TImageList.Draw 并传递 Enabled=False 的结果 - 没有其他东西看起来那么糟糕！你 100% 确定这真的是 TToolbar？

解决方法肯定是避免使用TImageList.Draw 并使用ILS_SATURATE 调用ImageList_DrawIndirect。

您可能需要修改一些 VCL 源。首先找到自定义绘制工具栏的位置并调用此例程而不是调用TImageList.Draw。

procedure DrawDisabledImage(DC: HDC; ImageList: TCustomImageList; Index, X, Y: Integer);
var
  Options: TImageListDrawParams;
begin
  ZeroMemory(@Options, SizeOf(Options));
  Options.cbSize := SizeOf(Options);
  Options.himl := ImageList.Handle;
  Options.i := Index;
  Options.hdcDst := DC;
  Options.x := X;
  Options.y := Y;
  Options.fState := ILS_SATURATE;
  ImageList_DrawIndirect(@Options);
end;

更好的解决方法是找出工具栏被自定义绘制的原因，并找到让系统这样做的方法。

编辑 1

我查看了 Delphi 源代码，我猜您正在自定义绘制工具栏，可能是因为它有渐变。我什至不知道 TToolbar 可以处理自定义绘图，但我只是一个普通的普通人！

无论如何，我可以看到TToolBar.GradientDrawButton 中的代码调用TImageList.Draw，所以我认为上面的解释是正确的。

我很确定调用上面的DrawDisabledImage 函数会给你带来更好的结果。如果可以在您致电 TImageList.Draw 时找到实现这一点的方法，那么我想这将是最好的解决方案，因为它将适用于批发。

编辑 2

将上面的函数与@RRUZ 的答案结合起来，你就有了一个很好的解决方案。

【讨论】：

有趣。你知道为什么 VCL 不是在每个实例中都依赖 Windows API 吗？如果您添加显示本地 Windows 样式和 VCL 样式的屏幕截图，我会非常非常喜欢您的回答，以便可以比较它们并查看差异。是的，我将其设置为渐变样式，我之所以这样设置，是因为当您将鼠标悬停在按钮上时，它会在按钮上绘制办公室风格的颜色。我还没有正确查看您的答案，但是当我有更多时间时，我会检查一下，谢谢。【参考方案3】：

如果您在 ActionToolBar 中使用 LargeImages，@RRUZ 的解决方案将不起作用。我对 @RRUZ 代码进行了更改，以便在 ActionToolBar 中使用 LargeImages。

unit unCustomImageDrawHook;

interface

uses
  Windows,
  SysUtils,
  Graphics,
  ImgList,
  CommCtrl,
  Math,
  Vcl.ActnMan,
  System.Classes;

implementation

type
  TJumpOfs = Integer;
  PPointer = ^Pointer;

  PXRedirCode = ^TXRedirCode;
  TXRedirCode = packed record
    Jump: Byte;
    Offset: TJumpOfs;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;
    Addr: PPointer;
  end;


  TCustomImageListHack = class(TCustomImageList);
  TCustomActionControlHook = class(TCustomActionControl);

var
  DoDrawBackup   : TXRedirCode;
  DoDrawBackup2   : TXRedirCode;  

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
  n: SIZE_T;
  Code: TXRedirCode;
begin
  Proc := GetActualAddr(Proc);
  Assert(Proc <> nil);
  if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
  begin
    Code.Jump := $E9;
    Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
    WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
  end;
end;

procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
  n: SIZE_T;
begin
  if (BackupCode.Jump <> 0) and (Proc <> nil) then
  begin
    Proc := GetActualAddr(Proc);
    Assert(Proc <> nil);
    WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
    BackupCode.Jump := 0;
  end;
end;

procedure Bitmap2GrayScale(const BitMap: TBitmap);
type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;
var
  x, y, Gray: Integer;
  Row       : PRGBArray;
begin
  BitMap.PixelFormat := pf24Bit;
  for y := 0 to BitMap.Height - 1 do
  begin
    Row := BitMap.ScanLine[y];
    for x := 0 to BitMap.Width - 1 do
    begin
      Gray             := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
      Row[x].rgbtRed   := Gray;
      Row[x].rgbtGreen := Gray;
      Row[x].rgbtBlue  := Gray;
    end;
  end;
end;


//from ImgList.GetRGBColor
function GetRGBColor(Value: TColor): DWORD;
begin
  Result := ColorToRGB(Value);
  case Result of
    clNone:
      Result := CLR_NONE;
    clDefault:
      Result := CLR_DEFAULT;
  end;
end;


procedure New_Draw(Self: TObject; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
var
  MaskBitMap : TBitmap;
  GrayBitMap : TBitmap;
begin
  with TCustomImageListHack(Self) do
  begin
    if not HandleAllocated then Exit;
    if Enabled then
      ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0, GetRGBColor(BkColor), GetRGBColor(BlendColor), Style)
    else
    begin
      GrayBitMap := TBitmap.Create;
      MaskBitMap := TBitmap.Create;
      try
        GrayBitMap.SetSize(Width, Height);
        MaskBitMap.SetSize(Width, Height);
        GetImages(Index, GrayBitMap, MaskBitMap);
        Bitmap2GrayScale(GrayBitMap);
        BitBlt(Canvas.Handle, X, Y, Width, Height, MaskBitMap.Canvas.Handle, 0, 0, SRCERASE);
        BitBlt(Canvas.Handle, X, Y, Width, Height, GrayBitMap.Canvas.Handle, 0, 0, SRCINVERT);
      finally
        GrayBitMap.Free;
        MaskBitMap.Free;
      end;
    end;
  end;
end;


procedure New_Draw2(Self: TObject; const Location: TPoint);
var
  ImageList: TCustomImageList;
  DrawEnabled: Boolean;
  LDisabled: Boolean;
begin
  with TCustomActionControlHook(Self) do
  begin
    if not HasGlyph then Exit;
    ImageList := FindImageList(True, LDisabled, ActionClient.ImageIndex);
    if not Assigned(ImageList) then Exit;
    DrawEnabled := LDisabled or Enabled and (ActionClient.ImageIndex <> -1) or
      (csDesigning in ComponentState);
    ImageList.Draw(Canvas, Location.X, Location.Y, ActionClient.ImageIndex,
      dsTransparent, itImage, DrawEnabled);
  end;
end;


procedure HookDraw;
begin
  HookProc(@TCustomImageListHack.DoDraw, @New_Draw, DoDrawBackup);
  HookProc(@TCustomActionControlHook.DrawLargeGlyph, @New_Draw2, DoDrawBackup2);
end;

procedure UnHookDraw;
begin
  UnhookProc(@TCustomImageListHack.DoDraw, DoDrawBackup);
  UnhookProc(@TCustomActionControlHook.DrawLargeGlyph, DoDrawBackup2);
end;


initialization
  HookDraw;
finalization
  UnHookDraw;
end.

【讨论】：

【参考方案4】：

看看this Delphi IDE fix。也许你可以模仿它的实现。

【讨论】：

不错的工具，现在我的 IDE 看起来不错这是一个很好的例子，说明应该不尝试改变 Windows GUI 的默认外观。这不是 Windows GUI 的默认外观。除了 Delphi 应用程序之外，我从未在 Windows 上的任何地方看到过如此丑陋的图标。你可能是对的。我不知道 VCL 自己画图。尽管如此，由于上述“修复”，我对新外观的担忧仍然存在。 @Andreas 这个修复不是我的，我同意 Delphi 禁用的图标更明显，但我也认为它们很丑。【参考方案5】：

使用 TActionToolbar , TActionmanager , Timagelist

将操作管理器图像列表设置为 Timagelist。并将 Disabledimages 设置为另一个图像列表

【讨论】：

以上是关于使禁用的菜单和工具栏图像看起来更好？的主要内容，如果未能解决你的问题，请参考以下文章

使图像窗口小部件禁用/变灰

如何在Eclipse插件开发中禁用/启用视图工具栏菜单/操作

如何在工具栏中禁用菜单项长按侦听器

如何恢复EXCEL菜单栏和工具栏的默认状态

如何禁用 Sierra 应用程序中的“显示标签栏”菜单选项？

Charles——charles 工具栏Tools总结——禁用缓存