My Visual Database — Главное меню на другой форме

Re: Главное меню на другой форме

null@example.com (k245) — Mon, 10 Jun 2019 07:30:06 +0000

У меня есть пример создания меню из данных, хранимых в БД. Пример довольно сложный, описание здесь: https://vk.com/@createmyvisualdatabaseapp-menu в конце описания - ссылка для скачивания проекта.

Собственно, построение меню идёт в процедуре LoadMenu(). Меню создаётся на форме frmMain.

procedure LoadMenu;
var
  tmpMainMenu: TMainMenu;
  tmpDataSet:TDataSet;
  tmpSQL:string;
  tmpMenuItem: TMenuItem;
  tmpParentStack: array[1..MAX_MENU_LEVEL+1] of TMenuItem; // стек для хранения родительских элементов при создании главного меню
  tmpLevel: integer;
begin
  tmpMainMenu := TMainMenu.Create(frmMain);
  frmMain.Menu := tmpMainMenu;
  // запрос формируется с учётом прав пользователя
  tmpSQL :=
  ' select menu_.* , object_.name as object_name '+
  ' from menu_'+
  ' left join object_ on object_.id = menu_.id_object_';
  // если роль указана, то добавляем фильтр по роли:
  if RoleID <> 0 then
    tmpSQL := tmpSQL +
    ' left join role_object_ on role_object_.id_object_ = object_.id'+
    ' where (menu_.id_object_ is null) or (role_object_.id_role_ = '+inttostr(RoleID)+' )';
    // сортировка обеспечивает правильность сборки дерева
  tmpSQL := tmpSQL + ' order by order_num';
  //
  SQLQuery(tmpSQL,tmpDataSet);
  while not tmpDataSet.EOF do
  begin
    tmpMenuItem := TMenuItem.Create (tmpMainMenu);
    tmpMenuItem.Caption := tmpDataSet.FieldByName('name').asString;
    tmpMenuItem.Tag := tmpDataSet.FieldByName('id').asInteger;
    // если указан объект, то подключаем обработчик
    if not tmpDataSet.FieldByName('id_object_').isNull then
      tmpMenuItem.OnClick := @MainMenuClick;
    tmpLevel := tmpDataSet.FieldByName('level').asInteger;
    //
    if tmpLevel = 0 then
    begin
      tmpMainMenu.Items.Add(tmpMenuItem);
    end
    else
    begin
      tmpParentStack[tmpLevel].Add(tmpMenuItem);
    end;
    // записываем в стек текущий элемент как родителя для следующего уровня
    tmpParentStack[tmpLevel+1] := tmpMenuItem;
    // переходим к следующей записи
    tmpDataSet.Next;
  end;
  tmpDataSet.Free;
end;

Re: Главное меню на другой форме

null@example.com (sibprogsistem) — Sat, 08 Jun 2019 16:07:42 +0000

ivan wrote:

ув. sibprogsistem! можете пример проекта приложить?

да, конечно

Re: Главное меню на другой форме

null@example.com (ivan) — Sat, 08 Jun 2019 03:40:22 +0000

ув. sibprogsistem! можете пример проекта приложить?

Re: Главное меню на другой форме

null@example.com (sibprogsistem) — Fri, 07 Jun 2019 16:24:18 +0000

Вот Вам пример меню из моего проекты.. можно хоть на всех формах проекта запускать..

//------------------------------- выподающее меню  ----------------------------------------------
//***********************************************************************************************
//***********************************************************************************************
//Выпадающее меню работает в трех формах frmAdmin, frmMasterWork и frmServiceCen*****************
//переменная mur содержит имя формы в которой должно отображаться выподающее меню****************
//***********************************************************************************************
procedure SwitchMenu (Sender, r: string);
var
   fiLang,reporfile:TStringList;
   i,s,t,c: integer;
   subfiLangi,mnFilereport,subfiLangiEdit,subfiLangirepor,subfiLangiDel,subfiLangiPrint: TMenuItem;
   subfiLangipdf,mnFile,mnfiLangi,subFileNextUser,subFileClose,mnDictionary,subDictionaryPriceList : TMenuItem;
   subDictionaryDash1,subDictionaryDash2,subDictionaryDash3,subDictionaryDash4,subDictionaryDash5,subDictionaryDash6: TMenuItem;
   subDictionaryStatusEquipment,subDictionaryCompany,subDictionaryEquipment,subDictionaryBrand : TMenuItem;
   subDictionaryAccessories,subabout,subFilereport,mnActivities,subEvents,subDonations, mnSetting, subTelMask,subKey : TMenuItem;
   rta:TMainMenu;
   mur:TForm;
begin
  // если открыта форма * то переменная содежит имя этой формы
  if sender = 'frmAdmin' then mur:=frmAdmin;
  if sender = 'frmMasterWork' then mur:=frmMasterWork;
  if sender = 'frmServiceCen' then mur:=frmServiceCen;
  if r = '1' then rta.free;

