Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Разыскивается код... [Delphi, Windows]


Страницы:   1 2

MTsv DN ©   (2009-12-02 16:08:00) 

Всем привет... Не знаю, будет ли продолжение данной темы, однако...

MTsv DN   (2009-12-04 23:12:00) [1]

На первый взгляд работает, тока у меня подключена директива DEBUG_MENU и при закрытии вылетают ошибки...при удалении меню... Завтра гляну, сегодня спать...

Дмитрий К   (2009-12-04 22:40:00) [2]

Вот так, кажется, работает:
begin
 Count := GetMenuItemCount(Menu);
 SetLength(MIIS, Count);
 for i := 0 to Count - 1 do
 begin
   IID := GetMenuItemID(Menu, i);
   if IID = -1 then
     Sort(GetSubMenu(Menu, i));
   FillChar(MII, SizeOf(MII), 0);
   MII.cbSize := SizeOf(MII);
   if IID = -1 then
     MII.fMask := MIIM_STRING or MIIM_SUBMENU
   else
     MII.fMask := MIIM_STRING;
   if not GetMenuItemInfo(Menu, i, True, PMenuItemInfo(@MII)^) then
     MsgOK(SysErrorMessage(getLastError));
   Buff := AllocMem(MII.cch + 1);
   MII.dwTypeData := Buff;
   MII.cch := MII.cch + 1;
   if not GetMenuItemInfo(Menu, i, True, PMenuItemInfo(@MII)^) then
     MsgOK(SysErrorMessage(getLastError));
   MIIS[i] := MII;
 end;
 SortData(MIIS, Count, @CompareItems, @SwapItems);
 for i := 0 to Count - 1 do
 begin
   RemoveMenu(Menu, i, MF_BYPOSITION);
   InsertMenuItem(Menu, i, True, PMenuItemInfo(@(MIIS[i]))^);
   FReeMem(MIIs[i].dwTypeData);
 end;
end;

MTsv DN   (2009-12-04 22:24:00) [3]

Дмитрий К,
Спасибо за код...

MTsv DN   (2009-12-04 22:24:00) [4]

Ну, судя по тому, что больше идей нету...походу действительно дескриптор "ломается"... Придется делать "через назад"...

MTsv DN   (2009-12-04 21:49:00) [5]

После добавления MIIM_SUBMENUошибка при повторной сортировке вот в этом месте:
Count := GetMenuItemCount(Menu);
getLastError выдал "Неверный дескриптор меню"

robt   (2009-12-04 21:41:00) [6]


> ...не забывая об обработчиках

зачем?
один обработчик на все меню
итемы различать по Tag тогда позиция итема не будет иметь значения,хоть обсортируйся

MTsv DN   (2009-12-04 21:36:00) [7]

