Quelle  ShowInfoDialog.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *
 * This file incorporates work covered by the following license notice:
 *
 *   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 .
-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ShowInfoDialog" script:language="StarBasic">REM  *****  BASIC  *****
Dim oWnd As Object
Dim oWnd2 As Object
Dim oWnd3 As Object
Dim oDoc as Object
    
Sub ShowInfoMain
 prop() = GetShowInfoProperties()
 Init(prop(0).Value, prop(1).Value, prop(2).Value, prop(3).Value, prop(4).Value, prop(5).Value, prop(6).Value, prop(7).Value, prop(8).Value)  
End Sub

Sub Init(tFieldText As String, windowX, windowY, windowWidth, windowHeight, tFieldX, tFieldY, tFieldWidth, tFieldHeight)
 toolkit = createUnoService("com.sun.star.awt.Toolkit")
    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 = 0
    
    'officeX = StarDesktop.ActiveFrame.getContainerWindow().AccessibleContext.LocationOnScreen.X
 'officeY = StarDesktop.ActiveFrame.getContainerWindow().AccessibleContext.LocationOnScreen.Y
 'officeWidth  = StarDesktop.ActiveFrame.getContainerWindow().getPosSize().Width
 'officeHeight = StarDesktop.ActiveFrame.getContainerWindow().getPosSize().Height
 officeWidth  = thisComponent.CurrentController.Frame.getContainerWindow().getPosSize().Width
 officeHeight = thisComponent.CurrentController.Frame.getContainerWindow().getPosSize().Height

 'dialogWidth  = myTutoShowDialog.getPosSize().Width
 'dialogHeight = myTutoShowDialog.getPosSize().Height
 X = officeWidth - windowWidth - windowX
 Y = officeHeight - windowHeight - windowY
    
    oBounds.X = X : oBounds.Y = Y
    oBounds.Width = windowWidth : oBounds.Height = windowHeight
    oWndDescr.Bounds = oBounds
    oWndDescr.Parent = thisComponent.CurrentController.Frame.ContainerWindow
    with com.sun.star.awt.WindowAttribute
        oWndDescr.WindowAttributes = .CLOSEABLE AND .MOVEABLE AND .SIZEABLE AND .BORDER AND .SHOW
    end with
           
    oWnd = toolkit.createWindow(oWndDescr) 

 Dim oWndDescr3 As new com.sun.star.awt.WindowDescriptor
    Dim oBounds3 As new com.sun.star.awt.Rectangle
 oWndDescr3.Type = com.sun.star.awt.WindowClass.TOP
    oWndDescr3.WindowServiceName = "fixedimage" '"fixedtext"
    oWndDescr3.ParentIndex = 0
    oBounds3.X = 0 : oBounds3.Y = 0
    oBounds3.Width = tFieldWidth : oBounds3.Height = tFieldHeight
    oWndDescr3.Bounds = oBounds3
    oWndDescr3.Parent = oWnd
    with com.sun.star.awt.WindowAttribute
        oWndDescr3.WindowAttributes = .CLOSEABLE AND .MOVEABLE AND .SIZEABLE AND .BORDER AND .SHOW
    end with

    oWnd3= toolkit.createWindow(oWndDescr3)    
    'oWnd2.Text = tFieldText  
 'printdbgInfo(oWnd3)
 setImage(oWnd3)
 'oWnd3.Background = 16777215 
' oWnd2.SetBackGround(16776960)
 oWnd.SetBackGround(16776960)
' oWnd.FontDescriptors(0).Name = "Albany"
' oWnd.FontDescriptors(0).StyleName = "BOLD" 

 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 = "fixedtext"
    oWndDescr2.ParentIndex = 0
    oBounds2.X = tFieldX : oBounds2.Y = tFieldY
    oBounds2.Width = tFieldWidth : oBounds2.Height = tFieldHeight
    oWndDescr2.Bounds = oBounds2
    oWndDescr2.Parent = oWnd3
    with com.sun.star.awt.WindowAttribute
        oWndDescr2.WindowAttributes = .CLOSEABLE AND .MOVEABLE AND .SIZEABLE AND .BORDER AND .SHOW
    end with

    oWnd2= toolkit.createWindow(oWndDescr2)
    oWnd2.Text = tFieldText 
    oWnd2.Background = 268435455
    'printdbgInfo(oWnd2)
    
    'printdbgInfo oWnd.getPosSize()
 
End Sub

Function GetShowInfoProperties()
 stepText = GetStepTitle()
 Dim Properties(8) As new com.sun.star.beans.NamedValue 
 Properties(0).Name = "ShowInfoDialogText"
 Properties(0).Value = stepText & "Press [Esc] to abort." 
 Properties(1).Name = "WindowX"
 Properties(1).Value = 20  
 Properties(2).Name = "WindowY"
 Properties(2).Value = 40  
 Properties(3).Name = "WindowWidth"
 Properties(3).Value = 190 
 Properties(4).Name = "WindowHeight"
 Properties(4).Value = 50
 Properties(5).Name = "TFieldX"
 Properties(5).Value = 7
 Properties(6).Name = "TFieldY"
 Properties(6).Value = 8
 Properties(7).Name = "TFieldWidth"
 Properties(7).Value = 190
 Properties(8).Name = "TFieldHeight"
 Properties(8).Value = 50
 GetShowInfoProperties = Properties()
End Function

Sub setShowInfoText()
 stepText = GetStepTitle()
 oWnd2.Text = stepText & "Press [Esc] to abort."
End Sub

Sub ShowON()
 setShowInfoText()
 oWnd.setVisible(True)
 oWnd3.setVisible(True) 
 oWnd2.setVisible(True)
End Sub

