fproperty.class

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

' Gambas class file

PRIVATE $iBackground AS Integer
PRIVATE $cIndex AS NEW Collection
PRIVATE $bMany AS Boolean
PRIVATE $hObject AS Object
PRIVATE $hForm AS Object

PRIVATE $iLast AS Integer
PRIVATE $sLast AS String
PRIVATE $sType AS String
PRIVATE $hEditor AS Object
PRIVATE $sOldVal AS String
PRIVATE $bFreeze AS Boolean
PRIVATE $bButton AS Boolean
PRIVATE $bIgnoreHide AS Boolean

PUBLIC SUB _new()

  grdProperty.Columns.Count = 2
  grdProperty.ScrollBar = Scroll.Vertical
  grdProperty.Columns.Resizable = TRUE

  $iBackground = grdProperty.Background

  ME.Move(Desktop.Width - ME.Width, 0)
  Config.LoadWindow(ME, "/FProperty")
  ReadConfig

END


PUBLIC SUB Form_Close()

  Config.SaveWindow(ME, "/FProperty")

END



PUBLIC SUB Form_Resize()

  DIM iWidth AS Integer

  lblMessage.Width = ME.ClientW - lblMessage.X * 2

  grdProperty.Move(0, 0, ME.ClientWidth, ME.ClientHeight)

  IF grdProperty.Columns.Count < 2 THEN RETURN

  iWidth = Min(128, grdProperty.ClientWidth \ 2)

  grdProperty.Columns[0].Width = iWidth
  grdProperty.Columns[1].Width = grdProperty.ClientWidth - iWidth
  'grdProperty.Columns.Width = 100 'ME.ClientWidth / 4

  MoveProperty

  'CATCH $$ Non déréférencement en cas d'erreur

END


PUBLIC SUB RefreshAll()

  DIM cSelection AS Collection
  DIM hCtrl AS CControl
  DIM sClass AS String
  DIM bDiff AS Boolean
  DIM cProp AS String[]
  DIM hProp AS CPropertyInfo
  DIM iRow AS Integer
  DIM sProp AS String
  DIM sVal AS String
  DIM hCtrlAlone AS CControl
  DIM cKeyProp AS Collection

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

  TRY cSelection = $hForm.Selection
  IF NOT cSelection THEN RETURN

  $cIndex.Clear
  $bMany = FALSE
  HideProperty
  $hObject = NULL

  IF NOT cSelection THEN GOTO _HIDE

  IF cSelection.Count = 0 THEN
    cSelection = NEW Collection
    cSelection.Add($hForm.Control[$hForm.Name], $hForm.Name)
  ENDIF

  $bMany = cSelection.Count > 1

  FOR EACH hCtrl IN cSelection

    IF sClass = "" THEN
      $hObject = hCtrl
      sClass = hCtrl.Kind
    ELSE IF sClass <> hCtrl.Kind THEN
      bDiff = TRUE
    ENDIF

  NEXT

  IF bDiff THEN sClass = "Control"

  'PRINT "Kind = "; sClass

  'cProp = CControl.PropertiesInOrder[sClass]
  cProp = CComponent.Classes[sClass].PropertyList
  'PRINT "FProperty: "; sClass; ": "; cProp.Join()

  grdProperty.Rows.Count = cProp.Count + 3
  grdProperty.Columns.Count = 2
  'grdProperty.Clear

  grdProperty[iRow, 0].Text = "(Class)"
  grdProperty[iRow, 1].Text = $hObject.Kind

  INC iRow

  grdProperty[iRow, 0].Text = "(Name)"
  IF $bMany THEN
    grdProperty[iRow, 1].Text = ""
  ELSE
    grdProperty[iRow, 1].Text = $hObject.Name
  ENDIF

  iRow = iRow + 1

  'grdProperty[iRow, 0].Text = "(Event name)"
  'IF $bMany THEN
  '  grdProperty[iRow, 1].Text = ""
  'ELSE
  '  grdProperty[iRow, 1].Text = $hObject.EventName
  'ENDIF
  '
  'iRow = iRow + 1

  FOR EACH sProp IN cProp

    'PRINT sProp

    hProp = CComponent.Classes[sClass].GetProperties()[sProp]
    IF hProp.Hidden THEN CONTINUE

    $cIndex[sProp] = iRow

    grdProperty[iRow, 0].Text = sProp

    sVal = GetProperty(sProp)

    grdProperty[iRow, 1].Text = sVal
    INC iRow

  NEXT

  grdProperty.Rows.Count = iRow

  Form_Resize
  grdProperty.Visible = TRUE
  RETURN

