Keskustelu: Koodit: LibreOffice Basic - Labellit Taulukoksi

'Esimerkin ohjausobjektit
'Valintaikkuna (Dialog1)
'Otsikko: Tuplakikkaa mitä tahansa otsikkorivin solua tallentaaksesi tiedostoon
'Sido: Näppäin vapautettu -> DlgKeyUp

'5 label kontrollia (niemeä Header1, Header2, jne,)
'Leveys 50, korkeus 11, taustaväri tummempi harmaa
'tekstin tasaus keskelle, Sarkainkohta: Ei
'Aseta Labellit riviin perkkäin.
'Sido: Hiiren painiketta painettu -> HeaderMouseDown

'25 label kontrollia (Label1, Label2, jne.)
'Leveys 50, korkeus 11, tekstin tasaus oikealla
'Sarkainkohta: Ei

'Aseta otsikkorivin solujen alle viisi riviin
'joiden alle taas viisi riviin jne. (5 x 5 taulukko)
'Sido: Hiiren painiketta painettu -> LabelMouseDown
'Sido: Hiiren painike vapautettu -> LabelMouseUp

'1 Tekstiruutu (TextField1), leveys 48, korkeus 9
'Asetus: Ei käytössä, tekstin tasaus oikealla,
'Suurin tekstinpituus: 10, taustaväri valkoinen, Sarkainkohta: Kyllä
'Sido: Näppäin vapautettu -> EditBoxKeyUp

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

Private oDlg As Object
Private oEditBox As Object
Private LastActive As Object
Private index As Integer
Private dataUrl As String

Private oEditBoxOriginaX As Long
Private oEditBoxOriginaY As Long

Type CellInfoStruct
    X As Long
    Y As Long
    W As Long
    H As Long
    Row As Integer
    Col As Integer
    Value As String
    Control As Object
    'DataType As Variant
End Type

Private CellInfo() As CellInfoStruct

Sub ShowDialog

    DialogLibraries.LoadLibrary("Standard")
    oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
    oImg = oDlg.getControl("ImageControl1")
    oEditBox = oDlg.getControl("TextField1")
    CenterDialog
    Initialize
    oDlg.execute()
    oDlg.dispose()

End Sub

Sub CenterDialog

    Dim oSize As New com.sun.star.awt.Size, factor As Double
    Dim oCC, oComponentWindow, oTopWindowPosSize
    oCC = ThisComponent.getCurrentController()
    oComponentWindow = oCC.ComponentWindow
    oTopWindowPosSize = oComponentWindow.Toolkit.ActiveTopWindow.getPosSize()

    oSize.Width = oDlg.Model.Width
    oSize.Height = oDlg.Model.Height
    factor = oSize.Width / oDlg.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT).Width

    With oDlg.Model
        .PositionX = (factor * oTopWindowPosSize.Width - .Width) / 2
        .PositionY = (factor * oTopWindowPosSize.Height - .Height) / 2
    End With

End Sub

