请参阅附带的屏幕截图,其中显示了我的一个程序中的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)
结果将是

我在一年前提交了一份关于相关问题的质量控制报告,但这是针对菜单的.我从来没有见过这个,TToolbar因为它是公共控件的包装,而绘图是由Windows处理的.
然而,您看到的图像显然是VCL呼叫TImageList.Draw和传递的结果Enabled=False- 没有其他看起来那么糟糕!你是否100%确定这真的是一个TToolbar?
此修复程序一定会避免TImageList.Draw和呼叫ImageList_DrawIndirect与ILS_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的答案相结合,您就拥有了出色的解决方案.