![]() |
PopUp Untermenüs und Laufzeit
Hallo
wie erstelle ich zur Laufzeit in einem POPUpMenu neue Einträge (Untermenüs) und dann auch noch diesem Eintrag ein Icons zuweisen! Danke Euch... |
Re: PopUp Untermenüs und Laufzeit
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,
ich habe das irgendwann einmal folgendermaßen gelöst: (Erklärung im Anschluss)
Delphi-Quellcode:
***AUA*** *gg*
//***** Items hinzufügen
procedure TfrmMain.AddMenuItems(); var SubMenuItem: TTBXSubmenuItem; MenuItem: TPopItem; SeparatorItem: TTBXSeparatorItem; GroupIcon: TIcon; AppIcon: TIcon; sGroupPath: String; sGroupName: String; slDirectories: TStringlist; slApplications: TStringlist; i, j: Integer; k, l: Integer; //***** Zähler für Icons begin slDirectories := TStringlist.Create; slDirectories.Sorted := True; slApplications := TStringlist.Create; try k := 0; //***** Zähler für SubMenuItem-Icons l := 0; //***** Zähler für MenuItem-Icons imglistSubMenus.Clear; imglistMenus.Clear; GetSubDirs(ExtractFilePath(ParamStr(0)) + 'defs\', slDirectories); if slDirectories.Count > 0 then begin for i := 0 to slDirectories.Count - 1 do begin slApplications.Clear; sGroupPath := slDirectories.Strings[i]; sGroupName := Copy(slDirectories.Strings[i], LastPos('\', slDirectories.Strings[i]) + 1, Length(slDirectories.Strings[i]) - LastPos('\', slDirectories.Strings[i])); //***** SubMenu einfügen SubMenuItem := TTBXSubmenuItem.Create(self); SubMenuItem.Name := 'SubMenuItem' + IntToStr(i); SubMenuItem.Caption := sGroupName; //***** Icon einlesen falls vorhanden if FileExists(sGroupPath + '\' + sGroupName + '.ico') = True then begin GroupIcon := TIcon.Create; GroupIcon.LoadFromFile(sGroupPath + '\' + sGroupName + '.ico'); imglistSubMenus.AddIcon(GroupIcon); SubMenuItem.Images := imglistSubMenus; SubMenuItem.ImageIndex := k; Inc(k); end; popupTray.Items.Add(SubMenuItem); //***** Definitionsliste einlesen try slApplications.LoadFromFile(sGroupPath + '\' + sGroupName + '.txt'); except on exception do begin MessageBox(0, PChar('Kann Datei "' + sGroupPath + '\' + sGroupName + '.txt' + '" nicht lesen'), 'Lesefehler', MB_ICONERROR or MB_OK); end; end; //***** für jede Zeile der Definitionsliste ein MenuItem anlegen for j := 0 to slApplications.Count - 1 do begin if slApplications.Strings[j] <> '' then begin if LowerCase(slApplications.Strings[j]) = 'separator' then begin //***** Separator anlegen SeparatorItem := TTBXSeparatorItem.Create(self); SeparatorItem.Name := 'Sep' + IntToStr(i) + '_' + IntToStr(j); SubMenuItem.Add(SeparatorItem); end else begin //*********************************************************************************** //* ANWENDUNGSNAME|COMMAND|KOMPLETTER ANWENDUNGSPFAD|PARAMETER|VERZEICHNIS|ALT.ICON * //*********************************************************************************** MenuItem := TPopItem.Create(self); MenuItem.Name := 'MenuItem' + IntToStr(i) + '_' + IntToStr(j); MenuItem.Caption := ParseString('|', slApplications.Strings[j], 1); MenuItem.sCommand := ParseString('|', slApplications.Strings[j], 2); MenuItem.sExePath := '"' + ParseString('|', slApplications.Strings[j], 3) + '"'; MenuItem.sParameter := ParseString('|', slApplications.Strings[j], 4); MenuItem.sDirectory := ParseString('|', slApplications.Strings[j], 5); MenuItem.Hint := StringReplace(ParseString('|', slApplications.Strings[j], 3), '"', '', [rfReplaceAll]); MenuItem.OnClick := ButtonClick; //***** Icon der Anwendung laden sofern Anwendung vorhanden und kein alternatives //***** Icon angegeben worden ist if (FileExists(ParseString('|', slApplications.Strings[j], 3)) = True) and (ParseString('|', slApplications.Strings[j], 6) = '') then begin AppIcon := TIcon.Create; GetIconFromFileB(ParseString('|', slApplications.Strings[j], 3), AppIcon, True); imglistMenus.AddIcon(AppIcon); MenuItem.Images := imglistMenus; MenuItem.ImageIndex := l; Inc(l); end //***** ggf. alternatives Icon laden else if ParseString('|', slApplications.Strings[j], 6) <> '' then begin if (FileExists(ParseString('|', slApplications.Strings[j], 6)) = True) and (ParseString('|', slApplications.Strings[j], 6) <> 'na') then begin AppIcon := TIcon.Create; GetIconFromFileB(ParseString('|', slApplications.Strings[j], 6), AppIcon, True); imglistMenus.AddIcon(AppIcon); MenuItem.Images := imglistMenus; MenuItem.ImageIndex := l; Inc(l); end; end; SubMenuItem.Add(MenuItem); FreeAndNil(AppIcon); end; end; end; end; CreateMenuItem('Separator', '', 0, nil); CreateMenuItem('btnReload', 'neu laden', 3, ReloadClick); CreateMenuItem('Separator2', '', 0, nil); CreateMenuItem('btnAboutDialog', 'Info', 2, AboutClick); CreateMenuItem('btnBeenden', 'Beenden', 1, BeendenClick); end else begin CreateMenuItem('btnAchtung', 'ACHTUNG', 0, AchtungClick); CreateMenuItem('Separator1', '', 0, nil); CreateMenuItem('btnReload', 'neu laden', 3, ReloadClick); CreateMenuItem('Separator2', '', 0, nil); CreateMenuItem('btnAboutDialog', 'Info', 2, AboutClick); CreateMenuItem('btnBeenden', 'Beenden', 1, BeendenClick); end; finally FreeAndNil(slDirectories); FreeAndNil(slApplications); end; end; Ist schon etwas her das Ganze, und ich habe ehrlich gesagt gerade gar keine Lust, alles auseinander zu klamüsern :( Jedenfalls war das Ziel, ein kleines Startmenü für die TNA zu basteln, welches ich beliebig sortieren und mit Separatoren ausstatten kann. Dahinter steckt einfach die Definition der Einträge des Menüs in Textdateien, was ehrlich gesagt etwas unschön ist - ohne GUI. Jedenfalls werden die Untereinträge im PopUp Menü zur Laufzeit erstellt und auch noch Icons hinzugefügt, was wohl das ist, was Du erreichen möchtest. Da das so aus dem Zusammenhang gerissen wahrscheinlich etwas verwirrend ist, habe ich mal das ganze Projekt angehängt. Ist zwar nicht ausgereift, aber was solls... Ich hoffe, das hilft Dir wenigstens ein bissel weiter ;) BTW: Ich habe mich damals nicht auf Standardkomponenten beschränkt, weshalb Du beim kompilieren ggf. Probleme haben könntest. Eingesetzt wurden Toolbar 2000 + TBX, TMS Komponenten und ein paar Jedi Komponenten. greetz Sascha |
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:10 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz