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

19 delphi image menu toolbar

请参阅附带的屏幕截图,其中显示了我的一个程序中的TToolBar:

在此输入图像描述

注意工具栏的最后两个图像,它们被禁用.它们被绘制为显示禁用的方式并不是很吸引人,事实上在Delphi IDE中,一些图像看起来是一样的.

我遇到的问题是我希望我的应用程序看起来更清洁.绘制禁用项目的方式看起来不太好.TToolBar允许设置一个禁用的TImageList,我尝试将我的图像设置为黑白但是它们看起来不正确,而且不必总是使图像变为黑白(时间和精力).此问题也出现在我的菜单和弹出菜单中,无论如何都不允许禁用图像.

有没有办法画出残疾人物品以便在眼睛上看起来更好?

如果可能的话,我宁愿不使用第三方控制.我知道Jedi组件允许禁用图像的菜单等,但更喜欢一种方法,不要求助于第三方组件,如果可能的话我更喜欢使用标准问题VCL,特别是因为有时我使用TActionMainMenuBar来绘制Office风格菜单,当DrawingStyle设置为渐变时匹配TToolBar.

编辑

我接受了RRUZ的回答,虽然接受David的回答也是可能的,两者都是非常好的答案,并且如果可能的话,他们希望在他们之间分享答案.

谢谢.

RRU*_*RUZ 21

有时阿戈我写了一个补丁来解决这个问题.关键是修补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.
Run Code Online (Sandbox Code Playgroud)

结果将是

在此输入图像描述

  • 如果Embarcadero可以在他们的代码库中解决这个问题,那会不会很可爱?! (8认同)
  • 我仍然认为很难将残疾人与已启用的物品区分开来...... (3认同)
  • @Andreas,我可以清楚地看到差异;) (2认同)
  • @Craig看起来很重要.您是否注意到菜单实现中的错误,其中突出显示的字形(即热门曲目)与突出显示在其他位置时的绘制方式不同.http://qc.embarcadero.com/wc/qcmain.aspx?d=86876 (2认同)
  • 非常好!恕我直言,比饱和图像更好的是使用 alpha 代替 Options.fState := ILS_ALPHA; Options.Frame := 100; (2认同)
  • 不得不修改 n : DWORD; 和 n:红衣主教;为 n : SIZE_T 以便在 XE4 下编译。 (2认同)

Dav*_*nan 7

我在一年前提交了一份关于相关问题的质量控制报告,但这是针对菜单的.我从来没有见过这个,TToolbar因为它是公共控件的包装,而绘图是由Windows处理的.

然而,您看到的图像显然是VCL呼叫TImageList.Draw和传递的结果Enabled=False- 没有其他看起来那么糟糕!你是否100%确定这真的是一个TToolbar

此修复程序一定会避免TImageList.Draw和呼叫ImageList_DrawIndirectILS_SATURATE.

您可能需要修改一些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;
Run Code Online (Sandbox Code Playgroud)

更好的解决方法是弄清楚为什么工具栏是自定义绘制的,并找到让系统执行它的方法.


编辑1

我查看了Delphi源代码,我猜你是自定义绘制工具栏,也许是因为它有一个渐变.我甚至都不知道TToolbar可以处理自定义绘图,但我只是一个普通的香草人!

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

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

编辑2

将上述功能与@ RRUZ的答案相结合,您就拥有了出色的解决方案.