Sub ShowOFF()
 'On Local Error Goto NOPROPERTYSETINFO:
  oWnd.setVisible(False)
  oWnd2.setVisible(False)
  oWnd3.setVisible(False)
  'oDoc.dispose()
 Exit Sub
 'NOPROPERTYSETINFO:
End Sub

Sub DisposeIDialog()
    'On Local Error Goto NOPROPERTYSETINFO: 
  oWnd3.dispose
  oWnd2.dispose
  oWnd.dispose
  oDoc.dispose() 
 Exit Sub
 'NOPROPERTYSETINFO:
End Sub

sub setImage(whatever as Object) 
 
 templatePath = GetPathSettings("Template",false, 0)
 Dim bitmapPath As String
 iPos = InStr(templatePath,"/")
 if(iPos > 0) Then
  bitmapPath = templatePath & "../wizard/bitmap/tutorial_background.gif"
 Else
  bitmapPath = templatePath & "..\wizard\bitmap\tutorial_background.gif"
 End If
 
 dim props(0) as new com.sun.star.beans.PropertyValue
 props(0).Name = "Hidden"
 props(0).Value = true
    oDoc = StarDesktop.loadComponentFromUrl("private:factory/swriter","_blank",0,props())
    oShape = addControlToDefaultForm("ImageButton", 1000, 1000, 2000, 1000)    
    imgControl = oShape.getControl()
    'imgControl.ImageUrl="file:///D:/Program%20Files/src680_m11_qwizards1_49_TEST/share/gallery/tutoItem.gif"    
 imgControl.ImageUrl = bitmapPath  
    imgControl.addConsumer(whatever)
    imgControl.startProduction()
end sub

Function createControlShape(cKind As String) As Object

    Dim oControlShape As Object
    Dim oControl As Object

    
    oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    oControl = oDoc.createInstance("com.sun.star.form.component." & cKind)
    oControl.setPropertyValue("DefaultControl", "com.sun.star.form.control." & cKind)
    oControlShape.setControl(oControl)


    createControlShape() = oControlShape

End Function

Function createControlShapeWithDefaultControl(cKind As String) As Object

    Dim oControlShape As Object
    Dim oControl As Object

    
    oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    oControl = oDoc.createInstance("com.sun.star.form.component." & cKind)
    oControlShape.setControl(oControl)


    createControlShapeWithDefaultControl() = oControlShape

End Function

Function createUNOControlShape(cKind As String, defControl As String) As Object

    Dim oControlShape As Object
    Dim oControl As Object


    oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    oControl = oDoc.createInstance("com.sun.star.form.component." & cKind)
    oControl.setPropertyValue("DefaultControl", "com.sun.star.awt." & defControl)
    oControlShape.setControl(oControl)


    createUNOControlShape() = oControlShape

End Function

Function addShape(oShape As Object) As Boolean

 Dim vSize As New com.sun.star.awt.Size
 Dim oDrawPage As Object
 Dim oForms As Object
 Dim oForm As Object

    oDrawPage = oDoc.getDrawPage()
    oForms = oDrawPage.getForms()
    
    if oForms.Count = 0 then
        oForm = oDoc.createInstance("com.sun.star.form.component.Form")
        oForms.insertByIndex(0, oForm)
    end if
    
    vSize.Height = 2000 : vSize.Width = 2000
    oShape.Size = vSize
    oDrawPage.add(oShape)

    addShape() = true

End Function

sub addControl(cKind as String)

    Dim oDrawPage As Object
    Dim oForm As Object, oForms As Object
    Dim oControl As Object, oControlShape As Object
    Dim aSz As Variant
    Dim oText As Object

    oDrawPage = oDoc.DrawPage
    oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    oControl = oDoc.createInstance("com.sun.star.form.component." + cKind)
    oForm = oDoc.createInstance("com.sun.star.form.component.Form")
    oforms = oDrawPage.Forms
    if oforms.count = 0 then
            oforms.insertbyindex(0,oForm)
    end if
    oControlShape.Control = oControl
    oDrawPage.add(oControlShape)
        
End sub

Function addControlToDefaultForm(cKind as String, x As Integer, y As Integer, width As Integer, height As Integer) As Object

    Dim oDrawPage As Object
    Dim oControl As Object, oControlShape As Object
    Dim pos As New com.sun.star.awt.Point
    Dim size As New com.sun.star.awt.Size

 pos.X = x
 pos.Y = y
 size.Width = width
 size.Height = height
 
    oDrawPage = oDoc.DrawPage
    oControlShape = oDoc.createInstance("com.sun.star.drawing.ControlShape")
    oControl = oDoc.createInstance("com.sun.star.form.component." + cKind)
    oControlShape.Control = oControl
    oControlShape.Position = pos
    oControlShape.Size = size
    oDrawPage.add(oControlShape)

 addControlToDefaultForm() = oControlShape

End Function

Function addShapeToDrawDoc(oPage as Object, nPosX, nPosY as Integer, oType As String) As Object
    Dim aPoint As New com.sun.star.awt.Point
    Dim aSize As New com.sun.star.awt.Size
    Dim oShape As Object
    Dim servNames As Variant

    aPoint.x = nPosX
    aPoint.y = nPosY
    aSize.Width = 2000
    aSize.Height = 1000
    oShape = oDoc.createInstance("com.sun.star.drawing."+oType+"Shape")
    oShape.Size = aSize
    oShape.Position = aPoint
    
    if oShape.getPropertySetInfo().hasPropertyByName("FillColor") then
     oShape.FillColor = RGB(128, 255, 0)
    End If

    oPage.add(oShape)

    addShapeToDrawDoc() = oShape
End Function
</script:module>