Недавно добавленные исходники

•  TDictionary Custom Sort  2 701

•  Fast Watermark Sources  2 571

•  3D Designer  4 227

•  Sik Screen Capture  2 878

•  Patch Maker  3 086

•  Айболит (remote control)  2 911

•  ListBox Drag & Drop  2 515

•  Доска для игры Реверси  74 780

•  Графические эффекты  3 342

•  Рисование по маске  2 551

•  Перетаскивание изображений  2 138

•  Canvas Drawing  2 213

•  Рисование Луны  2 146

•  Поворот изображения  1 722

•  Рисование стержней  1 747

•  Paint on Shape  1 228

•  Генератор кроссвордов  1 816

•  Головоломка Paletto  1 457

•  Теорема Монжа об окружностях  1 824

•  Пазл Numbrix  1 359

•  Заборы и коммивояжеры  1 623

•  Игра HIP  1 108

•  Игра Go (Го)  1 065

•  Симулятор лифта  1 236

•  Программа укладки плитки  1 017

•  Генератор лабиринта  1 329

•  Проверка числового ввода  1 097

•  HEX View  1 273

•  Физический маятник  1 144

•  Задача коммивояжера  1 176

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

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



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








Copyright © 2004-2023 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте