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.