Программное добавление TMenuItem

[devICE]

Lazarus: 0.9.29.24591
FPC: 2.4.1

Появилась необходимость добавить пункт в меню. Пишу следующий код:

Код: Выделить всё

function GetReportsList(sqltrans:TSQLTransaction;sqlquery:TSQLQuery):fields;
var
   sl:TStringList;
  ItemName:string;
begin
   if not sqltrans.Active then
       sqltrans.StartTransaction;
   sqlquery.SQL.Text:='select p.* from "GetReportsList" p';
   sqlquery.Open;
   sl:=TStringList.Create;
   while not sqlquery.EOF do
   begin
      ItemName:=sqlquery.FieldByName('ReportName').Text;
      sl.Add(ItemName);
    sqlquery.Next;
   end;
   sqlquery.Close;
   sqltrans.Commit;
   GetReportsList:=sl;
   sl.Free;
end;

Эта функция формирует StringList с наименованиями отчетов.

Код: Выделить всё

procedure TfmMain.SelectReport(Sender: TObject);
var
   mi: TMenuItem;
  ReportName: string;
begin
   mi:=Sender as TMenuItem;
  ReportName:=mi.Caption;
  ureports.CreateReport(fbtrans,fbquery,ReportName);
  ureports.ShowReport(fmPreview.htmlPreview);
  fmPreview.ShowModal;
end;

Эта процедура будущая отработка события OnClick нового пункта меню.

Код: Выделить всё

procedure TfmMain.ReportList(MenuItem:TMenuItem);
var
   mi: TMenuItem;
  sl: TStringList;
  i: integer;
begin
   sl:=TStringList.Create;
  sl:=ureports.GetReportsList(fbtrans,fbquery);
  for i:=0 to sl.Count-1 do
  begin
     mi:=TMenuItem.Create(MenuItem);
    try
       mi.Caption:=sl.Strings[i];
      //mi.OnClick:=SelectReport;
      MenuItem.Add(mi);
    finally
       mi.Free;
    end;
  end;
  sl.Free;
end;

А эта процедура уже формирует нужный мне список новых пунктов меню.

Возникли следующие вопросы:
1. Закомментированная строка //mi.OnClick:=SelectReport; выдает ошибку Hint: Found declaration: TfmMain.SelectReport(TObject);.
2. При подключении к базе программа валится с ошибкой на External: SIGSEGV.

Искал в гугле по запросу "Добавление MenuItem в Lazarus", дельного ничего не нашел.

[скалогрыз]

попробуй так:

Код: Выделить всё

procedure TfmMain.ReportList(MenuItem:TMenuItem);
var
   mi: TMenuItem;
  sl: TStringList;
  i: integer;
begin
  sl:=TStringList.Create;
  sl.Add('test1');
  sl.Add('test2');
  sl.Add('test3');
  for i:=0 to sl.Count-1 do
  begin
    mi:=TMenuItem.Create(MenuItem);
    mi.Caption:=sl.Strings[i];
    mi.OnClick:=@SelectReport;
    MenuItem.Add(mi);
  end;
  sl.Free;
end;

как у тебя с ООП?

код вроде:

Код: Выделить всё

function GetReportsList(sqltrans:TSQLTransaction;sqlquery:TSQLQuery):fields;
var
   sl:TStringList;
begin
   sl:=TStringList.Create;
   ...
   GetReportsList:=sl;
   sl.Free;
end;


доставляет

Добавлено спустя 4 минуты 58 секунд:
а... чёрт с ним... воть!

Код: Выделить всё

function GetReportsList(sqltrans:TSQLTransaction;sqlquery:TSQLQuery):TStringList;
var
  sl       : TStringList;
  ItemName : string;
begin
  if not sqltrans.Active then
    sqltrans.StartTransaction;
  sqlquery.SQL.Text:='select p.* from "GetReportsList" p';
  sqlquery.Open;
  sl:=TStringList.Create;
  while not sqlquery.EOF do
  begin
    ItemName:=sqlquery.FieldByName('ReportName').Text;
    sl.Add(ItemName);
    sqlquery.Next;
  end;
  sqlquery.Close;
  sqltrans.Commit;
  GetReportsList:=sl;
end;


procedure TfmMain.SelectReport(Sender: TObject);
var
   mi: TMenuItem;
  ReportName: string;
begin
   mi:=Sender as TMenuItem;
  ReportName:=mi.Caption;
  ureports.CreateReport(fbtrans,fbquery,ReportName);
  ureports.ShowReport(fmPreview.htmlPreview);
  fmPreview.ShowModal;
end;

procedure TfmMain.ReportList(MenuItem:TMenuItem);
var
  mi : TMenuItem;
  sl : TStringList;
  i  : integer;
begin
  sl:=ureports.GetReportsList(fbtrans,fbquery);
  try
    for i:=0 to sl.Count-1 do begin
      mi:=TMenuItem.Create(MenuItem);
      mi.Caption:=sl.Strings[i];
      mi.OnClick:=@SelectReport;
      MenuItem.Add(mi);
    end;
  finally
    sl.Free;
  end;
end;


[devICE]

Благодарю ))) Обновил параллельно лазаря, так что в целом все заработало.

[blacksirius]

решил не создавать новую тему а задать вопрос тут.
как возможно определить индекс выбранного пункта меню, если все меню создано через код? есть же параметры манипулирование меню через индексы

[grigoreo]

решил не создавать новую тему а задать вопрос тут.
как возможно определить индекс выбранного пункта меню, если все меню создано через код? есть же параметры манипулирование меню через индексы

ну так в событии OnClick есть параметр Sender, указатель на экземпляр который ты нажал а у него есть порядковый номер в меню есть капция есть наконец имя если ты конечно когда создавал все это конструктору подсовывал))

[blacksirius]

можете показать экземпляр кода как извлечь его индекс

Добавлено спустя 1 час 45 минут 55 секунд:
уже разобрался