Как рисовать картинки в пунктах меню?
Материал из 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