69 - Planner Dialogo - DbaseForm

REM  *****  BASIC  *****


Option Explicit


Sub Main



End Sub


rem Il database su cui operare - globale perchè ci operano le funzioni
Dim oTabella          As Object
Dim iColumns          As Integer
Dim iRows           As Integer
Dim iCurRow           As Integer



Dim sFirstField         As String
Dim sSecondField        As String
Dim sLastField          As String
Dim sBLastField         As String



Dim oDialogDesc               As Object
Dim oDbaseDialog              As Object
Dim oDbaseDialogModel         As Object


Sub DbaseForm (RengeName as String)
  Dim iDialogResult    As Integer
  Dim oControl     As Object
  Dim oControlModel  As Object
  Dim iI         As Integer
  Dim sName      As String
  Dim oDimensioni    As Object
  Dim oCell      As Object



  rem Blocca visualizzazione e ricalcolo
  ThisComponent.LockControllers

  ThisComponent.enableAutomaticCalculation(False)


  oTabella = ThisComponent.NamedRanges.GetByName(RengeName).ReferredCells

  oDimensioni = oTabella.getRangeAddress()
  iRows = oDimensioni.EndRow - oDimensioni.StartRow
  iColumns = oDimensioni.EndColumn

  iCurRow = 1


  ' Get dialog description from the dialog library
  DialogLibraries.LoadLibrary("Standard")
  oDialogDesc                =  DialogLibraries.Standard.DatabaseForm



  ' create the dialog
  oDbaseDialog             =  CreateUnoDialog( oDialogDesc )
  oDbaseDialogModel        =  oDbaseDialog.Model

  

  oDbaseDialog.setTitle (RengeName)
  Rem Nasconde campi e label
  for iI = 1 to 5

    sName = "Label" & iI
    oControl       =  oDbaseDialog.getControl(sName)
    oControl.Visible = "false"

    sName = "TextField" & iI
    oControl       =  oDbaseDialog.getControl(sName)
    oControl.Visible = "false"

  next

  

  sFirstField = ""


  for iI = 0 to iColumns

    Rem Sistema la label
    oControl       =  oDbaseDialog.getControl("Label" & (iI + 1))
    oControl.Visible = "true"

    oControlModel  =  oControl.Model
    oCell = oTabella.getCellByPosition(iI,0)
    oControlModel.Label                =  oCell.getString()
    Rem Sistema il campo

    sName = "TextField" & (iI + 1)
    oControl       =  oDbaseDialog.getControl(sName)
    oControlModel  =  oControl.Model

    oControl.Visible = "true"
    oCell = oTabella.getCellByPosition(iI,1)
    if oCell.getType () = 3 then
      oControl.Enable="False"

      oControlModel.BackgroundColor = 15132390 ' Grigio 10%
    else

      oControl.Enable="True"
      sBLastField = sLastField

      sLastField = sName
      if sFirstField = "" then
        sFirstField = sName

        oControl.setFocus()
      else if sSecondField = "" then
          sSecondField = sName
        endif


      endif

      ' oLabelModel.BackgroundColor = 0 ' Non imposta il colore - lascia "trasparente"
    endif

    ' msgbox oCell.getType ()

  next

  

  CaricaRiga



  ' start the dialog
  iDialogResult              =  oDbaseDialog.Execute()
  


  SalvaRiga



  oDbaseDialog.Dispose()


  rem Ripristina visaulizzazione e ricalcolo
  ThisComponent.enableAutomaticCalculation(true)
  ThisComponent.CalculateAll()
  ThisComponent.UnlockControllers


end Sub


Sub Nuovo
  Dim iI         As Integer
  Dim oCell      As Object
  Dim oNextCell    As Object
  Dim bNotEmpty    As Boolean

  Dim dispatcher     As Object
  Dim Array ()
  Dim document     As Object
  

  SalvaRiga

  iCurRow = iRows

  Rem Controlla se la riga è vuota
  bNotEmpty = "False"
  for iI = 0 to iColumns

    oCell = oTabella.getCellByPosition(iI,iCurRow)
    if oCell.getType () <> 3 AND oCell.getString () <> "" then
      bNotEmpty = "True"

    endif

  next

  Rem Se l'ultima riga non è vuota, ne crea un'altra
  if bNotEmpty then
    Rem Aggiungo la riga
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    document   = ThisComponent.CurrentController.Frame

    Rem Seleziona le celle
    ThisComponent.CurrentController.Select(oTabella.getCellRangeByPosition(0,iRows,iColumns,iRows))
    Rem Copia le celle

    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
    Rem Insersce una riga
    oTabella.getRows().insertByIndex(iRows,1)
    Rem Riseleziona le celle

    ThisComponent.CurrentController.Select(oTabella.getCellRangeByPosition(0,iRows,iColumns,iRows))
    Rem Incolla le celle
    dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
    Rem aggiorna la riga corrente e il numero di righe

    iRows = iRows + 1
    iCurRow = iRows
    Rem ultima riga

    oCell = oTabella.getCellRangeByPosition(0,iRows,iColumns,iRows)
    Rem Cancella i valori
    oCell.clearContents (com.sun.star.sheet.CellFlags.VALUE + _

        com.sun.star.sheet.CellFlags.STRING + _
        com.sun.star.sheet.CellFlags.DATETIME)
  endif

  CaricaRiga

End Sub



Sub SalvaRiga
  Dim oField       As Object
  Dim iI         As Integer
  Dim oCell      As Object


  for iI = 0 to iColumns

    Rem Copia il contenuto della cella nel campo
    oField       =  oDbaseDialog.getControl("TextField" & (iI + 1))
    oCell = oTabella.getCellByPosition(iI,iCurRow)
    rem modifica solo le celle che non contengono formule

    if oCell.getType () <> 3 then
      Dim stringVal As String
      ' msgbox "Salvo il campo " {amp} iI {amp} " Che vale " {amp} 
      stringVal = formatField (oField.getText (), oCell.getType(), oCell.numberFormat)
      oCell.formula = stringVal

    endif

  next