//************ создаем выподающее меню ***************************
       //меню файл
   mnFile := TMenuItem.Create (mur);
   mnFile.Caption := pupmFa;

       subFileNextUser := TMenuItem.Create (mur);
       subFileNextUser.Caption := pupmnuser;
       subFileNextUser.OnClick := @MenuClick1;

       subFileClose := TMenuItem.Create (mur);
       subFileClose.Caption := pupmex;
       subFileClose.OnClick := @MenuClick2;
       //меню словари
   mnDictionary := TMenuItem.Create (mur);
   mnDictionary.Caption := pupmlib;

       subDictionaryPriceList := TMenuItem.Create (mur);
       subDictionaryPriceList.Caption := pupmpr;
       subDictionaryPriceList.OnClick := @MenuClick3;

       subDictionaryDash1:= TMenuItem.Create (mur);
       subDictionaryDash1.Caption := '-';
       subDictionaryDash1.Enabled:= False;

       subDictionaryStatusEquipment := TMenuItem.Create (mur);
       subDictionaryStatusEquipment.Caption := pupmst;
       subDictionaryStatusEquipment.OnClick := @MenuClick5;

       subDictionaryDash2:= TMenuItem.Create (mur);
       subDictionaryDash2.Caption := '-';
       subDictionaryDash2.Enabled:= False;

       subDictionaryCompany := TMenuItem.Create (mur);
       subDictionaryCompany.Caption := pupmco;
       subDictionaryCompany.OnClick := @MenuClick6;

       subDictionaryEquipment := TMenuItem.Create (mur);
       subDictionaryEquipment.Caption := pupmeq;
       subDictionaryEquipment.OnClick := @MenuClick7;

       subDictionaryBrand := TMenuItem.Create (mur);
       subDictionaryBrand.Caption := pupmbr;
       subDictionaryBrand.OnClick := @MenuClick8;

       subDictionaryDash3:= TMenuItem.Create (mur);
       subDictionaryDash3.Caption := '-';
       subDictionaryDash3.Enabled:= False;

       subDictionaryAccessories := TMenuItem.Create (mur);
       subDictionaryAccessories.Caption := pupmeex;
       subDictionaryAccessories.OnClick := @MenuClick9;
      // Меню настройки
   mnSetting := TMenuItem.Create (mur);
   mnSetting.Caption := pupmms;

       subTelMask := TMenuItem.Create (mur);
       subTelMask.Caption := pupmtm;
       subTelMask.OnClick := @MenuClick12;
      // меню помощь
   mnActivities := TMenuItem.Create (mur);
   mnActivities.Caption := pupmhe;

       subEvents := TMenuItem.Create (mur);
       subEvents.Caption := pupmsi;
       subEvents.OnClick := @MenuClick10;

       subDictionaryDash4:= TMenuItem.Create (mur);
       subDictionaryDash4.Caption := '-';
       subDictionaryDash4.Enabled:= False;

       subDonations := TMenuItem.Create (mur);
       subDonations.Caption := pupmab;
       subDonations.OnClick := @MenuClick11;

       subKey := TMenuItem.Create (mur);
       subKey.Caption := 'Регистрация ';
       subKey.OnClick := @MenuClick13;

      // меню отчет
 mnFilereport := TMenuItem.Create (mur);
 mnFilereport.Caption := pupmreport;

         subFilereport:= TMenuItem.Create (mur);
         subFilereport.Caption := pupmreportnew;
         subFilereport.OnClick := @clicknew;

         subDictionaryDash5:= TMenuItem.Create (mur);
         subDictionaryDash5.Caption := '-';

 mnfiLangi := TMenuItem.Create (mur);
 mnfiLangi.Caption := pupmlang;

   // выводим выподающее меню
   rta:=TMainMenu.Create(mur);
   rta.Items.Add(mnFile);
       mnFile.Add(subFileNextUser);
       mnFile.Add(subFileClose);

   rta.Items.Add(mnDictionary);
        mnDictionary.Add(subDictionaryPriceList);
        mnDictionary.Add(subDictionaryDash1);
        mnDictionary.Add(subDictionaryStatusEquipment);
        mnDictionary.Add(subDictionaryDash2);
        mnDictionary.Add(subDictionaryCompany);
        mnDictionary.Add(subDictionaryEquipment);
        mnDictionary.Add(subDictionaryBrand);
        mnDictionary.Add(subDictionaryDash3);
        mnDictionary.Add(subDictionaryAccessories);
 // выводим в выподающем меню список файлов мультиязычности
 rta.Items.Add(mnfiLangi);

 fiLang := TStringList.Create;
 fiLang.Text := GetFilesList('languages','*.ini',False);
 s := fiLang.Count-1;
