При использовании ListImage, в недоступных пунктах Menu пиктограммы
отображаются некорректно. Это можно видеть на рисунке:
Ошибка связана с получением монохромного изображения в процедуре
TCustomImageList.DoDraw. Однако ее можно исправить, если воспользоваться
небольшой "заплаткой" - ScrambleBitmap.
procedure TCustomImageList.DoDraw(Index: Integer; Canvas: TCanvas;
X, Y: Integer; Style: Cardinal; Enabled: Boolean);
procedure ScrambleBitmap(var BMP: TBitmap);
const
RMask = $0000FF;
RAMask = $FFFF00;
GMask = $00FF00;
GAMask = $FF00FF;
BMask = $FF0000;
BAMask = $00FFFF;
var
R, C: integer;
Color: LongWord;
beginwith Bmp.Canvas dobeginfor C := 0 to Bmp.Height - 1 dofor R := 0 to Bmp.Width - 1 dobegin
Color := Pixels[R, C];
if ((Color = 0) or (Color = $FFFFFF)) then
Continue;
if (((Color and RMask > $7F) and (Color and RAMask > $0)) or
((Color and GMask > $7F00) and (Color and GAMask > $0)) or
((Color and BMask > $7F000) and (Color and BAMask > $0))) then
Pixels[R, C] := $FFFFFF
else
Pixels[R, C] := 0;
end;
end;
end;
const
ROP_DSPDxax = $00E20746;
var
R: TRect;
DestDC, SrcDC: HDC;
beginif HandleAllocated thenbeginif Enabled then
ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0,
GetRGBColor(BkColor), GetRGBColor(BlendColor), Style)
elsebeginif FMonoBitmap = nilthenbegin
FMonoBitmap := TBitmap.Create;
with FMonoBitmap dobegin// Monochrome:= True; закомментировать!!!
Width := Self.Width;
Height := Self.Height;
end;
end;
{ Store masked version of image temporarily in FBitmap }
FMonoBitmap.Canvas.Brush.Color := clWhite;
FMonoBitmap.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
ImageList_DrawEx(Handle, Index, FMonoBitmap.Canvas.Handle, 0, 0, 0, 0,
CLR_DEFAULT, 0, ILD_NORMAL);
ScrambleBitmap(FMonoBitmap); // заплатка
R := Rect(X, Y, X + Width, Y + Height);
SrcDC := FMonoBitmap.Canvas.Handle;
BitBlt(SrcDC, 0, 0, Width, Height, SrcDC, 0, 0, DSTINVERT); // добавить!!!{ Convert Black to clBtnHighlight }
Canvas.Brush.Color := clBtnHighlight;
DestDC := Canvas.Handle;
Windows.SetTextColor(DestDC, clWhite);
Windows.SetBkColor(DestDC, clBlack);
BitBlt(DestDC, X + 1, Y + 1, Width, Height, SrcDC, 0, 0, ROP_DSPDxax);
{ Convert Black to clBtnShadow }
Canvas.Brush.Color := clBtnShadow;
DestDC := Canvas.Handle;
Windows.SetTextColor(DestDC, clWhite);
Windows.SetBkColor(DestDC, clBlack);
BitBlt(DestDC, X, Y, Width, Height, SrcDC, 0, 0, ROP_DSPDxax);
end;
end;
end;
Теперь пиктограммы в Menu будут отображаться как на приведенном рисунке:
"Заплатку" можно использовать и в ToolBar, где ошибка аналогична. ToolBar без
"заплатки":
ToolBar с "заплаткой":
Бессконечная борьба с нефункциональными иконками в меню и панелях инструментов!
Ваше решение, ScrambleBitmap, - это хитрый трюк для решения проблемы. Перемешивая данные пикселей монохромной картинки, вы фактически замените любые пиксели, которые не белые или прозрачные, на белые, что будет отображаться корректно системой.
Вот шаг за шагом, что ваш код делает:
Он определяет процедуру ScrambleBitmap, которая принимает TBitmap в качестве входного параметра.
Внутри этой процедуры он проходит по каждому пикселю в битмапе и проверяет, если его цвет не белый или прозрачный. Если так, он устанавливает пиксель в белый.
В методе DoDraw класса TCustomImageList, вы проверяете, если элемент включен (то есть не отключен). Если он не включен, вы создаете монохромную версию картинки с помощью FMonoBitmap.
Затем вы рисуете картинку на FMonoBitmap и вызываете ScrambleBitmap, чтобы исправить любые нефункциональные пиксели.
Наконец, вы используете BitBlt для копирования зашумленной картинки на канвас.
Что касается альтернативного решения, вы могли бы рассмотреть другой подход к созданию своих монохромных картинок. Например, вы можете использовать графическую библиотеку,such as GDI+ или FreeImage, для загрузки и манипуляции картинками программно. Это может быть более эффективно, чем полагаться на битмапы и перемешивание пиксельных данных.
В любом случае, поздравления за найдение креативного решения этой проблемы!
Исправление ошибки отображения иконок выключенных пунктов меню при использовании компонента ListImage.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.