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.
Plässyn plässyn bullshit! Esitetyillä demoilla ei ole mitään tekemistä LibreOffice Draw PDF export/import sydeemien kanssa. PDF export onnistuu missä tahansa LibreOffice -pakettiin kuuluvassa ohjelmassa joko UI:n puolelta tai koodista käsin. Sen sijaan import onnistuu (ilman 3rd Party palikkaa) vain Draw'n kautta, jota voi sitten halutessaan käyttää proxyna, jonka kautta tekstiä grafiikkaa jne. voi napata mihin tahansa muuhun LibreOffice -pakettiin kuuluvaan ohjelmaan. Grafiikan tuontia PDF-tiedostosta Writer projektin sivulle voi halutessaan testata imaisemalla tämän paketin. Hieman edistyneempi PDF -> Writer testi löytyy täältä. Nyt jos Draw piirtely tuntuu hankalalta niin aina voi piirellä vaikka Paintin avulla tai muulla (käyttiksessä toimivalla) piirtelyyn tarkoitetulla ohjelmalla mitä tykkää ja kykenee, tallentaa kuvatiedostoon, upottaa minkä tahansa LibreOffice-ohjelman kuva objektiin ja pukata edelleen PDF-tiedostoon. Draw & Impress piirtelyyn Basic koodilla voi alkaa tutustumaan tämän ohjeen avulla...
'PDF Export Basic koodista käsin:
'Module1
Sub ExportToPDF
Dim oDoc As Object
Dim baseURL As String
Dim args(1) As New com.sun.star.beans.PropertyValue
Dim filterProps(0) As New com.sun.star.beans.PropertyValue
oDoc = ThisComponent
baseURL = oDoc.URL
' Varmistetaan, että dokumentti on tallennettu
If baseURL = "" Then
MsgBox "Tallenna projekti ensin, jotta kansio voidaan tunnistaa!", 48, "Virhe"
Exit Sub
End If
Dim newURL As String
newURL = Left(baseURL, InStrReverse(baseURL, "/")) & "Exported.pdf"
' Rajataan vienti vain ensimmäiselle testisivulle
filterProps(0).Name = "PageRange"
filterProps(0).Value = "1"
' Asetukset PDF-vientiä varten
args(0).Name = "FilterName"
args(0).Value = "writer_pdf_Export" 'riippuen tapauksesta: calc_pdf_Export impress_pdf_Export draw_pdf_Export
args(1).Name = "FilterData"
args(1).Value = filterProps()
' Tallennetaan PDF
On Error GoTo ErrorHandler
oDoc.storeToURL(newURL, args())
MsgBox "PDF tallennettu onnistuneesti nimellä:" & Chr(13) & ConvertFromURL(newURL), 64, "Valmis"
Exit Sub
ErrorHandler:
MsgBox "Tallennus epäonnistui!", 16, "Virhe"
On Error GoTo 0
End Sub
Function InStrReverse(sText As String, search As String) As Long
If sText = "" Or search = "" Or Len(search) > Len(sText) Then
InStrReverse = 0
Exit Function
End If
Dim i As Long
For i = Len(sText) To 1 Step -1
If Mid(sText, i, Len(search)) = search Then
InStrReverse = i : Exit Function
End If
Next i
End Functionwy5vn kirjoitti:
Minkä takia libreoffice drawissa pystyy piirtämään pdf:ään hymynaamoja ja kolmiulotteisia pyramideja mutta siinä ei ole kynää millä vois piirtää.
peran kirjoitti:
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 C++ tai Javalla & SKD paketin avulla voi rakennella vaikka minkälaisen UNO-palvelun ja rekisteröidä sen LibreOffice sydeemiin. Eri asia on huoliiko LibreOffice Dev Team sen mukaan johonkin tulevaan päivitys-/maintenance jakeluun. Nyt jos joku taidokas onnistuu vääntämään tällaisen palvelun varsinkin AI:n ohjeistuksella niin olen valmis testaamaan ja eritoten antamaan välittömästi palautetta 😎