Dynamiczny PopUpMenu z pliku txt ze zdarzeniem OnClick

Dzień dobry.
Czy dał by ktoś radę naprowadzić mnie trochę co robię nie tak?
Do istniejącego Menu dodaję dynamicznie dodatkową pozycję 'Wczytaj' wraz z submenu sczytywanymi z danych zawartych w plikach *.txt znajdujących się w katalogu X.
Do StatusBar1 próbuje przekierować informację o pozycji użytkownika w Menu.
Po otwarciu Menu StatusBar wyświetla Captiony poszczególnych pozycji menu tylko gdy w nich są zagnieżdżone kolejne menu. Jeżeli pozycja w menu jest ostatnia to nic się nie dzieje. Pomimo że, procedura jest OnClick działa jako OnMoseMove. Samo kliknięcie w pole Menu nic nie powoduje.

Zależy mi, aby po kliknięciu w 2021 (jak na zdjęciu) w StatusBar1 Był tekst: Agroplus + NOX + 2021.

Procedura OnPopup:

procedure TForm1.PopupMenu1Popup(Sender: TObject);
Var
   Path, Path1, Got : String;
   Lamane, Kropka, Dlugosc, i, j : integer;
   TF : TextFile;
   Str1, Str2 : String;
   Dlugosc1, Dlugosc2 : integer;
   Seppos1, Seppos2 : integer;
   Wyraz1, Wyraz2  :String;
begin
// jeśli już istnieje to usuń
   If PopUpMenu1.ComponentCount=2 Then
    begin
    PopUpMenu.Items[3].Destroy;
    end;
// dodanie nowego elementu menu 'Wczytaj'
   MenuItem := TMenuItem.Create(PopUpMenu);
   MenuItem.Caption:='Wczytaj';
   PopUpMenu.Items.Add(MenuItem);
// tworzenie submenu z plików zawartych w katalogu      
        j := 0;
        For Path in TDirectory.GetFiles(OpenPictureDialog1.filename) do
        begin
         Lamane := Pos('/', Path);
         Got := Copy(Path, Lamane+1);
          Kropka := Pos('.', Got);
          Got := Copy(Got, 1, Kropka-1);
     Subitem := TMenuItem.Create(MenuItem);
     Subitem.Caption := Got;
     MenuItem.Add(Subitem);
     AssignFile(TF, path);
     Reset(TF);
     i := 0;
       while not Eof(TF) do
         begin
         //pobieranie pierwszysch wyrazów w pliku txt
           ReadLn(TF, Str1);
           Dlugosc1 := Length(Str1);
           SepPos1  := Pos(';', Str1);
           Wyraz1  := Copy(Str1, 1, SepPos1-1);
         //tworzenie sub.submenu z pierwszysch wyrazów w pliku txt
           Subitem2 := TMenuItem.Create(MenuItem);
           Subitem2.Caption := Wyraz1;
           MenuItem.Items[j].OnClick := Cos; // działa od najechania kursorem a nie przy OnClick
           MenuItem.Items[j].Add(Subitem2);
         //pobieranie  drugich wyrazów w pliku txt
           Dlugosc1 := Length(Str1);
           SepPos1  := Pos(';', Str1);
           Wyraz1   := Copy(Str1, SepPos1+1, Dlugosc1);
           SepPos1  := Pos(';', Wyraz1);
           Wyraz2   := Copy(Wyraz1, 1, SepPos1-1);
         // tworzenie sub.sub.submenu z drugiego wyrazu
           Subitem3 := TMenuItem.Create(MenuItem);
           Subitem3.Caption := Wyraz2;
           MenuItem.Items[j].items[i].OnClick := Cos2; //jak wyżej
           Menuitem.Items[j].items[i].Add(Subitem3);
           inc(i);
         end;
         inc(j);
        CloseFile(tf);
   end;
end;

Powyższa część kodu działa prawidłowo. Problem pojawia się niżej. Obie poniższe procedury uruchamiane są po najechaniu kursorem na pole Menu, a kliknięcie w menu nie wywołuje żadnej reakcji oprócz jego zamknięcia.

Procedura 1 OnClick dla SubMenu:

   procedure TForm1.Cos (Sender : TObject);
     var
       i : Integer;
       begin
          MenuItem := Sender as TMenuItem;
          i := Pos('&', MenuItem.Caption);
            if i > 0 then
              begin
               MenuName := LeftStr(MenuItem.Caption, i-1) + RightStr(MenuItem.Caption, Length(MenuItem.Caption)-i);
              end;
            if i = 0 then
              begin
               MenuName := MenuItem.Caption;
              end;
          StatusBar1.SimpleText := MenuName + ' + ' + MenuItem.Hint;
        end;