Вроде решает: MII.fMask := MIIM_STRING or MIIM_SUBMENU;
Однако второй раз уже не отсортировать 8(

MTsv DN   (2009-12-04 21:26:00) [8]

Спасибо. Буду разбираться. ...Только он не работает 8( После нажатия Sort, субменю из D-11 переходит в df... Буду смотреть где сбой...

Дмитрий К   (2009-12-04 21:18:00) [9]

MTsv DN
Сортировка по алфавиту. Остальное за Вами.
program SortMenu;

uses
 Windows, KOL;
var Menu: PMenu;
Form, Btn1, Btn2 : PControl;

procedure Sort(const Menu: hMenu);
var i: Integer; Count: Integer; IID: Integer;
MII: TMenuItemInfo;  MIIS: array of TMenuitemInfo;
function CompareItems(const Data: Pointer; const e1,e2 : Dword) : Integer;
var MIIS: array of TMenuItemInfo;
begin
 MIIS := Data;
 Result := StrComp_NoCase(MIIS[e1].dwTypeData, MIIS[e2].dwTypeData);
end;
procedure SwapItems(const Data : Pointer; const e1,e2 : Dword);
var MIIS: array of TMenuItemInfo;
 MII: TMenuItemInfo;
begin
 MIIS := Data;
 MII := MIIs[e1];
 MIIs[e1] := MIIs[e2];
 MIIs[e2] := MII;
end;
var Buff: Pointer;
begin
 Count := GetMenuItemCount(Menu);
 SetLength(MIIS, Count);
 for i := 0 to Count - 1 do
 begin
   IID := GetMenuItemID(Menu, i);
   if IID = -1 then
     Sort(GetSubMenu(Menu, i));
   FillChar(MII, SizeOf(MII), 0);
   MII.cbSize := SizeOf(MII);
   MII.fMask := MIIM_STRING;
   if not GetMenuItemInfo(Menu, i, True, PMenuItemInfo(@MII)^) then
     MsgOK(SysErrorMessage(getLastError));
   Buff := AllocMem(MII.cch + 1);
   MII.dwTypeData := Buff;
   MII.cch := MII.cch + 1;
   if not GetMenuItemInfo(Menu, i, True, PMenuItemInfo(@MII)^) then
     MsgOK(SysErrorMessage(getLastError));
   MIIS[i] := MII;
 end;
 SortData(MIIS, Count, @CompareItems, @SwapItems);
 for i := 0 to Count - 1 do
 begin
   SetmenuItemInfo(Menu, i, True, PMenuItemInfo(@(MIIS[i]))^);
   FReeMem(MIIs[i].dwTypeData);
 end;
end;

procedure Btn2Click(Dummy, Sender: Pobj);
begin
 Sort(Menu.Handle);
end;
procedure FormMouseUp(Dummy, Sender: PControl; var Mouse: TMouseEventData);
var
pt : TPoint;
begin
if Mouse.Button = mbRight then
 begin
  GetCursorPos(pt);
  Menu.PopupEx(pt.X, pt.Y);
 end;
end;
var a: PMenu;
begin
 Form := newForm(nil, 'test');
 Form.OnMouseUp := TOnMouse(MakeMethod(nil, @FormMouseUp));
 NewMenu(Form, 0, [], nil);
 Menu := newmenu(Form, 0, ['a','1', '2', '0','df'], nil);
 Btn2 := NewButton(Form, 'Sort');
 Btn2.OnClick := TOnEvent(MAkeMethod(nil, @Btn2Click));
Menu.Insert(-1, 'f-11', nil, []);
a := Menu.Insert(-1, 'D-11', nil, [moSubMenu]);
  a.Insert(-1, '4444444', nil, []);
  a := a.Insert(-1, '3333333', nil, []);
    a.Insert(-1, 'BBBBBBB', nil, []);
    a.Insert(-1, 'CCCCCCC', nil, []);
    a.Insert(-1, 'AAAAAAA', nil, []);
Menu.Insert(-1, 'A-11', nil, []);
Menu.Insert(-1, 'k-11', nil, []);
Menu.Insert(-1, 'L-11', nil, []);
Menu.Insert(-1, 'Я-11', nil, []);
 Run(Form);
end.

Dy1   (2009-12-04 21:12:00) [10]

...не забывая об обработчиках

robt   (2009-12-04 20:08:00) [11]

ну смотри ты сортируеш меню,пральна
делаеш это удалением\вставкой,пральна
при этом чета там не работает
тогда замени удаление\вставку обменом данными самих итемов
нафига их удалять и создавать новые когда можно обменяться инфой (swap)

MTsv DN   (2009-12-04 19:50:00) [12]

> SetMenuItemInfo ничего не двигает :)
Тада на кой она мне? Или я совсем уже запутался?.. Вы задачу поняли?

robt   (2009-12-04 19:47:00) [13]

SetMenuItemInfo ничего не двигает :)
она изменяет информацию о пункте меню,надпись,чеканутость и тд
и зачем по позиции,делай по идентификатору(false)

MTsv DN   (2009-12-04 19:30:00) [14]

Если я правильно понимаю, то:
1. Изменяться будет родитель Form1.pm.Items[MenuID].Parent.Handle
2. Третий параметр = true, значит второй - это позиция
3. wID поменял, максимальный+1.
4. Вызов SetMenuItemInfoW результат Успешно. Элемент не двигался

MTsv DN   (2009-12-04 19:27:00) [15]

> если не получается через api поменять итем например SetMenuItemInfo значит чето не так делаеш
Я в курсе. Если делал так не было б проблемы. Вот код с SetMenuItemInfo:
for i := 0 to Length(Rec) - 1 do
 begin
  if not Rec[i].IsSM then
   begin
    Form1.pm.Items[MenuID].Parent.InsertItem(-1,
                                             PWideChar(Rec[i].Name),
                                             nil,
                                             []);
    Form1.pm.RemoveSubMenu(Rec[i].Id);
   end
    else
     begin
      ZeroMemory(@MII, SizeOf(MII));
      MII.cbSize := MenuStructSize;
      MII.fMask := MIIM_ID;
      MII.wID := Form1.pm.Items[Form1.pm.Count - 1].MenuId + 1;
      SetMenuItemInfoW( Form1.pm.Items[MenuID].Parent.Handle,
                        i,
                        TRUE,
                        MII );
//       Form1.pm.Items[MenuID].Parent.InsertSubMenu(Form1.pm.Items[Rec[i].ID], -1);
//       RemoveMenu(Form1.pm.Items[MenuID].Parent.Handle, i, MF_BYPOSITION);
     end;

MTsv DN   (2009-12-04 19:13:00) [16]

moDefault
Пардон, перестарался...

robt   (2009-12-04 19:10:00) [17]


>  по крайней мере, в Win7

тажа фигня

robt   (2009-12-04 19:08:00) [18]

LoadMenu грузит из ресурсов а LoadMenuIndirect создает из MenuTemplate который програмно создаеш

если не получается через api поменять итем например SetMenuItemInfo значит чето не так делаеш, тогда проще пересоздать полностью меню видимо

Дмитрий К   (2009-12-04 19:04:00) [19]

Пункт "по умолчанию", в меню может быть только один, поэтому moDefault там лишние и генерация не пашет, по крайней мере, в Win7. А сортировке проблема, если в подменю первый пункт тоже подменю.

MTsv DN   (2009-12-04 19:01:00) [20]

> f-11 и фсе :)
Весьма странно. ЕХЕшник в архиве работает, я ж его не с куста взял.

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо