заполнение Tpopup в runtime

← →
Alexandr © (2005-01-21 13:30) [0]

приведети плиз пример кода, который
в Tpopup menu
создаст в рунтайме меню, соответвующие уровням:
имяменю 1
имя подменю 1
имя подподменю 1
имя подподменю 2
имя подподменю 3
...
имя подменю 2
....
имя подменю N
имяменю 2
...
имяменю N

номера и мена я буду давать, а на выходе функции должны быть эти 3 номера - номер меню, подменю и под подменю.
Сам массив с номерами и названиями я выдам.

← →
stone © (2005-01-21 13:43) [1]

TPopUpMenu + F1

> приведети плиз пример кода, который ...

Сколько $?

← →
Alexandr © (2005-01-21 13:45) [2]

мда...
хорошо, а сколько надо?

← →
stone © (2005-01-21 13:49) [3]

В справке пример вообще-то есть.
Впрочем, если есть заинтересованность платить плиз в асю (см. анкету)

← →
Рамиль © (2005-01-21 14:00) [4]

procedure TForm1.Button1Click(Sender: TObject);
var
mi: TMenuItem;
begin
mi := TMenuItem.Create(Self);
mi.Caption := "Caption";
PopupMenu1.Items.Add(mi);
end;

← →
Рамиль © (2005-01-21 14:01) [5]

procedure TForm1.Button1Click(Sender: TObject);
var
mi: TMenuItem;
begin
mi := TMenuItem.Create(Self);
mi.Caption := "Caption";
PopupMenu1.Items.Add(mi);
end;

← →
Alexandr © (2005-01-24 06:22) [6]

а вот как с подменю?
А как хранить привязку, чтоб выбирать код

← →
Alexandr © (2005-01-24 13:06) [7]

← →
MetalFan © (2005-01-24 13:21) [8]

> как хранить привязку, чтоб выбирать код

расшифруй !

← →
Alexandr © (2005-01-24 14:18) [9]

ну вот в базе есть таблица1
ID
NAME
по ней строится верхний уровень меню.
Далее точно такие же таблица2 и таблица3
необходимо после того как юзер тыкнет мышкой в нужное место, получить эти коды таблица1.id таблица2.id таблица3.id
в зависимости, на каком уровне и что тыкнул.

← →
Alexandr © (2005-01-24 16:11) [10]

← →
MetalFan © (2005-01-24 16:17) [11]

мда... а без меню обойтись никак?

← →
Alexandr © (2005-01-24 16:23) [12]

в смысле?
Вот хочу такую навигацию по таблицам master-detail сделать.
Примерно как TreeView но не список и плюсики, а вот как на кнопке "пуск".

← →
Alexandr © (2005-01-25 10:23) [13]

← →
stone © (2005-01-25 11:32) [14]

Маленькая подсказка:
Items может иметь вложенные уровни, напимер:
PopupMenu1.Items[Index].Items.Add(mi);
т.е.

> Примерно как TreeView но не список и плюсики, а вот как
> на кнопке "пуск".

← →
Alexandr © (2005-01-25 11:57) [15]

ага. Да я уже сам все сделал.
Сделал наследника с нужными свойствами и все.

← →
den303 © (2005-01-25 13:47) [16]

Заодно вопрос по теме:

procedure MenuClick; begin //Как я в этой процедуре могу узнать, по какому из пунктов меню кликнул пользователь, если я создаю много пунктов с одной и той же процедурой MenuClick, а никакие параметры передать нельзя, т.к. ругается на TNotifyEvent? end; procedure TForm1.Button1Click(Sender: TObject); var mi: TMenuItem; begin mi := TMenuItem.Create(Self); mi.Caption := "Caption"; mi.OnClick:=MenuClick; PopupMenu1.Items.Add(mi); end;

← →
MetalFan © (2005-01-25 13:56) [17]

> procedure MenuClick;
> begin
> //Как я в этой процедуре могу узнать, по какому из пунктов
> меню кликнул пользователь, если я создаю много пунктов с
> одной и той же процедурой MenuClick, а никакие параметры
> передать нельзя, т.к. ругается на TNotifyEvent?
> end;

а Sender уже отменили я смотрю...

← →
den303 © (2005-01-25 14:06) [18]

> MetalFan © (25.01.05 13:56) [17]

С любым параметром, в т.ч. и Sender, Дельфя ругается на "Incopatible types: TNotifyEvent and "procedure,untyped pointer or untuped parameter""

type
TDBMenuItem=class(TMenuItem)
public
categorycode:variant;
subcategory_id:variant;
gruppa_id:variant;
end ;

В нутри процедуры это узнать невозможно, поскольку реакция на нажатие поступает как Message. В этом случае следует использовать форму и заполнить ее элементами списка. Я использую для этого:
TGetItem = procedure(var Index: integer; var Buf: string) of object;

RStandart = record
Id: integer;
Name: ShortString;
end;
TDefArray = array of RStandart;
PDefArray = ^TDefArray;

TPopup = class(TCustomForm)
lbChoice: TListBox;
procedure lbChoiceClick(Sender: TObject);
// procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure lbChoiceMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lbChoiceKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
private
GetProc: TGetItem;
ArrData: PDefArray;

