VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Separação Silábica"
   ClientHeight    =   570
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3855
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   570
   ScaleWidth      =   3855
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox Source 
      Height          =   285
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3855
   End
   Begin VB.Label Dest 
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Left            =   0
      TabIndex        =   1
      Top             =   285
      Width           =   3855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim o As String, d As String
Private Sub Source_KeyUp(KeyCode As Integer, Shift As Integer)
  Dim i As Integer, a As Byte, w As Byte, s As Byte, e As Boolean
  '   Índice        Anterior   Working    Separar    Encontrado
  o = Source.Text: d = "": i = 1
  Do Until i > Len(o)
    If i > 1 Then a = Asc(Mid(o, i - 1, 1)) Else a = 0
    w = Asc(Mid(o, i, 1))
    s = 0
    If éVogal(w) Then
      If éVogal(a) Then
        ' aqui dentro, a e w tomam outros valores, vez
        ' que os valores originais já não interessam mais
        i = i - 1: a = 0: e = False
        Do Until i > Len(o)
          w = nVoc(Asc(Mid(o, i, 1)))
          If w = 0 Then s = 0: Exit Do
          If w = a And w > 1 Then: s = 1: Exit Do
          If a > w And Not e Then e = True
          If w > a And e Then s = 2: Exit Do
          a = w
          i = i + 1
        Loop
      ElseIf a = 0 Then s = 1
      Else
        s = 2
        If i > 2 Then If InStr("-ch-lh-nh-br-cr-dr-" & _
        "fr-gr-kr-pr-tr-vr-bl-cl-dl-fl-gl-kl-pl-tl-" & _
        "vl", "-" & LCase(Mid(o, i - 2, 2))) Then s = 3
      End If
    End If
    If s > 0 Then
      d = d & Left(o, i - s) & "-"
      o = Mid(o, i - s + 1)
      i = s
    End If
    i = i + 1
  Loop
  d = d & o & "-"
  Dest.Caption = d
End Sub
'ase 66, 67, 68, 70, 71, 72, 74, 75, 76, 77, 78, 80, 81, 82, 83, 84, 86, 87, 88, 90, 199
'     b   c   d   f   g   h   j   k   l   m   n   p   q   r   s   t   v   w   x   z    ç
Function éVogal(Char As Byte) As Boolean
  Select Case Asc(UCase(Chr(Char)))
    Case 65, 69, 73, 79, 85, 192, 193, 194, 195, 201, 202, 205, 211, 212, 213, 218, 220 ', 89, 221, 159
    '     a   e   i   o   u    à    á    â    ã    é    ê    í    ó    ô    õ    ú    ü '   y    ý    ÿ
      éVogal = True
    Case Else: éVogal = False
  End Select
End Function
Function nVoc(Char As Byte) As Byte 'Nível Vocálico
  Select Case Asc(UCase(Chr(Char)))
    Case 73, 85, 220: nVoc = 1 ' i u ü
    Case 69, 79: nVoc = 2 ' e o
    Case Else: If éVogal(Char) Then nVoc = 3 Else nVoc = 0
  End Select
End Function