ftable.class

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

' Gambas class file

PUBLIC Connection AS CConnection
PUBLIC Table AS String

PRIVATE $hConn AS CConnection
PRIVATE $sTable AS String
PRIVATE $bCreate AS Boolean
PRIVATE $sName AS String
PRIVATE $sType AS String

PRIVATE $aField AS NEW Object[]
PRIVATE $cFieldName AS Collection
PRIVATE $aIndexField AS NEW Object[]

PRIVATE $hFieldEditor AS CTableViewEditor
PRIVATE $hIndexEditor AS CTableViewEditor

PRIVATE $bModify AS Boolean
PRIVATE $bReadOnly AS Boolean

PRIVATE frmData AS FData

STATIC PRIVATE $hNullValue AS Object ' Used for representing the NULL value in a Collection

STATIC PUBLIC SUB _init()

  $hNullValue = NEW Integer[]

END


PUBLIC SUB _new(hConn AS CConnection, sTable AS String, OPTIONAL bReadOnly AS Boolean)

  $cFieldName = NEW Collection(gb.Text)

  $hConn = hConn
  $sTable = sTable
  $sName = sTable
  $bCreate = hConn.Tables.Find($sTable) < 0
  $bReadOnly = bReadOnly
  $sType = hConn.Handle.Tables[$sTable].Type

  Connection = hConn
  Table = sTable

  WITH tbvField

    .Columns.Count = 5

    WITH tbvField.Columns[0]
      .Text = " "
      .Width = 24
    END WITH

    WITH tbvField.Columns[1]
      .Text = ("Name")
      .Width = 160
    END WITH

    WITH tbvField.Columns[2]
      .Text = ("Type")
      .Width = 96
    END WITH

    WITH tbvField.Columns[3]
      .Text = ("Length")
      .Width = 80
    END WITH

    WITH tbvField.Columns[4]
      .Text = ("Default value")
      .Width = 160
    END WITH

  END WITH

  WITH tbvIndex

    .Columns.Count = 3

    WITH tbvIndex.Columns[0]
      .Text = ("Index")
      .Width = 160
    END WITH

    WITH tbvIndex.Columns[1]
      .Text = ("Unique")
      .Width = 64
    END WITH

    WITH tbvIndex.Columns[2]
      .Text = ("Field")
      .Width = 160
    END WITH

  END WITH

  IF NOT $bReadOnly THEN

    tabTable.Index = 0
    $hFieldEditor = NEW CTableViewEditor(tbvField) AS "tbvField"
    tabTable.Index = 1
    $hIndexEditor = NEW CTableViewEditor(tbvIndex) AS "tbvIndex"

  ENDIF

  tabTable.Index = 0

  RefreshTitle

  ReadTable

  'FMain.MoveRandom(ME)

END

PRIVATE FUNCTION IsModified() AS Boolean

  DIM bModify AS Boolean

  bModify = $bModify
  IF frmData THEN bModify = bModify OR frmData.IsModified()

  RETURN bModify

END


PUBLIC SUB RefreshTitle()

  DIM sTitle AS String

  sTitle = $hConn.Server.Name & " - " & $hConn.Name & " - " & $sName
  IF IsModified() THEN sTitle = sTitle & " [" & ("modified") & "]"

  lblTitle.Text = sTitle

END

PUBLIC SUB Modify(OPTIONAL bModify AS Boolean = TRUE)

  $bModify = bModify
  RefreshTitle

END


PRIVATE SUB ReadTable()

  DIM hTable AS Table
  DIM hField AS Field
  DIM hIndex AS Index
  DIM hCField AS CField
  DIM hCIndexField AS CIndexField
  DIM sField AS String
  DIM bCreate AS Boolean

  IF NOT $bReadOnly THEN
    $hFieldEditor.Hide
    $hIndexEditor.Hide
  ENDIF

  $aField.Clear
  $cFieldName.Clear
  $aIndexField.Clear

  hTable = $hConn.Handle.Tables[$sTable]

  FOR EACH hField IN hTable.Fields
    hCField = NEW CField(hField)
    $aField.Add(hCField)
    $cFieldName[hField.Name] = TRUE
  NEXT

  FOR EACH hIndex IN hTable.Indexes

    IF hIndex.Primary THEN CONTINUE

    hCIndexField = NEW CIndexField(hIndex)
    $aIndexField.Add(hCIndexField)
    bCreate = FALSE

    FOR EACH sField IN Split(hIndex.Fields)
      IF bCreate THEN
        hCIndexField = NEW CIndexField
        $aIndexField.Add(hCIndexField)
      ELSE
        bCreate = TRUE
      ENDIF
      hCIndexField.Field = sField
    NEXT

  NEXT

  tbvField.Rows.Count = $aField.Count
  'tbvField.Columns.Width = -1
  tbvField.MoveTo(0, 1)

  tbvIndex.Rows.Count = $aIndexField.Count

  $bModify = FALSE
  RefreshTitle

