fform.class

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

' Gambas class file

PUBLIC Name AS String
PUBLIC Path AS String
PUBLIC Master AS CControl
PUBLIC Selection AS NEW Collection
PUBLIC Control AS Collection
PUBLIC Menus AS NEW Object[]

PRIVATE $bDoNotModify AS Boolean
PRIVATE $bModify AS Boolean
PRIVATE $bSelChange AS Boolean
PRIVATE $bReadOnly AS Boolean
PRIVATE $bActivate AS Boolean


' Gestion de la souris

PRIVATE $iMode AS Integer

PRIVATE CONST MODE_NOTHING AS Integer = 0
PRIVATE CONST MODE_CREATE AS Integer = 1
PRIVATE CONST MODE_MOVE AS Integer = 2
PRIVATE CONST MODE_SELECT AS Integer = 3

PRIVATE $sTool AS String
PRIVATE $hCurrent AS CControl
PRIVATE $X AS Integer
PRIVATE $Y AS Integer
PRIVATE $MX AS Integer
PRIVATE $MY AS Integer
PRIVATE $W AS Integer
PRIVATE $H AS Integer

PRIVATE $XS AS Integer
PRIVATE $YS AS Integer
PRIVATE $WS AS Integer
PRIVATE $HS AS Integer

PRIVATE CONST MIN_WIDTH AS Integer = 4
PRIVATE CONST MIN_HEIGHT AS Integer = 4

' Gestion de la sauvegarde

PRIVATE $sSave AS String
PRIVATE $iSaveX AS Integer
PRIVATE $iSaveY AS Integer
'PRIVATE $iIndent AS INTEGER
PRIVATE $iSaveLevel AS Integer
PRIVATE $bSelectNew AS Boolean
PRIVATE $bMustArrange AS Boolean

PRIVATE CONST FORM_CLIPBOARD_FORMAT AS String = "text/x-gambas-form"

'PRIVATE CONST FORM_NAME AS String = "$"

PUBLIC SUB _new(sPath AS String)

  DIM sData AS String

  Path = sPath
  Name = File.BaseName(sPath)
  Control = NEW Collection(gb.Text)

  'mnuSave.Enabled = NOT Project.ReadOnly
  SetReadOnly

  sData = File.Load(sPath)

  IF UCase(Left$(sData, Len(Project.FORM_MAGIC))) <> UCase(Project.FORM_MAGIC) THEN
    Message.Warning(("Bad form file"))
    RETURN
  ENDIF

  'ME.Font.Size =

  $bDoNotModify = TRUE

  sData = Mid$(sData, Len(Project.FORM_MAGIC) + 1)
  FromString(sData)

  DrawTitle

  RefreshMenu

END