End Sub


Sub Elimina
  Dim oCell      As Object
  Rem Se ha mano di tre righe (quindi solo titolo ed una riga) 

  Rem svuota la riga ma non la elimina
  if iRows < 3 then
    oCell = oTabella.getCellRangeByPosition(0,iRows,iColumns,iRows)
    Rem Cancella i valori

    oCell.clearContents (com.sun.star.sheet.CellFlags.VALUE + _
        com.sun.star.sheet.CellFlags.STRING + _
        com.sun.star.sheet.CellFlags.DATETIME)
  else


    oTabella.getRows().removeByIndex(iCurRow,1)
    iRows = iRows - 1

  endif

  if iCurRow > iRows then
    iCurRow = iRows
  endif


  CaricaRiga

End Sub


Sub SelField (oField As Object)
  Dim oSelection As New com.sun.star.awt.Selection 

  oField.setFocus()
  oSelection.Min = 0 
  oSelection.Max = Len( oField.getText () ) 

  oField.setSelection( oSelection ) 
End Sub


Rem Gestisce la prssione dei tasti per "CR", Tab e Shift Tab
Rem CR -{gt} KeyCode = 1280
Rem Tab -{gt} KeyCode = 1280 (Shift -{gt} Modifiers AND 1)
Sub FieldKey (oEvent As Object)
  Dim oControl     As Object



  if oEvent.KeyCode = 1282 then
    if (oEvent.Modifiers AND 1) = 1 then
      if oEvent.Source.Model.Name = sFirstField then
        Precedente


        SelField (oDbaseDialog.getControl(sLastField))
      endif

    else

      if oEvent.Source.Model.Name = sLastField then
        Successivo


        Rem Se sono in fondo, creo nuovo record
        if iCurRow = iRows then
          Nuovo

        endif


        SelField (oDbaseDialog.getControl(sFirstField))
      endif

    endif

  endif


End Sub


Sub Successivo
  SalvaRiga

  if iCurRow < iRows then
    iCurRow = iCurRow + 1

    CaricaRiga

  endif

End Sub


Sub Precedente
  SalvaRiga

  if iCurRow > 1 then
    iCurRow = iCurRow - 1

    CaricaRiga

  endif

End Sub


Function formatField (Content As String, cellType As Integer, cellFormat As Integer) as String
  Rem tipo=0 -{gt} vuota (com.sun.star.table.CellContentType.EMPTY)

  Rem tipo=1 -{gt} intero (com.sun.star.table.CellContentType.VALUE)
  Rem tipo=2 -{gt} stringa  (com.sun.star.table.CellContentType.TEXT)
  Rem tipo=3 -{gt} Formula  (com.sun.star.table.CellContentType.FORMULA)
  if (cellType = 1) then
    if (cellFormat <> 0) then
      Dim dParti(3)
      dParti = split (Content)
      ' msgbox "Data - valore '" {amp} dParti(0) {amp} " - " {amp} dParti(1) {amp} " - " {amp} dParti(2)

      if (left (dParti(1),3) = "gen") then
        dParti(1)="jan"

      endif

      if (left (dParti(1),3) = "feb") then
        dParti(1)="feb"

      endif

      if (left (dParti(1),3) = "mar") then
        dParti(1)="mar"

      endif

      if (left (dParti(1),3) = "apr") then
        dParti(1)="apr"

      endif

      if (left (dParti(1),3) = "mag") then
        dParti(1)="may"

      endif

      if (left (dParti(1),3) = "giu") then
        dParti(1)="jun"

      endif

      if (left (dParti(1),3) = "lug") then
        dParti(1)="jul"

      endif

      if (left (dParti(1),3) = "ago") then
        dParti(1)="aug"

      endif

      if (left (dParti(1),3) = "set") then
        dParti(1)="sep"

      endif

      if (left (dParti(1),3) = "ott") then
        dParti(1)="oct"

      endif

      if (left (dParti(1),3) = "nov") then
        dParti(1)="nov"

      endif

      if (left (dParti(1),3) = "dic") then
        dParti(1)="dec"

      endif

      Content=join (dParti)
    else

      Dim virPos       As Integer
      virPos = inStr(Content, ",")
      if (virPos > 0) then
        Content = left(Content, virPos-1) & "." & mid (Content, virPos+1)
      endif


    endif

  endif

  formatField=Content
End Function



Sub CaricaRiga
  Dim oField       As Object
  Dim iI         As Integer
  Dim oCell      As Object
  Dim oControl     As Object
  Dim oControlModel  As Object
  Dim stringVal    As String
  


  oControl       =  oDbaseDialog.getControl("Pannello")
  oControlModel  =  oControl.Model
  oControlModel.Label                =  "Riga corrente " & iCurRow & " di " & iRows



  for iI = 0 to iColumns
    Rem Copia il contenuto della cella nel campo
    oField       =  oDbaseDialog.getControl("TextField" & (iI + 1))
    oCell = oTabella.getCellByPosition(iI,iCurRow)
    stringVal = formatField (oCell.getString(), oCell.getType(), oCell.numberFormat)
    ' msgbox oPageStyles.Dbg_Methods ' Dbg_Properties ' Dbg_Methods

    ' msgbox oCell.Dbg_Methods
    ' msgbox oCell.Dbg_Properties
    ' msgbox oCell.numberFormat
    oField.setText (stringVal)
  next


End Sub

© Ing. Stefano Salvi - released under FDL licence