Советы по 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 с "заплаткой":