PRIVATE SUB FromString(sData AS String, OPTIONAL hParent AS CControl)

  DIM hCtrl AS Object
  'DIM hParent AS OBJECT

  DIM sName AS String
  DIM sClass AS String
  DIM iPos AS Integer
  DIM sLine AS String
  DIM hData AS CControl

  DIM sProperty AS String
  DIM sValue AS String
  DIM vValue AS Variant

  DIM iLevel AS Integer
  DIM bFirst AS Boolean
  DIM sEventName AS String

  DIM cCoord AS String[]

  hCtrl = hParent
  bFirst = TRUE

  WHILE sData

    iPos = Instr(sData, gb.newLine)
    IF iPos = 0 THEN
      sLine = Trim(sData)
      sData = ""
    ELSE
      sLine = Trim(Left$(sData, iPos - 1))
      sData = Mid$(sData, iPos + 1)
    ENDIF

    'PRINT "> "; sLine

    IF Len(sLine) = 0 THEN CONTINUE
    IF Left$(sLine, 1) = "#" THEN sLine = Mid$(sLine, 2)

    IF Left$(sLine, 1) = "{" THEN

      sLine = Trim(Mid$(sLine, 2))
      iPos = Instr(sLine, " ")
      sName = Left$(sLine, iPos - 1)
      sClass = Trim(Mid$(sLine, iPos + 1))
      iPos = Instr(sClass, " ")
      IF iPos THEN
        sEventName = Trim(Mid$(sClass, iPos + 1))
        sClass = Trim(Left$(sClass, iPos - 1))
      ELSE
        sEventName = ""
      ENDIF

      IF Left$(sClass) = "#" THEN sClass = Mid$(sClass, 2)

      IF IsNull(hCtrl) THEN sName = Name

      IF sClass = "Image" THEN
        PRINT "Image -> PictureBox"
        sClass = "PictureBox"
      ENDIF

      hCtrl = CreateControl(sClass, hCtrl, sName)

      IF sEventName THEN hCtrl.SetProperty(CPropertyInfo.EVENT_NAME, sEventName)

      INC iLevel

    ELSE IF Left$(sLine, 1) = "}" THEN

      'IF hCtrl = hParent THEN RETURN
      DEC iLevel

      IF iLevel = 0 THEN
        IF $bSelectNew THEN
          hCtrl.Select(ME, bFirst)
          bFirst = FALSE
        ENDIF
      ENDIF

      hCtrl = hCtrl.Parent

    ELSE

      iPos = Instr(sLine, "=")

      IF iPos THEN

        sProperty = Trim(Left$(sLine, iPos - 1))
        sValue = Trim(Mid$(sLine, iPos + 1))

        vValue = Val(sValue)
        IF IsNull(vValue) THEN

          IF Left$(sValue, 2) = "(" & Chr$(34) THEN
            sValue = Mid$(sValue, 2, -1)
          ENDIF

          IF Left$(sValue, 1) = Chr$(34) THEN
            vValue = Mid$(sValue, 2, Len(sValue) - 2)
            vValue = Replace(vValue, "\\n", gb.NewLine)
            vValue = Replace(vValue, "\\" & Chr$(34), Chr$(34))
            vValue = Replace(vValue, "\\\\", "\\")
          ELSE IF Left$(sValue, 5) = "Font[" THEN
            vValue = Mid$(sValue, 7, -2)
          ELSE IF Left$(sValue, 8) = "Picture[" THEN
            vValue = Mid$(sValue, 10, -2)
            'PRINT File.Dir(Project.Path) &/ Mid$(sValue, 9, -1)
            'vValue = Picture[File.Dir(Project.Path) &/ Mid$(sValue, 9, -1)]
          ELSE IF UCase(sValue) = "TRUE" THEN
            vValue = TRUE
          ELSE IF UCase(sValue) = "FALSE" THEN
            vValue = FALSE
          ELSE IF Left$(sValue, 6) = "CDate(" THEN
            vValue = CDate(Mid$(sValue, 8, -2))
          ELSE

            iPos = Instr(sValue, ".")
            IF iPos THEN
              vValue = Mid$(sValue, iPos + 1)
            ELSE
              PRINT "Bad property value "; sValue
            ENDIF

          ENDIF

        ENDIF

        IF hCtrl.SetProperty(sProperty, vValue) THEN
          PRINT "Error: "; hCtrl.Kind; "."; sProperty; " = "; sValue
        ENDIF

      ELSE IF Left$(sLine, 5) = "Move(" THEN

        cCoord = Split(Mid$(sLine, 6, -1))
        'TRY PRINT cCoord[0]; ","; cCoord[1]; ","; cCoord[2]; ","; cCoord[3]
        TRY hCtrl.Move(Val(cCoord[0]), Val(cCoord[1]), TRUE)
        'TRY hCtrl.SetProperty("X", Val(cCoord[0]))
        'TRY hCtrl.SetProperty("Y", Val(cCoord[1]))
        IF cCoord.Count >= 2 THEN
          TRY hCtrl.Resize(Val(cCoord[2]), Val(cCoord[3]), TRUE)
        ENDIF

        IF ERROR THEN PRINT "Error: Syntax error: "; sLine

      ELSE

        PRINT "Error: Syntax error: "; sLine

      ENDIF

    ENDIF

  WEND

END


PUBLIC FUNCTION Save() AS Boolean

  DIM hFic AS File

  IF Project.ReadOnly THEN RETURN
  IF NOT $bModify THEN RETURN

  UnselectAll

  Save.Begin(Path)

  ResetSave

  AddLine(Project.FORM_MAGIC)
  AddLine()

  SaveOne(Control[Name])

  File.Save(Path, $sSave)

  Project.SetFormIcon(ME)

  'OPEN Path & ".test" FOR CREATE AS #hFic ' y a un truc bizarre avec CREATE !
  'PRINT #hFic, $sSave
  'CLOSE #hFic

  $sSave = ""
  $bModify = FALSE
  DrawTitle

  Save.End()

CATCH

  RETURN Save.Error()

END


