fformstack.class

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

' Gambas class file

STATIC PRIVATE $hForm AS Object
STATIC PRIVATE $cPict AS NEW Collection

PRIVATE $bNoSelect AS Boolean

PUBLIC SUB Form_Show()

  RefreshAll

END


PUBLIC SUB Form_Hide()

  $hForm = NULL

END


PRIVATE SUB FillTree(hCtrl AS CControl, OPTIONAL sParent AS String)

  DIM hChild AS Control
  DIM hTab AS TabStrip
  DIM iTab AS Integer
  DIM sImg AS String
  DIM sKey AS String
  DIM hPict AS Picture

  IF NOT hCtrl THEN RETURN

  IF sParent THEN
    sImg = "img/control/" & LCase(hCtrl.Kind) & ".png"
  ELSE
    sImg = "img/32/form.png"
  ENDIF

  hPict = $cPict[sImg]
  IF NOT hPict THEN
    hPict = Picture[sImg].Image.Stretch(16, 16, TRUE).Picture
    $cPict[sImg] = hPict
  ENDIF

  tvwControl.Add(hCtrl.Name, hCtrl.Name, hPict, sParent)

  IF NOT hCtrl.IsContainer() THEN RETURN

  IF hCtrl.Kind = "TabStrip" THEN

    hTab = hCtrl.Control

    FOR iTab = 0 TO hTab.Count - 1
      sKey = hCtrl.Name & "." & iTab
      tvwControl.Add(sKey, hTab[iTab].Caption, $cPict["img/control/tabstrip.png"], hCtrl.Name)
      tvwControl[sKey].Expanded = TRUE
      FOR EACH hChild IN hTab[iTab].Children
        FillTree($hForm.Control[hChild.Tag], sKey)
      NEXT
    NEXT

  ELSE

    FOR EACH hChild IN hCtrl.Control.Children
      FillTree($hForm.Control[hChild.Tag], hCtrl.Name)
    NEXT

  ENDIF

  tvwControl[hCtrl.Name].Expanded = TRUE

END

PUBLIC SUB Form_Resize()

  lblMessage.W = ME.ClientW - lblMessage.X * 2
  tvwControl.Move(0, 0, ME.CLientW, ME.ClientH)

END

PUBLIC SUB RefreshAll()

  IF NOT ME.Visible THEN RETURN

  $hForm = Project.ActiveForm
  IF NOT $hForm THEN RETURN 'GOTO _HIDE

  IF NOT Project.IsForm($hForm) THEN RETURN
  tvwControl.Clear
  FillTree($hForm.Control[$hForm.Name])
  tvwControl.Show

END

PUBLIC SUB HideAll()

  tvwControl.Hide

END


'PUBLIC SUB tvwControl_Collapse()
'
'  TRY tvwControl.Item.Expanded = TRUE
'
'END

' PUBLIC SUB tvwControl_Select()
'
'   DIM sParent AS String
'   DIM sKey AS String
'
'   IF $bNoSelect THEN RETURN
'   $bNoSelect = TRUE
'
'   IF NOT tvwControl.Item.MoveParent() THEN
'     sParent = tvwControl.Item.Key
'   ENDIF
'
'   tvwControl.MoveFirst
'   WHILE tvwControl.Available
'
'     'PRINT tvwControl.Item.Key
'
'     IF NOT tvwControl.Item.Selected THEN GOTO SUIVANT
'     sKey = tvwControl.Item.Key
'     IF NOT tvwControl.MoveParent() THEN
'       IF tvwControl.Item.Key = sParent THEN
'         tvwControl.MoveTo(sKey)
'         GOTO SUIVANT
'       ENDIF
'     ENDIF
'     tvwControl.MoveTo(sKey)
'     tvwControl.Item.Selected = FALSE
'
' SUIVANT:
'     tvwControl.MoveBelow
'   WEND
'
'   $bNoSelect = FALSE
'
' END