[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