Forum społeczności użytkowników OpenOffice i LibreOffice

Kod: Zaznacz cały

sub przewijaj()
	dt = 20 ' czas w tysięcznych częściach sekundy
	d = thisComponent
	c = d.getCurrentController()
	v = c.getViewCursor()
	v.GoToStart(0)
	res = true
	do while (res = true)
		res = v.goRight(1, 0)
		rem albo res = v.goDown(1, 0)
		wait(dt)
	loop
end sub

Kod: Zaznacz cały

Sub Przewijaj2
Dim s As String, sStyl as String
Dim oCurs as Variant, vCurs as Variant
Dim sCurStyle As String 
Dim t1 as double, t2 as double
sStyl=InputBox ("Podaj nazwę stylu" , "Przewijanie", "Nagłówek 3")
t1= Cdbl(InputBox("Podaj w sekundach czas potrzebny na przeczytanie dziesięciu znaków", "Zmienny czas wyświetlania",0))
t2= Cdbl(InputBox("Podaj w sekundach wymagany czas wyświetlania akapitu", "Stały czas wyświetlania",0))
Wait(5000)
oCurs = ThisComponent.Text.CreateTextCursor()
vCurs= ThisComponent.getCurrentController.getViewCursor()
oCurs.GoToStart(False)
vCurs.GoToStart(0)
Do
	If NOT oCurs.gotoEndOfParagraph(True) Then Exit Do
	sCurStyle = oCurs.ParaStyleName
	oCurs.ParaStyleName=sStyl
	i = Len(oCurs.getstart().TextParagraph().string)
	Wait((i/10*t1+t2)*1000)
	oCurs.ParaStyleName=sCurStyle
	NextPar() : NextPar() :vCurs.goUp(1,0)
Loop Until NOT oCurs.gotoNextParagraph(False)
End Sub

sub NextPar()
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:GoToNextPara", "", 0, Array())
end sub

Kod: Zaznacz cały

Sub Prompter
REM Procedura wyróżnia przez określony czas kolejne akapity dokumentu 
REM wyświetlając je w wybranym stylu. Czas wyświetlania zależy od długości akapitu
REM i czasu stałego, określonego przez użytkownika.
REM Autor: Jermor, polskie forum Apache OpenOffice i LibreOffice (2019)
Dim s As String, sStyl as String
Dim oCurs as Variant, vCurs as Variant
Dim sCurStyle As String 
Dim t1 as double, t2 as double
On Local Error GoTo Styles
Const test="Samolot sił powietrznych USA obserwował Koreę Północną z ogromnej wysokości." &_
" Obecność maszyny szpiegowskiej EP-3E nad Półwyspem Koreańskim została potwierdzona." & _
" Media donoszą, że armia USA obserwowała działania wojsk Kim Dzong Una."
Const komunikat1 = "Za chwilę zostanie wyświetlony przykład tekstowy złożony z 231 znaków. Przeczytaj go w tempie, w jakim " &_
"chcesz czytać swój dokument i zanotuj czas trwania tego eksperymentu."
Const Komunikat2="Ten czas, wyrażony w sekundach, podaj jako parametr do obliczenia tempa czytania w kolejnym parametrze. " &_
"Na tej podstawie program obliczy jak długo powinien wyróżniać kolejne akapity czytanego tekstu."
Const komunikat3="Pamiętaj, że jest to czas szacowany. Rzeczywisty czas potrzebny na czytanie" &_
" zależy także od składni tekstu, złożoności zdań czy stosowanej intonacji. " &_
"Dlatego będziesz mógł określić dodatkowy stały czas, który będzie dodawany do czasu zmiennego."
MsgBox (komunikat1 &chr(10) & komunikat2 & chr(10) & chr(10) & komunikat3,,"Prompt: Komunikat")
MsgBox (test,,"Prompt: Tekst przykładowy") 

s = InputBox("Podaj w sekundach czas potrzebny do określenia tempa czytania", "Prompter: Zmienny czas wyświetlania",0)
If len(s)=0 Then Exit Sub
t1 = Cdbl(s)
s = InputBox("Podaj w sekundach wymagany czas wyświetlania akapitu", "Prompter: Stały czas wyświetlania",0)
If len(s)=0 Then Exit Sub
t2=Cdbl(s)
sStyl=InputBox ("Podaj nazwę stylu (rozróżniana jest wielkość liter)" & chr(10) & chr(10) &_
 "Po zatwierdzeniu nazwy nastąpi 5 sekund zwłoki przed rozpoczęciem działania." , "Prompter: Sposób wyróżniania", "Nagłówek 3")
If len(sStyl)=0 Then
	MsgBox ("Nie podano nazwy stylu." & chr(10) & "Działanie zostanie zakończone.",16,"Prompter: Styl wyróżnienia")
	Exit Sub
End If
Wait(5000)
oCurs = ThisComponent.Text.CreateTextCursor()
vCurs= ThisComponent.getCurrentController.getViewCursor()
oCurs.GoToStart(False)
vCurs.GoToStart(0)
Do
	If NOT oCurs.gotoEndOfParagraph(True) Then Exit Do 
	sCurStyle = oCurs.ParaStyleName 
	oCurs.ParaStyleName=sStyl 
	i = Len(oCurs.getstart().TextParagraph().string) 'Właściwość TextParagraph nie występuje w Basicu Apache OpenOffice 4.1.7
	Wait((i/len(test)*t1+t2)*1000)
	oCurs.ParaStyleName=sCurStyle 
	NextPar()
	Do While NOT IsEmpty(vCurs.TextTable)
		NextPar()
	Loop
	NextPar()
	vCurs.goUp(1,0)
Loop Until NOT oCurs.gotoNextParagraph(False) 
Exit Sub
Styles:
If NOT IsNumeric(s) Then
	MsgBox ("Czas w sekundach." & chr(10) & "Nie wpisałeś liczby!",16,"Błąd parametrów.")
	Exit Sub
End If

MsgBox ("Nie ma w systemie stylu " & sStyl,16, "Błąd parametrów.")
End Sub
sub NextPar()
rem Makro zarajestrowane przez nagrywanie
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:GoToNextPara", "", 0, Array())
end sub