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ä
Oukki Doukki, viisarikello on taputeltu tappiin. Final Cut versiossa Draw projektin pääikkuna siirretään sivuun tunnelmaa häiritsemästä jolloin pelkkä Dialog Boxin Image objektiin renderöity kello ja näkyviin.
REM ***** BASIC *****
Dim oHourHand As Object
Dim oMinuteHand As Object
Dim oSecondHand As Object
Dim bClockRunning As Boolean
Global oDlg As Object
Private oListenerTop As Object
Private oLabel As Object
Private oFocusListener As Object
Private IsGained As Boolean
Private winW As Long
Private winH As Long
Private winX As Long
Private winY As Long
Private oWindow As Object
Sub DrawClockFace()
ClearDrawDocument
Dim oController As Object
Dim oFrame As Object
Dim aPosSize As Object
oController = thisComponent.CurrentController
oFrame = oController.Frame
oWindow = oFrame.ContainerWindow
oWindowIsMaximized = True
aPosSize = oWindow.PosSize
winW = aPosSize.Width
winH = aPosSize.Height
winX = aPosSize.X
winY = aPosSize.Y
aPosSize = Nothing
oFrame = Nothing
oWindow = Nothing
oController = Nothing
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)
oListenerTop = createUnoListener("TopListen_", "com.sun.star.awt.XTopWindowListener")
oDlg.addTopWindowlistener(oListenerTop)
oImg = oDlg.getControl("ImageControl1")
oLabel = oDlg.getControl("Label1")
oFocusListener = CreateUnoListener("FocusListener_","com.sun.star.awt.XFocusListener")
oLabel.addFocusListener(oFocusListener)
IsGained = False
oImg.Model.ScaleMode = 1
CenterDialog
oDlg.setVisible(True)
oLabel.setFocus()
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
Sub TopListen_WindowClosing
OnClose
oWindow.IsMaximized = True
ThisComponent.Close(true)
StarDesktop.terminate()
End Sub
Sub TopListen_windowOpened
End Sub
Sub TopListen_windowClosed
End Sub
Sub TopListen_windowMinimized
End Sub
Sub TopListen_windowNormalized
End Sub
Sub TopListen_windowActivated
End Sub
Sub TopListen_windowDeactivated
End Sub
Sub TopListen_disposing
End Sub
Sub FocusListener_focusGained(oEvent)
If Not IsGained Then
IsGained = True
oDlg.Model.PositionX = CLng(winW / 5.23)
oDlg.Model.PositionY = CLng(winH / 7.77)
Dim oController As Object
Dim oFrame As Object
Dim oPosSize As Object
oController = thisComponent.CurrentController
oFrame = oController.Frame
oWindow = oFrame.ContainerWindow
aPosSize = oWindow.PosSize
oWindow.IsMaximized = False
oWindow.setPosSize(1000000,1000000, 0, 0, com.sun.star.awt.PosSize.POSSIZE)
End If
End Sub
Sub FocusListener_focusLost : End Sub
Sub FocusListener_disposing : 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
'The tuning is fucking brilliant 😎Halutessaan valmiin Final Cut version voi ladata täältä
Voisin itse asiassa testata tätä koodia lähipäivinä ja antaa jotain parannusehdotuksia. Sitten jos ja kun on aikaa.
Varmaan itsestään selvää, mutta LibreOfficen Drawiin tämä liittyy, kuten edellisestkin.
Kyllä, kyseessä on nimenomaan LibreOffice Draw-projekti. Ja kerro ihmeessä parannusehdotuksia mikäli sattuu putkahtamaan mieleesi. Nyt jos sinulla sattuisi olemaan enemmänkin aikaa niin voisit ehkä tutkia samalle pohjalle perustuvaa mittari demo viritelmää josko löytäisit jotain hienosäädettävää.
Mittari demon sorsat:
REM ***** BASIC *****
Dim oPointer As Object
Global oDlg As Object
Private oListenerTop As Object
Private oLabel As Object
Private oFocusListener As Object
Private IsGained As Boolean
Private winW As Long
Private winH As Long
Private winX As Long
Private winY As Long
Private oWindow As Object
Sub DrawGauge()
ClearDocument
Dim oController As Object
Dim oFrame As Object
Dim aPosSize As Object
oController = thisComponent.CurrentController
oFrame = oController.Frame
oWindow = oFrame.ContainerWindow
oWindowIsMaximized = True
aPosSize = oWindow.PosSize
winW = aPosSize.Width
winH = aPosSize.Height
winX = aPosSize.X
winY = aPosSize.Y
aPosSize = Nothing
oFrame = Nothing
oWindow = Nothing
oController = Nothing
Dim oDoc As Object
Dim oPage As Object
Dim oTick As Object
Dim oText As Object
Dim oBoundingCircle As Object
Dim CX As Long
Dim CY As Long
Dim R As Long
Dim OuterR 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
OuterR = R + 1000
oBoundingCircle = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
oPage.add(oBoundingCircle)
Dim CirclePos As New com.sun.star.awt.Point
Dim CircleSize As New com.sun.star.awt.Size
CircleSize.Width = OuterR * 2
CircleSize.Height = OuterR * 2
CirclePos.X = CX - OuterR
CirclePos.Y = CY - OuterR
oBoundingCircle.setPosition(CirclePos)
oBoundingCircle.setSize(CircleSize)
oBoundingCircle.FillStyle = com.sun.star.drawing.FillStyle.NONE
oBoundingCircle.LineStyle = com.sun.star.drawing.LineStyle.NONE
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 oHand 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
P0.X=10000
P0.Y=10000
P1.X=10000
P1.Y=6200
P2.X=10000
P2.Y=13800
oHand=oDoc.createInstance("com.sun.star.drawing.PolyLineShape")
oPage.add(oHand)
Dim A(1) As New com.sun.star.awt.Point
A(0)=P0
A(1)=P1
oHand.PolyPolygon=Array(A)
oHand.LineWidth=160
oHand.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(oHand)
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()
Dim oDoc As Object, oPage As Object, oImg As Object, V As Integer
Dim oPageShapesColl As Object, i As Long, j As Long, oGraphic As Object
oDoc = ThisComponent
oPage = oDoc.getDrawPages().getByIndex(0)
DialogLibraries.LoadLibrary("Standard")
oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oListenerTop = createUnoListener("TopListen_", "com.sun.star.awt.XTopWindowListener")
oDlg.addTopWindowlistener(oListenerTop)
oImg = oDlg.getControl("ImageControl1")
oLabel = oDlg.getControl("Label1")
oFocusListener = CreateUnoListener("FocusListener_","com.sun.star.awt.XFocusListener")
oLabel.addFocusListener(oFocusListener)
IsGained = False
oImg.Model.ScaleMode = 1
CenterDialog
oDlg.setVisible(True)
oLabel.setFocus()
For V= 100 To 0 Step - 1
SetGauge(V)
Wait 50
oPageShapesColl = CreateUnoService("com.sun.star.drawing.ShapeCollection")
For i = 0 To oPage.getCount() - 1
oPageShapesColl.add(oPage.getByIndex(i))
Next i
oGraphic = GetGaugeAsGraphic(oPageShapesColl)
oImg.Model.Graphic = oGraphic
Next V
For V=0 To 100
SetGauge(V)
Wait 50
oPageShapesColl = CreateUnoService("com.sun.star.drawing.ShapeCollection")
For j = 0 To oPage.getCount() - 1
oPageShapesColl.add(oPage.getByIndex(j))
Next j
oGraphic = GetGaugeAsGraphic(oPageShapesColl)
oImg.Model.Graphic = oGraphic
Next V
TopListen_WindowClosing
End Sub
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 TopListen_WindowClosing
OnClose
oWindow.IsMaximized = True
ThisComponent.Close(true)
StarDesktop.terminate()
End Sub
Sub TopListen_windowOpened
End Sub
Sub TopListen_windowClosed
End Sub
Sub TopListen_windowMinimized
End Sub
Sub TopListen_windowNormalized
End Sub
Sub TopListen_windowActivated
End Sub
Sub TopListen_windowDeactivated
End Sub
Sub TopListen_disposing
End Sub
Sub FocusListener_focusGained(oEvent)
If Not IsGained Then
IsGained = True
oDlg.Model.PositionX = CLng(winW / 5.10)
oDlg.Model.PositionY = CLng(winH / 6.40)
Dim oController As Object
Dim oFrame As Object
Dim oPosSize As Object
oController = thisComponent.CurrentController
oFrame = oController.Frame
oWindow = oFrame.ContainerWindow
aPosSize = oWindow.PosSize
oWindow.IsMaximized = False
oWindow.setPosSize(1000000,1000000, 0, 0, com.sun.star.awt.PosSize.POSSIZE)
End If
End Sub
Sub FocusListener_focusLost : End Sub
Sub FocusListener_disposing : End Sub
Function GetGaugeAsGraphic(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
GetGaugeAsGraphic = oProvider.queryGraphic(aProviderProps)
End Function
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
oDlg.Title = "Goodbye"
Wait 1000
ThisComponent.setModified(False)
End SubValmiin testiprojektin voi imaista täältä
Mikäli sattuisi käymään niin, että AI ei tarjoaisikaan mitään ihmeparannuksia niin... mielen virkistämiseksi voi välillä tsiikata vaikkapa auringonpaistetta dialog boxissa...
Minkä takia libreoffice drawissa pystyy piirtämään pdf:ään hymynaamoja ja kolmiulotteisia pyramideja mutta siinä ei ole kynää millä vois piirtää.
wy5vn kirjoitti:
Minkä takia libreoffice drawissa pystyy piirtämään pdf:ään hymynaamoja ja kolmiulotteisia pyramideja mutta siinä ei ole kynää millä vois piirtää.
Todennäköisesti siksi, ettei kukaan ole ohjelmoinut kyseistä ominaisuutta sille.
(Olettaen, että väitteesi pitää paikkansa.)
Ohjelma on avoin, joten sen voi ohjelmoida lähes kuka tahansa ohjelmointitaitoinen. Varsinkin nykyisen AI aikakautena.
No ei ainakaan 10min ettimisellä sovelluksen valikoista löytynyt että aika hyvin on piilotettu jos on.
Kait tuo vektorikrafiikkaan jotenkin liittyy tuo rajoite mutta jännä kun muista ohjelmista löytyy.
PDF:ssähän voi toki olla tekstin, vektorigrafiikan ja kolmiulotteisten objektien lisäksi myös bittikarttagrafiikkaa (ja paljon muuta). Kenties kuitenkin ovat halunneet pitää bittikartan piirto-ohjelman erillään ja siinä saattaisi olla mahdollisuus liittää piirto-ohjelmassa tehty bittikartta PDF:ään.