_HIDE:

  HideAll

END


PUBLIC SUB HideAll()

  HideProperty
  grdProperty.Visible = FALSE

END



PUBLIC SUB RefreshOne(hCtrl AS CControl, sProp AS String)

  IF NOT $bMany THEN
    IF $hObject <> hCtrl THEN RETURN
  ENDIF

  IF sProp = "Name" THEN

    IF $bMany THEN RETURN
    grdProperty[1, 1].Text = $hObject.Name

  ELSE

    IF NOT $cIndex.Exist(sProp) THEN RETURN

    grdProperty[$cIndex[sProp], 1].Text = GetProperty(sProp)

  ENDIF

  IF sProp = $sLast THEN
    CancelProperty
  ENDIF

END


PRIVATE FUNCTION SaveProperty() AS Boolean

  DIM vVal AS Variant
  DIM hCtrl AS CControl
  DIM sMsg AS String

  IF IsNull($hEditor) THEN RETURN FALSE

  vVal = $hEditor.Text
  IF vVal = $sOldVal THEN RETURN FALSE

  SELECT $sType

    CASE "Name"

      IF IsNull(vVal) THEN GOTO _CANCEL

      IF CControl.CheckName(vVal) THEN
        sMsg = ("Forbidden characters in control name.")
        GOTO _CANCEL
      ENDIF

      IF $hObject.Rename(vVal) THEN
        sMsg = ("This name is already in use.")
        GOTO _CANCEL
      ENDIF

      RefreshOne($hObject, "Name")
      RETURN FALSE

    CASE "Group"

      IF CControl.CheckName(vVal) THEN
        sMsg = ("Forbidden characters in control group.")
        GOTO _CANCEL
      ENDIF

    'CASE "EventName"
    '
    '  FOR EACH hCtrl IN $hForm.Selection
    '    hCtrl.EventName = vVal
    '  NEXT
    '  RefreshOne($hObject, "EventName")
    '  RETURN FALSE

    CASE "i", "b", "f", "d"

      vVal = Val(vVal)
      IF IsNull(vVal) THEN GOTO _BAD

    CASE "Color"

      IF NOT IsNull(vVal) THEN
        vVal = Val(vVal)
        IF IsNull(vVal) THEN GOTO _BAD
      ENDIF

    CASE "s", "Font", "Picture", "Constant", "List", "Path"

    CASE ELSE

      RETURN FALSE

  END SELECT

  IF $bMany THEN

    FOR EACH hCtrl IN $hForm.Selection
      IF hCtrl.SetProperty($sLast, vVal) THEN GOTO _BAD
    NEXT

  ELSE

    IF $hObject.SetProperty($sLast, vVal) THEN GOTO _BAD

  ENDIF

  $sOldVal = $hEditor.Text

  RETURN

_BAD:

  sMsg = ("Incorrect property value.")

_CANCEL:

  CancelProperty
  $hEditor.SetFocus
  IF sMsg THEN Message.Warning(sMsg)
  RETURN TRUE

END


PRIVATE SUB HideProperty()

  IF $bIgnoreHide THEN RETURN

  IF $sLast THEN

    IF SaveProperty() THEN RETURN

    cmbProperty.Visible = FALSE
    txtProperty.Visible = FALSE
    btnProperty.Visible = FALSE

    $sLast = ""
    $iLast = -1
    $hEditor = NULL

  ENDIF

END