END


PRIVATE SUB WriteTableDef(sName AS String, sType AS String, aPrimaryKey AS String[], OPTIONAL bKill AS Boolean)

  DIM hTable AS Table
  DIM hCField AS CField
  DIM hCIndex AS CIndexField
  DIM hLastCIndex AS CIndexField
  DIM sError AS String

  TRY $hConn.Handle.Tables.Remove(sName)
  hTable = $hConn.Handle.Tables.Add(sName, sType)

  WITH hTable

    FOR EACH hCField IN $aField
      .Fields.Add(hCField.Name, hCField.Type, hCField.Length, hCField.DefaultValue)
    NEXT

    .PrimaryKey = aPrimaryKey
    .Update

  END WITH

  FOR EACH hCIndex IN $aIndexField
    IF hCIndex.Index THEN
      hCIndex.List = hCIndex.Field
      hLastCIndex = hCIndex
    ELSE
      hLastCIndex.List = hLastCIndex.List & "," & hCIndex.Field
    ENDIF
  NEXT

  FOR EACH hCIndex IN $aIndexField
    IF NOT hCIndex.Index THEN CONTINUE
    hTable.Indexes.Add(LCase(hCIndex.Index), hCIndex.List, hCIndex.Unique)
  NEXT

FINALLY

  sError = Replace(Error.Text, sName, $sName)
  IF bKill THEN
    TRY $hConn.Handle.Tables.Remove(sName)
  ENDIF

CATCH

  Error.Raise(sError)

END



PRIVATE FUNCTION WriteTable() AS Boolean

  DIM aPrimaryKey AS NEW String[]
  DIM hCField AS CField
  DIM sTemp AS String
  DIM rTemp AS Result
  DIM rTable AS Result
  DIM hForm AS Object
  DIM sType AS String
  DIM sError AS String

  IF $hFieldEditor.Hide() THEN RETURN TRUE
  IF $hIndexEditor.Hide() THEN RETURN TRUE

  FOR EACH hCField IN $aField
    IF hCField.Key THEN
      aPrimaryKey.Add(hCField.Name)
    ENDIF
  NEXT

  IF aPrimaryKey.Count = 0 THEN
    Message.Warning(("You must define a primary key."))
    RETURN TRUE
  ENDIF

  IF frmData THEN
    IF frmData.IsModified() THEN frmData.btnSaveData_Click
    frmData.Delete
    frmData = NULL
  ENDIF

'   FOR EACH hForm IN FMain.Container.Children
'     IF Object.Type(hForm) = "FData" THEN
'       IF hForm.Table = Table THEN
'         IF hForm.Close() THEN RETURN TRUE
'         BREAK
'       ENDIF
'     ENDIF
'   NEXT

  INC Application.Busy

  IF $hConn.CountTableData($sTable) THEN
    sTemp = $hConn.CopyTableData($sTable)
  ENDIF

  sType = $hConn.Handle.Tables[$sTable].Type

  WriteTableDef($hConn.GetTempTableName(), sType, aPrimaryKey, TRUE)
  WriteTableDef($sName, sType, aPrimaryKey)

  'hTable = $hConn.Handle.Tables.Add($sName, sType)

  IF sTemp THEN

    $hConn.Handle.Begin

    rTemp = $hConn.Handle.Find(sTemp)
    rTable = $hConn.Handle.Create($sName)

    FOR EACH rTemp

      FOR EACH hCField IN $aField
        IF hCField.OldName THEN
          TRY rTable[hCField.Name] = rTemp[hCField.OldName]
          'IF Error THEN PRINT hField.OldName; "->"; hField.OldName; ": "; Error.Text
        ENDIF
      NEXT

      TRY rTable.Update
      'IF Error THEN PRINT "Update: "; Error.Text

    NEXT

    $hConn.Handle.Commit

  ENDIF

  'IF frmData THEN
  '  frmData.btnRefresh_Click
  'ENDIF
  tabTable_Click

  Modify(FALSE)

FINALLY

  sError = Error.Text

  IF sTemp THEN
    TRY $hConn.Handle.Tables.Remove(sTemp)
    'IF Error THEN PRINT "Delete temporary table: "; Error.Text
  ENDIF

  IF $sTable <> $sName THEN
    TRY Connection.RefreshTree
    $sTable = $sName
    Table = $sName
  ENDIF

  DEC Application.Busy

CATCH

  Message.Error(("Cannot write table.") & "\n\n" & sError)
  RETURN TRUE

END


PRIVATE FUNCTION FindField(sField AS String) AS CField

  DIM hCField AS CField

  FOR EACH hCField IN $aField
    IF hCField.Name = sField THEN RETURN hCField
  NEXT

END


