image - 让禁用的菜单和工具栏图像看起来更好?

标签 image delphi menu toolbar

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

enter image description here

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

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

有没有办法让禁用的项目看起来更好看?

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

编辑

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

谢谢。

最佳答案

不久前,我编写了一个补丁来修复此行为。关键是修补TCustomImageList.DoDraw的代码函数,所使用的技术类似于 delphi-nice-toolbar 使用的技术app,但在本例中我们不是修补 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.

结果将是

enter image description here

关于image - 让禁用的菜单和工具栏图像看起来更好?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/6003018/

相关文章:

javascript - 将图像对象插入 HTML

html - SSI 元素超出页面宽度

android - 使用 Apache poi 和 MS Excel 在 Android 应用程序中插入图像时出现 NoClassDefFoundError

Java API 从 tif 源文件中嵌入的剪切路径创建形状

delphi - 将可写的虚拟字段添加到可更新的 TClientDataset

sql - 在Delphi 7中运行更新查询时,如何解决封闭数据集错误?

delphi - 如何使用 Delphi 在运行时获取单元路径?

c# - 基于绑定(bind)数据的 MenuItem 模板更改

css - 不是全宽 css 水平菜单

java - Wicket 应用程序 : Image interpreted as text/html