PRIVATE SUB MoveProperty()

  DIM iW AS Integer

  IF IsNull($hEditor) THEN RETURN

  WITH grdProperty[grdProperty.Row, 1]

    iW = .Width - 2
    IF $bButton THEN iW = iW - (.Height - 2)

    $hEditor.Move(grdProperty.X + .X + 2, grdProperty.Y + .Y + 2, iW, .Height - 2)
    $hEditor.Raise

  END WITH

  IF $bButton THEN
    btnProperty.Resize(txtProperty.Height, txtProperty.Height)
    btnProperty.Move(txtProperty.X + txtProperty.Width, txtProperty.Y)
    btnProperty.Raise
  ENDIF

END


PRIVATE SUB CancelProperty()

  IF IsNull($hEditor) THEN RETURN

  $sOldVal = grdProperty[grdProperty.Row, 1].Text
  IF $hEditor.Text <> $sOldVal THEN
    $hEditor.Text = $sOldVal
  ENDIF

END


PRIVATE SUB ShowProperty()

  DIM hProp AS CPropertyInfo
  DIM sType AS String
  DIM bButton AS Boolean
  DIM sProp AS String
  DIM sConst AS String

  IF Project.Running THEN RETURN

  IF grdProperty.Row = 0 THEN RETURN

  IF grdProperty.Row = 1 THEN

    IF $hObject.Name = $hForm.Name THEN RETURN
    IF $bMany THEN RETURN

    sProp = "Name"
    sType = "Name"

  ELSE IF grdProperty.Row = 2 THEN

    IF $hObject.Name = $hForm.Name THEN RETURN

    sProp = CPropertyInfo.EVENT_NAME
    sType = "Group"

  ELSE

    sProp = grdProperty[grdProperty.Row, 0].Text
    'hProp = CControl.Properties[$hObject.Kind][sProp]
    hProp = CComponent.Classes[$hObject.Kind].GetProperties()[sProp]
    sType = hProp.Type

  ENDIF

  IF $sLast THEN HideProperty

  $sLast = sProp
  $sType = sType

  $hEditor = txtProperty
  txtProperty.ReadOnly = FALSE

  SELECT CASE $sType

    CASE "i", "f", "d", "v", "Name", "Group" ', "EventName"

    CASE "s"
      bButton = TRUE

    CASE "List"
      bButton = TRUE
      txtProperty.ReadOnly = TRUE

    CASE "Constant"

      IF hProp.ConstantClass THEN

        $hEditor = cmbProperty
        cmbProperty.ReadOnly = TRUE
        cmbProperty.Clear

        FOR EACH sConst IN hProp.ConstantList
          cmbProperty.Add(sConst)
        NEXT

        'cmbProperty.Sort

      ENDIF

    CASE "b"

      $hEditor = cmbProperty
      cmbProperty.ReadOnly = TRUE
      cmbProperty.Clear
      cmbProperty.Add("False")
      cmbProperty.Add("True")

    CASE "Color"
      bButton = TRUE

    CASE "Font", "Picture", "Path"
      bButton = TRUE
      txtProperty.ReadOnly = TRUE

    CASE ELSE

  END SELECT

  CancelProperty

  '$hEditor.Border = Border.None

  $bButton = bButton

  MoveProperty

  $hEditor.Visible = TRUE
  btnProperty.Visible = bButton

  $hEditor.SetFocus

  IF $hEditor = txtProperty THEN
    'IF NOT txtProperty.ReadOnly THEN
      txtProperty.Selection
    'ENDIF
  ENDIF

END


PUBLIC SUB cmbProperty_Activate()

  SaveProperty

END


PUBLIC SUB cmbProperty_Click()

  SaveProperty

END


PUBLIC SUB txtProperty_Activate()

  SaveProperty

END


PUBLIC SUB txtProperty_Change()

  IF $sLast = "Text" THEN
    $bFreeze = TRUE
    SaveProperty
    $bFreeze = FALSE
  ENDIF

END


