Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv26873/gio/src/examples/simple
Modified Files:
SimpleMenu.hs
Log Message:
Complete implementation for Menu with both GTK and Win32.
Supported:
- command menu items with bitmaps
- checked menu items
- radio menu items
- sepparators
- sub menus
Index: SimpleMenu.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/SimpleMenu.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** SimpleMenu.hs 2 Apr 2003 21:33:55 -0000 1.3
--- SimpleMenu.hs 23 Apr 2003 21:48:48 -0000 1.4
***************
*** 7,15 ****
do w <- window [title =: "Hello world", view =: sz 200 200]
! fm <- menu "&File" [] mainMenu
! menuitem "&Open" [menukey =: KeyChar 'o'] fm
! menuitem "&Close" [enabled =: False] fm
! menuline mainMenu
! menuitem "&Exit" [on command =: halt] fm
-
--- 7,34 ----
do w <- window [title =: "Hello world", view =: sz 200 200]
! bmpNew <- readBitmap "new.bmp" []
! bmpOpen <- readBitmap "open.bmp" []
! bmpSave <- readBitmap "save.bmp" []
!
! fm <- menu [title =: "&File"] mainMenu
! menuitem [title =: "&New", accel =: KeyChar '\^N', on command =: messageAlert "NEW", menuicon =: Just bmpNew] fm
! menuitem [title =: "&Open", accel =: KeyChar '\^O', on command =: messageAlert "OPEN", menuicon =: Just bmpOpen] fm
! menuitem [title =: "&Close"] fm
! menuline fm
! menuitem [title =: "&Save", accel =: KeyChar '\^S', on command =: messageAlert "SAVE", menuicon =: Just bmpSave] fm
! menuline fm
! menuitem [title =: "&Exit", on command =: halt] fm
!
! cm <- menu [title =: "&Color"] mainMenu
! tgl <- menucheck [title =: "&Transparent", accel =: KeyChar '\^T'] cm
! set tgl [on command =: onToggleTransparent tgl]
! menuline cm
! rg <- menuRadioGroup [] cm
! menuRadioItem [title =: "&Red", on command =: messageAlert "RED COLOR" ] rg
! menuRadioItem [title =: "&Green", on command =: messageAlert "GREEN COLOR"] rg
! menuRadioItem [title =: "&Blue", on command =: messageAlert "BLUE COLOR" ] rg
! where
! onToggleTransparent tgl = do
! chk <- get tgl checked
! messageAlert (if chk then "TRANSPARENT ON" else "TRANSPARENT OFF")
|
