使禁用的菜单和工具栏图像看起来更好? [英] Make Disabled Menu and Toolbar Images look better?

问题描述

请参阅随附的屏幕截图，其中说明了我的一个程序中的 TToolBar:

Please see the attached screenshot which illustrates a TToolBar from one of my programs:

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

Notice the last two images of the Toolbar, they are disabled. The way they have been drawn to appear disabled is not very appealing, in fact in the Delphi IDE some of the images look the same.

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

The issue I have with it is I want my application to look a lot cleaner. The way the disabled items are drawn doesn't look very good. The TToolBar allows to set a disabled TImageList, I tried making my images black & white but they didn't look right, and would rather not have to always make the images black and white (time and effort). This problem also shows in my menus and popup menus, which don't allow for disabled images anyway.

有没有办法给残缺的物品涂上颜色，让眼睛看起来更好看?

Is there a way to paint the disabled items to look better on the eye?

如果可能，我宁愿不使用 3rd Party Controls.我知道 Jedi Components 允许禁用菜单等图像，但更喜欢一种不使用 3rd Party Components 的方法，如果可能，我更喜欢使用标准问题 VCL，尤其是有时我使用 TActionMainMenuBar 来绘制 Office 样式菜单，当 DrawingStyle 设置为渐变时匹配 TToolBar.

If possible I would rather not look to use 3rd Party Controls. I know the Jedi Components allow disabled images for the menu etc, but would prefer a way to not resort too 3rd Party Components, when possible I would much prefer to use the standard issue VCL, especially as sometimes I use the TActionMainMenuBar to draw Office Style menus, which match the TToolBar when DrawingStyle is set to gradient.

编辑

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

I have accepted RRUZ's answer, is it possible though to accept David's answer as well, both are very good answers and would like the answer to be shared between them if possible.

谢谢.

推荐答案

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

Sometime Ago i wrote a patch to fix this behavior. the key is patch the code of the TCustomImageList.DoDraw function, the technique used is similar to the used by the delphi-nice-toolbar app, but instead of patch a bpl IDE in this case we patch the function in memory.

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

Just include this unit in your project

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.

结果是

这篇关于使禁用的菜单和工具栏图像看起来更好?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！