Keskustelu: Koodit: LibreOffice Writer/Basic projekti - simppeli ObjectBrowser

' Module1
REM ***** BASIC *****
REM Lisenssi: DWYFW (tee mitä v***** ikinä haluat)

Option Explicit

Private  g_Object As Object
Private  oDlg As Object
Private  oDlgModel As Object
Private dpLstBox As Object
Private  dmLstBox As Object
Private  oProperties As Variant
Private  oMethods As Variant
Private  oDocProperties As Variant
Private  oDocMethods As Variant
Private winW As Long
Private winH As Long
Private winX As Long
Private winY As Long
Private oWindow As Object
Private oLabel As Object
Private oFocusListener As Object
Private IsGained As Boolean

' ==============================
' ENTRY POINT
' ==============================
Sub BasicObjectInspector()

    g_Object = GetAnyObject()
    If IsNull(g_Object) Then Exit Sub
    oDocProperties = Split(DumpProperties(g_Object), Chr(10))
    oDocMethods = Split(DumpMethods(g_Object), " ; ")
    PropertyInspector
    MethodInspector
    Dim i As Integer

    ShowInspectorDialog(g_Object)

End Sub

Sub PropertyInspector()

    Dim frms As Variant, i As Integer
    frms = ThisComponent.DrawPage.Forms
    Dim frm As Object, frmControl As Object

    For i = 0 To frms.getCount - 1
        frm = frms.getByIndex(i)
        frmControl = frm.getByIndex(0)
        oProperties = Split(DumpProperties(frmControl), Chr(10))
    Next i

End Sub

Sub MethodInspector()

    Dim oController As Object : oController = ThisComponent.getCurrentController()

    Dim frms As Object : frms = ThisComponent.DrawPage.Forms
    Dim frm As Object, frmModel As Object, oControlView As Object
    Dim i As Integer

    For i = 0 To frms.getCount - 1
        frm = frms.getByIndex(i)
        If frm.getCount > 0 Then
            frmModel = frm.getByIndex(0)
            oControlView = oController.getControl(frmModel)
            oMethods = Split(DumpMethods(oControlView), " ; ")
        End If
    Next i

End Sub

Function DumpProperties(oObject) As String

    Dim lst As String
    Dim oSI As Object : oSI = oObject
    Dim props, p, val, i As Integer

    props = oSI.getPropertySetInfo().getProperties()

    For i = LBound(props) To UBound(props)
        p = props(i)

        lst = lst & p.Name

        On Error Resume Next
        val = oSI.getPropertyValue(p.Name)

        If IsObject(val) Then
            val = "[Object]"
        ElseIf IsArray(val) Then
            val = "[Array]"
        End If
        If CStr(val) <> "" Then
            lst = lst & "=" & val
        End If

        If (p.Attributes AND 8) <> 0 Then
            lst = lst & " [ReaOnly]"
        End If

        If i < UBound(props) Then
            lst = lst & Chr(10)
        End If

        If Err <> 0 Then Err.Clear
    Next i

    DumpProperties = lst

End Function

Function DumpMethods(oObject) As String
    DumpMethods = oObject.dbg_methods
End Function

' ==============================
' OBJECT SOURCE
' ==============================
Function GetAnyObject() As Object
    GetAnyObject = ThisComponent
End Function


