Delphi World - Как рисовать картинки в пунктах меню (через OwnerDraw)
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как рисовать картинки в пунктах меню (через OwnerDraw)


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 World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования