Gtk2Hs リストビューとツリービュー

ホーム   目次

リストビュー

listview.hs

import Graphics.UI.Gtk

initList :: ListStore String -> TreeView -> IO ()
initList list treeview = do
  col <- treeViewColumnNew
  treeViewColumnSetTitle col "List Items"
  renderer <-cellRendererTextNew
  cellLayoutPackStart col renderer False
  cellLayoutSetAttributes col renderer list
    $ \ind -> [cellText := ind]
  treeViewAppendColumn treeview col
  tree <- treeViewGetSelection treeview
  treeSelectionSetMode tree  SelectionBrowse --Multiple

addToList :: ListStore String -> String -> IO ()
addToList list str  = do 
  listStoreAppend list str
  return () 

onSelection :: ListStore String -> TreeSelection -> Label -> IO ()
onSelection list tree label = do
  sel <- treeSelectionGetSelectedRows tree
  let s = head  (head sel)
  v <- listStoreGetValue list s
  labelSetLabel label v

main :: IO ()
main = do
  initGUI
  window <- windowNew
  
  list <- listStoreNew []
  treeview <- treeViewNewWithModel list
  
  set window [ windowTitle := "List view"]
  windowSetPosition window WinPosCenter
  containerSetBorderWidth window 20
  windowSetDefaultSize window 270 250
  
  treeViewSetHeadersVisible treeview False  --True
  
  vbox <- vBoxNew False 0
  boxPackStart vbox treeview PackGrow 5
  label <- labelNew (Just "")
  boxPackStart vbox label PackNatural 5
  containerAdd window vbox
  
  initList list treeview
  
  addToList list "Windows"
  addToList list "macOS"
  addToList list "Ubuntu"
  addToList list "Mint"
  addToList list "Fedora"
  
  tree <- treeViewGetSelection treeview

  on tree treeSelectionSelectionChanged $
    onSelection list tree label
  
  on window objectDestroy mainQuit
  
  widgetShowAll window
  
  mainGUI
    

リストビューの拡張

リストビューに項目を追加したり削除したりする機能を付けました。

dynamiclistview.hs

import Graphics.UI.Gtk

initList :: ListStore String -> TreeView -> IO ()
initList store treeview = do
  renderer <- cellRendererTextNew
  column <- treeViewColumnNew
  treeViewColumnSetTitle column "Lite Items"
  treeViewAppendColumn treeview column
  cellLayoutPackStart column renderer False
  cellLayoutSetAttributes column renderer store
    $ \ind -> [cellText := ind]
  return ()
  
appendItem :: ListStore String -> Entry -> IO ()
appendItem store entry = do
  str <- entryGetText entry
  let bool | str == "" = False
           | otherwise = True
  if bool
  then do
    listStoreAppend store str
    entrySetText entry ""
  else do
    return ()

removeItem :: ListStore String -> TreeSelection -> IO ()
removeItem store sel = do
  selected <- treeSelectionGetSelected sel
  case selected of
    Nothing -> return ()
    Just iter ->
      let pos = listStoreIterToIndex iter
        in listStoreRemove store pos

removeAllItems :: ListStore String -> TreeSelection -> IO ()
removeAllItems store sel = do
  exist <- treeModelGetIterFirst store
  case exist of
    Nothing -> return ()
    Just iter -> listStoreClear store

main :: IO ()
main = do

  initGUI
  
  window <- windowNew
  
  set window [windowTitle := "List view",
              windowWindowPosition := WinPosCenter,
              containerBorderWidth := 10,
              windowDefaultWidth := 370,
              windowDefaultHeight := 270]
  
  sw <- scrolledWindowNew Nothing Nothing
  store <- listStoreNew []
  treeview <- treeViewNewWithModel store
  containerAdd (toContainer sw) treeview
  scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
  scrolledWindowSetShadowType sw ShadowEtchedIn
  
  treeViewSetHeadersVisible treeview False
  
  vbox <- vBoxNew False 0
  boxPackStart vbox sw PackGrow 5
  
  hbox <- hBoxNew False 5
  
  add <- buttonNewWithLabel "Add"
  entry <- entryNew
  widgetSetSizeRequest entry 120 27
  remove <- buttonNewWithLabel "Remove"
  removeAll <- buttonNewWithLabel "Remove All"
  
  boxPackStart hbox add PackNatural 3
  boxPackStart hbox entry PackNatural 3
  boxPackStart hbox remove PackNatural 3
  boxPackStart hbox removeAll PackNatural 3
  
  boxPackStart vbox hbox PackNatural 3
  
  initList store treeview
  
  sel <- treeViewGetSelection treeview
  
  on add buttonActivated $ appendItem store entry
  
  on remove buttonActivated $ removeItem store sel
  
  on removeAll buttonActivated $ removeAllItems store sel
  
  on window objectDestroy mainQuit
  
  containerAdd window vbox
  
  widgetShowAll window
  
  mainGUI
    

ツリービュー

treeview.hs

import Graphics.UI.Gtk
import Data.Tree

onSelection ::
  TreeStore String -> TreeSelection -> Statusbar -> IO ()
onSelection treestore selection statusbar = do
  sel <- treeSelectionGetSelectedRows selection
  let path = head sel
  str <- treeStoreGetValue treestore path
  id <- statusbarGetContextId statusbar str
  statusbarPush statusbar id str
  return ()
  
createModel :: IO (TreeStore String)
createModel = do
  treestore <- treeStoreNew
    [Node "Scripting languages" [Node "Python" [],
                                 Node "Perl"   [],
                                 Node "PHP"    []],
     Node "Compiled languages"  [Node "C"      [],
                                 Node "C++"    [],
                                 Node "Java"   []]
    ]
  
  return treestore

createView :: TreeStore String -> IO TreeView
createView treestore = do
  
  treeview <- treeViewNewWithModel treestore
  
  column <- treeViewColumnNew
  treeViewColumnSetTitle column "Programming languages"
  treeViewAppendColumn treeview column
  treeViewSetHeadersVisible treeview True
    
  renderer <- cellRendererTextNew
  cellLayoutPackStart column renderer True
  cellLayoutSetAttributes column renderer treestore
    $ \ind -> [cellText := ind]
  
  return treeview

main :: IO ()
main = do

  initGUI
  
  window <- windowNew
  set window [windowWindowPosition := WinPosCenter,
              windowTitle := "Tree view",
              windowDefaultWidth := 350,
              windowDefaultHeight := 300]

  vbox <- vBoxNew False 2
  containerAdd window vbox
  
  treestore <- createModel
  
  treeview <- createView treestore
  
  selection <- treeViewGetSelection treeview
  
  boxPackStart vbox treeview PackGrow 1
  
  statusbar <- statusbarNew
  boxPackStart vbox statusbar PackNatural 1
  
  on selection treeSelectionSelectionChanged
    $ onSelection treestore selection statusbar
  
  on window objectDestroy mainQuit
  
  widgetShowAll window
  
  mainGUI
    

ホーム   目次   ページトップ