fpropertyproject.class

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

' Gambas class file

STATIC PRIVATE $bShowUsed AS Boolean
STATIC PRIVATE $bShowBeta AS Boolean

PRIVATE $cCheckBox AS NEW Collection
PRIVATE $bCheck AS Boolean

PRIVATE $hCheck AS Picture
PRIVATE $hUncheck AS Picture

PRIVATE $sLibName AS String

'PRIVATE $hProcess AS Process
PRIVATE $sTemp AS String
PRIVATE $sIcon AS String

PRIVATE $bCanInitLibrary AS Boolean
'PRIVATE $bLibModify AS Boolean


STATIC PUBLIC FUNCTION Run() AS Boolean

  RETURN FPropertyProject.ShowModal()

END


' PRIVATE SUB AddOption(sId AS String, sName AS String)
'
'   DIM hPict AS Picture
'
'   hPict = Picture["img/32/gambas.png"]
'   TRY hPict = Picture["img/32" &/ sId & ".png"]
'
'   lvwProject.Add(sId, " " & sName, hPict)
'
' END


PUBLIC SUB _new()

  DIM sClass AS String
  DIM sLib AS String
  DIM sLang AS String


  ME.Title = ("Project properties") & " - " & Project.Name

  'txtInfo.Background = txtInfo.Parent.Background
  'txtInfo.Text = ("Please wait...")
  'StartInfo
  lblName.Text = UCase(Left$(Project.Name)) & Mid$(Project.Name, 2)
  lblPath.Text = File.Dir(Project.Dir)

  WITH Project

    txtTitle.Text = .Title
    txtDesc.Text = .Description
    lstArgument.List = .Arguments
    chkDebug.Value = .KeepDebugInfo
    chkCtrlPublic.Value = .ControlPublic
    txtMajor.Text = CStr(.MajorVersion)
    txtMinor.Text = CStr(.MinorVersion)
    txtRelease.Text = CStr(.ReleaseVersion)
    chkSnap.Value = .SnapToGrid
    chkShowGrid.Value = .ShowGrid
    txtGrid.Value = .Snap
    'txtGridY.Text = CStr(.SnapY)
    chkLocalize.Value = .Localize
    $sIcon = .Icon
    IF $sIcon AND Exist(Project.Dir &/ $sIcon) THEN
      btnIcon.Picture = Picture[Project.Dir &/ $sIcon].Image.Stretch(48, 48).Picture
    ENDIF
    btnIcon.ToolTip = .Icon
    txtTabSize.Value = .TabSize

  END WITH

  UpdateArgument

  $hCheck = Picture["img/16/checked.png"]
  $hUncheck = Picture["img/16/unchecked.png"]

  WITH clvLibrary

    .Columns.Count = 3
    .Columns[0].Width = 24
    .Columns[1].Text = ("Component")
    .Columns[1].Width = 136
    .Columns[2].Text = ("Description")

  END WITH

  'IF $bShowUsed THEN
  chkShowUsed.Value = $bShowUsed
  chkShowBeta.Value = $bShowBeta
  $bCanInitLibrary = TRUE
  InitLibrary

  clvLibrary["gb"].Selected = TRUE

  IF Exist(File.Dir(Project.Path) &/ ".lang") THEN
    cvwTranslation.Columns.Count = 1
    FOR EACH sLang IN Dir(File.Dir(Project.Path) &/ ".lang", "*.po")
      cvwTranslation.Add(File.BaseName(sLang), Language.ToName(File.BaseName(sLang)))
    NEXT
  ENDIF

  btnApply.Enabled = NOT Project.ReadOnly
  btnOK.Enabled = NOT Project.ReadOnly

END


PUBLIC SUB btnCancel_Click()

  ME.Close(TRUE)

END


PRIVATE FUNCTION TestVersion(hCtrl AS TextBox) AS Boolean

  DIM vVal AS Variant

  vVal = Val(hCtrl.Text)
  IF IsInteger(vVal) THEN
    IF vVal >= 0 AND vVal <= 9999 THEN
      RETURN
    ENDIF
  ENDIF

  Message.Warning(("Bad version number"))
  hCtrl.SetFocus
  RETURN TRUE

END


PRIVATE FUNCTION DoApply() AS Boolean

  DIM bCheck AS Boolean
  DIM vVal AS Variant
  DIM bRefreshForm AS Boolean
  DIM bRefreshEditor AS Boolean
  DIM hFile AS Object

  IF TestVersion(txtMajor) THEN RETURN
  IF TestVersion(txtMinor) THEN RETURN
  IF TestVersion(txtRelease) THEN RETURN