' ==============================
' DIALOG
' ==============================
Sub ShowInspectorDialog(oObj As Object)

    Dim oController As Object
    Dim oFrame As Object
    Dim aPosSize As Object
    oController = thisComponent.CurrentController
    oFrame = oController.Frame
    oWindow = oFrame.ContainerWindow
    oWindow.IsMaximized = True
    aPosSize = oWindow.PosSize
    winW = aPosSize.Width
    winH = aPosSize.Height
    winX = aPosSize.X
    winY = aPosSize.Y
    aPosSize = Nothing
    oFrame = Nothing
    'oWindow = Nothing
    oController = Nothing

    oDlgModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
    oDlgModel.Width = 470
    oDlgModel.Height = 260
    oDlgModel.Title = "UNO Object Inspector"

    ' --------------------------
    ' INFO
    ' --------------------------
    Dim oInfo As Object
    oInfo = oDlgModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    oInfo.Name = "Info"
    oInfo.PositionX = 10
    oInfo.PositionY = 5
    oInfo.Width = 320
    oInfo.Multiline = True
    oInfo.Height = 20
    oDlgModel.insertByName("Info", oInfo)

    Dim oPropLabel As Object
    oPropLabel = oDlgModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    oPropLabel.Name = "pheader"
    oPropLabel.PositionX = 10
    oPropLabel.PositionY = 27
    oPropLabel.Width = 100
    oPropLabel.VerticalAlign = 2
    oPropLabel.Height = 12
    oPropLabel.Label = "----  DOCUMENT PROPERTIES ----"
    oDlgModel.insertByName("pheader", oPropLabel)

     Dim MethLabel As Object
    MethLabel = oDlgModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    MethLabel.Name = "mheader"
    MethLabel.PositionX = 180
    MethLabel.PositionY = 27
    MethLabel.Width = 100
    MethLabel.VerticalAlign = 2
    MethLabel.Height = 12
    MethLabel.Label = "----  DOCUMENT METHODS  ----"
    oDlgModel.insertByName("mheader", MethLabel)

    ' --------------------------
    ' PROPERTIES
    ' --------------------------
    dpLstBox = oDlgModel.createInstance("com.sun.star.awt.UnoControlListBoxModel")
    dpLstBox.Name = "dpLstBox"
    dpLstBox.PositionX = 10
    dpLstBox.PositionY = 40
    dpLstBox.Width = 160
    dpLstBox.Height = 90
    oDlgModel.insertByName("dpLstBox",  dpLstBox)

    ' --------------------------
    ' METHODS + FORMS
    ' --------------------------
    Dim dmLstBox As Object
    dmLstBox  = oDlgModel.createInstance("com.sun.star.awt.UnoControlListBoxModel")
    dmLstBox.Name = "dmLstBox"
    dmLstBox.PositionX = 180
    dmLstBox.PositionY = 40
    dmLstBox.Width = 280
    dmLstBox.Height = 90
    oDlgModel.insertByName("dmLstBox", dmLstBox )

    Dim pLstBox As Object
    pLstBox  = oDlgModel.createInstance("com.sun.star.awt.UnoControlListBoxModel")
    pLstBox.Name = "pLstBox"
    pLstBox.PositionX = 10
    pLstBox.PositionY = 160
    pLstBox.Width = 160
    pLstBox.Height = 90
    oDlgModel.insertByName("pLstBox", pLstBox)

    Dim mLstBox As Object
    mLstBox  = oDlgModel.createInstance("com.sun.star.awt.UnoControlListBoxModel")
    mLstBox.Name = "mLstBox"
    mLstBox.PositionX = 180
    mLstBox.PositionY = 160
    mLstBox.Width = 280
    mLstBox.Height = 90
    oDlgModel.insertByName("mLstBox", mLstBox)

    Dim oPropFrmLabel As Object
    oPropFrmLabel =             oDlgModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    oPropFrmLabel.Name = "pfrmheader"
    oPropFrmLabel.PositionX = 10
    oPropFrmLabel.PositionY = 148
    oPropFrmLabel.Width = 150
    oPropFrmLabel.VerticalAlign = 2
    oPropFrmLabel.Height = 12
    oPropFrmLabel.Label = "----  DOCUMENT FORMS OBJECT PROPERTIES ----"
    oDlgModel.insertByName("pfrmheader", oPropFrmLabel)

     Dim MethFrmLabel As Object
    MethFrmLabel = oDlgModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
    MethFrmLabel.Name = "mfrmheader"
    MethFrmLabel.PositionX = 180
    MethFrmLabel.PositionY = 148
    MethFrmLabel.Width = 150
    MethFrmLabel.VerticalAlign = 2
    MethFrmLabel.Height = 12
    MethFrmLabel.Label = "----  DOCUMENT FORMS OBJECT METHODS  ----"
    oDlgModel.insertByName("mfrmheader", MethFrmLabel)

     oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
    oDlg.setModel(oDlgModel)

    Dim oLabelModel As Object
    oLabelModel = createUnoService("com.sun.star.awt.UnoControlFixedTextModel")
    oLabelModel.setPropertyValues( _
    Array("Height", "Width", "PositionX", "PositionY"), _
    Array(1, 1, 299, 179))
    oDlgModel.insertByName("Label1", oLabelModel)
    oLabel = oDlg.getControl("Label1")
    oLabel.Model.Enabled = True
    oLabel.Model.Border = 0
    oFocusListener = CreateUnoListener("FocusListener_","com.sun.star.awt.XFocusListener")
    oLabel.addFocusListener(oFocusListener)
    IsGained = False


    ' ==============================
    ' FILL DATA
    ' ==============================
    FillObjectInfo oDlg, oObj
    FillPropertiesSafe
    FillMethodsSafe
    FillFormsSafe oDlg, oObj
    Dim oList As Object

    oList = oDlg.getControl("pLstBox")

    Dim i As Integer
    For i = Lbound(oProperties) To Ubound(oProperties)
        oList.addItem(oProperties(i), i)
    Next i

    Dim oList2 As Object
    oList2 = oDlg.getControl("mLstBox")

    For i = Lbound(oMethods) To Ubound(oMethods)
        oList2.addItem(oMethods(i), i)
    Next i

    ' ==============================
    ' EVENTS
    ' ==============================
    Dim oL1 As Object
    oL1 = CreateUnoListener("pLstBox_", "com.sun.star.awt.XItemListener")
    oDlg.getControl("pLstBox").addItemListener(oL1)

    oDlg.setVisible(true)
    oLabel.setFocus
    oDlg.execute()

    thisComponent.unlockControllers
    thisComponent.setModified(False)
    oWindow.IsMaximized = True
    thisComponent.close(True)

    oDlg.Dispose

