Dynamické přiřazení funkcí k menu – Delphi – Fórum – Programujte.com

Jak bych měl postupovat, když budu potřebovat pro každou položku menu přiřadit funkci, dynamicky? Je v Delphi nějaká funkce, která umožňuje registrovat funkci pro dané menu?

poslední verze

Kód který mám:

procedure subMenuClick(Sender: TObject);
 var this: TmenuItem;
begin
end;

Při kliknutí na menu je třeba provézt průzkum daného adresáře, odvozeného buď od názvu položky menu nebo od pořadového čísla toho menu (to první bude asi jednodušší).

A jak vlastně mohu vrátit všechny položky menu Testy abych je mohl projít v cyklu?

TMenuItem má vlastnost OnClick. Je to v dokumentaci.

A parametr Sender je ta kliknutá položka. To je taky v dokumentaci.

procedure trida.subOkruhyClick(sender :TObject);
var
  dir : string;
begin
  dir := sender.name;
  otevri(dir);
end;

#1 oxidián

jde to v pohodě, položce menu item jde přidat událost Onclick

vytvoříš si univerzální obslužnou funkci pro klik, kde si pak můžeš vtáhnout bud menuitem.name nebo menuitem.tag např.

při přidávání. pak doplníš jen k nové položce menu událost

NewItemMenu.onclick := objektTřídy.subOkruhyClick;

NewItemMenu obsahuje nějakou vlastnost, která sdružuje vnořené položky submenu?

#4 oxidián
místo newitemmenu dáš to co máš v programu před přidáním té nové položky submenu k nadřazené.

Jinak k dotazu procházení submenu - TMenuItem je potomek T component a ten má spoustu vlastností např. list vnořených component a counter, takže submenu lze procházet pomocí cyklu.

function Name_items_in_menu(const koren : TMenuItem) : TStringList;
var
  Item : TMenuItem;
  I : integer;

begin
  result := TStringList.create;
  for I := 0 to koren.ComponentCount-1
  begin
    Item := koren.Components[I];
    result.add(Item.name);
  end;
end;

Drobnost místo 

MenuItem.Name potřebuješ spíš MenuItem.Caption

Zkoušel jsem pro začátek jen něco jednoduchého:

if not assigned(TestyOrganizer) then
TestyOrganizer := TTesty.Create(Form1);
TestyOrganizer.JazykyInitiate;        // step 2.
TestyOrganizer.readINI; // step 1.
TestyOrganizer.DynMenu;        // step 3.

s := Testy.Components[0].name;
s := Testy.Components[1].name;
s := Testy.Components[2].name;
s := Testy.Components[3].name;
s := Testy.Components[4].name;
s := Testy.Components[5].name;
i := Testy.ComponentCount;

To krokuju krok za krokem a "s" by mělo v kukátku ukazovat hodnotu, ale ukazuje jen ''.

A

s := Testy.Components[0].Caption;
s := Testy.Components[1].caption;
s := Testy.Components[2].caption;
s := Testy.Components[3].caption;
s := Testy.Components[4].caption;
s := Testy.Components[5].caption;

Ukazuje že vlastnost caption/Caption neexistuje (is undeclared).

Jinak ale používám Caption Testy.pas #374, takže by to tam mělo být.

langMenuItems[i].Caption := Jazyky[i];

#7 oxidián
hod mi sem ten kousek z Testy

create po vložení do testy langmenuitem[i]

a už tam máš v ini taky nějaký ty názvy?

Mám tam

langMenuItems[i].Caption := Jazyky[i];

ale vlastně to je chyba má tam být Self.Jazyky[i].

Když se podíváš na writeINI poslední verze, které jsem předělal, zjistíš, že to generuju automaticky, pokud ini je prázdný. Mělo by se to vytvořit samo, pokud je prázdný, ale vytvoří se to až po uzavření programu. V konstantách konstanty.pas tam to je předdefinované jako pole.

máš tam něco špatně, mě to v tom ini ty jazyky nevytváří.

místo podmínky na iniempty bys tam měl mít lancount=0

při chybějících adresářích, je tam jeden msgbox navíc. se základní cestou.

#10 MilanL
už jsem na to přišel, je třeba použít přetypování

s := TMenuItem(Testy.Components[0]).Caption;

;
akorát v tý obslužný funkci nevím, jestli sender má být TObject nebo TComponent je třeba to vyzkoušet.

Díky :)

Vlastně potřebuju jinou funkci, ne click, ale takovou, která se spustí, když se pokusím o rozbalení menu (například tím že tam najedu myší nebo šipkama)