Procedura 2 OnClick dla SubMenu:

procedure TForm1.Cos2 (Sender : TObject);
  var
    i : integer;
  begin
    MenuItem := Sender as TMenuItem;
    i := Pos('&', MenuItem.Caption);
     if i > 0 then
      begin
      MenuName2 := LeftStr(MenuItem.Caption, i-1) + RightStr(MenuItem.Caption, Length(MenuItem.Caption)-i);
      end;
     if i = 0 then
      begin
       MenuName2 := MenuItem.Caption;
      end;
     StatusBar1.SimpleText := MenuName + ' + ' + MenuName2 + ' + ' + MenuItem.Hint;
  end;

Próbowałem ominąć problem korzystając ze zdarzenia OnClose w PopUpMenu. To już taka desperacka metoda była, polegająca na strzelaniu czym popadnie na ślepo i oczywiście nie trafiona, zmienne pozostają puste.

Procedura PopupMenu1Close

procedure TForm1.PopupMenu1Close(Sender: TObject);
begin
    MenuItem := TMenuItem(Sender);
    MenuName3 := MenuItem.Caption;
    StatusBar1.SimpleText := PopUpMenu1.Items.Hint + ' + ' + MenuName3;
end;

   procedure TForm1.Cos(Sender:TObject);
   var MenuItem:TMenuItem;
   var Path:String;
   begin
     MenuItem:=Sender as TMenuItem;
     while MenuItem<>nil do
     begin
       if Length(Path)>0 then Path:=Path+' + ';
       Path:=Path+MenuItem.Caption;
       MenuItem:=MenuItem.Parent;
     end;
     StatusBar1.SimpleText:=Path;
   end;

_13th_Dragon napisał(a):

   procedure TForm1.Cos(Sender:TObject);
   var MenuItem:TMenuItem;
   var Path:String;
   begin
     MenuItem:=Sender as TMenuItem;
     while MenuItem<>nil do
     begin
       if Length(Path)>0 then Path:=Path+' + ';
       Path:=Path+MenuItem.Caption;
       MenuItem:=MenuItem.Parent;
     end;
     StatusBar1.SimpleText:=Path;
   end;

Moje rozwiązanie na pewno jest przekombinowane. Podobno mam dar komplikowania sobie życia. Zawartość pliku:

AgroPlus.txt
NOX;2021;185600;5450;3560;62,9;2056;0,02;30500;2730;549000;4950;4151875,26;59749500;50000;20000000;9000000;2,5;szt
FOX;2021;215000;18680;2225;1943;1125;0;12400;1321;161200;0;923624,74;12362800;20000;9000000;4000000;1,3;ton

Pierwszy wyraz to trzeci poziom listy - Wczytaj / AgroPlus / NOX
Drugi wyraz to czwarty poziom listy - Wczytaj / AgroPlus / NOX / 2021

Twoje rozwiązanie uruchamia się po najechaniu kursorem na NOX (trzeci poziom listy). Kliknięcie lub najechanie na datę (czwarty poziom) nie zwraca żadnej wartości do StatuBar1. Mam takie wrażenie, jakby ostatni poziom listy nie miał podpiętej procedury.

W moim rozwiązaniu, do MenuItem.Caption losowo dorzucany jest znak "&" (przynajmniej ja nie znalazłem do tej pory zależności co do częstotliwości i pozycji wstawianego znaku) dlatego tak kombinowałem z jego usuwaniem przed wyświetleniem w StatusBar. U Ciebie ten problem znika, chociaż przyznam, że nie mam pojęcia dlaczego. U mnie w StatusBar wygląda to tak: A&groPlus mimo, że w Menu jest AgroPlus. --- ten fragment już nie aktualny, znalazłem przyczynę. & jest dodawany gdy PopUpMenu1.AutoHotKeys : = maAutomatic.

W kwestii inicjacji to jak zacząłem kombinować to wrzuciłem część deklaracji jako globalne. Dlatego kompilator milczał.

object DynamicMenuForm: TDynamicMenuForm
  Left = 257
  Top = 124
  Width = 1305
  Height = 675
  Caption = 'DynamicMenuForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object BtnRead: TButton
    Left = 24
    Top = 42
    Width = 75
    Height = 25
    Caption = 'ReadFile'
    PopupMenu = PopupMenu
    TabOrder = 0
    OnClick = BtnReadClick
  end
  object StatusBar: TStatusBar
    Left = 0
    Top = 618
    Width = 1289
    Height = 19
    Panels = <>
    SimplePanel = False
  end
  object PopupMenu: TPopupMenu
    Left = 56
    Top = 85
    object MnuReady: TMenuItem
      Caption = '&Ready'
    end
  end
  object DlgOpen: TOpenDialog
    FileName = 'DlgOpen'
    Filter = 'Text files (*.txt)|*.txt'
    Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing]
    Title = 'Select File'
    Left = 87
    Top = 86
  end
