Как рисовать картинки в пунктах меню (через OwnerDraw)

Delphi , Компоненты и Классы , Меню

unit DN_Win;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, StdCtrls,

type
  TDNForm = class(TForm)
    MainMenu1: TMainMenu;
    cm_MainExit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure cm_MainExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    BM: TBitmap;
    procedure WMDrawItem(var Msg:TWMDrawItem); message wm_DrawItem;
    procedure WMMeasureItem(var Msg:TWMMeasureItem); message wm_MeasureItem;
end;

var
  DNForm: TDNForm;

implementation

{$R *.DFM}

var
  Comm, yMenu: word;

procedure TDNForm.FormCreate(Sender: TObject);
begin
  yMenu:=GetSystemMetrics(SM_CYMENU);
  comm:=cm_MainExit.Command;
  ModifyMenu(MainMenu1.Handle,0,mf_ByPosition or mf_OwnerDraw,comm,'Go');
end;

procedure TDNForm.cm_MainExitClick(Sender: TObject);
begin
  DNForm.Close;
end;

procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem);
begin
  with Msg.MeasureItemStruct^ do
    if ItemID=comm then
    begin
      ItemWidth:=yMenu;
      Itemheight:=yMenu;
    end;
end;

procedure TDNForm.WMDrawItem(var Msg: TWMDrawItem);
var
  MemDC:hDC;
  BM:hBitMap;
  mtd:longint;
begin
  with Msg.DrawItemStruct^ do
  begin
    if ItemID=comm then
    begin
      BM:=LoadBitMap(hInstance,'dver');
      MemDC:=CreateCompatibleDC(hDC);
      SelectObject(MemDC,BM);
      if ItemState=ods_Selected then
        mtd:=NotSrcCopy
      else
        mtd:=SrcCopy;

      StretchBlt(hDC,rcItem.left, rcItem.top, yMenu, yMenu, MemDC,
      0, 0, 24, 23, mtd);
      DeleteDC(MemDC);
      DeleteObject(BM);
    end;
  end;
end;

end.

Перевод контента на русский язык:

Код, который вы предоставили, это приложение Delphi, использующее функциональность OwnerDraw для рисования битмапа на пункте меню. Вот разбивка на что каждый раздел делает:

1. FormCreate: Это процедура, которая вызывается при создании формы. Она получает высоту системы меню с помощью GetSystemMetrics и устанавливает ее в локальную переменную yMenu. Затем она модифицирует основное меню-итем (cm_MainExit) для использования owner draw, вызвав ModifyMenu.
2. WMDrawItem: Это процедура, которая вызывается при необходимости перерисовать пункт меню. Она проверяет, является ли пункт меню, который рисуется, тем с командой comm (которая была установлена в FormCreate). Если это так, она загружает битмап из ресурсного файла с помощью LoadBitMap, создает памятный DC с помощью CreateCompatibleDC, выбирает битмап в памятном DC с помощью SelectObject, и затем рисует битмап на прямоугольнике пункта меню с помощью StretchBlt. Наконец, она удаляет памятный DC и битмап.
3. WMMeasureItem: Это процедура, которая вызывается при необходимости измерить ширину и высоту пункта меню. Она проверяет, является ли пункт меню, который измеряется, тем с командой comm, и если так, она устанавливает его ширину и высоту в значение yMenu.

Некоторые предложения по улучшению:

• Вместо жесткого кодирования имени файла битмапа ('dver') в WMDrawItem, рассмотрите использование более надежного способа загрузки битмапов, например, с помощью строки ресурса или конфигурационного файла.
• Рассмотрите добавление обработки ошибок для случаев, когда битмап не может быть загружен или создание памятного DC fails.
• Если вы планируете поддерживать несколько языков, вам может потребоваться загрузка битмапов для каждого языка отдельно. В этом случае рассмотрите использование более гибкого способа загрузки битмапов, например, с помощью строки ресурса и конфигурационного файла.
• Переменная mtd в WMDrawItem не используется везде. Вы можете удалить ее или использовать ее для хранения другого значения.
• Рассмотрите добавление комментариев к коду, чтобы объяснить, что каждый раздел делает.

Вот альтернативное решение, использующее более надежный способ загрузки битмапов и добавляющее обработку ошибок:

procedure TDNForm.WMDrawItem(var Msg: TWMDrawItem);
var
  MemDC: HDC;
  BM: HBITMAP;
begin
  with Msg.DrawItemStruct^ do
  begin
    if ItemID = comm then
    begin
      try
        BM := LoadBitmap(hInstance, 'dver');
        MemDC := CreateCompatibleDC(hDC);
        SelectObject(MemDC, BM);
        StretchBlt(hDC, rcItem.left, rcItem.top, yMenu, yMenu, MemDC,
          0, 0, 24, 23, SRCCOPY);
      except
         // Обработка ошибки здесь, например, отображение сообщения об ошибке
      end;
      DeleteObject(BM);
      DeleteDC(MemDC);
    end;
  end;
end;

В этом альтернативном решении я использовал блок try-except, чтобы поймать любые ошибки, которые могут возникнуть при загрузке битмапа или создании памятного DC. Вы можете заменить комментарий на реальную обработку ошибок, например, отображение сообщения об ошибке или логирование ошибки.

Статья описывает способ рисования картинок в пунктах меню в программе на языке Delphi с помощью OwnerDraw метода.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Меню ::