VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form1 
   Caption         =   "Babel Back-Translator"
   ClientHeight    =   7800
   ClientLeft      =   2910
   ClientTop       =   1740
   ClientWidth     =   9045
   Icon            =   "BabelBak.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   7800
   ScaleWidth      =   9045
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1900
      Index           =   2
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   9
      TabStop         =   0   'False
      Text            =   "BabelBak.frx":030A
      Top             =   5040
      Width           =   8055
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1900
      Index           =   1
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   8
      TabStop         =   0   'False
      Text            =   "BabelBak.frx":0310
      Top             =   3120
      Width           =   8055
   End
   Begin VB.ComboBox Combo3 
      Height          =   315
      Left            =   960
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   7320
      Width           =   3735
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1900
      Index           =   0
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Text            =   "BabelBak.frx":0316
      Top             =   1200
      Width           =   8055
   End
   Begin VB.ComboBox Combo2 
      Height          =   315
      Left            =   960
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   120
      Width           =   3735
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   5160
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   120
      Width           =   3735
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   2760
      Top             =   -240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin ComctlLib.TabStrip TabStrip1 
      Height          =   6615
      Left            =   240
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   600
      Width           =   8655
      _ExtentX        =   15266
      _ExtentY        =   11668
      _Version        =   327682
      BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7} 
         NumTabs         =   3
         BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "English Original"
            Key             =   ""
            Object.Tag             =   ""
            Object.ToolTipText     =   "enter the English here"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "Translated to French"
            Key             =   ""
            Object.Tag             =   ""
            Object.ToolTipText     =   "the result of translation"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {0713F341-850A-101B-AFC0-4210102A8DA7} 
            Caption         =   "Retranslated back to English"
            Key             =   ""
            Object.Tag             =   ""
            Object.ToolTipText     =   "compare this to the original"
            ImageVarType    =   2
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "Bakken Home Page..."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   7200
      TabIndex        =   11
      Top             =   7365
      Width           =   1665
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "Goto..."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   4800
      TabIndex        =   10
      Top             =   7365
      Width           =   570
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Service:"
      Height          =   195
      Left            =   240
      TabIndex        =   7
      Top             =   7365
      Width           =   585
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Translate"
      Height          =   195
      Left            =   240
      TabIndex        =   5
      Top             =   165
      Width           =   660
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "to"
      Height          =   195
      Left            =   4920
      TabIndex        =   4
      Top             =   165
      Width           =   135
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuCredits 
      Caption         =   "&Credits"
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "&About"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Created by Bob Hanson, hansonr@stolaf.edu
' for the Bakken Museum exhibit "Robo-Science"
' 1/18/03
' all code is copyright (c) 2003, Integrated Graphics, 312 Nevada St., Northfield, Minnesota.

Dim isautochange As Integer

Private Sub Combo1_Click()
  TabStrip1.Tabs(2).Caption = "Translated to " & Combo1.List(Combo1.ListIndex)
  Call settranslation(0)
End Sub

Private Sub Combo2_Click()
  thisrhyme = Combo2.ItemData(Combo2.ListIndex)
  Call settranslation(0)
End Sub

Private Sub Combo3_Click()
  Call settranslation(0)
End Sub

Private Sub Form_Load()
  Dim s As String
  Call setupinfo
  
End Sub

