Gtk2Hs メニューとツールバー
ホーム
目次
この章ではメニューとツールバーの紹介をいたします。
簡単なメニュー
メニュー項目が一つだけのメニューを作ります。ウィンドウに何もないのも寂しいので、テキストビューをつけてみました。テキストビューには文字列が複数行入力できます。
simplemenu.hs
import Graphics.UI.Gtk
main :: IO ()
main = do
initGUI
window <- windowNew
windowSetPosition window WinPosCenter
windowSetDefaultSize window 300 200
set window [windowTitle := "簡単なメニュー"]
vbox <- vBoxNew False 0
containerAdd window vbox
menubar <- menuBarNew
fileMenu <- menuNew
fileMi <- menuItemNewWithLabel "ファイル"
quitMi <- menuItemNewWithLabel "終了"
menuItemSetSubmenu fileMi fileMenu
menuShellAppend fileMenu quitMi
menuShellAppend menubar fileMi
boxPackStart vbox menubar PackNatural 0
-- ここからTextView
sw <- scrolledWindowNew Nothing Nothing
set sw [scrolledWindowVscrollbarPolicy := PolicyAutomatic,
scrolledWindowHscrollbarPolicy := PolicyAutomatic]
textview <- textViewNew
containerAdd (toContainer sw) textview
boxPackStart vbox sw PackGrow 0
-- ここまでTextView
on window objectDestroy mainQuit
on quitMi menuItemActivate $ do
mainQuit
widgetHide window
widgetShowAll window
mainGUI
サブメニュー
このサンプルもテキストビューをつけてみました。
submenu.hs
import Graphics.UI.Gtk
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowWindowPosition := WinPosCenter,
windowDefaultWidth := 300,
windowDefaultHeight := 200,
windowTitle := "サブメニュー"]
vbox <- vBoxNew False 0
containerAdd window vbox
menubar <- menuBarNew
fileMenu <- menuNew
fileMi <- menuItemNewWithLabel "ファイル"
imprMenu <- menuNew
imprMi <- menuItemNewWithLabel "読み込み"
feedMi <- menuItemNewWithLabel "ニュースフィードの読み込み..."
bookMi <- menuItemNewWithLabel "ブックマークの読み込み..."
mailMi <- menuItemNewWithLabel "メールの読み込み..."
menuItemSetSubmenu imprMi imprMenu
menuShellAppend imprMenu feedMi
menuShellAppend imprMenu bookMi
menuShellAppend imprMenu mailMi
sep <- separatorMenuItemNew
quitMi <- menuItemNewWithLabel "終了"
menuItemSetSubmenu fileMi fileMenu
menuShellAppend fileMenu imprMi
menuShellAppend fileMenu sep
menuShellAppend fileMenu quitMi
menuShellAppend menubar fileMi
boxPackStart vbox menubar PackNatural 0
-- ここからテキストビュー
sw <- scrolledWindowNew Nothing Nothing
set sw [scrolledWindowVscrollbarPolicy := PolicyAutomatic,
scrolledWindowHscrollbarPolicy := PolicyAutomatic]
textview <- textViewNew
containerAdd (toContainer sw) textview
boxPackStart vbox sw PackGrow 0
-- ここまでテキストビュー
on window objectDestroy mainQuit
on quitMi menuItemActivate $ do
mainQuit
widgetHide window
widgetShowAll window
mainGUI
チェックメニューアイテム
Gtk3HsとGtk2Hsでコードが変わります。まずは、Gtk3Hsのサンプルです。
checkmenuitem3.hs
import Graphics.UI.Gtk
showStatus :: (CheckMenuItem, Statusbar) -> IO ()
showStatus (togStat, statusbar) = do
bool <- checkMenuItemGetActive togStat
if bool
then widgetShow statusbar
else widgetHide statusbar
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowWindowPosition := WinPosCenter,
windowDefaultWidth := 300,
windowDefaultHeight := 200,
windowTitle := "チェックメニューアイテム"]
vbox <- vBoxNew False 0
containerAdd window vbox
menubar <- menuBarNew
viewmenu <- menuNew
view <- menuItemNewWithLabel "表示"
togStat <- checkMenuItemNewWithLabel "ステータスバーを表示"
checkMenuItemSetActive togStat True
menuItemSetSubmenu view viewmenu
menuShellAppend viewmenu togStat
menuShellAppend menubar view
boxPackStart vbox menubar PackNatural 0
-- ここからテキストビュー
sw <- scrolledWindowNew Nothing Nothing
set sw [scrolledWindowVscrollbarPolicy := PolicyAutomatic,
scrolledWindowHscrollbarPolicy := PolicyAutomatic]
textview <- textViewNew
containerAdd (toContainer sw) textview
boxPackStart vbox sw PackGrow 0
-- ここまでテキストビュー
statusbar <- statusbarNew
boxPackEnd vbox statusbar PackNatural 0
on window objectDestroy mainQuit
--It is different here only from gtk2.
on togStat menuItemActivated (showStatus (togStat, statusbar))
widgetShowAll window
mainGUI
checkmenuitem2.hs
checkmenuitem3.hsとの違いは1文字だけです。
--It is different here only from gtk2.
on togStat menuItemActivated (showStatus (togStat, statusbar))
上記のコードの「menuItemActivated」の最後の「d」を取って「menuItemActivate」にします。ただし、Gth3Hsからはどちらのコードも正しく実行できます。
ポップアップメニュー
popupmenu.hs
import Graphics.UI.Gtk
import Control.Monad.IO.Class -- for liftIO
{- No Need
showPopup :: IO MouseButton -> IO Bool
showPopup eventButton = do
b <- eventButton
if b == RightButton
then return True
else return False
return False
-}
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowWindowPosition := WinPosCenter,
windowDefaultWidth := 300,
windowDefaultHeight := 200,
windowTitle := "ポップアップメニュー"]
pmenu <- menuNew
hideMi <- menuItemNewWithLabel "最小化"
widgetShow hideMi
menuShellAppend pmenu hideMi
quitMi <- menuItemNewWithLabel "終了"
widgetShow quitMi
menuShellAppend pmenu quitMi
widgetShowAll window
on window objectDestroy mainQuit
on window buttonPressEvent $ do
b <- eventButton
if b == RightButton
then liftIO (menuPopup pmenu Nothing)
else return ()
return False
on hideMi menuItemActivate $ do
windowIconify window
on quitMi menuItemActivate $ do
mainQuit
widgetHide window
mainGUI
ツールバー
toolbar.hs
import Graphics.UI.Gtk
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowWindowPosition := WinPosCenter,
windowDefaultWidth := 300,
windowDefaultHeight := 200,
windowTitle := "ツールバー"]
vbox <- vBoxNew False 0
containerAdd window vbox
toolbar <- toolbarNew
newTb <- toolButtonNewFromStock stockNew
toolbarInsert toolbar newTb 0
openTb <- toolButtonNewFromStock stockOpen
toolbarInsert toolbar openTb 1
saveTb <- toolButtonNewFromStock stockSave
toolbarInsert toolbar saveTb 2
sep <- separatorToolItemNew
toolbarInsert toolbar sep 3
exitTb <- toolButtonNewFromStock stockQuit
toolbarInsert toolbar exitTb 4
separatorToolItemSetDraw sep True -- Linux Mint 18では効果がない。
boxPackStart vbox toolbar PackNatural 0
-- ここからテキストビュー
sw <- scrolledWindowNew Nothing Nothing
set sw [scrolledWindowVscrollbarPolicy := PolicyAutomatic,
scrolledWindowHscrollbarPolicy := PolicyAutomatic]
textview <- textViewNew
containerAdd (toContainer sw) textview
boxPackStart vbox sw PackGrow 0
-- ここまでテキストビュー
onToolButtonClicked exitTb $ do
widgetHide window
mainQuit
on window objectDestroy mainQuit
widgetShowAll window
mainGUI
「元に戻す」と「やり直す」
undoredo.hs
import Graphics.UI.Gtk
undoredoHandler :: (ToolButton, ToolButton, Label) -> IO ()
undoredoHandler (tb1, tb2, label) = do
name <- widgetGetName tb1
let bool = name == "undo"
-- putStrLn name
-- print(bool)
str <- labelGetText label
let x = read str :: Integer
let xNew = if bool then x-1 else x+1
labelSetText label (show xNew)
widgetSetSensitive tb1 (if bool then xNew > 0 else xNew <5)
widgetSetSensitive tb2 (if bool then xNew < 5 else xNew > 0)
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowWindowPosition := WinPosCenter,
windowDefaultWidth := 300,
windowDefaultHeight := 200,
windowTitle := "Undo redo"]
vbox <- vBoxNew False 0
containerAdd window vbox
toolbar <- toolbarNew
toolbarSetStyle toolbar ToolbarIcons
containerSetBorderWidth toolbar 2
undo <- toolButtonNewFromStock stockUndo
widgetSetName undo "undo"
toolbarInsert toolbar undo 0
redo <- toolButtonNewFromStock stockRedo
widgetSetName redo "redo"
toolbarInsert toolbar redo 1
sep <- separatorToolItemNew
toolbarInsert toolbar sep 2
exit <- toolButtonNewFromStock stockQuit
toolbarInsert toolbar exit 3
boxPackStart vbox toolbar PackNatural 0
widgetSetSensitive redo False
-- ここからラベル
frame <- frameNew
--containerSetBorderWidth frame 5
label <- labelNew ( Just "5")
containerAdd frame label
--widgetModifyBg label StateNormal (Color 65535 65535 65535)
font <- fontDescriptionNew
fontDescriptionSetFamily font "Courier"
fontDescriptionSetStyle font StyleItalic
fontDescriptionSetWeight font WeightBook
labelSetAttributes label
[
AttrSize {paStart = 0, paEnd = -1, paSize = 50},
AttrFontDescription {paStart = 0, paEnd = -1, paFontDescription = font},
--AttrWeight {paStart = 0, paEnd = -1, paWeight = WeightBook }, -- WeightBold
AttrForeground {paStart = 0, paEnd = -1, paColor = Color 25000 25000 25000}
]
boxPackStart vbox frame PackGrow 0
-- ここまでラベル
onToolButtonClicked undo $ undoredoHandler (undo, redo, label)
onToolButtonClicked redo $ undoredoHandler (redo, undo, label)
onToolButtonClicked exit $ do
widgetHide window
mainQuit
on window objectDestroy $ mainQuit
widgetShowAll window
mainGUI
19703 visits
Posted: Dec. 28, 2018
Update: Dec. 29, 2018