AOO410/main/qadevOOo/tests/basic/ifc/awt/XToolkit/awt_XToolkit.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="awt_XToolkit" 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



Sub RunTest()

'*************************************************************************
' INTERFACE: 
' com.sun.star.awt.XToolkit
'*************************************************************************
On Error Goto ErrHndl
    Dim bOK As Boolean

    Test.StartMethod("getDesktopWindow()")
    bOK = true
    Dim oWindow As Object
    oWindow = oObj.getDesktopWindow()
    Out.Log("Desktop window is NULL : " &amp; isNULL(oWindow))
    ' Has "OK" status always, because Desktop component
    ' currently is not supported as visible.
    Test.MethodTested("getDesktopWindow()", bOK)

    Test.StartMethod("getWorkArea()")
    bOK = true
    Dim oRect As Object
    oRect = oObj.getWorkArea()
    Out.Log("WorkArea is NULL : " &amp; isNULL(oRect))
    if (NOT isNULL(oRect)) then
        Out.Log("Returned rectangle is: (" &amp; oRect.X &amp; ", " &amp; oRect.Y &amp; ", " &amp; oRect.Width &amp; ", " &amp; oRect.Height &amp; ")")
    end if
    Test.MethodTested("getWorkArea()", bOK)

    Test.StartMethod("createWindow()")
    bOK = true
    Dim oWndDescr As new com.sun.star.awt.WindowDescriptor
    Dim oBounds As new com.sun.star.awt.Rectangle
    oWndDescr.Type = com.sun.star.awt.WindowClass.TOP
    oWndDescr.WindowServiceName = ""
    oWndDescr.ParentIndex = -1
    oBounds.X = 10 : oBounds.Y = 20
    oBounds.Width = 110 : oBounds.Height = 120
    oWndDescr.Bounds = oBounds
    with com.sun.star.awt.WindowAttribute
        oWndDescr.WindowAttributes = .CLOSEABLE AND .MOVEABLE AND .SIZEABLE AND .BORDER AND .SHOW
    end with

    Dim oWnd As Object
    oWnd = oObj.createWindow(oWndDescr)
    Out.Log("Window is NULL : " &amp; isNULL(oWnd))
    bOK = bOK AND NOT isNULL(oWnd)
    if (bOK) then
        bOK = bOK AND hasUnoInterfaces(oWnd, "com.sun.star.awt.XWindowPeer")
        if (NOT bOK) then Out.Log("Returned object doesn't support XWindowPeer interface.")
    end if
    Test.MethodTested("createWindow()", bOK)

    Test.StartMethod("createWindows()")
    bOK = true
    Dim oWndDescrs(1) As Object
    Dim oWndDescr1 As new com.sun.star.awt.WindowDescriptor
    Dim oBounds1 As new com.sun.star.awt.Rectangle
    oWndDescr1.Type = com.sun.star.awt.WindowClass.TOP
    oWndDescr1.WindowServiceName = ""
    'oWndDescr1.Parent = 0
    oWndDescr1.ParentIndex = -1
    oBounds1.X = 10 : oBounds1.Y = 20
    oBounds1.Width = 110 : oBounds1.Height = 120
    oWndDescr1.Bounds = oBounds1
    with com.sun.star.awt.WindowAttribute
        oWndDescr1.WindowAttributes = .CLOSEABLE AND .MOVEABLE AND .SIZEABLE AND .BORDER AND .SHOW
    end with
    Dim oWndDescr2 As new com.sun.star.awt.WindowDescriptor
    Dim oBounds2 As new com.sun.star.awt.Rectangle
    oWndDescr2.Type = com.sun.star.awt.WindowClass.TOP
    oWndDescr2.WindowServiceName = ""
    'oWndDescr2.Parent = 0
    oWndDescr2.ParentIndex = -1
    oBounds2.X = 10 : oBounds2.Y = 20
    oBounds2.Width = 110 : oBounds2.Height = 120
    oWndDescr2.Bounds = oBounds2
    with com.sun.star.awt.WindowAttribute
        oWndDescr2.WindowAttributes = .CLOSEABLE AND .MOVEABLE AND .SIZEABLE AND .BORDER AND .SHOW
    end with

    oWndDescrs(0) = oWndDescr1
    oWndDescrs(1) = oWndDescr2

    Dim oWindows As Object

    oWindows = oObj.createWindows(oWndDescrs())
    bOK = bOK AND ubound(oWindows) = 1
    bOK = bOK AND hasUnoInterfaces(oWindows(0), "com.sun.star.awt.XWindowPeer")
    bOK = bOK AND hasUnoInterfaces(oWindows(1), "com.sun.star.awt.XWindowPeer")

    Test.MethodTested("createWindows()", bOK)

    Test.StartMethod("createScreenCompatibleDevice()")
    bOK = true
    Dim oDevice As Object
    oDevice = oObj.createScreenCompatibleDevice(123, 456)
    Out.Log("Device is NULL : " &amp; isNULL(oDevice))
    bOK = bOK AND NOT isNULL(oDevice)
    if (bOK) then
        bOK = bOK AND hasUnoInterfaces(oDevice, "com.sun.star.awt.XDevice")
        if (NOT bOK) then Out.Log("Returned object doesn't support XDevice interface.")
    end if
    Test.MethodTested("createScreenCompatibleDevice()", bOK)

    Test.StartMethod("createRegion()")
    bOK = true
    Dim oRegion As Object
    oRegion = oObj.createRegion()
    Out.Log("Region is NULL : " &amp; isNULL(oRegion))
    bOK = bOK AND NOT isNULL(oRegion)
    if (bOK) then
        bOK = bOK AND hasUnoInterfaces(oRegion, "com.sun.star.awt.XRegion")
        if (NOT bOK) then Out.Log("Returned object doesn't support XRegion interface.")
        if (bOK) then
            oRect = oRegion.getBounds
            Out.Log("Returned region's bounds are: (" &amp; oRect.X &amp; ", " &amp; oRect.Y &amp; ", " &amp; oRect.Width &amp; ", " &amp; oRect.Height &amp; ")")
        end if
    end if

    Test.MethodTested("createRegion()", bOK)

Exit Sub
ErrHndl:
    Test.Exception()
    bOK = false
    resume next
End Sub
</script:module>