'#Reference {00020905-0000-0000-C000-000000000046}#8.1#0#C:\Programme\Microsoft Office\Office\MSWORD9.OLB#Microsoft Word 9.0 Object Library
''Spell check of the current translation list with Microsoft Word Speller

'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND
'EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
'OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE

Option Explicit

Dim wrd As Word.Application
Dim sel As Word.Selection
Dim doc As Word.Document
Dim spl As Word.SpellingSuggestions
Dim lng As Integer
Dim bWrdLoaded As Boolean
' Load Microsoft Word
Private Sub LoadWord()
    Set wrd = New Word.Application
    wrd.Documents.Add
    wrd.Visible = False
    bWrdLoaded = True
	' Set Spell checking options
	With wrd.Options
		.IgnoreInternetAndFileAddresses = True
		.IgnoreMixedDigits = True
		.IgnoreUppercase = True
	End With
End Sub
' Unload Microsoft Word
Private Sub UnloadWord()
    wrd.Quit wdDoNotSaveChanges
    Set wrd = Nothing
    bWrdLoaded = False
End Sub
' Strip all ampersands
Private Sub StripAmpersands(temp As String)
	Dim i As Integer

	i = InStr(temp, "&")
	While i <> 0
		temp = Left(temp, i - 1) + Mid(temp, i + 1)
		i = InStr(temp, "&")
	Wend
End Sub
' Strip all tabs
Private Sub StripTabs(temp As String)
	Dim i As Integer

	i = InStr(temp, vbTab)
	If i <> 0 Then
		temp = Left(temp, i - 1)
	End If

	i = InStr(temp, "\t")
	If i <> 0 Then
		temp = Left(temp, i - 1)
	End If
End Sub
' Strip all extra strings to clean up strings before spell checking
Private Function StripExtras(temp As String, s As PslTransString) As Boolean
	StripExtras = True

	If Len(temp) <= 1 Or s.ResType = "Version" Or s.ResType = "AcceleratorTable" Or s.ResType = "Font" Then
		StripExtras = False
		Exit Function
	End If

	If s.ResType = "Dialog" Or s.ResType = "Menu" Or s.ResType = "Menü" Then
		StripTabs(temp)
		StripAmpersands(temp)
		Exit Function
	End If
End Function
'To check the spelling of the string
Private Function CheckString(txt As String, lng As Long) As Boolean
    Dim sperr As Word.ProofreadingErrors

    wrd.Selection.WholeStory
    wrd.Selection.Delete
    wrd.Selection.TypeText txt
    wrd.Selection.WholeStory
    wrd.Selection.LanguageID = lng
    Set sperr = wrd.ActiveDocument.SpellingErrors
    If sperr.Count = 0 Then
        CheckString = True
    Else
        CheckString = False
    End If
End Function
Sub Main
    Dim prj As PslProject
    Dim trn As PslTransList
    Dim i As Integer

    ' Do we have an open project?
    Set prj = PSL.ActiveProject
    If prj Is Nothing Then
		MsgBox("No active PASSOLO project.")
		Exit Sub
	End If

    ' Do we have an open translation list?
    Set trn = PSL.ActiveTransList
    If trn Is Nothing Then
		MsgBox("No active translation list.")
		Exit Sub
	End If

	' Load Word
	Dim dic As Word.Dictionary
	LoadWord

	' Check dictionary for current language
	Dim lng As Long
	lng = trn.Language.LangID
	Set dic = wrd.Languages(lng).ActiveSpellingDictionary
	If dic Is Nothing Then
		MsgBox("No dictionary for language " & PSL.GetLangCode(lng, pslCodeText) & " installed!")
		UnloadWord
		Exit Sub
	End If

	' Loop all displayed text strings
	PSL.Output( "Spell Checking with Word")
	Dim cnt As Long, errcnt As Long
	cnt = trn.StringCount(pslDisplay)
	errcnt = 0
	For i = 1 To cnt
		Dim pstr As PslTransString
		Set pstr = trn.String(i, pslDisplay)

		' Do we have a valid string
		If Not pstr Is Nothing Then
			' Is the strings translated
			If pstr.State(pslStateTranslated) Then
				Dim txt As String
				txt = pstr.Text
				' Strip tabs and ampersands from string not typed as Version, AcceleratorTable or Font
				If StripExtras(txt, pstr) Then
					Dim SpellOK As Boolean
					' Check Spelling
					SpellOK = CheckString(txt, lng)
					If Not SpellOK Then
						pstr.OutputError( "Spelling error: " & txt)
						errcnt = errcnt + 1
					End If
				End If
			End If
		End If
	Next i
	PSL.Output( errcnt & " spell checking errors found")
	UnloadWord
End Sub