Sub Initialize

    Dim i As  Integer, lblcount As Integer
    Dim controls As Object
    controls = oDlg.getControls()
    lblcount = -1
    For i = 0 To Ubound(controls)
        If InStr(controls(i).Model.Name, "Label") > 0  Then
            lblcount = lblcount + 1
        End If
    Next i

    Redim CellInfo(lblcount)
    Dim CelInfoStr As String
    Dim ctl As Object, lastctl As Object, col As Integer, row As Integer
    col = 0 : row = 0
    lastctl = oDlg.getControl("Label1")

    For i = 0 To Ubound(CellInfo)
        ctl = oDlg.getControl("Label"  & CStr(i + 1))
        CellInfo(i).Control = ctl
        CellInfo(i).X = ctl.Model.PositionX
        CellInfo(i).Y = ctl.Model.PositionY
        CellInfo(i).W =ctl.Model.Width
        CellInfo(i).H = ctl.Model.Height
        If lastctl.Model.PositionX = ctl.Model.PositionX Then
            CellInfo(i).Col = col
        ElseIf lastctl.Model.PositionX < ctl.Model.PositionX Then
            col = col + 1
            CellInfo(i).Col = col
        End If
        If lastctl.Model.PositionY = ctl.Model.PositionY Then
            CellInfo(i).Row = row
        ElseIf lastctl.Model.PositionY <  ctl.Model.PositionY Then
            row = row + 1 : col = 0
            CellInfo(i).Row = row
        End If
        ctl.Model.Align = 2
        CellInfo(i).Control = ctl
        lastctl = ctl
        ctl = Nothing
        'If CellInfo(i).Col = 0 Then CellInfo(i).Control.Model.Align = 0 ' (0=Vasemmalla, 1=Keskellä, 2=Oikealla)
    Next i

    If Not IsNull(thisComponent.Url) Then
        dataUrl = Left(thisComponent.Url, InStrReverse(thisComponent.Url, "/")) & "CellValues.data"
        GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
        Set fso = CreateScriptService("FileSystem")

        If fso.FileExists(dataUrl) Then
            Dim inpFile As Object, fileData As String
            Set  inpFile= fso.OpenTextFile(dataUrl)
            fileData =  inpFile.ReadAll()
            inpFile.CloseFile()
            fileData = Replace(fileData, Chr(13) & Chr(10), "")
            Set inpFile = Nothing
            Set fso = Nothing
            If fileData <> "" Then
                Dim values() As String
                values = Split(fileData, ";")
                For i = Lbound(values ) To Ubound(values)
                    CellInfo(i).Value = values(i)
                    If IsNumeric(values(i)) Then
                        CellInfo(i).Control.Model.Align = 2
                    Else
                        CellInfo(i).Control.Model.Align = 0
                    End If
                    CellInfo(i).Control.Model.Label = values(i)
                Next i
                Erase values
            End If
        End If
    End If

    LastActive = oDlg.getControl("Label1") : Index = 0
    oEditBoxOriginaX = oEditBox.Model.PositionX
    oEditBoxOriginaY = oEditBox.Model.PositionY

End Sub

Sub LabelMouseUp(oEvent)

    If oEvent.Buttons = 1 Then
        If Not oEditBox.Model.Enabled Then oEditBox.Model.Enabled = True
        If Not oEditBox.hasFocus Then oEditBox.setFocus()
        oEditBox.Model.PositionX = oEvent.Source.Model.PositionX + 1
        oEditBox.Model.PositionY = oEvent.Source.Model.PositionY + 1
        oEvent.Source.Model.BackGroundColor = RGB(32, 32, 32)
        oEditBox.Model.Align = oEvent.Source.Model.Align
        oEditBox.Model.Text = oEvent.Source.getText()
        LastActive = oEvent.Source
        index = Cint(Replace(LastActive.Model.Name, "Label", "")) - 1
        SetTextSelection oEditBox
    End If

End Sub

Sub EditBoxKeyUp(oEvent)

    Dim i As Integer

    If oEvent.KeyCode = com.sun.star.awt.Key.RETURN Then
        LastActive.Model.Label = oEditBox.Model.Text
        CellInfo(index).Value = LastActive.Model.Label
        oEditBox.Model.Text = ""
        oEditBox.Model.PositionX = oEditBoxOriginaX
        oEditBox.Model.PositionY = oEditBoxOriginaY
        oEditBox.Model.Enabled = False
        LastActive.Model.BackGroundColor = RGB(255, 255, 255)
        oDlg.setFocus    : Exit Sub
    ElseIf oEvent.KeyCode = 1027 Then 'RightArrow
        index = index  + 1
        If index > Ubound(CellInfo) Then index  = 0
        LastActive.Model.BackGroundColor = RGB(255, 255, 255)
        CellInfo(index).Control.Model.BackGroundColor = RGB(32, 32, 32)
        oEditBox.Model.PositionX = CellInfo(index).Control.Model.PositionX + 1
        oEditBox.Model.PositionY = CellInfo(index).Control.Model.PositionY + 1
        oEditBox.Model.Text = CellInfo(index ).Value
        LastActive = CellInfo(index).Control
        oEditBox.Model.Text = LastActive.Model.Label
    ElseIf oEvent.KeyCode = 1026 Then 'LeftArrow
        index = index - 1
        If index < 0 Then index = Ubound(CellInfo)
        LastActive.Model.BackGroundColor = RGB(255, 255, 255)
        CellInfo(index).Control.Model.BackGroundColor = RGB(32, 32, 32)
        oEditBox.Model.PositionX = CellInfo(index).Control.Model.PositionX + 1
        oEditBox.Model.PositionY = CellInfo(index).Control.Model.PositionY + 1
        oEditBox.Model.Text = CellInfo(index).Value
        LastActive = CellInfo(index).Control
        oEditBox.Model.Text = LastActive.Model.Label
    ElseIf oEvent.KeyCode = 1024 Then 'UpArrow
        If CellInfo(index).Row < CellInfo(Ubound(CellInfo)).Row Then
            For i = 0 To Ubound(CellInfo)
                If CellInfo(i).Row > CellInfo(index).Row And CellInfo(i).Col = CellInfo(index).Col Then
                    index = i
                    LastActive.Model.BackGroundColor = RGB(255, 255,255)
                    oEditBox.Model.PositionX = CellInfo(index).Control.Model.PositionX + 1
                    oEditBox.Model.PositionY = CellInfo(index).Control.Model.PositionY + 1
                    LastActive.Model.BackGroundColor = RGB(255, 255,255)
                    LastActive = CellInfo(index).Control
                    oEditBox.Model.Text = LastActive.Model.Label 'CellInfo(index).Value
                    LastActive.Model.BackGroundColor = RGB(34, 34,34)
                    Exit For
                End If
            Next i
        End If
    ElseIf oEvent.KeyCode = 1025Then 'DownArrow
        If CellInfo(index).Row > 0 Then
            For i = 0 To Ubound(CellInfo)
                If CellInfo(i).Row = CellInfo(index).Row - 1 And CellInfo(i).Col = CellInfo(index).Col Then
                    index = i
                    LastActive.Model.BackGroundColor = RGB(255, 255,255)
                    oEditBox.Model.PositionX = CellInfo(index).Control.Model.PositionX + 1
                    oEditBox.Model.PositionY = CellInfo(index).Control.Model.PositionY + 1
                    LastActive.Model.BackGroundColor = RGB(255, 255,255)
                    LastActive = CellInfo(index).Control
                    oEditBox.Model.Text = CellInfo(index).Value
                    LastActive.Model.BackGroundColor = RGB(34, 34,34)
                    Exit For
                End If
            Next i
        End If
    End If

    SetTextSelection oEvent.Source