'   IF chkSnap.Value THEN
'
'     vVal = Val(txtGrid.Text)
'     IF NOT IsInteger(vVal) THEN vVal = 0
'     IF vVal < 2 OR vVal > 64 THEN
'       txtGrid.SetFocus
'       GOTO BAD_GRID
'     ENDIF
'
'   ENDIF

  WITH Project

    .Title = Trim(txtTitle.Text)
    .Description = Trim(txtDesc.Text)
    .Icon = $sIcon
    .Arguments = lstArgument.List
    .KeepDebugInfo = chkDebug.Value

    IF .ControlPublic <> chkCtrlPublic.Value THEN
      Project.ResetScan
      Project.DeleteCompiledFiles
    ENDIF

    .ControlPublic = chkCtrlPublic.Value
    .MajorVersion = Val(txtMajor.Text)
    .MinorVersion = Val(txtMinor.Text)
    .ReleaseVersion = Val(txtRelease.Text)
    .SnapToGrid = chkSnap.Value

    IF chkShowGrid.Value <> .ShowGrid OR .Snap <> txtGrid.Value THEN
      bRefreshForm = TRUE
    ENDIF

    .ShowGrid = chkShowGrid.Value
    .Snap = txtGrid.Value
    .Localize = chkLocalize.Value

    IF .TabSize <> txtTabSize.Value THEN
      bRefreshEditor = TRUE
    ENDIF

    .TabSize = txtTabSize.Value

  END WITH

  SaveLibrary

  Project.WriteProject

  IF bRefreshForm THEN Project.RefreshForm
  IF bRefreshEditor THEN Project.RefreshEditor

  RETURN

BAD_GRID:

  Message.Error(("Snapping value is incorrect."))
  RETURN TRUE

END


PUBLIC SUB btnOK_Click()

  IF DoApply() THEN RETURN
  ME.close

END


PRIVATE SUB SaveLibrary()

  DIM sLib AS String
  DIM bCheck AS Boolean
  DIM hComp AS CComponent

  Project.Libraries.Clear

  FOR EACH hComp IN CComponent.All

    sLib = CComponent.All.Key
    bCheck = FALSE

    TRY bCheck = (clvLibrary[sLib].Picture = $hCheck)

    IF bCheck THEN
      IF sLib <> "gb" THEN Project.Libraries.Add(sLib)
    ENDIF

  NEXT

  Project.Libraries.Sort

  Project.RefreshLibrary

END


' PRIVATE FUNCTION CountChr(sStr AS String, sChr AS String) AS Integer
'
'   DIM iPos AS Integer
'   DIM iCpt AS Integer
'
'   DO
'
'     iPos = Instr(sStr, sChr, iPos + 1)
'     IF iPos = 0 THEN RETURN iCpt
'
'     iCpt = iCpt + 1
'
'   LOOP
'
' END


PRIVATE SUB InitLibrary()

  DIM sLib AS String
  DIM hComp AS CComponent
  DIM aRemove AS NEW String[]

  IF NOT $bCanInitLibrary THEN RETURN

  clvLibrary.Clear

  FOR EACH hComp IN CComponent.All

    sLib = CComponent.All.Key

    'IF NOT $bShowBeta THEN
    '  IF hComp.Alpha THEN CONTINUE
    'ENDIF

    clvLibrary.Add(sLib, "", $hUncheck)

    clvLibrary[sLib][1] = sLib
    clvLibrary[sLib][2] = hComp.Name

  NEXT

  FOR EACH sLib IN Project.Libraries
    TRY clvLibrary[sLib].Picture = $hCheck
  NEXT
  clvLibrary["gb"].Picture = $hCheck

  IF $bShowUsed THEN

    WITH clvLibrary
      .MoveFirst

      WHILE .Available
        sLib = .Item.Key

        IF clvLibrary[sLib].Picture = $hUncheck THEN
          aRemove.Add(sLib)
        ENDIF

        .MoveNext
      WEND

    END WITH

  ENDIF

  FOR EACH sLib IN aRemove
    clvLibrary.Remove(sLib)
  NEXT

  'svwLibrary.ClientHeight = Max(svwLibrary.Height - 4, iY)

  'clvLibrary.Resizable = FALSE
  clvLibrary.Columns.Sort = 1

  $bCheck = TRUE

END


PRIVATE SUB CheckComponent(sKey AS String, bCheck AS Boolean)

  DIM hComp AS CComponent
  DIM sComp AS String

  WITH clvLibrary

    .MoveTo(sKey)

    IF NOT .Available THEN RETURN

    IF bCheck THEN

      .Item.Picture = $hCheck

      FOR EACH sComp IN CComponent.All[sKey].Exclude
        CheckComponent(sComp, FALSE)
      NEXT

      FOR EACH sComp IN CComponent.All[sKey].Require
        CheckComponent(sComp, TRUE)
      NEXT

    ELSE

      .Item.Picture = $hUncheck

      FOR EACH hComp IN CComponent.All
        IF hComp.Require.Find(sKey) < 0 THEN CONTINUE
        CheckComponent(hComp.Key, FALSE)
      NEXT

    ENDIF

  END WITH

END


PUBLIC SUB clvLibrary_ColumnClick(Column AS Integer)

  IF Column THEN RETURN

  WITH clvLibrary

    IF .Item.Key = "gb" THEN RETURN

    IF .Item.Picture = $hCheck THEN

      'IF CControl.IsRefLibrary(.Item.Key) THEN
      '  Message.Warning(("This component is in use."))
      '  RETURN
      'ENDIF

      CheckComponent(.Item.Key, FALSE)

    ELSE

      CheckComponent(.Item.Key, TRUE)

    ENDIF

  END WITH

  '$bLibModify = TRUE