#13 oxidián
no nevím zkusím po googlit v základu u TMenuItem nejsou tyhle event funkce "OnEnter" - vstup šipkama ani "OnMouseEnter"  - najetí myší, musel by sis je asi vytvořit.

Zkusím kouknout až dojdu z práce dom.

Pokud chceš nejdřív jakoby ukázat seznam před otevřením submenu, tak možná přes HINT.

Tak když je tam nemaj tak to tam cpát nebudu. Načítání adresářů udělám všechno najednou.

Teď se šťourám v proceduře

procedure TTesty.DynMenu;

kde na řádku #400 mi to krachuje s chybou range check error. idx na třetím řádku je 0.

Self.langMenuItems v kukátku píše pole s csinheritable...

Self.langMenuItems[0].caption píše název jazyka ... pocud se vše zdá být vpořádku.

Tohle je vnitřní (2.) cyklus:

for j:=0 to Self.SubDirs.Count-1 do
  begin
  idx := Self.JazykyIndexy.IndexOf(Self.Jazyky[i]); // najít ID menu daného jazyka
  Self.SubMenuItems[j] := TMenuItem.Create(Self.langMenuItems[idx]); // langMenuItems[idx]
  Self.SubMenuItems[j].Caption := Self.SubDirs[j];
  Self.langMenuItems[idx].Add(Self.SubMenuItems[j]);
  end;

V nadřazeném cyklu načtu podadresáře jazyka. To se přidá do SubDirs : TStringList;

https://sourceforge.net/projects/uc-heb/files/developer_backups/2018/unfinished/ucheb.2407.zip/download

Přidávám zálohu souboru .ini

Nějaký nápad v čem by mohla být chyba?

#16 oxidián
smazány 2 odpovědi, měl jsem chybu v cestě v tom ini, v základu by ta položka měla být prázdná a při nahrávání by se při neurčené cestě měl automaticky nastavit ten programovej adresář.

s tím ini pracuješ blbě, když se program správně neukončí, tak se smaže většina obsahu.

a hcyba je v tom createsubdirlist dostává se to tam nějak mimo index

#16 oxidián
vůbec to tam nechápu co děláš s createSubDirsList v DynMenu:

1 cyklus v DynMenu , druhý cyklus ve funkci navíc ve funkci v každém cyklus mažeš pracovní list, takže v podstatě výstup je jen poslední seznam

navíc do funkce posíláš adresář z pole TestyDirs, a ve funkci používáš SubMenuItemsLoaded[i] pokaždé, navíc tan měníš hodnotu, takže při prvním průchodu se ti nastaví hodnoty na true a pro další už se nenačtou, zamysli se nad tím co tam s tím vlastně děláš.

#19 MilanL
pokud to chápu dobře a chceš mít ty názvy všechny načtený, tak bys musel to submenu mít 2d pole první index jazyky druhý index submenu.

Tak jsem na to přišel, pokud používáš stejnej INI, problém je v těch stejných názvech do lanCount napočítáš všechny řádky, ale do TlistString se ti načtou jen 2 ostatní jsou duplicity, takže do DynMenu u těch 2 smyček místo lanCount dát TestyDirs.count, a u druhé ti chybí -1.

#20 MilanL
mít klid a víc času radši bych ti to udělal sám, hledat ty chyby je kolikrát horší než to udělat.

#21 MilanL
jinak nejspíš jsem pracoval s jinou verzí, tu verzi v posledním odkazu jsem už měl dřív

Omlouvám se za odmlku.

Self.SubDirs := createSubDirsList(Self.TestyDirs[i]);

Vytvoří to seznam podadresářů pro aktuální jazyk Self.TestyDirs[i].

Pokud Self.TestyDirs[i] je např. 'english' tak vrátí seznam adresářů v testy/english...

Uvnitř toho vnořeného cyklu Jde o to vytvořit ty vnořené menu k tomuto jazyku

Asi dlouho nevydržím u PC bolí mě oči.

#23 oxidián
já tenhle víkend budu spíš později odpoledne a večer, přes den něco mám.

Kdyžtak hod aktuální verzi, ta poslední cos poslal nebyla aktuální s tím problémem.

Aha, tak ono se to přejmenovalo jinak tak místo 08 jsem poslal 07.

ucheb.2408.zip

#25 oxidián
čau koukal jsem na to, createsubdirslist nezná I to máš ve volající části, bud to musíš poslat jako parametr, nebo ty podmínku a nastavení po provedení u

