[lazarus] menu

[Mattias Gaertner]

On Sat, 22 Feb 2003 23:05:44 +0000
<jozsef at wingchun.hu> wrote:

Changing TMenuItem.GroupIndex after creation was not implemented in the gtk
interface. Now it is. Plz update your cvs and test it.


Mattias
 


> 
> 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.
> 
> _________________________________________________________________
>      To unsubscribe: mail lazarus-request at miraclec.com with
>                 "unsubscribe" as the Subject
>    archives at http://www.lazarus.freepascal.org/mailarchives