Jak přiřadit položku menu do objektu? – Delphi – Fórum – Programujte.com

Připojen obrázek.

Menu Testy:

- TMenuItem.name = 'langHebrew1'

TMenuItem.caption = 'Hebrejština'

tomu odpovídající sub-menu Testy/Hebrejština/ - vybrat složku - :

- TMenuItem.name = 'SelectLangHebrew1'

Jde mi o to že objektu subMenuItems[i] chci uložit pointer na objekt menu i pointer na objekt podmenu "- vyber složku - "

Snad je to takto srozumitelné?

#1 oxidián

jde o to kčemu ty pointery chceš používat - jejich funkce ale tak jak to chceš použít ti to nemůže fungovat, hlavně ta 3.řádka, nemůžeš měnit stringy v menuitem pomocí pointerů.

#2 MilanL
Já nechci měnit stringy, já chci ten string co je na obrázku použít k tomu abych nastavil pointer na dané menu. Jde to?

Polopatě: jde o to jak říct programu najdi objekt "langhebrew1" a přiřaď jeho adresu na toto místo v jiném poli/objektu.

#3 oxidián
no mám dlouhý vedení nebo co, ale pořád tě nějak nechápu jak to myslíš, napadá mě tohle:

podle výběru adresáře s testy nebo z konfiguračního souboru získáš jazyk a podle toho chceš aby se bud provedla akce nějakého menuitemu nebo v menu testy vytvořila struktura menu s tím jazykem?

V podstatě jo. Do té položky Hebrejština se mají vypsat složky z adresáře např. Testy/Hebrejština.

Definoval jsem pole, které obsahuje seznam těch menuItem (Tj. jazyky). Teď ho chci v cyklu projet a propojit to s těmi již existujícími menuItem (jazyky). Díky tomuto propojení s tím budu moci dále už snadno pracovat. Dokud to nepropojím a neřeknu mu co kam příjde tak s tím nemohu pracovat. Propojení se má uskutečnit na základě toho definovaného seznamu vlastností "name". To je ten dlouhý seznam co vidíš na obrázku.

#4 MilanL
mě se zdá, že se snažíš používat C++ konstrukce v Delphi

menu je tvořené polem menuitems, které mohou mít pak dále vlastní pole menuitems pro každou položku - rekurzivně.

při větší snaze by to snad nějak šlo, ale má to podmínku nelze do menu takhle přidávat nové položky, pouze nahrazovat existující, musel bys na místo, kde je uložena reference na menuitem vložit referenci na menuitem z toho tvého pole, ani ńevím jestli to jde, možná při znalosti struktury menuitems a použití ASSEMBLERU.

Pprostě píšeš o tom jak na to spěcháš a přitom nemáš pořádnou koncepci - tzv to šiješ horkou jehlou, a snažíš se o věci do kterých kolikrát nevidí ani zkušení programátoři.

Po hodině procházení netu jsem nikde nenarazi u delphi na používání pointerů ve vztaku k menu.

#5 oxidián
aha ted tomu rozumím s tím se dá pracovat, pointery asi nepomohou

To vytváření menupoložek dynamicky ale jde. je na to ta metoda .create. Dík za snahu.

#8 oxidián
create vytvoříš položku, ale musíš jí navázat do menu tzn aby se v menu přiřadila k jiné položce

přes pointery to nepůjde, snad přes indexy

něco podobného jako řeší zde, ikdyž v jiném kontextu

https://stackoverflow.com/questions/9771057/iterating-over-main-menus-items-including-subitems

hele něco vyzkouším jestli to půjde dám ti vědět
 

No kdyby to člověk měl dělat ručně nadefinovat třeba 13+13*25 položek ručně a všechny procedury click ručně, tak by to bylo nejen únavné, ale hlavně by ten kod byl až moc dlouhý.

#10 oxidián
tak jsem něco spáchal

Připojen obrázek.

// součástí TFORM

// DYN MENU
  private
    langs : TStrings;                    // pro převod textu na index
    langMenuItems : array of TMenuItem;
    SubMenuItems : Array of TMenuItem;
    procedure DynMenu;

// procedura spuštění ve FormCreate viz obrázekprocedure TForm1.DynMenu;
const
  Jazyky : array [0..3] of string = ('hebrew1','XXX','YYYY','ZZZ');
var
  I, idx : integer;
  str : string;