PUBLIC SUB Form_Delete()

  IF NOT $bReadOnly THEN
    $hFieldEditor.Close
    $hIndexEditor.Close
  ENDIF

  'Connection = NULL
  '$hConn = NULL

END


PUBLIC SUB Form_Resize()

  'DIM iIcon AS Integer

  tbvField.Resize(tabTable.ClientW, tabTable.ClientH - tbvField.Y)
  tbvIndex.Resize(tabTable.ClientW, tabTable.ClientH - tbvIndex.Y)
  IF frmData THEN frmData.Move(0, 0, tabTable.ClientW, tabTable.ClientH)

  IF NOT $bReadOnly THEN
    $hFieldEditor.Resize
    $hIndexEditor.Resize
  ENDIF

END

PUBLIC SUB tbvField_Data(Row AS Integer, Column AS Integer)

  DIM hCField AS CField

  TRY hCField = $aField[Row]
  IF NOT hCField THEN RETURN

  WITH tbvField.Data

    SELECT CASE Column

      CASE 0
        IF hCField.Key THEN
          .Picture = Picture["img/16/key.png"]
          .Alignment = Align.Center
        ENDIF

      CASE 1
        .Text = hCField.Name

      CASE 2
        .Text = TypeToString(hCField.Type)

      CASE 3
        IF hCField.Type = gb.String THEN
          IF hCField.Length THEN
            .Text = hCField.Length
          ELSE
            .Text = ("unlimited")
          ENDIF
        ENDIF

      CASE 4
        .Text = Str(hCField.DefaultValue)

    END SELECT

  END WITH

END


PRIVATE FUNCTION TypeToString(iType AS Integer) AS String

  SELECT CASE iType
    CASE gb.Integer
      RETURN ("Integer")
    CASE gb.Float
      RETURN ("Float")
    CASE gb.Date
      RETURN ("Date")
    CASE gb.Boolean
      RETURN ("Boolean")
    CASE gb.String
      RETURN ("String")
    DEFAULT
      RETURN "?"
  END SELECT

END

PRIVATE FUNCTION TypeFromString(sType AS String) AS Integer

  SELECT CASE sType
    CASE ("Integer")
      RETURN gb.Integer
    CASE ("Float")
      RETURN gb.Float
    CASE ("Date")
      RETURN gb.Date
    CASE ("Boolean")
      RETURN gb.Boolean
    CASE ("String")
      RETURN gb.String
    DEFAULT
      RETURN gb.Integer
  END SELECT

END

PUBLIC SUB tbvField_Click()

  DIM hField AS CField

  IF $bReadOnly THEN RETURN

  IF tbvField.Column = 0 THEN
    hField = $aField[tbvField.Row]
    hField.Key = NOT hField.Key
    tbvField.Current.Refresh
    Modify
  ENDIF

END

PUBLIC SUB tbvField_Change()

  DIM hField AS CField

  IF $bReadOnly THEN RETURN

  hField = $aField[tbvField.Row]

  WITH $hFieldEditor

    SELECT CASE tbvField.Column

      CASE 0
        .Hide

      CASE 1
        .ShowTextBox(TRUE, TRUE)

      CASE 2
        .ShowComboBox(("Boolean") & "\n" & ("Integer") & "\n" & ("Float") & "\n" & ("String") & "\n" & ("Date"), TRUE, TRUE)

      CASE 3
        IF hField.Type = gb.String THEN
          .ShowComboBox(("unlimited"))
        ELSE
          .Hide
        ENDIF

      CASE 4
        IF hField.Type = gb.Boolean THEN
          .ShowComboBox("True\nFalse") ' Non traduisible !
        ELSE
          .ShowTextBox()
        ENDIF

    END SELECT

  END WITH

END


PRIVATE SUB RenameField(hField AS CField, sNewName AS String)

  DIM hCIndex AS CIndexField

  FOR EACH hCIndex IN $aIndexField
    IF UCase(hCIndex.Field) = UCase(hField.Name) THEN
      hCIndex.Field = sNewName
    ENDIF
  NEXT

  $cFieldName[hField.Name] = NULL
  hField.Name = sNewName
  $cFieldName[sNewName] = TRUE

END



PUBLIC FUNCTION tbvField_Save(Row AS Integer, Column AS Integer, sData AS String) AS Boolean

  DIM hField AS CField
  DIM iVal AS Integer
  DIM vVal AS Variant

  hField = $aField[Row]

  SELECT Column

    CASE 1
      IF $cFieldName.Exist(sData) THEN
        Message.Warning(("This name already exists."))
        RETURN TRUE
      ENDIF

      IF UCase(hField.Name) <> UCase(sData) THEN
        RenameField(hField, sData)
      ENDIF

    CASE 2

      'PRINT sData; " -> "; TypeFromString(sData)
      hField.Type = TypeFromString(sData)
      hField.DefaultValue = NULL
      hField.Length = 0

      tbvField[Row, 3].Refresh