Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: Valintaikkuna kuvaobjektissa

neosofta [09.07.2026 01:50:33]

#

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 Sub

Halutessaan valmiin testiprojektin voi imaista täältä

Vastaus

Muista lukea kirjoitusohjeet.
Tietoa sivustosta