AOO410/main/qadevOOo/tests/basic/mod/dbaccess/SbaXGridControl/dbaccess_SbaXGridControl.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="dbaccess_SbaXGridControl" script:language="StarBasic">


'*************************************************************************
'
'  Licensed to the Apache Software Foundation (ASF) under one
'  or more contributor license agreements.  See the NOTICE file
'  distributed with this work for additional information
'  regarding copyright ownership.  The ASF licenses this file
'  to you under the Apache License, Version 2.0 (the
'  "License"); you may not use this file except in compliance
'  with the License.  You may obtain a copy of the License at
'  
'    http://www.apache.org/licenses/LICENSE-2.0
'  
'  Unless required by applicable law or agreed to in writing,
'  software distributed under the License is distributed on an
'  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
'  KIND, either express or implied.  See the License for the
'  specific language governing permissions and limitations
'  under the License.
'
'*************************************************************************





' Be sure that all variables are dimensioned:
option explicit


' REQUIRED VARIABLES for interface/service tests:

' Required for view.XSelectionSupplier
Global SelectableObj1 as Variant
Global SelectableObj2 as Variant
    
' Required for awt.XControl
Global oModel As Object
Global oContext As Object
Global oWinpeer As Object
Global oToolkit As Object

' Required for awt.XWindow
Global oXWindow As Object
Global oCtrlShape As Variant

' Required for awt.XView
Global oGraphics As Object

' Required for frame.XDispatch
Global dispatchURL As String

' Required for XContainer
Global oElementToInsert As Object
Global oContainer As Object ' in case if the 
 ' component tested doesn't support XNameContainer

' Required for XComponent
Global oComponentInstance As Object 'it will be disposed

' Required for form.XUpdateBroadcaster
Global bCustomUpdate As Boolean


Sub CreateObj()

'*************************************************************************
' COMPONENT: 
' dbaccess.SbaXGridControl
'*************************************************************************
    Dim cntrlShape as Object, grid as Object
    Dim size as new com.sun.star.awt.Size
    Dim pos as new com.sun.star.awt.Point
    Dim drawPage as Object, aForm as Object
    Dim aColumn1 as Object, aColumn2 as Object
    Dim theAccess as Object
    Dim sel1(0) as Long, sel2(0) as Long
    Dim device as Object
    
On Error Goto ErrHndl

    oDoc = utils.createDocument("swriter", cObjectName)
    
    ' creating ControlShape with GridControl inside it
    cntrlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    grid = oDoc.createInstance("com.sun.star.form.component.GridControl")
    grid.DefaultControl = "com.sun.star.form.control.InteractionGridControl"
    pos.X = 15000
    pos.Y = 10000
    size.Width = 4500
    size.Height = 3000
    cntrlShape.setPosition(pos)
    cntrlShape.setSize(size)
    cntrlShape.setControl(grid)
    
    ' adding the shape with grid into the document
    drawPage = oDoc.getDrawPage()
    drawPage.add(cntrlShape)
    
    ' binding the form which contains a grid model to
    ' the Bibliography database
    aForm = drawPage.getForms().getByName("Standard")
    aForm.DataSourceName = "Bibliography"
    aForm.Command = "biblio"
    aForm.CommandType = com.sun.star.sdb.CommandType.TABLE
    
    ' creating and inserting some columns
    aColumn1 = grid.createColumn("TextField")
    aColumn1.DataField = "Identifier"
    aColumn1.Label = "Identifier"
    grid.insertByName("First", aColumn1)
    aColumn2 = grid.createColumn("TextField")
    aColumn2.DataField = "Address"
    aColumn2.Label = "Address"
    grid.insertByName("Second", aColumn2)
    
    ' Getting the controller of the Grid
    theAccess = oDoc.getCurrentController()
    oObj = theAccess.getControl(grid)

    ' setting variable for XSelectionSupplier
    sel1(0) = 2
    sel2(0) = 5
    SelectableObj1 = sel1()
    SelectableObj2 = sel2()

    ' setting variable for XControl
    oContext = oDoc
    oModel = grid
    oWinpeer = oObj.getPeer()
    oToolkit = oWinpeer.getToolkit()

    ' setting variable for XWindow
    oXWindow = theAccess.getControl(cntrlShape.getControl())
    oCtrlShape = cntrlShape

    ' setting variable for XView
    device = oToolkit.createScreenCompatibleDevice(200, 200)
    oGraphics = device.createGraphics()

    'setting variable for XDispatch
    dispatchURL = ".uno:FormSlots/moveToNext"
    
    'setting variables for XContainer
    oElementToInsert = grid.createColumn("TextField")
    oElementToInsert.DataField = "Author"
    oElementToInsert.Label = "Author"
    oContainer = grid

    'setting variable for XComponent
    cntrlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    grid = oDoc.createInstance("com.sun.star.form.component.GridControl")
    grid.DefaultControl = "com.sun.star.form.control.InteractionGridControl"
    cntrlShape.setControl(grid)
    drawPage.add(cntrlShape)


   'setting variable for XUpdateBroadcaster
    bCustomUpdate = True

    oComponentInstance = theAccess.getControl(grid)

    ' Switching to non-design mode
    switchDesignMode(oDoc)
    
    wait(200)

Exit Sub
ErrHndl:
    Test.Exception()
End Sub

Sub UpdateComponent()
    oObj.commit
End Sub

Sub switchDesignMode(xDoc as Object)
On Error Goto ErrHndl

        Dim frame as Variant, disp as Variant, transf as Object
        Dim URL as new com.sun.star.util.URL
        Dim noProps()
        Dim res as Boolean
        
        frame = xDoc.getCurrentController().getFrame()
        URL.Complete = ".uno:SwitchControlDesignMode"
        transf = createUnoService("com.sun.star.util.URLTransformer")
        res = transf.parseStrict(URL)
        
        out.log("URL parsed :" + res)
        
        disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF _
                OR com.sun.star.frame.FrameSearchFlag.CHILDREN)

        out.log("disp get.")

        disp.dispatch(URL, noProps())
Exit Sub
ErrHndl:
    Test.Exception()
End Sub

' for XBoundComponent
Sub prepareCommit()
    Out.Log("prepareCommit() called")
    Out.Log("can be checked only interactively")
End Sub

' for XBoundComponent
Function checkCommit() As Boolean
    checkCommit() = True
End Function
</script:module>