Keskustelu: Koodit: LibreOffice Basic - simppeli animaatio player

' Valitse valikkoriviltä: Työkalut -> Mukauta -> Tapahtumat välilehti,
' valitse listasta Asiakirjaa ollaan sulkemassa. Klikkaa Makro nappia.
' Valitse vasemmalla (Kirjasto), laajenna projektsi nimi puuu -> laajenna
' Standard, klikkaa Module1, Valitse OnClose -> klikkaa alhaalla OK ja tallenna
' projektisi.

' Module1
REM  *****  BASIC  *****
REM Lisenssi: DWYFW (tee mitä v***** ikinä haluat)

Private oDlg As Object
Private oLbl As Object
Private oAnim As Object
Private oButton As Object
Private oTopListener As Object
Private basePath As String
Private arrayNames() As String
Private IsGained As Boolean
Private oFocusListener As Object
Private oActionListener As Object

Private IsGained  As Boolean

Sub BuildUI

	Dim oDialogModel As Object
	Dim oDialog As Object
	Dim oAnimation As Object
	Dim oControl As Object

	basePath = Left(thisComponent.Url, InStrReverse(thisComponent.Url, "/"))
	Redim arrayNames()
	Dim patterns As Variant
	patterns = Array("*.öäå", "*.gif")
	Dim i As Long, f As String, IsExisting As Boolean
	Dim sfa As Object
	sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")

	For i = 0 To UBound(patterns)
		f = Dir(basePath & patterns(i))
		Do While f <> ""
			If sfa.exists(basePath & f) Then
				IsExisting = True : Exit Do
			End If
		f = Dir()
		Loop
		If IsExisting Then Exit For
	Next i

	If Not IsExisting Then
		MsgBox "No iamge files found from the project directory", "48", "System"
		sfa = Nothing : Exit Sub
	End If

	Dim items As Variant, lstNames As String , j As Integer
	items = sfa.getFolderContents(basePath, True)
	For i = LBound(items) To UBound(items)
		For j = Lbound(patterns) To Ubound(patterns)
			If InStr(items(i), Replace(patterns(j), "*", "")) > 0 Then
				lstFnames = lstFnames & items(i) & ","
			End If
		Next j
	Next i

	sfa = Nothing
	lstFnames = Left(lstFnames, Len(lstFnames) - 1)
	arrayNames = Split(lstFnames, ",") : lstNames = ""

	oDialogModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
	oDialogModel.Width = 150
	oDialogModel.Height = 140
	oDialogModel.TabIndex = 0
	oDialogModel.BackGroundColor = RGB(225,225,225)

	oDialog = CreateUnoService("com.sun.star.awt.UnoControlDialog")
	oDialog.setModel(oDialogModel)
	oDlg = oDialog : oDlg.Title = "Animation in Pure Basic"

	lblFocusModel = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
	lblFocusModel.Name = "Label1"
	lblFocusModel.PositionX = 149
	lblFocusModel.PositionY = 139
	lblFocusModel.Label = ""
	lblFocusModel.Width = 1
	lblFocusModel.Height = 1
	lblFocusModel.TabIndex = 1
	lblFocusModel.TabStop = True

	oDialogModel.insertByName("Label1", lblFocusModel)
	oLbl = oDlg.getControl("Label1")
	AddFocusListenerToControl oLbl

    oAnimationModel = oDialogModel.createInstance("com.sun.star.awt.AnimatedImagesControlModel")
	oAnimationModel.Name = "oAnimation1"
	oAnimationModel.PositionX = 5
	oAnimationModel.PositionY = 5
	oAnimationModel.Width = 140
	oAnimationModel.Height = 110
	oAnimationModel.ScaleMode = 1
	oAnimationModel.BackGroundColor = RGB(0,0,0)
	oDialogModel.insertByName("oAnimation1", oAnimationModel)

	oButtonModel = oDialog.Model.createInstance("com.sun.star.awt.UnoControlButtonModel")
	oButtonModel.Name = "oButton1"
	oButtonModel.PositionX = 62
	oButtonModel.PositionY = 120
	oButtonModel.Width = 35
	oButtonModel.Height = 14
	oButtonModel.Label = "Pause"
	oButtonModel.TabIndex = 2
	oButtonModel.TabStop = True
	oDialogModel.insertByName("oButton1", oButtonModel)
	oControl = oDialog.getControl("oButton1")
	AddActionListenerToControl oControl
	oControl = Nothing

    oDialog.createPeer(CreateUnoService("com.sun.star.awt.Toolkit"), Null)

	On Error Resume Next
	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 = oDialog.Model.Width
	oSize.Height = oDialog.Model.Height
	factor = oSize.Width / oDialog.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT).Width

	With oDialog.Model
		.PositionX = (factor * oTopWindowPosSize.Width - .Width) / 2
		.PositionY = (factor * oTopWindowPosSize.Height - .Height) / 1.75
	End With
	If Err <> 0 Then Err.Clear


	IsGained = False

	ITicks = GetSystemTicks()

	Do
		If GetSystemTicks() > ITicks + 100 Then Exit Do
		DoEvents
	Loop

	oDlg.execute
	oDlg.dispose

End Sub

Sub ShowAnimation

	oAnim = oDlg.getControl("oAnimation1")
	oAnim.Model.AutoRepeat = True
	oAnim.Model.StepTime = 60  ' test
	oAnim.Model.insertImageSet(0, arrayNames)
	oAnim.startAnimation()

End Sub

Sub AddFocusListenerToControl(oControl As Object)
	oFocusListener = CreateUnoListener("FocusListener_","com.sun.star.awt.XFocusListener")
	oControl.addFocusListener(oFocusListener)
End Sub

Sub FocusListener_focusGained(oEvent)

	If Not  IsGained  Then
		 IsGained = True
		 ShowAnimation
		 oDlg.endexecute
	End If

End Sub

Sub FocusListener_focusLost(oEvent)
End Sub

Sub  FocusListener_disposing : End Sub

Sub AddActionListenerToControl(oControl As Object)


	oActionListener = CreateUnoListener("ActionListener_", "com.sun.star.awt.XActionListener")
	oControl.addActionListener(oActionListener)

End Sub

Sub ActionListener_actionPerformed(oEvent)

	If oEvent.Source.Model.Label = "Pause" And oAnim.isAnimationRunning Then
		 oAnim.stopAnimation() : oEvent.Source.Model.Label = "Resume" : Exit Sub
	End If

	If oEvent.Source.Model.Label = "Resume" And Not oAnim.isAnimationRunning Then
		 oAnim.startAnimation() : oEvent.Source.Model.Label = "Pause"
	End If

End Sub

Sub ActionListener_disposing : 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 Function

Sub OnClose
	ThisComponent.setModified(False)
End Sub

REM NO WARRANTY 😎