Kirjoittaja: jalski
Kirjoitettu: 27.10.2012 – 11.11.2012
Tagit: grafiikka, kirjaston käyttö, ohjelmointitavat, koodi näytille, sovellus, vinkki
Analoginen kello Silverfrost FTN95 -kääntäjälle käyttäen mukana tulevaa kirjastoa ClearWin+.
Rakenne on yksinkertainen: Ensiksi määritetään yksinkertainen ikkuna grafiikka-alueella, sekä grafiikka-alueen käsittelyyn funktio. Kyseinen funktio toimii samalla myös ajastimen kutsumana funktiona.
module clock
use mswin
implicit none
integer :: width = 240, height = 240
character (len=2), parameter :: hours(0:11) = &
(/'03','02','01','12','11','10','09','08','07','06','05','04'/)
contains
integer function draw_func()
integer :: i, resize
integer :: radius
integer :: xcenter, ycenter
integer :: angsecs, angmins, anghours
integer :: s, m, h
integer :: cx, cy ! point on a circle
integer :: handx(5), handy(5)
character (len=8) :: time@, time
resize=clearwin_info@('GRAPHICS_RESIZING')
if(resize.EQ.1) then
width = clearwin_info@('GRAPHICS_WIDTH')
height = clearwin_info@('GRAPHICS_DEPTH')
end if
if(width.GT.height) then
radius = height
else
radius = width
end if
radius = radius / 2 - 8
time = time@()
read(time(1:2),*) h
read(time(4:5),*) m
read(time(7:8),*) s
xcenter = width/2
ycenter = height/2
angsecs = 90 - s * 6
angmins = 90 - m * 6
anghours = 90 - (h * 5 + m / 10) * 6
! Draw clock frame
call draw_filled_ellipse@(xcenter,ycenter,radius,radius,rgb@(255,255,255))
call draw_ellipse@(xcenter,ycenter,radius+1,radius+1,rgb@(0,0,0))
call draw_filled_ellipse@(xcenter,ycenter,3,3,rgb@(0,0,0))
! Draw second and minute dots
do i = 0, 59, 1
call circlept(xcenter, ycenter, int(radius * 0.95), i * (360 / 60))
call draw_filled_ellipse@(cx,cy,1,1, rgb@(0,0,0))
end do
! Draw hour dots
call size_in_pixels@(14,14)
call bold_font@(1)
do i = 0, 11, 1
call circlept(xcenter, ycenter, int(radius * 0.95), i * (360 / 12))
call draw_filled_ellipse@(cx,cy,2,2, rgb@(0,0,0))
call circlept(xcenter-12, ycenter+7, int(radius * 0.80), i * (360 / 12))
call draw_characters@(hours(i),cx,cy,rgb@(0,0,0))
end do
! draw hands
! second hand
handx(1) = xcenter; handy(1) = ycenter
call circlept(xcenter, ycenter, int(radius * 0.25), angsecs-3)
handx(2) = cx; handy(2) = cy
call circlept(xcenter, ycenter, int(radius * 0.90), angsecs)
handx(3) = cx; handy(3) = cy
call circlept(xcenter, ycenter, int(radius * 0.25), angsecs+3)
handx(4) = cx; handy(4) = cy
handx(5) = xcenter; handy(5) = ycenter
call draw_filled_polygon@(handx,handy,5,rgb@(0,0,0))
! minute hand
call circlept(xcenter, ycenter, int(radius * 0.25), angmins-8)
handx(2) = cx; handy(2) = cy
call circlept(xcenter, ycenter, int(radius * 0.85), angmins)
handx(3) = cx; handy(3) = cy
call circlept(xcenter, ycenter, int(radius * 0.25), angmins+8)
handx(4) = cx; handy(4) = cy
call draw_filled_polygon@(handx,handy,5,rgb@(0,0,0))
! hour hand
call circlept(xcenter, ycenter, int(radius * 0.25), anghours-10)
handx(2) = cx; handy(2) = cy
call circlept(xcenter, ycenter, int(radius * 0.65), anghours)
handx(3) = cx; handy(3) = cy
call circlept(xcenter, ycenter, int(radius * 0.25), anghours+10)
handx(4) = cx; handy(4) = cy
call draw_filled_polygon@(handx,handy,5,rgb@(0,0,0))
draw_func=1
contains
subroutine circlept(x, y, r, deg)
integer, intent(in) :: x, y, r, deg
real :: rad
rad = deg * 3.14159 / 180
cx = x + Cos(rad) * r
cy = y - Sin(rad) * r
end subroutine circlept
end function draw_func
end module clock
winapp
use clock
implicit none
integer :: i
i=winio@('%ww[no_border,no_maxbox]&')
i=winio@('%ca[FTN95 Clock]&')
i=winio@('%pv%^gr[user_resize,grey,rgb_colours]&',width,height,draw_func)
i=winio@('%dl', 1.0D0, draw_func)
endLaitoin vaihtoehtoisen version alla olevan linkin taakse:
Oikealla hiiren napilla saa esiin popup menun. Sieltä voi vaihtaa ikkunan pyöreäksi kellon muotoiseksi ja tällöin sitä voi raahata vasen hiiren nappi pohjassa ikkunan client alueelta.
Hyvää työtä jalski!
Analoginen kello on kiva, ja hankalampi toteuttaa, mutta haluan tässä yhteydessä näyttää, miten lyhyellä REBOL-koodilla saa aikaiseksi tällaisen digitaalisen kellon:
https://petke.info/dgclock.jpg
REBOL [
Title: "Clock"
]
clock: layout [
origin 0
clock-face: banner 140x32 rate 1
effect [gradient 0x1 0.0.150 0.0.50]
feel [engage: func [f a e] [set-face clock-face now/time]]
]
view clockAnaloginen kello LibreOffice Draw/Basic ympäristössä
Module1:
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, lVari 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 = lVari : 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 SubCopy/Paskanna koodi LibreOffice Draw Basic moduuliin. Valitse valikkoriviltä Työkalut -> Mukauta -> Taphtumat välilehti, sido DrawClockFace aliohjelma Avaa asiakirja tapahtumaan ja OnClose Näkymää ollaan sulkemassa tapahtumaan. Paina OK ja tallenna lopuksi projekti. Sulje ja avaa Projekti uudestaan niin kello lähtee käyntiin automaattisesti.