[lazarus] menu
jozsef at wingchun.hu
jozsef at wingchun.hu
Sat Feb 22 17:50:13 EST 2003
Hi,
I recommend it for the maintainer(s) of menus unit.
---------------------------------------------------
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources,
Buttons,
Menus, StdCtrls;
type
TForm1 = class(TForm)
btnClose: TBUTTON;
btnOne: TBUTTON;
btnEach: TBUTTON;
btnUncheckpop1: TBUTTON;
btngroupindex1: TBUTTON;
mainpop:tpopupmenu;
Memo1: TMEMO;
pop1,pop2,pop3:tmenuitem;
procedure Button1CLICK(Sender: TObject);
procedure Form1CREATE(Sender: TObject);
procedure bntIspop1checkedCLICK(Sender: TObject);
procedure btnEachCLICK(Sender: TObject);
procedure btnOneCLICK(Sender: TObject);
procedure btnUncheckpop1CLICK(Sender: TObject);
procedure btngroupindex1CLICK(Sender: TObject);
procedure popc(sender:tobject);
procedure pop1c(sender:tobject);
procedure pop2c(sender:tobject);
procedure pop3c(sender:tobject);
procedure btnCloseCLICK(Sender: TObject);
private
{ private declarations }
st:string;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.Button1CLICK(Sender: TObject);
begin
end;
procedure TForm1.Form1CREATE(Sender: TObject);
begin
mainpop:=tpopupmenu.create(self);
mainpop.autopopup:=true;
pop1:=tmenuitem.Create(self);
pop1.name:='pop1';
pop1.caption:='pop1';
pop1.visible:=true;
pop1.radioitem:=true;
pop1.groupindex:=0;
pop1.checked:=false;
pop1.onclick:=@popc;
pop2:=tmenuitem.Create(self);
pop2.name:='pop2';
pop2.caption:='pop2';
pop2.visible:=true;
pop2.radioitem:=true;
pop2.groupindex:=0;
pop2.checked:=false;
pop2.onclick:=@popc;
pop3:=tmenuitem.Create(self);
pop3.name:='pop3';
pop3.caption:='pop3';
pop3.visible:=true;
pop3.radioitem:=true;
pop3.groupindex:=0;
pop3.checked:=true;
pop3.onclick:=@popc;
mainpop.items.add(pop1);
mainpop.items.add(pop2);
mainpop.items.add(pop3);
form1.popupmenu:=mainpop;
end;
procedure TForm1.bntIspop1checkedCLICK(Sender: TObject);
begin
if pop1.checked then showmessage('pop1 is checked');
end;
procedure TForm1.btnEachCLICK(Sender: TObject);
begin
pop1.OnClick:=@pop1c;
pop2.OnClick:=@pop2c;
pop3.OnClick:=@pop3c;
showmessage('each');
end;
procedure TForm1.btnOneCLICK(Sender: TObject);
begin
pop1.OnClick:=@popc;
pop2.OnClick:=@popc;
pop3.OnClick:=@popc;
showmessage('one');
end;
procedure TForm1.btnUncheckpop1CLICK(Sender: TObject);
begin
pop1.Checked:=false;
showmessage('You have unchecked pop1. I mean you tried. :)'#13#10+
'But it does not work'#13#10'It is the code:'#13#10'pop1.checked:=false;'+
#13#10'and THIS showmessage');
end;
procedure TForm1.btngroupindex1CLICK(Sender: TObject);
begin
showmessage('Now I will change grouindex from 0 to 1'+
#13#10'Just watch, it will be interesting! The code is:'#13#10+
'pop1.GroupIndex:=1;'#13#10'pop2.GroupIndex:=1;'#13#10'
pop3.GroupIndex:=1;');
pop1.GroupIndex:=1;
pop2.GroupIndex:=1;
pop3.GroupIndex:=1;
end;
procedure TForm1.popc(sender: tobject);
begin
st:='ONE (popc) '+tmenuitem(sender).name;
if tmenuitem(sender).Checked then st:=st+' - checked'
else st:=st+' - NOT checked';
st:=st+#13#10+'Now checked.';
showmessage(st);
tmenuitem(sender).checked:=true;
end;
procedure TForm1.pop1c(sender: tobject);
begin
st:='EACH (pop1c) '+tmenuitem(sender).name;
if tmenuitem(sender).Checked then st:=st+' - checked'
else st:=st+' - NOT checked';
showmessage(st);
end;
procedure TForm1.pop2c(sender: tobject);
begin
st:='EACH (pop2c) '+tmenuitem(sender).name;
if tmenuitem(sender).Checked then st:=st+' - checked'
else st:=st+' - NOT checked';
showmessage(st);
end;
procedure TForm1.pop3c(sender: tobject);
begin
st:='EACH (pop3c) '+tmenuitem(sender).name;
if tmenuitem(sender).Checked then st:=st+' - checked'
else st:=st+' - NOT checked';
showmessage(st);
end;
procedure TForm1.btnCloseCLICK(Sender: TObject);
begin
close;
end;
initialization
{$I unit1.lrs}
end.
More information about the Lazarus
mailing list