Rabu, 22 Januari 2014

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

Bank Saya

Pembayaran melalui Bank berikut :

Norek : 013 1 001384 5
An. Een Pahlefi

Norek BRI Rencana : 0623 01 000074-55-6
An. Een Pahlefi

Norek : 0623 01 015938 50 9
An. Een Pahlefi

Norek : 0623 01 015938 50 9
An. Een Pahlefi

Norek : 0623 01 015938 50 9
An. Een Pahlefi

Norek : 0623 01 015938 50 9
An. Een Pahlefi

Monitoring

Status Panel Admin
Jam Sekarang
Tanggal
Salam Sapa :
Status Admin :
User : User Online

Popular Posts