for i:=0  to s  do
 begin
  subfiLangi:= TMenuItem.Create (mur);
  subfiLangi.Caption := ExtractFileName(fiLang[i]);
  Delete(subfiLangi.Caption, Length(subfiLangi.Caption) -3 , 4);
  subfiLangi.Hint := (fiLang[i]);
  mnfiLangi.Add(subfiLangi);
  subfiLangi.OnClick := @clicklang;
  end;

 // выводим в выподющем меню список фалов отчетов
rta.Items.Add(mnFilereport);
   mnFilereport.Add(subFilereport);
   mnFilereport.Add(subDictionaryDash5);
reporfile := TStringList.Create;
    reporfile.Text := GetFilesList( 'Report\','*.fr3',True); //ExtractFilePath(Application.ExeName) +

     t := reporfile.Count-1;
     for i:=0  to t  do
     begin
         subfiLangirepor:= TMenuItem.Create (mur);
         subfiLangirepor.Caption := ExtractFileName(reporfile[i]);
         subfiLangirepor.Hint := (reporfile[i]);
         mnFilereport.Add(subfiLangirepor);

         Delete(subfiLangirepor.Caption, Length(subfiLangirepor.Caption) -3 , 4);

         subfiLangiEdit := TMenuItem.Create(mur);
         subfiLangiEdit.Caption := pupmreportedit;
         subfiLangiEdit.Hint := (reporfile[i]);
         subfiLangiDel := TMenuItem.Create(mur);
         subfiLangiDel.Caption := pupmreportdel;
         subfiLangiDel.Hint := (reporfile[i]);
         subfiLangipdf := TMenuItem.Create(mur);
         subfiLangipdf.Caption := 'PDF';
         //subfiLangipdf.Hint := (fiLang[i]);
         subfiLangiPrint := TMenuItem.Create(mur);
         subfiLangiPrint.Caption := pupmreportprint;
         subfiLangiPrint.Hint := (reporfile[i]);

         subfiLangiEdit.OnClick := @clickEdit;
         subfiLangiDel.OnClick := @clickDel;
         subfiLangiPrint.OnClick := @clickPrint;
         subfiLangipdf.OnClick := @clickpdf;
    
         subfiLangirepor.Add(subfiLangiEdit);
         subfiLangirepor.Add(subfiLangiDel);
         subfiLangirepor.Add(subfiLangipdf);
         subfiLangirepor.Add(subfiLangiPrint);
     end;

   rta.Items.Add(mnSetting);
        mnSetting.Add(subTelMask);

   rta.Items.Add(mnActivities);
        mnActivities.Add(subEvents);
        mnActivities.Add(subDictionaryDash4);
        mnActivities.Add(subDonations);
        mnActivities.Add(subKey);
end;

в свойствах формы OnShow обращаетесь к процедуре

Re: Главное меню на другой форме

null@example.com (m.prokhachev) — Fri, 07 Jun 2019 15:34:52 +0000

Ну не все с TPanel умеют заморачиваться, чтобы изменять форму не меняя формы...

Re: Главное меню на другой форме

null@example.com (k245) — Fri, 07 Jun 2019 14:46:07 +0000

m.prokhachev wrote:

Изящно! Всего лишь поменяли дескриптор у объекта-структуры Так и продублировать меню на другие формы можно!

Продублировать таким макаром нельзя, так как один экземпляр главного меню (TMainMenu) может быть только у одной формы. Но можно поэлементно скопировать.

Re: Главное меню на другой форме

null@example.com (m.prokhachev) — Fri, 07 Jun 2019 14:26:37 +0000

Изящно! Всего лишь поменяли дескриптор у объекта-структуры Так и продублировать меню на другие формы можно!

Re: Главное меню на другой форме

null@example.com (k245) — Fri, 07 Jun 2019 13:16:34 +0000

alex842 wrote:

... можно ли перенести главное меню на другую форму? ...

var
  Menu:TMainMenu;

begin
  Menu := Form1.Menu;
  Form1.Menu := nil;
  Form2.Menu := Menu;
end.

Код переносит главное меню с Form1 на Form2

Re: Главное меню на другой форме

null@example.com (k245) — Fri, 07 Jun 2019 13:06:03 +0000

vovka3003 wrote:

Зачем..? Так не проще?:

Если авторизация не проходит, то некрасиво блымкает главная форма перед своим закрытием.

Re: Главное меню на другой форме

null@example.com (alex842) — Wed, 05 Jun 2019 20:53:02 +0000

sibprogsistem wrote:

вот

Спасибо!

Re: Главное меню на другой форме

null@example.com (sibprogsistem) — Wed, 05 Jun 2019 20:48:22 +0000

вот

Главное меню на другой форме

null@example.com (alex842) — Wed, 05 Jun 2019 20:34:32 +0000

Добрый день.

Использую главную форму для аутентификации. После входа в систему появляется основная форма моего приложения. Как на эту форму добавить меню? Именно меню, как добавлять пункты в меню, я знаю. Т.е. можно ли перенести главное меню на другую форму? Вроде бы, такой вопрос уже задавался, но что-то поиск мне результатов не выдал.