Self.SubMenuItemsLoaded[i]

dát do té volající části

// v dynmenu tam kde se volá createsubdirslist

for i:=0 to lanCount-1 do
    begin
    if Self.SubMenuItemsLoaded[i]=false then
       begin
       Self.SubDirs := createSubDirsList(Self.TestyDirs[i]);
       Self.SubMenuItemsLoaded[i] := True;
       end;

...

a v createsubdisrlist ty řádky se submenuitems vyhodit

pak bych ještě doporučil přidat před ten druhý cyklus s J podmínku na subdirs.count>0

Myslíš asi řádek #389 sloupec 39. i je deklarované jako lokální proměnná a nastavuje se v cyklu for. Proto nechápu co říkáš, že nezná I. Nepředávám I, ale to co předávám by měla být položka typu TStringList.

#27 oxidián
deklarovaný to máš, ale for je v poznámce takže jí nenastaví, pokud bys to tam použil bude se to snažit několikrát načíst ty podadresáře toho samýho subdir které se nemění

proto by to mělo být o tu úroveň výš v dyn mernu jak jsem ti to napsal minule.

#28 MilanL
jinak mě to s tou mojí úpravou funguje.

Já ten cyklus zakomentovaný nemám. Právě, když to nechám krokovat (originální kód) tak jsem se dostal k i=1 a j=2. Tam se to pokouší jet 3x místo dvakrát, proto to krachne. Self.SubDirs.Count je nastaven na 3 místo na 2.

Takže se podívám na řádek 67:

function TTesty.createSubDirsList(subdir: string):TStringList;

Počkej, ty si mluvil o zakomentované smyčce for, a tady vidím, že je jedna zakomentovaná. To vypadá, že si mluvil o něčem jiném než já?

Tam scházela podmínka

and (SearchRecord.name[1]<>'..')

No ale stále mi to dává o jednu položku navíc.

....

Už asi chápu kde je problém.

Nejdříve načtu ty podadresáře TestyDirs := createTestyDirsList(Self.TestyDir);

Takže učebnice mám pod Self.TestyDirs[i]. S tím bych měl pracovat a vytvořit menu.

Místo toho procházím podadresář učebnice:

Self.SubDirs := createSubDirsList(Self.TestyDirs[i]);

a tuto podpodsložku se pak snažím projít vnořeným cyklem.

který má 3 podsložky, ne 2.

Jak zjistím kolikátá položka je menu na které jsem klikl?

pro funkci

TTesty.SubTestyClick

kde musím předat parametr i

SubDirs := createSubDirsList(dir, i);

Anebo já to vyřeším jinak.

 smažu

  if Self.SubMenuItemsLoaded[i]=true then
     exit;

A použiju toto:

    if Self.SubMenuItemsLoaded[i]=false then
       Self.SubDirs := createSubDirsList(Self.TestyDirs[i],i);

Respektive takto:

    if Self.SubMenuItemsLoaded[i]=false then
      begin
       Self.SubDirs := createSubDirsList(Self.TestyDirs[i]);
       Self.SubMenuItemsLoaded[i] := true;
      end;

Teď mi to jede, ale před ukončením programu dej restartovat, maže to ten ini soubor.

verze 2409

Co se týče učebnic, zítra zkusím zjistit proč se mi všude zobrazuje Angličtina doby krále Jakuba na prvním místě a naopak textbook se nezobrazuje v menu. textbook má být v každém jazyku

Zavedl jsem dvourozměrné pole SubMenuItems

type
  MenuSubFoldersGrid = Array of TMenuItem; // Menu Sub-folders
type
  TTesty = class(TObject)
  private
    i: integer;
    iniEmpty: boolean;
    langMenuItems : array of TMenuItem;
    SubMenuItems : Array[0..maxTestItems-1] of MenuSubFoldersGrid; // 2D array for Testy menu
...

2410

Konečně jsem vyřešil to submenu... uff.

Teď musím ještě řešit proč se mi všude automaticky vytvoří adresář textbook.

Nová verze je 2411

#34 oxidián
už jsi na to přišel?

já na to zatím nekoukal, ale řekl bych, že to bude obsahem subdirs, když submenuitems[i]=true, pamatuje si to poslední načtený subdirs a použije to i na ty další položky.

V podstatě bys měl mít i ten cyklus j v té podmínce na submeniitems[i]=false 

Já teď moc na PC nedělám, jsem dost unavený, přepracovaný atd. Tak asi se podívám mezi pátkem či víkendem.