Keskustelu: Koodit: Analoginen kello LibreOffice Draw/Basic

REM  *****  BASIC  *****

Dim oHourHand As Object
Dim oMinuteHand As Object
Dim oSecondHand As Object
Dim bClockRunning As Boolean

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

    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

        End If

        Wait 100
    Loop

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

REM ***** BASIC *****

Dim oPointer As Object
Dim bRunning As Boolean
Dim oGaugeGroup As Object

Sub DrawGauge()

    ClearDocument

    Dim oDoc As Object
    Dim oPage As Object
    Dim oTick As Object
    Dim oText As Object

    Dim CX As Long
    Dim CY As Long
    Dim R As Long

    Dim i As Integer
    Dim Angle As Double
    Dim Rad As Double

    oDoc = ThisComponent
    oPage = oDoc.DrawPages.getByIndex(0)

    CX = 10000
    CY = 10000
    R = 4500

    'Pääasteet ja numerot
    For i = 0 To 10

        Angle = 180 - i * 18
        Rad = Angle * 3.14159265359 / 180

        Dim P1 As New com.sun.star.awt.Point
        Dim P2 As New com.sun.star.awt.Point

        P1.X = CX + R * Cos(Rad)
        P1.Y = CY - R * Sin(Rad)

        P2.X = CX + (R-350) * Cos(Rad)
        P2.Y = CY - (R-350) * Sin(Rad)

        oTick = oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
        oPage.add(oTick)

        Dim A(1) As New com.sun.star.awt.Point
        A(0)=P1
        A(1)=P2

        oTick.PolyPolygon=Array(A)
        oTick.LineWidth=90

        Dim TP As New com.sun.star.awt.Point
        Dim TS As New com.sun.star.awt.Size

        TS.Width = 2000
        TS.Height = 500

        TP.X = CX + (R - 850) * Cos(Rad) - 1000
        TP.Y = CY - (R - 850) * Sin(Rad) - 250

        oText = oDoc.createInstance("com.sun.star.drawing.TextShape")
        oPage.add(oText)

        oText.setPosition(TP)
        oText.setSize(TS)

        oText.String = Trim(Str(i * 500))
        oText.CharHeight = 12

        oText.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
        oText.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER

        oText.TextLeftDistance = 0
        oText.TextRightDistance = 0
        oText.TextUpperDistance = 0
        oText.TextLowerDistance = 0

    Next i

    CreatePointer

    TestGauge

End Sub

Sub CreatePointer()

    Dim oDoc As Object
    Dim oPage As Object
    Dim oGaugePointer As Object
    Dim oCounter As Object
    Dim oGroup As Object
    Dim oColl As Object

    oDoc=ThisComponent
    oPage=oDoc.DrawPages.getByIndex(0)

    Dim P0 As New com.sun.star.awt.Point
    Dim P1 As New com.sun.star.awt.Point
    Dim P2 As New com.sun.star.awt.Point

    ' Centerpoint (10000, 10000)
    P0.X=10000
    P0.Y=10000

    P1.X=10000
    P1.Y=6200

    P2.X=10000
    P2.Y=13800
    oGaugePointer=oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
    oPage.add(oGaugePointer)

    Dim A(1) As New com.sun.star.awt.Point
    A(0)=P0
    A(1)=P1

    oGaugePointer.PolyPolygon=Array(A)
    oGaugePointer.LineWidth=160
    oGaugePointer.LineColor=RGB(255,0,0)
    oCounter=oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
    oPage.add(oCounter)

    Dim B(1) As New com.sun.star.awt.Point
    B(0)=P0
    B(1)=P2

    oCounter.PolyPolygon=Array(B)
    oCounter.LineWidth=160

    oCounter.LineStyle = com.sun.star.drawing.LineStyle.NONE

    oColl=CreateUnoService("com.sun.star.drawing.ShapeCollection")
    oColl.add(oGaugePointer)
    oColl.add(oCounter)

    oGroup=oPage.group(oColl)
    oPointer=oGroup

End Sub


Sub SetGauge(Value As Double)

    Dim Angle As Double

    Angle = 180 - Value * 1.8

    oPointer.RotateAngle=((360-Angle+180) Mod 360)*100

End Sub

Sub TestGauge() 'Testaamiseen

    Dim V As Integer

    bRunning=True

    Do While bRunning

        For V= 100 To 0 Step - 1

            SetGauge(V)

            Wait 100

        Next V

        For V=0 To 100

            SetGauge(V)

            Wait 100

        Next V

    Loop

End Sub

Sub ClearDocument()

    Dim oDoc As Object
    Dim oPages As Object
    Dim oPage As Object
    Dim oShapes As Object

    Dim i As Long
    Dim j As Long

    oDoc=ThisComponent
    oPages=oDoc.DrawPages

    For i=0 To oPages.Count-1

        oPage=oPages.getByIndex(i)
        oShapes=oPage

        For j=oShapes.Count-1 To 0 Step -1
            oPage.remove(oShapes.getByIndex(j))
        Next j

    Next i

End Sub

Sub OnClose

    bRunning = False
    ThisComponent.setModified(False)

End Sub