image - ver - vista de compatibilidad internet explorer 7

¿Las imágenes del menú deshabilitado y de la barra de herramientas se ven mejor?

Question

Por favor, mira la captura de pantalla adjunta que ilustra una TToolBar de uno de mis programas:

Observe las dos últimas imágenes de la barra de herramientas, están deshabilitadas. La forma en que se los ha dibujado para que aparezcan desactivados no es muy atractiva, de hecho, en Delphi IDE algunas de las imágenes tienen el mismo aspecto.

El problema que tengo es que quiero que mi aplicación se vea mucho más limpia. La forma en que se dibujan los elementos deshabilitados no se ve muy bien. El TToolBar permite configurar un TImageList desactivado, intenté hacer que mis imágenes aparezcan en blanco y negro, pero no se veían bien, y preferiría no tener que hacer siempre las imágenes en blanco y negro (tiempo y esfuerzo). Este problema también se muestra en mis menús y menús emergentes, que no permiten las imágenes desactivadas de todos modos.

¿Hay alguna manera de pintar los elementos deshabilitados para que se vean mejor en el ojo?

Si es posible, preferiría no utilizar los controles de terceros. Sé que los componentes Jedi permiten imágenes inhabilitadas para el menú, etc., pero preferiría una forma de no recurrir demasiado a los componentes de terceros, cuando sea posible preferiría usar el VCL estándar, especialmente porque a veces uso TActionMainMenuBar para dibujar Office Style. menús que coinciden con TToolBar cuando DrawingStyle se establece en degradado.

EDITAR

He aceptado la respuesta de RRUZ, aunque también es posible aceptar la respuesta de David, ambas son muy buenas respuestas y, si es posible, me gustaría que la respuesta se compartiera entre ellas.

Gracias.

Answer 1

En algún momento, escribí un parche para corregir este comportamiento. la clave es parchear el código de la función TCustomImageList.DoDraw , la técnica utilizada es similar a la utilizada por la aplicación delphi-nice-toolbar , pero en lugar de parchear un bpl IDE en este caso, parcheamos la función en la memoria.

Solo incluye esta unidad en tu proyecto

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.

y el resultado será

Answer 2

Eche un vistazo a esta solución Delphi IDE . Tal vez puedas imitar su implementación.

Answer 3

Utilice TActionToolbar, TActionmanager, Timagelist

Establezca la lista de imágenes de los gerentes de acción en una lista de Timage. y establecer Disabledimages a otra lista de imágenes

Answer 4

Presenté un informe de control de calidad para un problema relacionado hace más de un año, pero eso fue para los menús. Nunca he visto esto para TToolbar ya que es un contenedor para el control común y Windows maneja el dibujo.

Sin embargo, las imágenes que está viendo son claramente el resultado de la llamada de VCL TImageList.Draw y pasando Enabled=False - ¡nada más se ve tan mal! ¿Estás 100% seguro de que esto realmente es un TToolbar ?

La solución seguramente será evitar TImageList.Draw y llamar a ImageList_DrawIndirect con ILS_SATURATE .

Es posible que deba modificar alguna fuente de VCL. Primero encuentre la ubicación donde se dibujará la barra de herramientas personalizada y llame a esta rutina en lugar de las llamadas a 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;

Una solución aún mejor sería averiguar por qué la barra de herramientas se dibuja a medida y encontrar la forma de que el sistema lo haga.

EDIT 1

Miré el código fuente de Delphi y supongo que está dibujando la barra de herramientas, tal vez porque tiene un degradado. ¡Ni siquiera sabía que TToolbar podría manejar el dibujo personalizado, pero soy un tipo simple y vulgar!

De todos modos, puedo ver el código en TToolBar.GradientDrawButton llamando al TImageList.Draw así que creo que la explicación anterior está en el camino correcto.

Estoy bastante seguro de que si llamo a mi función DrawDisabledImage arriba DrawDisabledImage mejores resultados. Si pudiera encontrar una manera de hacer que eso suceda cuando llame a TImageList.Draw entonces supongo que sería la mejor solución, ya que se aplicaría al por mayor.

EDIT 2

Combina la función anterior con la respuesta de @ RRUZ y tienes una excelente solución.

Answer 5

La solución de @RRUZ no funciona si usa LargeImages en ActionToolBar. Realicé cambios en el código @RRUZ para trabajar con LargeImages en ActionToolBar.

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.