end

unit DynamicMenuMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ComCtrls, StdCtrls;

type
  TDynamicMenuForm=class(TForm)
    BtnRead:TButton;
    PopupMenu:TPopupMenu;
    StatusBar:TStatusBar;
    DlgOpen:TOpenDialog;
    MnuReady: TMenuItem;
    procedure BtnReadClick(Sender:TObject);
  private
    procedure MnuReadClick(Sender:TObject);
  public
    { Public declarations }
  end;

var
  DynamicMenuForm: TDynamicMenuForm;

implementation

{$R *.DFM}

function Split(var Str:String;const Delimeter:String):String;
var P:Integer;
begin
  P:=Pos(Delimeter,Str);
  if P>0 then
  begin
    Result:=Copy(Str,1,P-1);
    Delete(Str,1,P+Length(Delimeter)-1);
  end
  else
  begin
    Result:=Str;
    SetLength(Str,0);
  end;
end;

function AppendMenu(Parent:TMenuItem;const Caption:String):TMenuItem;
var N:Integer;
begin
  for N:=0 to Parent.Count-1 do
  begin
    if Parent[N].Caption=Caption then
    begin
      Result:=Parent[N];
      Exit;
    end;
  end;
  Result:=TMenuItem.Create(Parent);
  Result.Caption:=Caption;
  Parent.Add(Result);
end;

procedure TDynamicMenuForm.MnuReadClick(Sender:TObject);
var MenuItem:TMenuItem;
var Path:String;
begin
  MenuItem:=Sender as TMenuItem;
  while (MenuItem<>nil)and(MenuItem<>MnuReady) do
  begin
    if Length(Path)>0 then Path:=' + '+Path;
    Path:=StringReplace(MenuItem.Caption,'&','',[rfReplaceAll])+Path;
    MenuItem:=MenuItem.Parent;
  end;
  StatusBar.SimpleText:=Path;
end;

procedure TDynamicMenuForm.BtnReadClick(Sender: TObject);
var Fs:TFileStream;
var Content,FileName,Title,Name,Year:String;
var MnuItemFile,MnuItemName,MnuItemYear:TMenuItem;
var N:Integer;
begin
  if DlgOpen.Execute then
  begin
    MnuReady.Clear;
    for N:=0 to DlgOpen.Files.Count-1 do
    begin
      FileName:=DlgOpen.Files[N];
      Fs:=TFileStream.Create(FileName,fmOpenRead);
      try
        SetLength(Content,Fs.Size);
        SetLength(Content,Fs.Read(Content[1],Fs.Size));
        Content:=Trim(Content);
      finally
        FreeAndNil(Fs);
      end;
      Title:=ExtractFileName(FileName);
      MnuItemFile:=AppendMenu(MnuReady,Split(Title,'.'));
      while Length(Content)>0 do
      begin
        Name:=Split(Content,';');
        Year:=Split(Content,';');
        Split(Content,#13);
        Content:=Trim(Content);
        MnuItemName:=AppendMenu(MnuItemFile,Name);
        MnuItemYear:=AppendMenu(MnuItemName,Year);
        MnuItemYear.OnClick:=MnuReadClick;
      end;
    end;
  end;
end;

end.

Tym razem procedura OnClick działa, ale StatusBar pozostaje pusty. Kompilator zwraca błąd w linii 10. E2250 There is no overloaded version of 'StringReplace' that can be called with these aruments.

procedure TForm1.MnuReadClick(Sender:TObject);
var MenuItem:TMenuItem;
var Path:String;
begin
  MenuItem:=Sender as TMenuItem;
  while (MenuItem<>nil)and(MenuItem<>MnuReady) do
  begin
    if Length(Path)>0 then Path:=' + '+Path;
    Path:=MenuItem.Caption+Path;
    MenuItem:=StringReplace(MenuItem.Parent,'&','',[rfReplaceAll]);
  end;
  StatusBar.SimpleText:=Path;
end;

Zmieniłem kod w tym miejscu na:

MenuItem:=MenuItem.Parent;

Przy takim rozwiązaniu źle wypełnia się trzeci poziom Menu, a czwarty pozostaje pusty. Pewnie dlatego StatusBar nie ma czym się wypełnić.

Treść po kliknięciu

Funkcja StringReplace jako pierwszy argument przyjmuje string a Ty podajesz TMenuItem musisz odwoływać się do MenuItem.Caption.

Udało się wykorzystać Twój kod, troszkę to trwało zanim udało się zastosować Twoje rozwiązania, ale wszystko działa idealnie. Wielkie dzięki za pomoc.