End Sub

' ==============================
' INFO
' ==============================
Sub FillObjectInfo(oDlg As Object, oObj As Object)

    Dim s As String

    On Error Resume Next

    s = "Impl: " & oObj.ImplementationName

    If HasUnoInterfaces(oObj, "com.sun.star.lang.XServiceInfo") Then
        Dim si As Object
        si = oObj
        Dim services
        services = si.getSupportedServiceNames()
        s = s & " | Services: " & Join(services, ",")
    End If

    oDlg.getControl("Info").Text = s

End Sub


' ==============================
' PROPERTIES (SAFE)
' ==============================
Sub FillPropertiesSafe()

    Dim oList As Object
    oList = oDlg.getControl("dpLstBox")
    oList.removeItems(0, oList.getItemCount())
    Dim i As Integer

    For i = Lbound(oDocProperties) To Ubound(oDocProperties) -1
        oList.addItem(oDocProperties(i), i)
    Next i

    Exit Sub

End Sub


' ==============================
' METHODS + FORMS (SAFE)
' ==============================
Sub FillMethodsSafe()


    Dim oList As Object
    oList = oDlg.getControl("dmLstBox")
    oList.removeItems(0, oList.getItemCount())

    Dim i As Integer

    For i = LBound(oDocMethods) To UBound(oDocMethods)
        oList.addItem(oDocMethods(i), i)
    Next i

End Sub


' ==============================
' FORMS (ONLY IF EXISTS)
' ==============================
Sub FillFormsSafe(oDlg As Object, oObj As Object)

    On Error Resume Next

    If Not HasUnoInterfaces(oObj, "com.sun.star.form.XFormsSupplier") Then Exit Sub

    Dim oForms As Object
    oForms = oObj.DrawPage.Forms
    If IsNull(oForms) Then Exit Sub

    Dim oList As Object
    oList = oDlg.getControl("mLstBox")

    Dim i As Integer, j As Integer

    For i = 0 To oForms.getCount() - 1

        Dim oForm As Object
        oForm = oForms.getByIndex(i)

        oList.addItem("Form: " & SafeName(oForm), i + 100)

        For j = 0 To oForm.getCount() - 1

            Dim oCtrl As Object
            oCtrl = oForm.getByIndex(j)

            oList.addItem("  Ctrl: " & SafeName(oCtrl), i * 1000 + j)

        Next j

    Next i

End Sub


' ==============================
' SAFE NAME
' ==============================
Function SafeName(oObj As Object) As String

    On Error Resume Next

    SafeName = ""

    If Not IsNull(oObj) Then
        SafeName = oObj.Name
        If SafeName = "" Then SafeName = oObj.ImplementationName
    End If

End Function


' ==============================
' PROPERTY EVENT
' ==============================
Sub pLstBox_itemStateChanged(oEvent)
End Sub

Sub pLstBox_disposing : End Sub

Sub FocusListener_focusGained(oEvent)

    If Not IsGained Then

        IsGained = True
        oDlgModel.PositionX  = CLng(winW / 12.5)
        oDlgModel.PositionY  = CLng(winH / 12.5)
        thisComponent.lockControllers

        Dim oController As Object
        Dim oFrame As Object
        Dim oPosSize As Object
        oController = thisComponent.CurrentController
        oFrame = oController.Frame
        oWindow = oFrame.ContainerWindow
        oPosSize = oWindow.PosSize
        oWindow.IsMaximized = False

        oWindow.setPosSize(1000000,1000000, 0, 0, com.sun.star.awt.PosSize.POSSIZE)

    End If

End Sub

Sub FocusListener_focusLost : End Sub
Sub FocusListener_disposing : End Sub
REM NO WARRANTY 😎