Как рисовать картинки в пунктах меню?

Материал из DRKB

Как рисовать картинки в пунктах меню?[править | править код]

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); { hDC  ? TDrawItemStruct }
      SelectObject(MemDC, BM); { rcItem  ?  TDrawItemStruct }
      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.


 Eugeny Sverchkov
 es906@kolnpp.elektra.ru
 (2:5031/12.23)


Author: StayAtHome
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01305