PUBLIC SUB AddLine(OPTIONAL sLig AS String)

  DIM sAdd AS String

  'IF Left$(sLig, 1) = "}" THEN $iIndent = $iIndent - 1

  sAdd = Space$($iSaveLevel * 2) & sLig
  'PRINT sAdd
  $sSave = $sSave & sAdd & gb.NewLine

  'IF Left$(sLig, 1) = "{" THEN $iIndent = $iIndent + 1

END


PUBLIC FUNCTION GetChildren(sName AS String) AS Object[]

  DIM cList AS NEW Object[]
  DIM hCtrl AS CControl
  DIM hChild AS Control
  DIM iTab AS Integer
  DIM hMenu AS Menu
  DIM hTab AS TabStrip

  hCtrl = Control[sName]
  IF IsNull(hCtrl) THEN RETURN
  IF NOT hCtrl.IsContainer() THEN RETURN

  IF hCtrl.Kind = "Form" THEN

    FOR EACH hMenu IN ME.Menus
      cList.Add(Control[hMenu.Tag])
    NEXT

    FOR EACH hChild IN hCtrl.Control.Children
      cList.Add(Control[hChild.Tag])
    NEXT

  ELSE IF hCtrl.Kind = "TabStrip" THEN

    hTab = hCtrl.Control

    FOR iTab = 0 TO hTab.Count - 1

      FOR EACH hChild IN hTab[iTab].Children
        cList.Add(Control[hChild.Tag])
      NEXT

    NEXT

  ELSE IF hCtrl.Kind = "Menu" THEN

    FOR EACH hMenu IN hCtrl.Control.Children
      cList.Add(Control[hMenu.Tag])
    NEXT

  ELSE

    FOR EACH hChild IN hCtrl.Control.Children
      cList.Add(Control[hChild.Tag])
    NEXT

  ENDIF

  RETURN cList

END



PRIVATE SUB SaveOne(hCtrl AS CControl)

  DIM hChild AS Control
  DIM sLine AS String
  DIM hMenu AS Menu
  DIM hMenuCtrl AS CControl
  DIM cProp AS String[]

  DIM hTab AS TabStrip
  DIM iTab AS Integer
  DIM sVal AS String
  DIM vVal AS Variant
  DIM iArr AS Integer

  'hCtrl = Control[sName]
  IF IsNull(hCtrl) THEN RETURN

  IF hCtrl.Virtual THEN
    AddLine(Trim("{ " & hCtrl.Name & " #" & hCtrl.Kind & " " & hCtrl.GetProperty(CPropertyInfo.EVENT_NAME)))
  ELSE
    AddLine(Trim("{ " & hCtrl.Name & " " & hCtrl.Kind & " " & hCtrl.GetProperty(CPropertyInfo.EVENT_NAME)))
  ENDIF

  IF $iSaveLevel = 0 THEN
    cProp = hCtrl.GetEachProperty($iSaveX, $iSaveY)
  ELSE
    cProp = hCtrl.GetEachProperty(0, 0)
  ENDIF

  $iSaveLevel = $iSaveLevel + 1

  FOR EACH sLine IN cProp
    AddLine(sLine)
  NEXT

  IF hCtrl.IsContainer() THEN

    TRY iArr = CComponent.Classes[hCtrl.Kind].Symbols["_Arrangement"].Value

    IF NOT ERROR THEN

      IF iArr = Arrange.Fill THEN
        iArr = 0
        TRY iArr = CComponent.Classes["Arrange"].Symbols[hCtrl.GetProperty("Arrangement")].Value
      ENDIF

      IF iArr THEN

        IF hCtrl.Kind = "TabStrip" THEN

        ELSE

          ArrangeContainer(hCtrl.Control, iArr, FALSE)

        ENDIF

      ENDIF

    ENDIF

    IF hCtrl.Kind = "Form" THEN

      FOR EACH hMenuCtrl IN ME.Menus
        SaveOne(hMenuCtrl)
      NEXT

      FOR EACH hChild IN hCtrl.Control.Children
        SaveOne(Control[hChild.Tag])
      NEXT

    ELSE IF hCtrl.Kind = "TabStrip" THEN

      hTab = hCtrl.Control

      FOR iTab = 0 TO hTab.Count - 1

        AddLine("Index = " & CStr(iTab))
        sVal = Replace(hTab[iTab].Text, "\\", "\\\\")
        sVal = Replace(sVal, Chr$(34), "\\" & Chr$(34))
        sVal = Replace(sVal, gb.NewLine, "\\n")
        AddLine("Text = (" & Chr$(34) & sVal & Chr$(34) & ")")

        IF hCtrl.Tag THEN
          sVal = hCtrl.Tag[iTab]
          IF sVal THEN
            AddLine("Picture = Picture[" & Chr$(34) & sVal & Chr$(34) & "]")
          ENDIF
        ENDIF

        FOR EACH hChild IN hTab[iTab].Children
          SaveOne(Control[hChild.Tag])
        NEXT

      NEXT

      'AddLine("Index = " & CStr(hTab.Index))
      AddLine("Index = 0")

    ELSE IF hCtrl.Kind = "Menu" THEN

      FOR EACH hMenu IN hCtrl.Control.Children
        SaveOne(Control[hMenu.Tag])
      NEXT

    ELSE

      FOR EACH hChild IN hCtrl.Control.Children
        SaveOne(Control[hChild.Tag])
      NEXT

    ENDIF

  ENDIF

  $iSaveLevel = $iSaveLevel - 1

  AddLine("}")

