Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Untertiteldatei erstellen
| Uploader: |  grindstone |
| Datum/Zeit: | 05.02.2019 10:33:49 |
'Coded 2019 by grindstone
'Contact: https://forum.qbasic.at/privmsg.php?mode=post&u=1890
'
'This program is distributed under the terms of the FBPSL
' https://www.freebasic-portal.de/fbpsl.html
#Include Once "file.bi"
#Include Once "dir.bi"
Function ini OverLoad (datei As String, schluessel As String) As String
'liest werte aus der ini-datei
Dim As Integer ff
Dim As String g
ff = FreeFile
If Open(datei For Input As #ff) Then
Return ""
EndIf
Do
Line Input #ff, g
If Left(g, Len(schluessel) + 1) = schluessel + "=" Then
Close ff
Return Mid(g, InStr(g, "=") + 1)
EndIf
Loop Until Eof(ff)
Close ff
Return ""
End Function
Function ini (datei As String, schluessel As String, wert As string) As Integer
'schreibt werte in die ini-datei
Dim As Integer ff, ft
Dim As String g, td
Dim As boolean gefunden = FALSE
ff = FreeFile
If Open(datei For Input As #ff) Then
Return 1 'fehler
EndIf
td = Left(Command(0), Len(Command(0)) - 3) + "tmp"
ft = FreeFile
If Open(td For Output As #ft) Then
Close ff
Close ft
Return 1 'fehler
EndIf
Do
Line Input #ff, g
If Left(g, Len(schluessel) + 1) = schluessel + "=" Then
Print #ft, schluessel + "=" + wert
gefunden = TRUE
Else
Print #ft, g
EndIf
Loop Until Eof(ff)
If gefunden = FALSE Then
Print #ft, schluessel + "=" + wert
EndIf
Close ff
Close ft
Kill datei
Name td, datei
End Function
Function stringmod(text As String = "", modus As Integer = 0) As String
'die angabe von 'modus' ist optional, defaultwert ist 0
'modus0 --> normale funktion
'modus1 --> kehrt nach 'pfeil nach oben', 'pfeil nach unten', 'bild nach oben' und
' 'bild nach unten'zum hauptprogramm zurück
'modus4 --> setzt nur die variable 'vorigertext' und kehrt dann zurück
'modus8 --> setzt bei druck auf esc - taste code 27 (esc) vor den rückgabestring
Dim As Integer ze, sp, co, gi, ms, mz, rad, tasten, laenge
Dim As String g, merken, txt, g2
Static As String vorigertext
If (modus And 4) Then
vorigertext = text + " "
Return text
EndIf
If vorigertext = "" Then
vorigertext = " "
EndIf
txt = text + " "
merken = txt
co = Pos 'cursor offset
ze = CsrLin
sp = Len(txt) 'zeiger auf zeichen unter cursor
Locate ze, co, 1
Print txt;
Locate ze, sp+co-1, 1
Do
'eingabe
g = InKey
If Len(g) = 1 Then 'normales zeichen
If g[0] > 31 Then 'normaler buchstabe
txt = Left(txt, sp - 1) + g + Mid(txt, sp)
sp += 1
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
Else 'steuerzeichen
Select Case g[0]
Case 8 ' Rücktaste
If sp > 1 Then
txt = Left(txt, sp - 2) + Mid(txt, sp)
sp -= 1
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
End If
Case 13
'return
Case 27 'esc
If (modus And 8) Then
txt = Chr(27) + txt
Else
txt = merken 'alter string
EndIf
g = Chr(13) 'beenden
Case Else
'Print "*"; g; "*"; ASC(g) 'code von unbekannter taste anzeigen
End Select
End If
ElseIf Len(g) = 2 Then 'steuerzeichen
gi = g[1]
Select Case gi 'steuerzeichen
Case 75 'pfeil nach links -> cursor nach links
If sp > 1 Then
sp -= 1
Locate ze, sp+co-1, 1
End If
Case 77 'pfeil nach rechts -> cursor nach rechts
If sp < Len(txt) Then
sp += 1
Locate ze, sp+co-1, 1
ElseIf txt = " " Then 'vorherigen string setzen
txt = vorigertext
sp = Len(txt)
Print txt;
Locate ze, sp+co-1, 1
End If
Case 14 'rücktaste -> zeichen vor cursor löschen
If sp > 1 Then
txt = Left(txt, sp - 1) + Mid(txt, sp)
sp -= 1
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
End If
Case 83 'entf -> zeichen hinter cursor löschen
If sp < Len(txt) Then
txt = Left(txt, sp - 1) + Mid(txt, sp + 1)
Locate ze, co, 0
Print txt;
Locate ze, sp+co-1, 1
End If
Case 71 'pos1 -> cursor an stringanfang setzen
sp = 1
Locate ze, sp+co-1, 1
Case 79 'ende -> cursor an stringende setzen
sp = Len(txt)
Locate ze, sp+co-1, 1
Case Else
If (modus And 1) Then
txt = g + Chr(ze) + Chr(co) + txt 'steuerzeichen und cursorposition zurückgeben
g = Chr(13)
EndIf
'Print "*"; g; "*";Asc(Right(g,1)) 'code von unbekannter taste anzeigen
End Select
Else 'keine taste
Sleep 1 'zur ressourcenschonung
End If
Loop Until g = Chr(13) 'return
vorigertext = txt
Return Left(txt, Len(txt) - 1)
Locate ze, sp+co-1, 0 'cursor aus
End Function
Function msec(zeit As String) As Integer
'rechnet zeitangabe hh:mm:ss in millisekunden um
Dim As String stunden, minuten, sekunden
Dim As Integer ret
stunden = Left(zeit, 2)
minuten = Mid(zeit, 4, 2)
sekunden = Mid(zeit, 7, 2)
ret = 3600000 * Val(stunden) + 60000 * Val(minuten) + 1000 * Val(sekunden) + Val(Mid(zeit, 10))
Return ret
End Function
'############################################################################
Dim As String text, timecode, ausgabe, zeit, t, g, txt, timevon, timebis, leerzeichen, trenner, nummer, _
inidatei, timebismax, letzter, verzeichnis
ReDim As String texte(1), timecodes(1)
Dim As Integer zeilen, punkte, anfang, ende, x, y, z, timediff, buchstaben, naechster, voriger, silben, _
silbenzeiger, umschlag
Dim As Double laenge, korrektur
Dim As boolean fertig = FALSE
inidatei = Left(Command(0), Len(Command(0)) - 3) + "ini"
If Not FileExists(inidatei) Then 'inidatei anlegen
Open inidatei For Output As #1
Close 1
EndIf
'zu bearbeitendes verzeichnis angeben
verzeichnis = ini(inidatei, "verzeichnis") 'verzeichnis aus inidatei holen
Print "Verzeichnis: ";
verzeichnis = stringmod(verzeichnis) 'namen eingeben / bearbeiten
Print
Print
If verzeichnis = "" Then
verzeichnis = ExePath
EndIf
If InStrRev(verzeichnis, ".") > InStrRev(verzeichnis, Any "\/") Then 'pfad extrahieren
verzeichnis = Left(verzeichnis, InStrRev(verzeichnis, Any "\/") - 1)
EndIf
ini(inidatei, "verzeichnis", verzeichnis) 'in inidatei schreiben
MkDir(verzeichnis + "\untertitel") 'erstellt ausgabeverzeichnis, falls nicht vorhanden
'liste aller textdateien erstellen
x = 0
g = Dir(verzeichnis + "\*.txt", -1)
Do While Len(g)
x += 1
ReDim Preserve texte(x)
texte(x) = g
g = Dir("", -1)
Loop
'liste aller timecodedateien erstellen
x = 0
g = Dir(verzeichnis + "\*.src", -1)
Do While Len(g)
x += 1
ReDim Preserve timecodes(x)
timecodes(x) = g
g = Dir("", -1)
Loop
Dim As Integer bestmatch, matchmax, i, gleich
Print UBound(timecodes);IIf(UBound(timecodes) = 1, " Timecodedatei", " Timecodedateien")
For z = 1 To UBound(timecodes) 'alle timecodedateien
Print
Print z;". Objekt"
'passende textdatei suchen
bestmatch = 0
matchmax = 0
For y = 1 To UBound(texte) 'alle textdateien
'anfänge der dateinamen vergleichen
For i = 0 To IIf(Len(timecodes(z)) < Len(texte(y)), Len(timecodes(z)), Len(texte(y))) - 1
If timecodes(z)[i] <> texte(y)[i] Then '1. nichtübereinstimmender buchstabe
If matchmax < i Then 'größere anzahl übereinstimmender buchstaben gefunden
matchmax = i 'anzahl merken
bestmatch = y 'index der textdatei merken
EndIf
Exit For 'nächste textdatei
EndIf
Next
Next
Print " Timecode: ";timecodes(z)
Print " Text: ";texte(bestmatch)
If bestmatch = 0 Then 'keine passende textdatei gefunden
Print " Keine passende Textdatei"
Continue For
EndIf
Open verzeichnis + "\" + texte(bestmatch) For Input As #1
Open verzeichnis + "\" + timecodes(z) For Input As #2
Print " Ausgabe: ";Left(timecodes(z), matchmax) + ".src"
Open verzeichnis + "\untertitel\" + Left(timecodes(z), matchmax) + ".src" For Output As #3
Print " Lade Text..."
txt = Input(Lof(1), 1) 'gesamtes textfile in string laden
Close 1
silben = 0
timebismax = ""
timediff = 0
umschlag = 0
letzter = ""
'gesamtzahl der vokale ermitteln
For x = 0 To Len(txt) - 1
If InStr("aeiouäöüy", Chr(txt[x])) Then 'vokal
silben += 1
EndIf
Next
'zeiten aufaddieren
Do
Line Input #2, g
If InStr(g, "-->") Then 'timecode
timevon = Left(g, InStr(g, "-->") - 2)
timebis = Mid(g, InStr(g, "-->") + 4)
timediff += msec(timebis) - msec(timevon)
EndIf
Loop Until Eof(2)
timebismax = timebis
Seek 2, 1 'dateizeiger zurücksetzen
'variablen initialisieren
laenge = silben / timediff 'wert für silben/ms berechnen
korrektur = 1
leerzeichen = "j" 'trennen bei leerzeichen
anfang = 1
ende = 1
trenner = IIf(leerzeichen = "j", "#.,;: ", "#.,;:")
Print " Berechne Korrekturfaktor..."
Do
anfang = 1
ende = 1
Seek #2, 1 'dateizeiger zurücksetzen
Do 'timecodedatei abarbeiten
Line Input #2, g
If InStr(g, "-->") Then 'timecode
timevon = Left(g, InStr(g, "-->") - 2)
timebis = Mid(g, InStr(g, "-->") + 4)
timediff = msec(timebis) - msec(timevon) 'einblendzeit in ms
silben = Int(timediff * laenge * korrektur + .5) 'anzahl der silben berechnen
buchstaben = 0
Do 'silben abzählen und anzahl der buchstaben ermitteln
If anfang + buchstaben >= Len(txt) Then 'text zuende
Exit Do
EndIf
buchstaben += 1
If InStr("aeiouäöüy", Chr(txt[anfang + buchstaben])) Then 'vokal
silben -= 1
EndIf
Loop While silben
naechster = InStr(anfang + buchstaben, txt, Any trenner) 'nächsten trenner suchen
voriger = InStrRev(txt, Any trenner, anfang + buchstaben) 'vorhergehenden trenner suchen
'zeiger auf ende des textabschnitts setzen
If naechster = 0 Then
ende = voriger
ElseIf voriger = 0 Then
ende = naechster
ElseIf voriger < anfang Then
ende = naechster
ElseIf Abs(naechster - (anfang + buchstaben)) <= Abs(voriger - (anfang + buchstaben)) Then
ende = naechster
Else
ende = voriger
EndIf
If (umschlag > 2) And (letzter = "time") Then
'werte in ausgabedatei schreiben
Print #3, nummer
Print #3, g
g = Mid(txt, anfang, ende - anfang + 1)
Print #3, g
Print #3, ""
fertig = TRUE
EndIf
If (ende > anfang) And (ende + anfang > 0) Then
anfang = ende + 1 'zeiger auf beginn des nächsten textabschnitts
Else
If letzter = "time" Then
umschlag += 1
EndIf
letzter = "text"
korrektur -= .001 'korrekturfaktor vermindern
Exit Do 'text zuende
EndIf
Do While txt[anfang - 1] = Asc(" ")
anfang += 1
Loop
ElseIf Str(Val(g)) = g Then 'nummer
nummer = g
Else
'ignorieren --> nächste zeile
EndIf
Loop Until Eof(2)
If Eof(2) Then
If letzter = "text" Then
umschlag += 1
EndIf
letzter = "time"
korrektur += .001 'korrekturfaktor erhöhen
EndIf
Loop Until fertig
Close
Next
Print
Print "Fertig"
Sleep