Gtk2Hs ダイアログ
ホーム
目次
start
info
warning
question
error
start
dialog
start
dialog
メッセージダイアログ
messagedialogs.hs
import Graphics.UI.Gtk
showInfo :: Window -> IO()
showInfo window = do
dialog <- messageDialogNew (Just window) [DialogDestroyWithParent]
MessageInfo ButtonsOk "Download Conpleted"
set dialog [windowTitle := "Information"]
dialogRun dialog
widgetDestroy dialog
showError :: Window -> IO()
showError window = do
dialog <- messageDialogNew (Just window) [DialogDestroyWithParent]
MessageError ButtonsOk "Error loading file"
set dialog [windowTitle := "Error"]
dialogRun dialog
widgetDestroy dialog
showQuestion :: Window -> IO()
showQuestion window = do
dialog <- messageDialogNew (Just window) [DialogDestroyWithParent]
MessageQuestion ButtonsYesNo "Are you sure to quit?"
set dialog [windowTitle := "Question"]
dialogRun dialog
widgetDestroy dialog
showWarning :: Window -> IO()
showWarning window = do
dialog <- messageDialogNew (Just window) [DialogDestroyWithParent]
MessageWarning ButtonsOk "Unallowed operation"
set dialog [windowTitle := "Warning"]
dialogRun dialog
widgetDestroy dialog
main :: IO()
main = do
initGUI
window <- windowNew
windowSetPosition window WinPosCenter
windowSetDefaultSize window 220 150
set window [windowTitle := "Message dialogs"]
table <- tableNew 2 2 True
tableSetRowSpacings table 2
tableSetColSpacings table 2
info <- buttonNewWithLabel "Info"
warn <- buttonNewWithLabel "Warning"
ques <- buttonNewWithLabel "Question"
erro <- buttonNewWithLabel "Error"
tableAttachDefaults table info 0 1 0 1
tableAttachDefaults table warn 1 2 0 1
tableAttachDefaults table ques 0 1 1 2
tableAttachDefaults table erro 1 2 1 2
containerAdd window table
containerSetBorderWidth window 15
on info buttonActivated $ showInfo window
on warn buttonActivated $ showWarning window
on ques buttonActivated $ showQuestion window
on erro buttonActivated $ showError window
on window objectDestroy mainQuit
widgetShowAll window
mainGUI
アバウトダイアログ
ウィンドウをクリックするとアバウトダイアログが表示されます。
サンプルで使用する画像はここからダウンロードできます。解凍した img フォルダをコードファイルと同じディレクトリに置いてください。
aboutdialog.hs
import Graphics.UI.Gtk
import Control.Monad.IO.Class
showAbout :: IO ()
showAbout = do
pixbuf <- pixbufNewFromFile "img/precipice.jpg"
dialog <- aboutDialogNew
set dialog [aboutDialogProgramName := "Precipice",
aboutDialogVersion := "1.0",
aboutDialogCopyright := "© appdesign.jp",
aboutDialogComments :=
"Precipice is a sample of About dialog.",
aboutDialogWebsite := "https://appdesign.jp",
aboutDialogLogo := (Just pixbuf)]
dialogRun dialog
widgetDestroy dialog
main :: IO()
main = do
initGUI
window <- windowNew
windowSetPosition window WinPosCenter
windowSetDefaultSize window 220 150
set window [windowTitle := "precipice"]
containerSetBorderWidth window 15
widgetAddEvents window [ButtonPressMask]
on window buttonPressEvent $tryEvent $liftIO$
showAbout
on window objectDestroy mainQuit
widgetShowAll window
mainGUI
フォント選択ダイアログ
fontdialog.hs
import Graphics.UI.Gtk
selectFont :: Label -> IO()
selectFont label = do
dialog <- fontSelectionDialogNew "Select Font"
result <- dialogRun dialog
if result == ResponseOk || result == ResponseApply
then do
Just fontname <- (fontSelectionDialogGetFontName dialog)
::IO (Maybe String)
fontdescription <- (fontDescriptionFromString fontname)
::IO FontDescription
widgetModifyFont label (Just fontdescription)
else do
return ()
widgetDestroy dialog
main :: IO()
main = do
initGUI
window <- windowNew
windowSetPosition window WinPosCenter
windowSetDefaultSize window 280 200
set window [windowTitle := "Font Selection Dialog"]
vbox <- vBoxNew False 0
containerAdd window vbox
toolbar <- toolbarNew
containerSetBorderWidth toolbar 2
font <- toolButtonNewFromStock stockSelectFont
toolbarInsert toolbar font 0
boxPackStart vbox toolbar PackNatural 5
label <- labelNew (Just "Hello World")
boxPackStart vbox label PackGrow 5
onToolButtonClicked font $ selectFont label
on window objectDestroy mainQuit
widgetShowAll window
mainGUI
カラー選択ダイアログ
サンプルのファイル名に「2」をつけています。「2」の付いているサンプルは「Gtk2Hs」対応です。ただし、WindowsやmacOSでは、よほどのことがない限り、「Gtk2Hs」と「Gtk2Hs」の両方が実行できます。
Linuxでは、「Gtk2Hs」対応のシステムでは、「Gtk2Hs」ファイルだけを実行でき、「Gtk3Hs」対応のシステムでは「Gtk2Hs」ファイルだけを実行できます。
colordialog2.hs
import Graphics.UI.Gtk
selectFont :: Label -> IO ()
selectFont label = do
dialog <- fontSelectionDialogNew "Select Font"
result <- dialogRun dialog
if result == ResponseOk || result == ResponseApply
then do
Just fontname <- (fontSelectionDialogGetFontName dialog)
::IO (Maybe String)
fontdescription <- (fontDescriptionFromString fontname)
::IO FontDescription
widgetModifyFont label (Just fontdescription)
else do
return ()
widgetDestroy dialog
selectColor :: Label -> IO ()
selectColor label = do
dialog <- colorSelectionDialogNew "Font Color"
result <- dialogRun dialog
if result == ResponseOk
then do
colorsel <- colorSelectionDialogGetColor dialog
color <- colorSelectionGetCurrentColor colorsel
widgetModifyFg label StateNormal color
else do
return ()
widgetDestroy dialog
main :: IO ()
main = do
initGUI
window <- windowNew
windowSetPosition window WinPosCenter
windowSetDefaultSize window 280 200
set window [windowTitle := "Color Selection Dialog"]
vbox <- vBoxNew False 0
containerAdd window vbox
toolbar <- toolbarNew
toolbarSetStyle toolbar ToolbarIcons
containerSetBorderWidth toolbar 2
font <- toolButtonNewFromStock stockSelectFont
toolbarInsert toolbar font 0
color <- toolButtonNewFromStock stockSelectColor
toolbarInsert toolbar color 1
boxPackStart vbox toolbar PackNatural 5
label <- labelNew (Just "Hello World")
labelSetJustify label JustifyCenter
boxPackStart vbox label PackGrow 5
onToolButtonClicked font $ selectFont label
onToolButtonClicked color $ selectColor label
on window objectDestroy mainQuit
widgetShowAll window
mainGUI
20128 visits
Posted: Jan. 12, 2019
Update: Jan. 12, 2019