END

PUBLIC SUB chkShowUsed_Click()

  $bShowUsed = chkShowUsed.Value
  InitLibrary

END

PUBLIC SUB clvLibrary_Activate()

  clvLibrary_ColumnClick(0)

END


PUBLIC SUB chkSnap_Click()

  txtGrid.Enabled = chkSnap.Value

END



PUBLIC SUB btnApply_Click()

  DoApply

END


PRIVATE SUB FillLibrary(sLib AS String)

  DIM sText AS String

  WITH CComponent.All[sLib]

    sText = "<h2>" & sLib & "</h2>" & .Name & "<p>"

    IF .Alpha THEN
      sText = sText & "<table bgcolor=#43C7FF cellspacing=0 cellpadding=2><tr><td><img src=\"img/32/warning.png\"></td><td>"  & ("WARNING! This component is in BETA version.") & " " &
        ("It is under development and may change without notice.") & "</td></tr></table><br>"
    ELSE
      'sText = sText & "<p>"
    ENDIF

    sText = sText & "<b>" & ("Authors:") & "</b> " & .Authors.Join(", ")

    IF .Controls THEN
      IF .Controls.Count THEN
        sText = sText & "<p><b>" & ("Controls:") & "</b> " & .Controls.Join(", ")
      ENDIF
    ENDIF

    txtComponent.Text = sText

  END WITH

END

PUBLIC SUB clvLibrary_Select()

  FillLibrary(clvLibrary.Key)
  'lblLibrary.Visible = TRUE
  'clvLibrary.Height = 200
  'clvLibrary.Current.EnsureVisible

END


PUBLIC SUB chkLocalize_Click()

  cvwTranslation.Enabled = chkLocalize.Value

END

PUBLIC SUB btnIcon_Click()

  DIM sIcon AS String

  sIcon = FGetIcon.Run($sIcon)
  IF NOT sIcon THEN RETURN

  $sIcon = sIcon
  TRY btnIcon.Picture = Picture[Project.Dir &/ $sIcon].Image.Stretch(48, 48).Picture

END

PUBLIC SUB btnAddArg_Click()

  DIM sArg AS String

  IF lstArgument.Index >= 0 THEN
    IF NOT txtArgument.Text THEN RETURN
  ENDIF

  'IF lstArgument.Index < 0 THEN
    lstArgument.Add("")
    lstArgument.Index = lstArgument.Count - 1
  'ELSE
  '  lstArgument.Add("", lstArgument.Index)
  '  lstArgument.Index = lstArgument.Index - 1
  'ENDIF

  UpdateArgument

END

PUBLIC SUB btnRemoveArg_Click()

  IF lstArgument.Index >= 0 THEN
    txtArgument.Text = ""
    lstArgument.Remove(lstArgument.Index)
  ENDIF

  UpdateArgument

END

PUBLIC SUB txtArgument_Change()

  IF lstArgument.Index < 0 THEN RETURN
  lstArgument[lstArgument.Index].Text = txtArgument.Text

END

PUBLIC SUB lstArgument_Select()

  IF lstArgument.Index >= 0 THEN
    Object.Lock(txtArgument)
    txtArgument.Text = lstArgument[lstArgument.Index].Text
    Object.Unlock(txtArgument)
  ENDIF
  UpdateArgument

  IF txtArgument.Enabled THEN
    txtArgument.Select
    txtArgument.SetFocus
  ENDIF

END

PRIVATE SUB UpdateArgument()

  txtArgument.Enabled = lstArgument.Index >= 0

END

PUBLIC SUB btnUpArg_Click()

  DIM iInd AS Integer
  DIM sItem AS String

  Object.Lock(lstArgument)

  WITH lstArgument

    iInd = .Index
    IF iInd > 0 THEN
      sItem = lstArgument[iInd].Text
      .Add(sItem, iInd - 1)
      .Remove(iInd + 1)
      .Index = iInd - 1
    ENDIF

  END WITH

  Object.Unlock(lstArgument)

END

PUBLIC SUB btnDownArg_Click()

  DIM iInd AS Integer
  DIM sItem AS String

  Object.Lock(lstArgument)

  WITH lstArgument

    iInd = .Index
    IF iInd >=0 AND iInd < (.Count - 1) THEN
      sItem = lstArgument[iInd].Text
      .Remove(iInd)
      .Add(sItem, iInd + 1)
      .Index = iInd + 1
    ENDIF

  END WITH

  Object.Unlock(lstArgument)

END

PUBLIC SUB btnDeleteAllArg_Click()

  lstArgument.Clear
  txtArgument.Text = ""
  UpdateArgument

END

PUBLIC SUB txtArgument_LostFocus()

  IF NOT txtArgument.Text THEN btnRemoveArg_Click

END

PUBLIC SUB chkShowBeta_Click()

  $bShowBeta = chkShowBeta.Value
  InitLibrary

END