begin
  langs := TStringList.Create;
  for I := 0 to 3 do                                   // naplnění jazyků  aplikovat smyčku na adresář test
  begin
    setlength(langMenuItems,length(langMenuItems)+1); // dynamické zvětšování pole
    langMenuItems[I] := TMenuItem.Create(miTEST);    // objekt menu TEST
    langMenuItems[I].Caption := Jazyky[I];
    miTest.Add(langMenuItems[I]);
    str := Jazyky[I];
    langs.Add(str);
  end;

  repeat                    //smyčka přidávání submenu pod jazyky  / aplikovat postupně na adresáře jazyků
                            // případě vnořit do předchozí smyčky
    I := length(submenuitems);                      // i jako index pro aktuální submenu
    setlength(submenuitems,I+1);
    idx := langs.IndexOf(Jazyky[I div 4]);         // vyhledat index lang podle názvu jazyka
    submenuitems[I] := TMenuItem.Create(langMenuItems[idx]);
    submenuItems[I].Caption := jazyky[I mod 4];
    langMenuItems[idx].Add(submenuItems[I]);
  until I=15;

end;

samozřejmě je třeba vzít v úvahu jaké použiješ cykly a jak hluboké bude vnoření (struktura adresářů)

já bych třeba použil jinej způsob

hl.menu - JAZYKY a submenu 1 úroveň jednotlivé jazyky - 2. úroveň Lekce a ve 3. mít třeba Výuka/Vzorové texty/Testy, nebo prohodit 2. a 3. úroveň.

#11 MilanL
snad to pomůže, ještě jde o jednu věc, nějak pak musíš z toho menu dostat co se má s čím dělat.

#11 MilanL

Testy / Jazyk / Autor testu / Okruh / Testy (popis učebnice je uvnitř testu)

Lekce jsou už v samotných souborech (testech).

Je to tak protože se může sejít několik autorů testů ze stejného jazyka, každý bude používat jinou učebnici nebo bude trénovat něco jiného. Někdo může vytvořit testy na slovíčka, někdo testy na fráze...

Já řeším Testy / Jazyk / Autor

a další adresáře od Autora se už vypíší do menu Okruhy.

Mrknu na to.

 
miTEST je rodič (menu Test?)
Takže ve for cyklu se ti vytvářejí ty menu a v druhém cyklu se vytvářejí sub-menu. Myslím že to chápu. Tak to zkusím napodobit. Asi se na to vrhnu až zítra, dneska se mi už nechce.

Dík.

#13 oxidián
jinak pole menu items může být i jen jedno když to provážeš s tím TStringsem na názvy nadřazených, jen se ti tam nesmí názvy adresářů potkat v tom by mohl být problém třeba když bude autor pro více jazyků - napadlo mě tam dávat celou tu cestu test\lang\autor, jinak by ti nezbylo než ta tvoje struktura jen místo pointerů použít ty indexy.

jinak ty moje pole jsou omezené jen pamětí nebo max velikostí pole což je myslím 32bit integer.

ten můj kod ber jako příklad, je to jen 2 úrovnové

#15 MilanL
Dost starostí by sis ušetřil kdybys to dělal rekurzivně test-1. jazyk-1.autor - okruhy

vstup do funkce aktuální cesta a nadřazený MenuItem

první vstup ADDITEMS (adr.Testy, Test:menuitem)

procedure ADDITEMS(Adresář: NadřazenýItem)
cyklus procházení subdir v Adresář
  přidat sub do PoleMenuItems
  nadřazenýItem.add(poleMenuItems[index])

 ADDITEMS (Adresář+sub,poleMenuItems[index])

konec cyklu

Já sám si to neumím až tak dobře představit, protože moje představivost se rozvíjí až teprve s tím co vytvořím. Nedokážu až tak dalekosáhle přemýšlet. Takže nejdříve dělám hrubou stavbu a pak detaily a když vznikne problém, tak bourám stavbu, předělám a upravím :D

#17 oxidián
Upravil jsem svů jředchozí, omylem jsem odeslal nedokončenou odpověd

Ty položky na výběr adresáře

Testy / Hebrejština / - vybrat adresář -

to mám taky definovat dynamicky? Jako první položku submenu myslím. Protože to mám vytvořené na pevno, takže smazat?

A co znamená toto?

idx := langs.IndexOf(Jazyky[I div 4]);

Jazyky[I div 4]
Nechápu co je to v té závorce...

a

jazyky[I mod 4];
 

Ty definuješ const jazyky uvnitř metody, ale mi přijde lepší (přehlednější) to dát hned na začátek programu.

