Сделать отключенные изображения меню и панели инструментов лучше? - PullRequest
Новая
       28

Сделать отключенные изображения меню и панели инструментов лучше?

19 голосов
/ 14 мая 2011

Пожалуйста, смотрите прикрепленный скриншот, который иллюстрирует TToolBar от одной из моих программ:

enter image description here

Обратите внимание на последние два изображения панели инструментов, они отключены. То, как они были отображены как отключенные, не очень привлекательно, на самом деле в Delphi IDE некоторые изображения выглядят одинаково.

Проблема, с которой я столкнулся, заключается в том, что мое приложение должно выглядеть чище. То, как нарисованы отключенные предметы, выглядит не очень хорошо. TToolBar позволяет установить отключенный TImageList, я пытался сделать свои изображения черно-белыми, но они выглядели неправильно, и не всегда должны были делать изображения черно-белыми (время и усилия). Эта проблема также отображается в моих меню и всплывающих меню, которые в любом случае не позволяют отключить изображения.

Есть ли способ рисовать отключенные предметы, чтобы лучше выглядеть на глаз?

Если возможно, я бы предпочел не использовать сторонние средства управления. Я знаю, что Компоненты джедаев разрешают отключенные изображения для меню и т. Д., Но я предпочел бы, чтобы не использовались слишком сторонние Компоненты, когда это возможно, я бы предпочел использовать стандартный выпуск VCL, тем более что иногда я использую TActionMainMenuBar для рисования Office Style меню, которые соответствуют TToolBar, когда DrawingStyle установлен в градиент.

EDIT

Я принял ответ RRUZ, возможно ли принять и ответ Дэвида, оба являются очень хорошими ответами и хотели бы, чтобы ответ был разделен между ними, если это возможно.

Спасибо.

Ответы [ 5 ]

21 голосов
/ 14 мая 2011

Иногда я написал патч, чтобы исправить это поведение.ключ - это исправление кода функции TCustomImageList.DoDraw, используемая методика аналогична используемой приложением delphi-nice-toolbar, но в этом случае вместо исправления IDE bplмы исправляем функцию в памяти.

Просто включите этот блок в ваш проект 

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

7 голосов
/ 14 мая 2011

I представил отчет о контроле качества для связанной проблемы более года назад, но это было для меню. Я никогда не видел этого для 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;

Еще лучшим решением было бы выяснить, почему панель инструментов рисуется на заказ, и найти способ, позволяющий системе сделать это.

РЕДАКТИРОВАТЬ 1

Я посмотрел на исходный код Delphi и предположил, что вы рисуете панель инструментов по собственному усмотрению, возможно, потому что у нее есть градиент. Я даже не знал, что TToolbar может обрабатывать пользовательские рисунки, но я просто ванильный парень!

В любом случае, я вижу код в TToolBar.GradientDrawButton, вызывающий TImageList.Draw, поэтому я думаю, что приведенное выше объяснение находится на правильном пути.

Я вполне уверен, что вызов функции DrawDisabledImage, приведенной выше, даст вам лучшие результаты. Если бы вы могли найти способ сделать это, когда вы звоните TImageList.Draw, то это, я полагаю, будет самым лучшим решением, так как это будет применяться оптом.

РЕДАКТИРОВАТЬ 2

Объедините приведенную выше функцию с ответом @ RRUZ, и вы получите отличное решение.

2 голосов
/ 02 июля 2012

Решение от @RRUZ не работает, если вы используете LargeImages в ActionToolBar. Я внес изменения в код @RRUZ для работы с LargeImages в 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.
0 голосов
/ 14 мая 2011

Взгляните на это исправление Delphi IDE . Может быть, вы можете имитировать его реализацию.

0 голосов
/ 14 мая 2011

Использовать TActionToolbar, TActionmanager, Timagelist

Установить список изображений менеджеров действий в Timagelist.и установите Disabledimages в другой список изображений

...