END



PUBLIC SUB Form_Resize()

  IF NOT LAST.Visible THEN RETURN

  WITH Control[Name]
    .Control.Resize(ME.ClientWidth, ME.ClientHeight)
    .SetProperty("Width", ME.Width)
    .SetProperty("Height", ME.Height)
  END WITH

END


'PUBLIC SUB Form_KeyPress(Ascii AS String, Code AS Integer, State AS Integer)
'
'  Project.Shortcut(Code, Ascii, State)
'
'END


PRIVATE $bInFormMove AS Boolean

PUBLIC SUB Form_Move()

  IF NOT LAST.Visible THEN RETURN
  IF $bInFormMove THEN RETURN

  'PRINT "Form_Move"; ME.X; ME.Y

  $bInFormMove = TRUE

  WITH Control[Name]

    'PRINT "Set X"
    .SetProperty("X", ME.X, TRUE)
    'PRINT "Set Y"
    .SetProperty("Y", ME.Y, TRUE)
  END WITH
  'Control[Name].Parent.Move(ME.X, ME.Y)

  $bInFormMove = FALSE

END


PUBLIC SUB Control_MouseDown()

  'PRINT "> Control_MouseDown"

  DIM X AS Integer
  DIM Y AS Integer

  X = Mouse.X
  Y = Mouse.Y

  $hCurrent = Control[LAST.Tag]
  $sTool = FToolBox.GetTool()

  $X = LAST.X
  $Y = LAST.Y
  $MX = LAST.ScreenX + X
  $MY = LAST.ScreenY + Y

  'IF $hCurrent.Kind = "GridView" THEN
  '  PRINT "MouseDown: $X ="; $X; " $Y ="; $Y; " $MX ="; $MX; " $MY ="; $MY
  '  PRINT "X ="; X; " Y ="; Y
  'ENDIF

  IF $sTool = "" THEN

    IF Mouse.Control OR $hCurrent.Name = Name THEN

      $XS = X
      $YS = Y

      $iMode = MODE_SELECT

      $W = 0
      $H = 0

      GOTO FIN

    ELSE

      IF Master <> $hCurrent THEN

        IF NOT $hCurrent.Selected THEN
          UnSelectAll
        ENDIF

        SelectCurrent(TRUE)

      ENDIF

      IF $bReadOnly THEN RETURN

      $iMode = MODE_MOVE

    ENDIF

  ELSE

    IF $bReadOnly THEN RETURN

    IF NOT $hCurrent.IsContainer() THEN
      X = X + $hCurrent.Control.X + $hCurrent.Control.Parent.ClientX
      Y = Y + $hCurrent.Control.Y + $hCurrent.Control.Parent.ClientY
      $hCurrent = $hCurrent.Parent
      IF $hCurrent.Kind = "ScrollView" THEN
        X = X - $hCurrent.Control.ScrollX
        Y = Y - $hCurrent.Control.ScrollY
      ENDIF
    ENDIF

    $iMode = MODE_CREATE

    $X = X
    $Y = Y

    '$hCurrent = CreateControl(, $sTool, $hCurrent)
  ENDIF

  RefreshProperty

FIN:
  'PRINT "< Control_MouseDown"

END

PUBLIC SUB Control_MouseMove()

  DIM X AS Integer
  DIM Y AS Integer
  DIM iDepX AS Integer
  DIM iDepY AS Integer
  DIM hCtrl AS CControl