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
69 - Inseriamo le macro per la gestione del pannello - DbaseForm