Tutorial Subtitle Editor dengan Visual Basic
Dim MyIndex As Integer, VArr As Variant, VBarr As Variant
Private Sub CmdUpDown_Click(Index As Integer)
Dim n
n = Val(texts.Text)
If MyIndex = 3 Then
If Index = 1 And n < 999 Then
texts.Text = n + 1
End If
Else
If Index = 1 And n < 59 Then
texts.Text = n + 1
End If
End If
If Index = 0 And n > 0 Then
texts.Text = n - 1
End If
End Sub
Private Sub Command1_Click()
GetSrtFile
End Sub
Private Sub GetSrtFile()
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.Flags = cdlOFNHideReadOnly
CommonDialog1.Filter = "Subtitle (*.srt)|*.srt"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
Call GetSample(1)
Exit Sub
ErrHandler:
Exit Sub
End Sub
Private Sub GetSample(myNumb As Double)
Dim xLine, MyLine, SubArr
Open Text1.Text For Input As #1
Do
Line Input #1, xLine
If Val(xLine) = myNumb Then
TextSrt(0).Text = xLine
Line Input #1, MyLine
Call Splitter(MyLine, " --> ")
TextSrt(1).Text = VBarr(0)
TextSrt(2).Text = VBarr(1)
Call Splitter(TextSrt(1).Text, ",")
SubArr = VBarr(0)
textedit(3).Text = VBarr(1)
Call Splitter(SubArr, ":")
textedit(0).Text = VBarr(0)
textedit(1).Text = VBarr(1)
textedit(2).Text = VBarr(2)
TextSrt(3).Text = ""
Do
Line Input #1, MyLine
TextSrt(3).Text = TextSrt(3).Text & MyLine & vbCrLf
Loop Until MyLine = ""
Exit Do
End If
Loop
Close #1
End Sub
Private Sub Splitter(MyArg, Delim As String)
VBarr = Split(MyArg, Delim)
End Sub
Private Sub Command4_Click()
Dim n As Double
If Text1.Text = "" Then
Else
n = Val(TextSrt(0).Text) + 1
Call GetSample(n)
End If
End Sub
Private Sub Command6_Click()
Dim mya, myb, sto, st1, st2, st3
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
'EKSEKUSI
If Text1.Text = "" Then
Else
MsgBox "Membuat SRT FILE ORiginal", vbOKOnly, "PROCESS"
mya = Len(Text1.Text)
myb = Mid(Text1.Text, 1, (mya - 4))
myb = myb & "(original).srt"
FileCopy Text1.Text, myb
Open myb For Input As #1
Open Text1.Text For Output As #2
Do Until EOF(1)
Line Input #1, sto
If Mid(sto, 14, 3) = "-->" Then
Call Splitter(sto, "-->")
st1 = VBarr(0)
st2 = VBarr(1)
st1 = bagiempat(st1)
st2 = bagiempat(st2)
st1 = Val(st1) + Val(Text5.Text)
st2 = Val(st2) + Val(Text5.Text)
Call konversi(Val(st1))
st1 = nol(VArr(0)) & ":" & nol(VArr(1)) & ":" & nol(VArr(2)) & "," & nolz(VArr(3))
Call konversi(Val(st2))
st2 = nol(VArr(0)) & ":" & nol(VArr(1)) & ":" & nol(VArr(2)) & "," & nolz(VArr(3))
sto = st1 & " --> " & st2
End If
Print #2, sto
Loop
Close #1
Close #2
MsgBox "COMPLETE"
End If
End Sub
Private Sub textedit_Change(Index As Integer)
Dim myvalue
If Index = 3 Then
Select Case Len(textedit(Index).Text)
Case 0
textedit(Index).Text = "000"
Case 1
textedit(Index).Text = "00" & textedit(Index).Text
Case 2
textedit(Index).Text = "0" & textedit(Index).Text
End Select
Else
Select Case Len(textedit(Index).Text)
Case 0
textedit(Index).Text = "00"
Case 1
textedit(Index).Text = "0" & textedit(Index).Text
End Select
End If
myvalue = kalkulasi(Val(textedit(0).Text), Val(textedit(1).Text), Val(textedit(2).Text), Val(textedit(3).Text))
Text4.Text = myvalue
myvalue = Val(Text4.Text) - Val(Text2.Text)
If myvalue < 0 Then
Label4.Caption = "MAJU"
myvalue = Mid(myvalue, 2)
ElseIf myvalue > 0 Then
Label4.Caption = "MUNDUR"
Else
Label4.Caption = "-"
End If
Text5.Text = myvalue
Call konversi(Val(Text5.Text))
Text6.Text = nol(VArr(0)) & ":" & nol(VArr(1)) & ":" & nol(VArr(2)) & "," & nolz(VArr(3))
End Sub
Private Sub bagidua(MyText)
Dim myval1, myval2
Call Splitter(MyText, " --> ")
myval1 = VBarr(0)
myval2 = VBarr(1)
myval1 = bagiempat(myval1)
myval2 = bagiempat(myval2)
End Sub
Private Function bagiempat(myval)
Dim val1, val2, val3, val4, val5, value1, value2
Call Splitter(myval, ",")
val5 = VBarr(0)
val4 = VBarr(1)
Call Splitter(val5, ":")
val1 = VBarr(0)
val2 = VBarr(1)
val3 = VBarr(2)
bagiempat = kalkulasi(Val(val1), Val(val2), Val(val3), Val(val4))
End Function
Private Function nol(myval)
If Len(myval) = 0 Then
nol = "00"
ElseIf Len(myval) = 1 Then
nol = "0" & myval
Else
nol = myval
End If
End Function
Private Function nolz(myval)
If Len(myval) = 0 Then
nolz = "000"
ElseIf Len(myval) = 1 Then
nolz = "00" & myval
ElseIf Len(myval) = 2 Then
nolz = "0" & myval
Else
nolz = myval
End If
End Function
Private Function kalkulasi(val1 As Double, val2 As Double, val3 As Double, val4 As Double)
val1 = val1 * 3600000
val2 = val2 * 60000
val3 = val3 * 1000
kalkulasi = val1 + val2 + val3 + val4
End Function
Private Sub konversi(myval As Double)
Dim v1, v2, v3, v4
v4 = Right(myval, 3)
myval = (myval - Val(v4)) / 1000
If myval >= 3600 Then
v1 = Fix(myval / 3600)
myval = (myval - (v1 * 3600))
End If
If myval >= 60 Then
v2 = Fix(myval / 60)
myval = (myval - (v2 * 60))
End If
v3 = myval
VArr = Array(v1, v2, v3, v4)
End Sub
Private Sub textedit_GotFocus(Index As Integer)
Dim n
MyIndex = Index
texts.Enabled = True
Select Case Index
Case 0
n = "hours"
Case 1
n = "minutes"
Case 2
n = "seconds"
Case 3
n = "miliseconds"
End Select
Label3.Caption = n
texts.Text = Val(textedit(Index).Text)
End Sub
Private Sub texts_Change()
textedit(MyIndex).Text = texts.Text
End Sub
Private Sub texts_KeyPress(KeyAscii As Integer)
Dim Ky
Ky = KeyAscii
If (Ky >= 48 And Ky
If MyIndex = 3 Then
If Len(texts.Text) < 3 Or Ky = 8 Then
KeyAscii = Ky
Else
KeyAscii = 0
End If
Else
If Len(texts.Text) < 2 Or Ky = 8 Then
If Val(texts.Text) < 6 Or Ky = 8 Then
KeyAscii = Ky
Else
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End If
Else
KeyAscii = 0
End If
End Sub
Private Sub TextSrt_Change(Index As Integer)
If Index = 2 Then
Text2.Text = bagiempat(TextSrt(1).Text)
Text3.Text = bagiempat(TextSrt(2).Text)
End If
End Sub
Private Sub TextSrt_Click(Index As Integer)
On Error Resume Next
If Index = 1 Then
Call Splitter(TextSrt(1).Text, ",")
SubArr = VBarr(0)
textedit(3).Text = VBarr(1)
Call Splitter(SubArr, ":")
textedit(0).Text = VBarr(0)
textedit(1).Text = VBarr(1)
textedit(2).Text = VBarr(2)
End If
End Sub
0 comments:
Posting Komentar