Šlo by to rozšířit tak, aby v těch popiscích jazyků byly taky pomlčky nebo jak chceš vyřešit skupiny?

Připojen obrázek.

#19 oxidián
to bylo jen na testování aby mi to něco prostě vyplnilo

nová rekurzivní verze z adresářů 

procedure TForm1.DynMenu(path: string; MItem: TMenuItem);
var
  idx : integer;
  SearchRecord : TSearchRec;
begin
  if FindFirst(path+'*.*', faDirectory, SearchRecord) = 0 then
  begin
    repeat
      if (searchRecord.attr and faDirectory) <> faDirectory then continue;
      if SearchRecord.Name[1] = '.' then continue;
      idx := length(subMenuItems);
      setlength(subMenuItems,idx+1);
    // indexuje se od 0 proto +1 na velikost pole
      subMenuItems[idx] := TMenuItem.Create(MItem);
      subMenuItems[idx].Caption := SearchRecord.Name;
    // případně si v adresáři udělat soubor s názvem třeba název.name name.txt
      MItem.Add(subMenuItems[idx]);
      DynMenu(path+SearchRecord.Name+'\',subMenuItems[idx]);
    until FindNext(SearchRecord)<>0;
    SysUtils.FindClose(SearchRecord);
  end;
end;

výsledek na volání  dynMenu('C:\Users\...\Embarcadero\Studio\Projects\',miTEST);

Připojen obrázek.

#21 MilanL
skupiny napadá mě třeba na znak+# , # jako detekce a znak jako skupina, pak by ale bylo potřeba si ten result nejdřív hodit do listu a seřadit to samé převod zkratek jazyků na celé názvy, musíš si vybrat mezi tím jestli to dělat vše automaticky nebo ručně přes konfigurák.

fakt u tebe postrádám ucelenou koncepci, děláš to hokus pokus.

Mám hotovo podle té staré verze + skupiny. Když tam je ' ' tak se to přeloží jako caption := '-'

a v druhé smyčce se to ignoruje. Bude třeba doladit a odstranit chyby.

Nová verze 2.357

#22 MilanL
ten konfigurák by se dal dělat přes nějakou funkci Import/Aktualizace - najde nové adresáře a umožní ti to k nim přiřadit klíčové vlastnosti jako skupina / název dokonce by tam možná šlo, aby sis mohl nějakou položku přiřadit do více nadřazených menu jako třeba nějakej výukovej text ke 2 autorům nebo do 2 okruhů. apod

#24 MilanL
ty moje funkce jsou dělaný jen na testování a pro tebe abys věděl jak to funguje, vlastní zpracování už je na tobě

idx := langs.IndexOf(Jazyky[I div 4]); // vyhledat index lang podle názvu jazyka

submenuItems[I].Caption := jazyky[I mod 4];

to byly pomocné hodnoty aby mi to nějak udělalo tu druhou úroveň, měl jsem 4 prvkovej string aray tak idx určovalo nadřazenou položku a I mod 4 naplnovalo 4 submenu

musíš si nahradit svými hodnotami v IDX by se měli zjišťovat ty indexy testy.submenu podle názvů těch jazyků

Trochu jsem to upravil. První cyklus co si použil jsem přesunul do procedury JazykyInitiate.

Následně volám tři procedury:

JazykyInitiate; // vytvoř jazyky a indexy jazyků

readINI;

DynMenu.

Teď upravuju readINI (používám tam ty indexy jazyků, což je TStrings.

Následně ze souboru ini přečtu např. Hebrejština;0 ... tzn. že není ještě vybrán adresář pro hebrejštinu

Dále, rozparsuju a vytáhnu přečtený jazyk jako TestFolderInfo[0];

Nyní potřebuju zkontrolovat jestli string TestFolderInfo[0] je v seznamu indexů TStrings.

Tady je popsán následující postup:
 

if Strings.IndexOf('Hello')<>-1 then caption:='Found';

Převedeno do našeho kódu:

if JazykyIndexy.IndexOf(TestFolderInfo[0])<>-1 then SubMenuItemsLoaded:=true;

Dobře, ale co když bych hledal 'Hebrejština' v 'Moderní Hebrejština' nedojde ke shodě?

Nevíš proč se to zacykluje?

SubDirs.clear;
if FindFirst(testyDir, faDirectory, SearchRecord) = 0 then
      begin
        repeat SubDirs.add(SearchRecord.Name);
        until FindNext(SearchRecord)<>0;
        SysUtils.FindClose(SearchRecord);
      end;

#26 oxidiánx
ke shodě by myslím dojít nemělo testuje to celej string a ne jen část, v případě, že bys tam měl opravdu stejné položky ukáže to myslím na první výskyt.

Jinak vytvoř si proměnou na ten index jednodušeji se to používá pokud tam budeš mít víc podmínek a potřebuješ to pak na další indexování do pole menuitems pro přidávání položek.

#27 oxidián
Hm divný to by se zacyklit němělo napsaný to máš správně.

#27 oxidián
pozor v tom searchRexord budou všechny soubory ne jen adresáře.

No to je divný, vždyť je tam atribut faDirectory

The Attributes may be set as follows:
 

faAnyFile  : Any file
faReadOnly  : Read-only files
faHidden  : Hidden files
faSysFile  : System files
faVolumeID  : Volume ID files
faDirectory  : Directory files
faArchive  : Archive files

Tak asi nejde o zacyklování, ještě to ladím.

Je tam problém "out of memory". Asi se to někde zacyklovalo.

Nechceš to otestovat?

ucheb.2358.zip

Jo už si vzpomínám že já jsem vlastně v tom .ini

schválně vynechal ty položky které by měly být pod sekcí

[TestFolders]

...

Možná je ten cyklus na ř. 638

for i:=0 to maxTestFolders-1 do

nešťastný. Není tam podmínka jako u toho until

until (...) or eof(f);

Jen na vysvětlení readINI:

  testyDirFound := false;
  if line='[TestyDir]' then
    begin
     readln(f,TestyDir);
     if DirectoryExists(TestyDir) then
       testyDirFound := true;
     readln(f,line);
    end;

Zkouší nalézt adresář s testy.

c := maxTestItems-1;
  if (line='[TestFolders]') and (testyDirFound=true) then
    begin
    TestFolderInfo := TStringList.Create;
    for i:=0 to maxTestFolders-1 do

začíná číst sekci [TestFolders]

na konci této sekce se mají preventivně vyplnit pole týkající se toho načítání .ini

    // prevent crash: initiate arrays for DynMenu
    for i:=0 to maxTestItems-c-1 do
      begin
           JazykyFolders[i] := '';
           SubMenuItemsLoaded[i] := false;
      end;

Ještě jsem našel chybu, smazal jsem řádek:

  // naplnění jazyků aplikovat smyčku na adresář Testy:
  JazykyInitiate;

ale krachuje to stále.

#31 oxidián
manuál k FindFirst adrsáře v druhé části examples 

příznak faDirectories říká funkci, že se do seznamu mají zahrnout i adresáře.

 if findfirst('*', faDirectory, searchResult) = 0 then
  begin
    repeat


      // Only show directories

      if (searchResult.attr and faDirectory) = faDirectory


      then ShowMessage('Directory = '+searchResult.Name);
    until FindNext(searchResult) <> 0;
    // Must free up resources used by these successful finds
    FindClose(searchResult);
  end;

Edit: aha, teď vidím jak to máš v tom kódu.

#33 oxidián
přesně tak, ale ty tečky stačí 1 podmínka, pokud nebudeš dělat adresáře začínající tečkou vem první písmeno z toho názvu a srovnej s tečkou 

if (TSearchRec.attr=faDirectory)  and 
   (TSearchRec.name[1]<>'.')then ...

Dobře tak už jsem aktualizoval ten zip.

#35 oxidián
už jsi odhalil zdroj OUT OF memory?

co takhle zkontrolovat si na poslední řádce DynMenu v until podmínku? kde v cyklu získáváš/měníš I :D

Jo tak to je ono. Dík

Mě už se dnes nechce uvažovat, tak zas zítra

#37 oxidián
když se ti tohle stane, tak je třeba breakpointama odchytávat v hlavní proceduře postupně ty spouštěné procedury - tím zjistíš která to dělá a pak v první řadě si zkontrolovat u cyklů řídící proměné a podmínky.

no nic dolehlo na mě to celodenní horko, za chvilku, jdu spát, takže další asi až ráno, v práci ted nemám čas, je konec měsíce do pátka musím dodělat tu úpravu programu na docházku, aby to mohli použít už na kveten.

Ve verzi ucheb.2359.zip jsem opravil tu smyčku a zápis sekce [TestFolders] do souboru .ini

Dotaz: bylo by možné přesunout následující dvě funkce:

createTestyDirsList, createSubDirsList

UC_HEB1?

unit Uc_heb1;
interface

uses
  WinTypes, ...  functions, ... FileCtrl;

const maxRecentFiles = 10;
const maxTestFolders = 13; // 4 separators or gaps
const maxTestItems = maxTestFolders+4; // 4 separators or gaps
const maxSubFolders = 255;
const Jazyky: Array [0..maxTestItems-1] of string = ( ... );

type
  TForm1 = class(TForm)
...
    procedure readINI;
    procedure writeINI;
 ...
  // DYNAMICKY GENEROVANÉ MENU TESTY
  private
    langMenuItems : array of TMenuItem;
    SubMenuItems : Array of TMenuItem;
    SubMenuItemsLoaded : Array [0..maxTestItems-1] of boolean;
    TestyDirs, SubDirs : TStringList; // for folders search
    JazykyIndexy : TStrings;
    JazykyFolders : Array [0..maxTestItems-1] of string; // Folder names associated with Jazyky munu items
    JazykySelected : Array [0..maxTestItems-1] of string; // Jazyky sub-folder folder specification
    procedure JazykyInitiate;
    procedure DynMenu;
    function createTestyDirsList(TestyDir: string):TStringList;
    function createSubDirsList(TestyDir: string; subdir: string):TStringList;

  public
  end;

var


Forn1, ... , TestyDir : string;

do modulu functions, když ty funkce využívají konstanty a proměnné deklarované/definované až za klauzulí uses?

Z toho důvodu že už je nepřehledné mít všechno v jednom souboru, takže funkce se snažím dát do modulu functions. Když uses se nachází před const, tedy v modulu functions by mi to křičelo že ty dvě konstanty nejsou definované:

maxTestFolders // count of Subdirs in Testy

maxSubFolders // max. count of Subdirs in /Testy/*/

 

#40 oxidián
záleží co všechno dělají, pokud jen vrací stringlist s názvy adresářů a nepoužívají nějaké další proměnné Form1, tak ano.

akorát jsem s touhle konstrukcí měl kdysi problém, musel jsem použít jiný způsob, problém byl s vracením TStringList,

doporučuji do parametrů vložit argument var list:Tstrings nebo TStringList

a místo
         výsledek: = funkce
mít
         Funkce/procedura (výsledek,....

#41 MilanL
NJ narůstá ti to s tím jsi musel počítat. jí to dělám tak, že si funkce procedury sbalím tím '-' v editoru vlevo od funkce / objektu a rozbalený nechám jen ty úseky na kterých zrovna pracuju.

No ale děje se jak jsem říkal, po přesunutí mi to hlásí undeclared identifier u těch konstant.

#43 oxidián
no na sdílení konstant si můžeš udělat soubor, kterej pak přes include direktivu napojíš do všech jednotek.

nebo je dáš do tý function knihovny a pak by se měli do formu dostat přes uses knihovny

Když dám ty konstanty samostatně tak dostávám chybovou hlášku, že na konci souboru očekává deklaraci.

Proč deklaraci? Čeho? Jak to dokončit?

unit konstanty;

interface

const maxRecentFiles = 10;
const maxTestFolders = 13; // 4 separators or gaps
const maxTestItems = maxTestFolders+4; // 4 separators or gaps
const maxSubFolders = 255;
const Jazyky: Array [0..maxTestItems-1] of string = (
{ POZOR: u položky " nevybráno" nebo " vyber"
  musí být na začátku mezera! Jinak dojde k chybnému
  čtení a zápisu souboru .ini }
' - nevybráno - ',
' ',
'Biblická hebrejština', 'Biblická řečtina (Koiné)', 'Latina',
'Angličtina doby Krále Jakuba', 'Jiné starověké jazyky',
' ',
'Moderní hebrejština (Ivrit)', 'Moderní řečtina', 'Moderní angličtina',
'Moderní němčina', 'Moderní francouzština', 'Moderní španělština',
'Jiné současné jazyky',
' ',
'Škola hrou');

#45 oxidián
musíš tam dát ještě tyhle 2 řádky alespoň :

implementation
end.

nebo to dát do ne pas souboru bez řádky unit a použít tu directivu include.

Inklude vloží na to místo obsah toho souboru a pak to kompiluje jako by to bylo součástí tý unity

např

unit functions;

Implements

uses ....;

{$Include konstanty.pas}  lze použít i {$I function.pas}

chová se to jako bys ty řádky napsal do té unity functions.

Výhoda je že to můžeš takhle importovat všude kam potřebuješ a na přidání dalších konstant pro celou aplikaci ti stačí je přidat jen do toho 1 souboru