Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Исправление иконок выключенных пунктов меню

Автор: VS

При использовании 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;
   begin
     with Bmp.Canvas do
     begin
       for C := 0 to Bmp.Height - 1 do
         for R := 0 to Bmp.Width - 1 do
         begin
           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;
 
 begin
   if HandleAllocated then
   begin
     if Enabled then
       ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0,
         GetRGBColor(BkColor), GetRGBColor(BlendColor), Style)
     else
     begin
       if FMonoBitmap = nil then
       begin
         FMonoBitmap := TBitmap.Create;
         with FMonoBitmap do
         begin
           // 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 с "заплаткой":




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS