Новичок
Профиль
Группа: Участник
Сообщений: 11
Регистрация: 15.7.2009
Где: Kirov
Репутация: нет
Всего: нет
|
Вот решил вот так записать. Где могут быть ошибки? Как лучше записать? Почему-то ширину получаю не правильно, если submenu. Как исправить? | Код |
program menu_;
uses
Windows, Messages, commctrl;
type
MYITEM = record
szItemText:String[30];
ico:Longint;
end;
var intKD:integer;
myItem_:array[0..17] of MYITEM;//кол-во пунктов меню, не считая separator
const HeightItem=20;
HeightItemSeparator=4;
LeftText=5; //для главного меню смещение текста
LeftText_=30; //для выпадающего меню смещение текста
procedure SetMenuOwnerDraw(menu1:HMenu);//изменяем стиль для пунктов меню на mf_OwnerDraw, чтобы можно было рисовать
type TinfoMenu = record
info:MENUITEMINFO;
b:boolean;
end;
var i:integer;
mii:TinfoMenu;
minf:menuiteminfo;
function GetMenuIDName(Menu_:HMenu; INDEX:integer):TinfoMenu;//получаем информацию о пункте меню
var Buffer: array[0..30] of Char;
begin
result.info.cbSize := SizeOf(MENUITEMINFO);
result.info.fMask := MIIM_FTYPE or miim_submenu or miim_string;
result.info.dwTypeData := buffer;
result.info.cch := sizeof(buffer);
If GetMenuItemInfo(Menu_,INDEX,true,result.info) then begin
result.b:=true;
end;
end;
function getico_(intI_:integer):HICON;//для установки значка для пункта меню
begin
Result:=0;
case intI_ of
1:Result:=loadicon(hinstance,'MENUNEW');
2:Result:=loadicon(hinstance,'MENUOPEN');
4:Result:=loadicon(hinstance,'MENUSAVE');
9:Result:=loadicon(hinstance,'MENUEXIT');
11:Result:=loadicon(hinstance,'MENUCUT');
12:Result:=loadicon(hinstance,'MENUCOPY');
13:Result:=loadicon(hinstance,'MENUPASTE');
14:Result:=loadicon(hinstance,'MENUDELETE');
16:Result:=loadicon(hinstance,'MENUHELP');
end;
end;
begin
if menu1<>0 then begin
for i:=0 to GetMenuItemCount(menu1)-1 do begin//цикл по всем пунктам меню
mii:=GetMenuIDName(menu1,i);
if mii.b then begin//если получить информацию о пункте удалось то
if MII.info.fType=MF_SEPARATOR then begin//если SEPARATOR то так:
ModifyMenu(menu1,i,mf_OwnerDraw or MF_SEPARATOR or mf_ByPosition,0,nil);
end else begin
minf.cbSize:= sizeof(MENUITEMINFO);
minf.fMask := MIIM_TYPE or MIIM_DATA;
minf.fType := MFT_OWNERDRAW;
minf.dwItemData :=intKD;
myItem_[intKD].szItemText:=MII.info.dwTypeData;
myItem_[intKD].ico:=getico_(intKD);
SetMenuItemInfo(menu1,i,true,minf);
inc(intKD);
end;
if MII.info.hSubMenu <>0 then SetMenuOwnerDraw(MII.info.hSubMenu);//если есть выпадающее меню, то снова вызываем процедуру
end;
end;
end;
end;
procedure Line(DC_:HDC;x1,y1,x2,y2:integer);
begin
MoveToEx(DC_,x1,y1,nil);
LineTo(DC_,x2,y2);
end;
procedure drawmenu(ID,intX,Left_Text:Longint;DC:hdc;Move:boolean;R:TRect);
const Color1:array[0..19] of integer=
($00FAE9D6,$00FAE9D6,$00FAE7CE,$00F8E2C5,$00F5DFBC,
$00F5DFBB,$00F3DBB8,$00F3DBB8,$00F2D9B7,
$00F1D8B3,$00F1D8B1,$00EFD3AA,$00EFD3AA,
$00EED2A6,$00ECD0A1,$00ECD0A1,$00EED2A6,
$00EED3A7,$00F0D4AB,$00F0D4AB);
Color2=$00F3AE7E;
var hMemDC:hDC;
pen,oldPen:Hpen;
Brush,oldBrush:HBRUSH;
hOldBitmap,Bitmap:HBitmap;
i:integer;
myfont,oldfont:hfont;
Height_,WidthItem:integer;
strText:string;
begin
hMemDC:=CreateCompatibleDC(DC);
if hMemDC<>0 then begin
WidthItem:=R.Right-R.Left;
if ID=0 then strText:='' else strText:=myItem_[intX].szItemText;
if strText='' then Height_:=HeightItemSeparator else Height_:=HeightItem;
Bitmap:=CreateCompatibleBitmap(dc,WidthItem,Height_);//создаем изображение на котором будем рисовать
hOldBitmap:=SelectObject(hMemDC, Bitmap);
SetBkMode(hMemDC, TRANSPARENT);//задаем прозрачный фон для вывода текста
SetBkMode(DC, TRANSPARENT);
myfont := CreateFont(HeightItem-4, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, 'Tahoma');
oldfont:=SelectObject(hMemDC,myfont);
Brush:=CreateSolidBrush(rgb(240,240,240));
oldBrush:=SelectObject(hMemDC,Brush);
PatBlt(hMemDC,0,0,WidthItem,HeightItem,rgb(240,240,240));
if Move then begin
for i:=0 to HeightItem-1 do begin
//рисуем фон для выделенного пункта меню
Pen:=CreatePen(PS_SOLID, 1, Color1[i]);
oldPen:=SelectObject(hMemDC,pen);
Line(hMemDC,0,i,WidthItem,i);
SelectObject(hMemDC,oldpen);
DeleteObject(pen);
end;
//рисуем рамку для выделенного пункта меню
Pen:=CreatePen(PS_SOLID, 1, Color2);
oldPen:=SelectObject(hMemDC,pen);
Line(hMemDC,1,0,WidthItem-1,0);
Line(hMemDC,1,HeightItem-1,WidthItem-1,HeightItem-1);
Line(hMemDC,0,1,0,HeightItem-1);
Line(hMemDC,WidthItem-1,1,WidthItem-1,HeightItem-1);
SelectObject(hMemDC,oldpen);
DeleteObject(Pen);
end else begin
if Left_Text=LeftText_ then begin //если главное меню то не рисуем
Pen:=CreatePen(PS_SOLID, 1, rgb(224,224,224));
oldPen:=SelectObject(hMemDC,pen);
Line(hMemDC,25,0,25,HeightItem);
SelectObject(hMemDC,oldpen);
DeleteObject(Pen);
Pen:=CreatePen(PS_SOLID, 1, rgb(255,255,255));
oldPen:=SelectObject(hMemDC,pen);
Line(hMemDC,26,0,26,HeightItem);
SelectObject(hMemDC,oldpen);
DeleteObject(Pen);
end;
end;
if strText<>'' then begin
textout(hMemDC,Left_Text,2,pchar(strText),length(strText));
//выводим картинку
if myItem_[intX].ico>0 then DrawIconEx(hMemDC,5,2,myItem_[intX].ico,HeightItem-4,HeightItem-4,0,0,3);
end else begin
//если separator то
Pen:=CreatePen(PS_SOLID, 1, rgb(224,224,224));
oldPen:=SelectObject(hMemDC,pen);
Line(hMemDC,27,1,WidthItem-1,1);
SelectObject(hMemDC,oldpen);
DeleteObject(Pen);
Pen:=CreatePen(PS_SOLID, 1, rgb(255,255,255));
oldPen:=SelectObject(hMemDC,pen);
Line(hMemDC,27,2,WidthItem-1,2);
SelectObject(hMemDC,oldpen);
DeleteObject(Pen);
end;
BitBlt(DC, r.Left, r.Top, WidthItem, HeightItem, hMemDC, 0, 0, SRCCOPY);
SelectObject(hMemDC,oldfont);
SelectObject(hMemDC,oldBrush);
DeleteObject(myfont);
DeleteObject(Brush);
SelectObject(hMemDC, hOldBitmap);
DeleteObject(Bitmap);
DeleteDC(hMemDC);
end;
end;
function GetTextWidth(wnd_:hwnd;strS:string):integer;//получаем ширину текста
var DC_:HDC;
myfont,oldfont:HFont;
siz:Size;
begin
DC_:=GetDC(wnd_);
myfont := CreateFont(HeightItem-4, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, 'Tahoma');
oldfont:=SelectObject(DC_,myfont);
GetTextExtentPoint32(DC_,pchar(strS),length(strS),siz);
result:=siz.cx;
SelectObject(DC_,oldfont);
DeleteObject(myfont);
ReleaseDC(wnd_,DC_);
end;
procedure drawMenuWnd(DC:HDC);
var h:hwnd;
pen,oldPen:Hpen;
DC_:hdc;
t:trect;
begin
h:=WindowFromDC(DC);
DC_:=GetWindowDC(h);
GetClientRect(h,t);
Pen:=CreatePen(PS_SOLID, 1, rgb(127,157,185));
oldPen:=SelectObject(DC_,pen);
Line(DC_,0,0,t.Right+6,0);
Line(DC_,0,0,0,t.Bottom+6);
Line(DC_,t.Right+5,0,t.Right+5,t.Bottom+6);
Line(DC_,0,t.Bottom+5,t.Right+5,t.Bottom+5);
SelectObject(DC_,oldpen);
DeleteObject(Pen);
ReleaseDC(h,DC_);
end;
function DlgProc(hWin, uMsg, wParam, lParam: Integer): Integer; stdcall;
var t:tpoint;
DIS:PDRAWITEMSTRUCT;
mis:PMeasureItemStruct;
begin
Result := 0;
case uMsg of
WM_INITDIALOG:
begin
intKD:=0;
SendMessage(hWin, WM_SETICON, ICON_BIG, LoadIcon(hInstance, 'MAINICON'));
SetMenu(hwin,LoadMenu(HInstance, 'MAINMENU'));
SetMenuOwnerDraw(GetMenu(hwin));
end;
WM_MeasureItem:begin
mis:=PMeasureItemStruct(LParam);
if mis.CtlType=ODT_MENU then begin
mis.itemHeight:=HeightItem;
if mis.itemID=0 then mis.itemHeight:=HeightItemSeparator;
mis.itemWidth:=GetTextWidth(hwin,myItem_[mis.itemData].szItemText)+20;
if MIS.itemID>10000 then mis.itemWidth:=GetTextWidth(hwin,myItem_[mis.itemData].szItemText);//если заголовок главного меню
end;
end;
WM_DrawItem:begin
DIS := PDrawItemStruct(LParam);
if integer(WindowFromDC(dis.hDC))<>hwin then drawMenuWnd(dis.hDC);//рисуем по всему окну меню
if DIS.itemState=257 then begin
//при помещении курсора мыши над элементом меню или при нажатом пункте главного меню
if dis.hwndItem=getmenu(hwin) then drawmenu(dis.itemID,dis.itemData,LeftText,dis.hDC,true,dis.rcItem) else
drawmenu(dis.itemID,dis.itemData,LeftText_,dis.hDC,true,dis.rcItem);
end else begin
//при помещении курсора мыши над элементом главного меню и при нажатии кнопки Alt
if (DIS.itemState=320) or (DIS.itemState=1) then begin
if dis.hwndItem=getmenu(hwin) then drawmenu(dis.itemID,dis.itemData,LeftText,dis.hDC,true,dis.rcItem) else
drawmenu(dis.itemID,dis.itemData,LeftText_,dis.hDC,true,dis.rcItem);
end else begin
//когда курсор мыши уходит с пункта меню
if dis.hwndItem=getmenu(hwin) then drawmenu(dis.itemID,dis.itemData,LeftText,dis.hDC,false,dis.rcItem) else //5
drawmenu(dis.itemID,dis.itemData,LeftText_,dis.hDC,false,dis.rcItem);
end;
end;
end;
WM_COMMAND:
begin
case LoWord(wParam) of
1001,1002: EndDialog(hWin, 0);
1003:begin
//вызов popup меню
GetCursorPos(t);
TrackPopupMenuEx(getsubmenu(getmenu(hwin),1),0,t.X,t.Y,hwin,nil);
end;
end;
end;
WM_DESTROY, WM_CLOSE: begin
PostQuitMessage(0);
end;
end;
end;
begin
{$R WindowsXP.res}
{$R menu.res}
InitCommonControls;
DialogBox(hInstance, 'MAIN_WINDOW', 0, @DlgProc);
end.
|
menu_.RAR 20,20 Kb |
Как рисовать картинки в пунктах меню 
Дата 28.7.2009, 13:20 (
Загрузка ...