procedure SetPosit(const Pt: TPoint);
procedure PopulateChoice(List: TStrings);
procedure GetDefaultItem(var Index: integer; var Buf: string);
public
ResultIndex: integer;
constructor Create(const Pt: TPoint; const pArrData: PDefArray;
const Proc: TGetItem); virtual;
end;

implementation
uses Controls, Math;
{ TPopup }

constructor TPopup.Create(const Pt: TPoint; const pArrData: PDefArray;
const Proc: TGetItem);
begin
inherited CreateNew(nil);
GetProc := Proc;
ArrData := pArrData;

BorderIcons := [];
BorderStyle := bsNone;
Width := 123;
Scaled := false;
// OnClose := FormClose;

lbChoice := TListBox.Create(Self);
lbChoice.Parent := Self;
lbChoice.Align := alClient;
lbChoice.ExtendedSelect := false;
lbChoice.OnClick := lbChoiceClick;
lbChoice.OnMouseMove := lbChoiceMouseMove;
lbChoice.OnKeyDown := lbChoiceKeyDown;

PopulateChoice(lbChoice.Items);
SetPosit(Pt);
lbChoice.ItemIndex := 0;
end;

procedure TPopup.SetPosit(const Pt: TPoint);
begin
Height := lbChoice.ItemHeight * lbChoice.Items.Count + 4;
if (Pt.x > -1) and (Pt.y > -1) then
begin
Position := poDesigned;
Left := Pt.x;
Top := Pt.y;
if Left + Width > Application.MainForm.Width then
Left := Application.MainForm.Width - Width;
if Top + Height > Application.MainForm.Height then
Top := Application.MainForm.Height - Height;
end;
end;

procedure TPopup.PopulateChoice(List: TStrings);
var
i: Integer;
Buf: string;
begin
i := 0;
while i <> -1 do
begin
if not Assigned(GetProc) then
GetDefaultItem(i, Buf)
else
GetProc(i, Buf);
if i <> -1 then
List.Append(Buf);
Width := Max(Width, Length(Buf) * 6);
end;
end;
{ Erik
procedure TPopup.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
}

procedure TPopup.lbChoiceClick(Sender: TObject);
begin
if lbChoice.ItemIndex >= 0 then
begin
ResultIndex := lbChoice.ItemIndex;
Close;
end;
end;

procedure TPopup.lbChoiceMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
lbChoice.ItemIndex := lbChoice.ItemAtPos(Point(X, Y), True);
end;

procedure TPopup.lbChoiceKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_DOWN:
begin
Key := 0;
lbChoice.ItemIndex := Min(lbChoice.Items.Count - 1, lbChoice.ItemIndex +
1);
end;
VK_UP:
begin
Key := 0;
lbChoice.ItemIndex := Max(0, lbChoice.ItemIndex - 1);
end;
VK_LEFT, VK_RIGHT: Key := 0;
VK_RETURN: lbChoiceClick(Sender);
end;
end;

procedure TPopup.GetDefaultItem(var Index: integer; var Buf: string);
begin
if Index > Length(ArrData^) - 1 then
begin
Index := -1;
Exit;
end;
Buf := ArrData^[Index].Name;
Inc(Index);
end;

end.

А что далше, пример как вызывать привести? Есть 2 метода передачи списка, через процедуру или через масив. Привожу через масив:
function TLepingForm.CreatePopUp(DataSet: TDataSet; Pt: TPoint): Integer;
Var
Index: Integer;
ArrTemp: TDefArray;
begin
Result := -1;
with DataSet do
if RecordCount > 1 then
begin
Index := 0;
SetLength(ArrTemp, RecordCount + 1);
while not EOF do
begin
with ArrTemp[Index] do
begin
Name := FieldByName("NIMETUS").AsString;
Id := FieldByName("ID").AsInteger;
end;
Next;
end;

with TPopup.Create(Pt, @ArrTemp, nil) do
begin
ShowModal;
Result := ArrTemp[ResultIndex].Id;
Free;
end;
end
else if RecordCount = 1 then
Result := FieldByName("ID").AsInteger;
end;
Вот исзодный вызов:
with Sender do
Pt := ClientToScreen(Point(Width - 5, Height div 2));
ID := CreatePopUp(DataSet, Pt);
Думаю несоставит труда CreatePopUp переработать для себя.

а с подменю?
Ладно, это я уже придираюсь :)

=> den303 © (25.01.05 13:47) [16]

procedure MenuClick;
begin
//Как я в этой процедуре могу узнать, по какому из пунктов меню кликнул пользователь, если я создаю много пунктов с одной и той же процедурой MenuClick, а никакие параметры передать нельзя, т.к. ругается на TNotifyEvent?
if (Sender as TMenuItem).Tag=1 then ...
end;

procedure TForm1.Button1Click(Sender: TObject);
var
mi: TMenuItem;
begin
mi := TMenuItem.Create(Self);
mi.Caption := "Caption";
mi.OnClick:=MenuClick;
mi.Tag:= 1;
PopupMenu1.Items.Add(mi);
end;

заполнение Tpopup в runtime Найти похожие ветки