EVOLUTION-MANAGER
Edit File: ShowInfoDialog.xba
<?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() = GetShowInfoPropeties() 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 GetShowInfoPropeties() 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 GetShowInfoPropeties = 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>