PUBLIC SUB txtProperty_KeyPress()

  IF txtProperty.ReadOnly THEN
    IF $sType = "Font" OR $sType = "Picture" OR $sType = "List" OR $sType = "Path" THEN
      IF Key.Code = Key.Delete OR Key.Code = Key.Backspace THEN

        txtProperty.Text = ""
        SaveProperty

      ENDIF
    ENDIF
  ENDIF

END


PRIVATE FUNCTION GetFont() AS String

  DIM sFont AS String
  DIM bDefault AS Boolean

  sFont = Dialog.Font.ToString()

  bDefault = Instr(sFont, Application.Font.Name) = 1

  IF bDefault THEN
    sFont = Replace(sFont, Application.Font.Name, "")
    sFont = Replace(sFont, CStr(Application.Font.Size), "")
    WHILE Left$(sFont) = ","
      sFont = Mid$(sFont, 2)
    WEND
  ENDIF

  RETURN sFont

END



PUBLIC SUB btnProperty_Click()

  DIM sDir AS String
  DIM sVal AS String
  DIM sSrc AS String
  DIM sDest AS String

  $bIgnoreHide = TRUE

  SELECT $sType

    CASE "s"
      IF FText.Run($sOldVal) THEN GOTO _EXIT
      $hEditor.Text = FText.Value

    CASE "List"
      IF FList.Run($sOldVal) THEN GOTO _EXIT
      $hEditor.Text = FList.Value

    CASE "Font"

      IF $sOldVal THEN
        Dialog.Font = Font[$sOldVal]
      ELSE
        Dialog.Font = $hForm.Font
      ENDIF

      IF Dialog.SelectFont() THEN GOTO _EXIT

      $hEditor.Text = GetFont()

    CASE "Color"
      IF $sOldVal THEN
        Dialog.Color = Val($sOldVal)
      ELSE
        Dialog.Color = 0
      ENDIF
      IF Dialog.SelectColor() THEN GOTO _EXIT
      $hEditor.Text = "&H" & Hex$(Dialog.Color, 6) & "&"

    CASE "Picture"

      sDest = FGetIcon.Run($sOldVal) 'GetPicture()
      IF NOT sDest THEN GOTO _EXIT
      $hEditor.Text = sDest

    CASE "Path"
      Dialog.Path = $sOldVal
      IF Dialog.OpenFile() THEN GOTO _EXIT
      $hEditor.Text = Dialog.Path

  END SELECT

  SaveProperty

_EXIT:

  $bIgnoreHide = FALSE

END


PUBLIC SUB grdProperty_DblClick()

  IF cmbProperty.Visible THEN
    IF cmbProperty.ReadOnly THEN
      cmbProperty.Index = (cmbProperty.Index + 1) MOD cmbProperty.Count
    ENDIF
  ELSE IF btnProperty.Visible THEN
    btnProperty_Click
  ENDIF

END


PRIVATE FUNCTION GetProperty(sProp AS String) AS String

  DIM sVal AS String
  DIM hCtrl AS CControl
  DIM bFirst AS Boolean

  IF NOT $bMany THEN RETURN $hObject.GetPropertyString(sProp)

  FOR EACH hCtrl IN $hForm.Selection

    IF bFirst THEN
      IF sVal <> hCtrl.GetPropertyString(sProp) THEN
        RETURN ""
      ENDIF
    ELSE
      sVal = hCtrl.GetPropertyString(sProp)
      bFirst = TRUE
    ENDIF

  NEXT

  RETURN sVal

END


' PUBLIC SUB grdProperty_MouseDown(X AS Integer, Y AS Integer, Button AS Integer)
'
'   grdProperty.Raise
'
' END
'
'
PUBLIC SUB grdProperty_MouseUp()

  ShowProperty

END


PUBLIC SUB grdProperty_Scroll()

  MoveProperty

END

PUBLIC SUB txtProperty_LostFocus()

  SaveProperty

END

PUBLIC SUB ReadConfig()

  grdProperty.Font.Size = If(Settings["/UseSmallFont", FALSE], 8, 10)
  txtProperty.Font = grdProperty.Font
  cmbProperty.Font = grdProperty.Font
  MoveProperty

END