End Sub

Sub SetTextSelection(Source As Object)

    oView = Source.getView()
    Source.setFocus()
    oSelection = New com.sun.star.awt.Selection
    textLen = Len(Source.Model.Text)
    oSelection.Min = textLen
    oSelection.Max = Len(Source.Model.Text)
    oView.setSelection(oSelection)
    oSelection = Nothing

End Sub

Sub DlgKeyUp(oEvent) 'Focus oEditBoxille

    If oEvent.KeyCode = 1282 Then
        oEditBox.Model.Enabled = True
        oEditBox.setFocus
        CellInfo(0).Control.Model.BackGroundColor = RGB(32, 32, 32)
        oEditBox.Model.PositionX = CellInfo(0).Control.Model.PositionX + 1
        oEditBox.Model.PositionY = CellInfo(0).Control.Model.PositionY + 1
        oEditBox.Model.Enabled = True
        oEditBox.Model.Text = CellInfo(0).Value
        LastActive = CellInfo(0).Control
        index = 0
    End If

End Sub

Sub LabelMouseDown(oEvent)

    LastActive.Model.BackGroundColor = RGB(255, 255, 255)

End Sub

Sub HeaderMouseDown(oEvent)

    Dim sTitle As String
    sTitle = oDlg.Title

    If oEvent.ClickCount = 2  And oEvent.Buttons = 1 Then
        If dataUrl <> "" Then
            Dim i As Integer,  dataStr As String
            Open dataUrl For Output As #1
            For i = Lbound(CellInfo) To Ubound(CellInfo)
                dataStr = dataStr & CellInfo(i).Value
                If i <  Ubound(CellInfo) Then dataStr = dataStr & ";"
            Next i
            Print #1, dataStr : Close #1
        End If
        oDlg.Title = "Solujen arvot  tallennettu"
        Wait 1000
        oDlg.Title = sTitle
    End If

End Sub

Sub EditBoxTextChange
    If IsNumeric(oEditBox.Model.Text) Then
        oEditBox.Model.Align = 2
        LastActive.Model.Align = 2
    Else
        oEditBox.Model.Align = 0
        LastActive.Model.Align = 0
    End If
End Sub

Function InStrReverse(sText As String, search As String) As Long

    If sText = "" Or search = "" Or Len(search) > Len(sText) Then
        InStrReverse = 0
        Exit Function
    End If

    Dim i As Long

    For i = Len(sText) To 1 Step -1
        If Mid(sText, i, Len(search)) = search Then
            InStrReverse = i : Exit Function
        End If
    Next i

End Function