Sub setupinfo()
  Dim i As Integer
  Dim s As String
  Dim unit As Integer
  Dim sfile As String
  Dim sLine As String
  On Error Resume Next
  
  ReDim Preserve Rhymes(1)
  Rhymes(0).rhyme = "Welcome to the Bakken Library and Museum!"

  Combo1.AddItem "French"
  Combo1.AddItem "German"
  Combo1.AddItem "Italian"
  Combo1.AddItem "Pig Latin"
  Combo1.AddItem "Portuguese"
  Combo1.AddItem "Spanish"
  Combo1.ListIndex = 3
  
  Combo2.AddItem "  My Own Words..."
  unit = FreeFile
  sfile = App.Path & "\rhymes.txt"
  Open sfile For Input As #unit
  If Err Then
    MsgBox Error & " opening " & sfile
    End
  End If
  
  While Not EOF(unit)
  
    Line Input #unit, sLine
    sLine = Trim(sLine)
    If sLine = "" Or Left(sLine, 1) = "#" Then
    ElseIf Left(sLine, 6) = "title:" Then
      nrhymes = nrhymes + 1
      ReDim Preserve Rhymes(nrhymes)
      Rhymes(nrhymes).name = Trim(Mid(sLine, 7))
      Combo2.AddItem " " & Rhymes(nrhymes).name
      Combo2.ItemData(Combo2.NewIndex) = nrhymes
      Rhymes(nrhymes).rhyme = ""
    ElseIf Left(sLine, 6) = "idiom:" Then
      nrhymes = nrhymes + 1
      ReDim Preserve Rhymes(nrhymes)
      Rhymes(nrhymes).name = Trim(Mid(sLine, 7))
      Combo2.AddItem "Idiom: " & Rhymes(nrhymes).name
      Combo2.ItemData(Combo2.NewIndex) = nrhymes
      Rhymes(nrhymes).rhyme = ""
    ElseIf Left(sLine, 9) = "wavefile:" Then
      Rhymes(nrhymes).wavefile = Trim(Mid(sLine, 10))
    Else
      Rhymes(nrhymes).rhyme = Rhymes(nrhymes).rhyme & Chr(13) & Chr(10) & sLine
    End If
  Wend
  Close unit
  Combo2.ListIndex = 0
 
  Combo3.AddItem "babelfish.altavista.com"
  Combo3.AddItem "www.freetranslation.com"
  Combo3.ListIndex = 0
  
'  Rhymes(0).rhyme = ""
  Text1(1).Text = "Enter a phrase above, or choose a nursery rhyme " & Chr(13) & Chr(10) & "or idiom from the selection box." & Chr(13) & Chr(10) & "Then select a language and check the translation."
  

End Sub

Private Sub Form_Unload(Cancel As Integer)
 End
End Sub

