Attribute VB_Name = "TextCorrecter"
Option Explicit

Public CCheckActiv As Boolean
Public DrawIconAt As Long
Private CorrectPos As Integer
Private CorWord As String
Private CorAnf As Integer
Private CorLen As Integer
Private ConIsLastW As Boolean

Public Sub CorrectText(cText As Object, OutText() As String)
  Dim I As Integer
  Dim I2 As Integer
  Dim I3 As Integer
  Dim I4 As Integer
  Dim StrL As Long
  Dim DAT As String
  Dim DAT2 As String
  
  If Len(cText.Text) > 1024 Then Exit Sub
  If CorrectPos > cText.SelStart Then CorrectPos = cText.SelStart
  If Len(cText.Text) < 1 Or Len(OutText(4)) > 0 Or Left(cText.Text, 1) = "/" Or CCheckActiv = False Then
    OutText(5) = ""
    DrawIconAt = 0
    Exit Sub
  End If
  If CorAnf + CorLen > Len(cText.Text) Then
    OutText(5) = ""
    DrawIconAt = 0
  End If
  OutText(0) = ""
  OutText(1) = ""
  OutText(2) = ""
  OutText(3) = ""
  OutText(4) = ""
  If CorrectPos + 1 > Len(cText.Text) Then CorrectPos = Len(cText.Text) - 1
  For I = CorrectPos To 1 Step -1
    Select Case AscW(Mid(cText.Text, I, 1))
      Case 33, 35, 36, 64, 92, 162 To 255  'Andere Zeichen
      Case 65 To 90, 97 To 122, 214, 246, 220, 252, 196, 228 'Alle Buchstaben
      Case Else
        Exit For
    End Select
    If I = 1 Then Exit For
  Next
  If I < 1 Then CorrectPos = 1 Else CorrectPos = I
  I2 = CorrectPos - 1
  For I = CorrectPos To Len(cText.Text)
    Select Case AscW(Mid(cText.Text, I, 1))
      Case 65 To 90, 97 To 122, 214, 246, 220, 252, 196, 228  'Alle Buchstaben
      Case Else
        If I2 > 0 Then I3 = I2 Else I3 = I2 + 1
        Select Case AscW(Mid(cText.Text, I3, 1))
          Case 33, 35, 36, 47 To 57, 64, 92, 162 To 255
          Case Else
            If I - I2 > 2 Then
              DAT = Mid(cText.Text, I2 + 1, I - I2 - 1)
              If FindInFile(DAT, AppPath + "Words.dat", DAT2) = False Then
                I3 = 0
                I4 = 0
                StrL = 0
                Do Until I4 + 1 > I2
                  I4 = I4 + 1
                  I3 = I3 + 1
                  StrL = StrL + TextWW(Mid(cText.Text, I4, 1), Form1.pTBox.hDC)
                  If Mid(cText.Text, I4, 1) = Chr(13) Or Mid(cText.Text, I4, 1) = Chr(10) Or StrL > cText.Width Then
                    I3 = 0
                    StrL = 0
                  End If
                Loop
                DrawIconAt = StrL + TextWW(DAT, Form1.pTBox.hDC) / 2 - 8
                If DrawIconAt < 1 Then DrawIconAt = 1
                CorWord = Trim(DAT2)
                CorAnf = I2
                CorLen = I - I2 - 1
                OutText(5) = CorWord + "?"
                Exit For
              ElseIf CorAnf = I2 Then
                OutText(5) = ""
                DrawIconAt = 0
              End If
            End If
        End Select
        I2 = I
    End Select
  Next
  ConIsLastW = I > Len(cText.Text) Or CorAnf + CorLen + 1 = cText.SelStart
  CorrectPos = I
  Form1.TfRedraw
End Sub

Public Sub CorrectWord()
  If DrawIconAt = 0 Then Exit Sub
  Form1.Text1.Text = Left(Form1.Text1.Text, CorAnf) + LCase(CorWord) + Mid(Form1.Text1.Text, CorAnf + CorLen + 1)
  Form1.Text1.SelStart = Len(Form1.Text1.Text)
  CorrectPos = 1
End Sub

Public Sub CancelWord(OutText() As String)
  If DrawIconAt = 0 Then Exit Sub
  If ConIsLastW = True Then CorrectPos = 1
  CorrectText Form1.Text1, OutText
End Sub

Private Function FindInFile(Text As String, FileName As String, Vorschlag As String) As Boolean
  Dim I As Long
  Dim I2 As Integer
  Dim iStep As Long
  Dim eqCount As Integer
  Dim hgCount As Integer
  Dim DAT As String * 32
  Dim CpString As String * 32
  Dim cgCount As Integer
  Dim Frif As Integer
  Dim Found As Boolean
  Frif = FreeFile
  On Error Resume Next
  If Len(Dir(AppPath + "Words.dat")) = 0 Then
    CCheckActiv = False
    Exit Function
  End If
  Open FileName For Binary As #Frif
    CpString = LCase(Text)
    I = Int(LOF(Frif) / 32) / 2
    iStep = I
    Do
      cgCount = cgCount + 1
      iStep = iStep / 2
      Get Frif, Int(I) * 32 + 1, DAT
      If LCase(DAT) > CpString Then
        I = I - iStep
      ElseIf LCase(DAT) < CpString Then
        I = I + iStep
      Else
        Found = True
        Exit Do
      End If
      If iStep < 1 Then Exit Do
    Loop
    If Found = False And LOF(Frif) > 32 * 32 Then
      If I < 15 Then I = 15
      If (I + 15) * 32 > LOF(Frif) Then I = I - 16
      For iStep = I - 15 To I + 15
        Get Frif, iStep * 32 + 1, DAT
        If CpString = LCase(DAT) Then Found = True: Exit For
        eqCount = 0
        For I2 = 1 To Len(Text)
          If Mid(CpString, I2, 1) = LCase(Mid(DAT, I2, 1)) Then eqCount = eqCount + 2
        Next
        If Len(Text) = Len(Trim(DAT)) Then eqCount = eqCount + 1
        If eqCount > hgCount Then hgCount = eqCount: Vorschlag = DAT
      Next
    End If
    If Found = True Then Vorschlag = DAT
  Close #Frif
  If Err <> 0 Then MsgBox Err.Description + " in 'FindInFile'": CCheckActiv = False
  FindInFile = Found
End Function







