Näin viisarikellon saa näkymään Valintaikkunan kuvaobjektissa
Lisää projektiin Valintaikkuna (Dialog1) ja ikkunaan kuvaobjekti (ImageControl1) ja vaihada module1 koodin tilalle tämä:
REM ***** BASIC *****
Dim oHourHand As Object
Dim oMinuteHand As Object
Dim oSecondHand As Object
Dim bClockRunning As Boolean
Private oDlg As Object
Sub DrawClockFace()
ClearDrawDocument
Dim oDoc As Object, oPage As Object, oShape As Object, oIndex As Object
Dim i As Integer, m As Integer
Dim nRadians As Double
Dim nCenterpointX As Long, nCenterpointY As Long, nRadius As Long
oDoc = ThisComponent
oPage = oDoc.getDrawPages().getByIndex(0)
nCenterpointX = 10000 : nCenterpointY = 10000 : nRadius = 4000
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
oPage.add(oShape)
Dim oPos As New com.sun.star.awt.Point, oSize As New com.sun.star.awt.Size
oPos.X = nCenterpointX - nRadius : oPos.Y = nCenterpointY - nRadius
oSize.Width = nRadius * 2 : oSize.Height = nRadius * 2
oShape.setPosition(oPos) : oShape.setSize(oSize)
oShape.FillStyle = com.sun.star.drawing.FillStyle.NONE
oShape.LineColor = RGB(0, 0, 0) : oShape.LineWidth = 100
For m = 0 To 59
If (m Mod 5) <> 0 Then
nRadians = (m * 6 - 90) * (3.14159265 / 180)
Dim ptMOutside As New com.sun.star.awt.Point, ptMInside As New com.sun.star.awt.Point
ptMOutside.X = nCenterpointX + (nRadius * Cos(nRadians))
ptMOutside.Y = nCenterpointY + (nRadius * Sin(nRadians))
ptMInside.X = nCenterpointX + ((nRadius - 150) * Cos(nRadians))
ptMInside.Y = nCenterpointY + ((nRadius - 150) * Sin(nRadians))
oIndex = oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
oPage.add(oIndex)
Dim mPoints(1) As New com.sun.star.awt.Point
mPoints(0) = ptMOutside : mPoints(1) = ptMInside
oIndex.PolyPolygon = Array(mPoints)
oIndex.LineColor = RGB(0, 0, 0) : oIndex.LineWidth = 40
End If
Next m
For i = 1 To 12
nRadians = (i * 30 - 90) * (3.14159265 / 180)
Dim ptOutside As New com.sun.star.awt.Point, ptInside As New com.sun.star.awt.Point
ptOutside.X = nCenterpointX + (nRadius * Cos(nRadians))
ptOutside.Y = nCenterpointY + (nRadius * Sin(nRadians))
ptInside.X = nCenterpointX + ((nRadius - 400) * Cos(nRadians))
ptInside.Y = nCenterpointY + ((nRadius - 400) * Sin(nRadians))
oIndex = oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
oPage.add(oIndex)
Dim points(1) As New com.sun.star.awt.Point
points(0) = ptOutside : points(1) = ptInside
oIndex.PolyPolygon = Array(points)
oIndex.LineColor = RGB(0, 0, 0) : oIndex.LineWidth = 60
Dim oText As Object, ptText As New com.sun.star.awt.Point, oTextSize As New com.sun.star.awt.Size
oTextSize.Width = 1000 : oTextSize.Height = 600
ptText.X = (nCenterpointX + ((nRadius - 800) * Cos(nRadians))) - (oTextSize.Width / 2)
ptText.Y = (nCenterpointY + ((nRadius - 800) * Sin(nRadians))) - (oTextSize.Height / 2)
oText = oDoc.createInstance("com.sun.star.drawing.TextShape")
oPage.add(oText)
oText.setPosition(ptText) : oText.setSize(oTextSize)
oText.String = Trim(Str(i)) : oText.CharHeight = 12 : oText.CharFontName = "Arial"
oText.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
oText.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
Next i
CreateAllHands
StartClock
End Sub
Sub CreateAllHands()
oHourHand = CreateSingleHand(8000, 12000, 160, RGB(0, 0, 0))
oMinuteHand = CreateSingleHand(6800, 13200, 100, RGB(0, 0, 0))
oSecondHand = CreateSingleHand(6300, 13700, 40, RGB(255, 0, 0))
End Sub
Function CreateSingleHand(nYTop As Long, nYBottom As Long, nThickness As Long, lColor As Long) As Object
Dim oDoc As Object, oPage As Object, oHand As Object, oCounterweight As Object, oGroup As Object, oColl As Object
Dim ptStart As New com.sun.star.awt.Point, ptEnd1 As New com.sun.star.awt.Point, ptEnd2 As New com.sun.star.awt.Point
oDoc = ThisComponent : oPage = oDoc.getDrawPages().getByIndex(0)
ptStart.X = 10000 : ptStart.Y = 10000
ptEnd1.X = 10000 : ptEnd1.Y = nYTop
ptEnd2.X = 10000 : ptEnd2.Y = nYBottom
oHand = oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
oPage.add(oHand)
Dim p1(1) As New com.sun.star.awt.Point : p1(0) = ptStart : p1(1) = ptEnd1
oHand.PolyPolygon = Array(p1) : oHand.LineColor = lColor : oHand.LineWidth = nThickness
oCounterweight = oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
oPage.add(oCounterweight)
Dim p2(1) As New com.sun.star.awt.Point : p2(0) = ptStart : p2(1) = ptEnd2
oCounterweight.PolyPolygon = Array(p2) : oCounterweight.LineStyle = com.sun.star.drawing.LineStyle.NONE
oColl = CreateUnoService("com.sun.star.drawing.ShapeCollection")
oColl.add(oHand) : oColl.add(oCounterweight)
oGroup = oPage.group(oColl)
CreateSingleHand = oGroup
End Function
Sub StartClock()
Dim hours As Single, minutes As Single, seconds As Single
Dim previousSeconds As Single
Dim degreeSecond As Single, degreeMinute As Single, degreeHour As Single
Dim oDoc As Object, oPage As Object, oImg As Object
oDoc = ThisComponent
oPage = oDoc.getDrawPages().getByIndex(0)
DialogLibraries.LoadLibrary("Standard")
oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oImg = oDlg.getControl("ImageControl1")
oImg.Model.ScaleMode = 1
CenterDialog
oDlg.setVisible(True)
bClockRunning = True
Do While bClockRunning
seconds = CSng(Second(Now))
If seconds <> previousSeconds Then
hours = CSng(Hour(Now))
minutes = CSng(Minute(Now))
degreeSecond = (seconds * 6) Mod 360
degreeMinute = ((minutes + seconds / 60.0) * 6) Mod 360
degreeHour = CInt(((hours Mod 12) * 30) + Int(minutes * 0.5)) Mod 360
oSecondHand.RotateAngle = ((360 - degreeSecond + 90) Mod 360) * 100
oMinuteHand.RotateAngle = ((360 - degreeMinute + 90) Mod 360) * 100
oHourHand.RotateAngle = ((360 - degreeHour + 90) Mod 360) * 100
previousSeconds = seconds
Dim oPageShapesColl As Object
oPageShapesColl = CreateUnoService("com.sun.star.drawing.ShapeCollection")
Dim x As Long
For x = 0 To oPage.getCount() - 1
oPageShapesColl.add(oPage.getByIndex(x))
Next x
Dim oGraphic As Object
oGraphic = GetClockAsGraphic(oPageShapesColl)
oImg.Model.Graphic = oGraphic
End If
Wait 100
Loop
oDlg.dispose()
End Sub
Function GetClockAsGraphic(oShapeCollection As Object) As Object
Dim oExporter As Object
Dim oPipe As Object
Dim oProvider As Object
Dim oGraphic As Object
oPipe = CreateUnoService("com.sun.star.io.Pipe")
oExporter = CreateUnoService("com.sun.star.drawing.GraphicExportFilter")
oExporter.setSourceDocument(oShapeCollection)
Dim aExportProps(1) As New com.sun.star.beans.PropertyValue
aExportProps(0).Name = "OutputStream"
aExportProps(0).Value = oPipe
aExportProps(1).Name = "MediaType"
aExportProps(1).Value = "image/png"
oExporter.filter(aExportProps)
oPipe.closeOutput()
oProvider = CreateUnoService("com.sun.star.graphic.GraphicProvider")
Dim aProviderProps(0) As New com.sun.star.beans.PropertyValue
aProviderProps(0).Name = "InputStream"
aProviderProps(0).Value = oPipe
GetClockAsGraphic = oProvider.queryGraphic(aProviderProps)
End Function
Sub CenterDialog()
Dim oSize As New com.sun.star.awt.Size, factor As Double
Dim oCC, oComponentWindow, oTopWindowPosSize
oCC = ThisComponent.getCurrentController()
oComponentWindow = oCC.ComponentWindow
oTopWindowPosSize = oComponentWindow.Toolkit.ActiveTopWindow.getPosSize()
oSize.Width = oDlg.Model.Width
oSize.Height = oDlg.Model.Height
factor = oSize.Width / oDlg.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT).Width
With oDlg.Model
.PositionX = (factor * oTopWindowPosSize.Width - .Width) / 2
.PositionY = (factor * oTopWindowPosSize.Height - .Height) / 2
End With
End Sub
Sub ClearDrawDocument
Dim oDoc As Object, oPages As Object, oPage As Object, oShapes As Object
Dim i As Long, j As Long
oDoc = ThisComponent : oPages = oDoc.getDrawPages()
For i = 0 To oPages.getCount() - 1
oPage = oPages.getByIndex(i)
oShapes = oPage
For j = oShapes.getCount() - 1 To 0 Step -1
oPage.remove(oShapes.getByIndex(j))
Next j
Next i
End Sub
Sub OnClose
bClockRunning = False
ThisComponent.setModified(False)
End SubHalutessaan valmiin testiprojektin voi imaista täältä