Private Sub Label4_Click()
  Call puttofile(App.Path & "\~goto.htm", "<script language=javascript>location=""http://" & Combo3 & """</script>")
  Call shellopen(App.Path & "\~goto.htm", vbNormal)
End Sub

Private Sub Label5_Click()
  Call puttofile(App.Path & "\~goto.htm", "<script language=javascript>location=""http://www.thebakken.org""</script>")
  Call shellopen(App.Path & "\~goto.htm", vbNormal)
End Sub

Private Sub mnuAbout_Click()
  Dim s As String
  s = "Babel Back-Translator was written by Bob Hanson (hansonr@stolaf.edu) for the Bakken Museum, in Minneapolis, Minnesota. It is a Visual Basic 6 program that interacts with the web via a Microsoft Inet Browser Connection Control Extension."
  s = s & " The program (BabelBak.exe) and full source code is available at http://www.stolaf.edu/people/hansonr/translate/bakken."
  MsgBox s
End Sub

Private Sub mnuCredits_Click()
  Dim s As String
  s = "Thanks to Ira Hanson, researched and collected all of the nursery rhymes and selected all the idioms."
  s = s & Chr(13) & Chr(13) & "Thanks to Melissa Brown and Tim Barrett for the wonderful exhibit on ""Robo-Science."" What a great introduction to the Bakken!"
  MsgBox s
End Sub

Private Sub mnuExit_Click()
 End
End Sub

Private Sub TabStrip1_Click()
 Dim i As Integer
 i = TabStrip1.SelectedItem.index
 'Text1(i - 1).Visible = True
 'Text1(i Mod 3).Visible = False
 'Text1((i + 1) Mod 3).Visible = False
 isautochange = True
 If i = 1 Then Text1(0) = Rhymes(thisrhyme).rhyme
 If i >= 2 Then
   If (Combo2.ListIndex = 0) Then Rhymes(thisrhyme).rhyme = Text1(0)
   If Not havetranslation Then
        Text1(1) = getTranslation(1)
        Call settranslation(1)
   End If
 End If
 If i = 3 Then
   If Not haveretranslation Then
        Text1(2) = getTranslation(-1)
        Call settranslation(2)
   End If
 End If
 isautochange = False
End Sub
Function getTranslation(idirection As Integer) As String
Dim theinfo As String
Dim theurl As String
Dim lp As String
Dim s As String
Dim tag1 As String

On Error Resume Next

If Combo1 = "Pig Latin" Then
  If idirection = 1 Then
    getTranslation = fTranslate(Text1(0), 1)
  Else
    getTranslation = fTranslate(Text1(1), -1)
  End If
  Exit Function
End If

Select Case Combo3.ListIndex

Case 0 'altavista

Select Case Combo1
Case "French"
  lp = "fr"
Case "German"
  lp = "de"
Case "Italian"
  lp = "it"
Case "Portuguese"
  lp = "pt"
Case "Spanish"
  lp = "es"
End Select

If idirection = 1 Then
  lp = "en_" & lp
Else
  lp = lp & "_en"
End If
theurl = "http://babelfish.altavista.com/babelfish/tr?doit=done&tt=urltext&intl=1&lp=" & lp & "&urltext="
tag1 = "<Div style=padding:"


Case 1  'freetranslation
  Select Case idirection
  Case 1
    lp = "English/" & Combo1
  Case -1
    lp = Combo1 & "/English"
  End Select
  theurl = "http://ets.freetranslation.com/?Sequence=core&Mode=html&template=TextResults2.htm&Language=" & lp & "&SrcText="
  tag1 = "<textarea"

End Select

If idirection = 1 Then
  s = Text1(0)
  Text1(1) = ""
  Text1(2) = ""
  If s = "" Then Exit Function
  Text1(1) = "translating..."
Else
  s = Text1(1)
  If (Combo3.ListIndex = 0) Then s = fromvbstr(Text1(1))
  Text1(2) = ""
  If s = "" Then Exit Function
  Text1(2) = "translating..."
End If

Call strsub(s, Chr(13) & Chr(10), ";")
While (Left(s, 1) = ";"): s = Mid(s, 2): Wend

theurl = theurl & s
theinfo = Inet1.OpenURL(theurl)
Call puttofile(App.Path & "\~recent.htm", theinfo)
s = strextr(theinfo, tag1)
s = strextr(theinfo, ">")
theinfo = Left(theinfo, InStr(theinfo, "<") - 1)

If (idirection = 1) Then theinfo = tovbstr(theinfo)

Call strsub(theinfo, Chr(10), Chr(13) & Chr(10))
Call strsub(theinfo, ";", Chr(13) & Chr(10))
getTranslation = theinfo
End Function

Private Sub Text1_Change(index As Integer)
  Dim s As String
  Dim i As Integer
  Select Case index
  Case 0
    If Combo2.ListIndex <> 0 Then
      If Not isautochange Then
        Debug.Print Text1(0)
        Rhymes(0).rhyme = Text1(0)
        i = Text1(0).SelStart
        Combo2.ListIndex = 0
        Text1(0).SelStart = i
      Else
        Call settranslation(0)
      End If
    Else
        Call settranslation(10)
    End If
  Case 1
    Call settranslation(-2)
  Case 2
    Call settranslation(-2)
  End Select
End Sub

Sub settranslation(i)
Select Case i
Case 0, 10
      havetranslation = False
      haveretranslation = False
      Text1(1) = ""
      Text1(2) = ""
      If i = 0 Then TabStrip1.Tabs(1).Selected = True
Case 1
      havetranslation = True
      haveretranslation = False
      Text1(2) = ""
Case 2
      haveretranslation = True
Case -1
      havetranslation = False
      haveretranslation = False
      Text1(2) = ""
Case -2
      haveretranslation = False
End Select

End Sub
Function tovbstr(sstr As String) As String
Dim s As String
Dim i As Integer
s = sstr
Do
  i = InStr(s, Chr(&HC3))
  If i = 0 Then Exit Do
  s = Left(s, i - 1) & Chr(Asc(Mid(s, i + 1, 1)) + 64) & Mid(s, i + 2)
Loop
Call strsub(s, Chr(&HC2), "")
tovbstr = s
End Function
Function fromvbstr(sstr As String) As String
Dim s As String
Dim i As Integer
Dim iChar As Integer
s = ""
For i = 1 To Len(sstr)
  iChar = Asc(Mid(sstr, i, 1))
  If (iChar > 122) Then
    s = s & Chr(&HC3)
    iChar = iChar - 64
  End If
  s = s & Chr(iChar)
Next
fromvbstr = s
End Function