Ñîâåòû ïî Delphi
         

Äèíàìè÷åñêîå äîáàâëåíèå ïóíêòîâ ìåíþ II


Âîò ïðèìåð ïðîãðàììû, ñîçäàþùåé ñòðóêòóðó ìåíþ áîëüøîé âëîæåííîñòè äâóìÿ ðàçëè÷íûìè ñïîñîáàìè. Îíà äàñò âàì ïèùó äëÿ ðàçìûøëåíèé. Ôîðìà ñîäåðæèò êîìïîíåíò TMainMenu1 è, ïåðâîíà÷àëüíî, îäíî ïîäìåíþ ñ èìåíåì SubMenu1.

    unit Istopmnu;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus;
type TForm1 = class(TForm)

MainMenu1: TMainMenu; SubMenu1: TMenuItem; procedure AClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AClick(Sender: TObject); VAR TM : TMenuItem; Lev : Word; begin MessageBeep(0); TM := Sender AS TMenuItem; IF TM.Count > 0 THEN Caption := 'ïîäìåíþ' ELSE Caption := 'ýëåìåò ìåíþ'; Caption := Caption + ' ñ èìåíåì "' + TM.Name + '"'; Lev := 0; WHILE (TM.Parent <> NIL) AND (TM.Parent IS TMenuItem) DO BEGIN TM := TM.Parent; Inc(Lev); END; CASE Lev OF 1 : Caption := 'Âåðõíèé óðîâåíü ' + Caption; 2 : Caption := '2-é óðîâåíü ' + Caption; 3 : Caption := '3-é óðîâåíü ' + Caption; ELSE Caption := Format('%d-é óðîâåíü %s', [Lev, Caption]); END; end;
procedure TForm1.FormCreate(Sender: TObject); VAR TM : TMenuItem; N  : Integer; begin TM := SubMenu1; TM.Add(NewItem('&Ýëåìåíò',0,False,True,AClick,0,'MenuItem2')); FOR N := 2 TO 5 DO BEGIN TM.Add(TMenuItem.Create(nil)); TM := TM.Items[TM.Count-1]; TM.Caption := '&Ìåíþ'; TM.Name := 'SubMenu'+IntToStr(N); TM.OnClick := AClick; TM.Add(NewItem('&Ýëåìåíò',0,False,True,AClick,0, 'MenuItem'+IntToStr(N+1))); END; MainMenu1.Items.Add(NewSubMenu('Ìåíþ&2', 0, 'SM1', [NewItem('&Ýëåìåíò',0,False,True,AClick,0,'MI2'), NewSubMenu('&Ìåíþ', 0, 'SM2', [NewItem('&Ýëåìåíò',0,False,True,AClick,0,'MI3'), NewSubMenu('&Ìåíþ', 0, 'SM3', [NewItem('&Ýëåìåíò',0,False,True,AClick,0,'MI4'), NewSubMenu('&Ìåíþ', 0, 'SM4', [NewItem('&Ýëåìåíò',0,False,True,AClick,0,'MI5'), NewSubMenu('&Ìåíþ', 0, 'SM5', [NewItem('&Ýëåìåíò',0,False,True,AClick,0,'MI6') ]) ]) ]) ]) ])); TM := MainMenu1.Items[1]; WHILE TRUE DO BEGIN TM.OnClick := AClick; IF TM.Count < 2 THEN Break; TM := TM.Items[1]; END; end;
end.

- Neil J. Rubenking [000769]



Ñîäåðæàíèå ðàçäåëà