PC World Komputer 1998 November/pcwk_11_98a.iso/Wtestowe/SOFTSRC/vtrial15.exe/DATA.1/SpellChk.frm

Visual Basic Form | 1997-03-21 | 6.6 KB | 197 lines

VERSION 4.00
Begin VB.Form SpellChk
   Caption         =   "Spelling Checker Example"
   ClientHeight    =   1575
   ClientLeft      =   1170
   ClientTop       =   1515
   ClientWidth     =   4455
   Height          =   1980
   Icon            =   "SpellChk.frx":0000
   Left            =   1110
   LinkTopic       =   "Form1"
   ScaleHeight     =   1575
   ScaleWidth      =   4455
   Top             =   1170
   Width           =   4575
   Begin VB.CheckBox CheckZoomText
      Caption         =   "&Zoom to Text"
      Enabled         =   0   'False
      Height          =   255
      Left            =   2040
      TabIndex        =   5
      Top             =   960
      Width           =   2295
   End
   Begin VB.CommandButton Complete
      Caption         =   "&Done"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   1080
      Width           =   1455
   End
   Begin VB.CheckBox CheckNumbers
      Caption         =   "Ignore Words with &Numbers"
      Enabled         =   0   'False
      Height          =   255
      Left            =   2040
      TabIndex        =   3
      Top             =   240
      Width           =   2295
   End
   Begin VB.CheckBox CheckUppercase
      Caption         =   "Ignore &UPPERCASE words"
      Enabled         =   0   'False
      Height          =   255
      Left            =   2040
      TabIndex        =   4
      Top             =   600
      Width           =   2295
   End
   Begin VB.CommandButton PickObject
      Caption         =   "&Pick Object"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1455
   End
   Begin VB.CommandButton EntireDrawing
      Caption         =   "&Entire Drawing"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   1455
   End
   Begin VeventsLib.VdraftEvents VdraftEvents1
      Left            =   3480
      Top             =   1080
      _Version        =   65536
      _ExtentX        =   1508
      _ExtentY        =   661
      _StockProps     =   0
   End
Attribute VB_Name = "SpellChk"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim WordObj As Object
Dim Temporary_WindowName$
Private Function SpellCheckString(ByRef old$) As Boolean
    Dim str$
    WordObj.AppShow
    WordObj.EditSelectAll           ' select everything
    WordObj.EditClear 2             ' out with the old
    WordObj.Insert old$             ' in with the new
    On Error Resume Next            ' errors even when success!?!
    WordObj.ToolsSpelling           ' spell check it
    WordObj.EditSelectAll           ' select everything
    str$ = WordObj.Selection$()     ' grab the new text
    str$ = Left$(str$, Len(str$) - 1)
    AppActivate "Virtual Drafter -"
    If old$ = str$ Then
        SpellCheckString = False    ' text is the same
    Else
        SpellCheckString = True     ' text is different
        old$ = str$                 ' return new text
    End If
End Function
Private Sub SpellCheckEntity(Entity As Object)
    Dim str$, Count%
    ' determine if entity suitable for spell check and aquire text
    If Entity.Type = veET_Text Or Entity.Type = veET_Attdef Then
        str$ = Entity.Text
        If SpellCheckString(str$) Then
            Entity.Text = str$
        End If
    ElseIf Entity.Type = veET_Insert Then
        If Entity.HasAttributes Then
            Dim Attributes, Attrib As Object
            Set Attributes = Entity.Attributes
            For Count% = 1 To Attributes.Count
                Set Attrib = Attributes(Count)
                str$ = Attrib.Text
                If SpellCheckString(str$) Then Attrib.Text = str$
            Next
        End If
    End If
End Sub
Private Sub Complete_Click()
    Form_Unload False
    End
End Sub
Private Sub EntireDrawing_Click()
    Dim Entities, Entity As Object
    Dim Count As Long
    ' connect to vdraft
    If VdraftEvents1.Connect = False Then
        MsgBox "Could not connect with Vdraft"
        Exit Sub
    End If
    ' make sure that at least one document is available
    If VdraftEvents1.vdraft.Documents.Count = 0 Then
        MsgBox "No drawings currently loaded."
        Exit Sub
    End If
    ' get a handle on the active document
    Set Entities = VdraftEvents1.vdraft.ActiveDocument.Entities
    For Count = 1 To Entities.Count
        Set Entity = Entities(Count)
        SpellCheckEntity Entity
    Next
End Sub
Private Sub Form_Load()
    On Error Resume Next
    ' try and get hold of existing one
    Set WordObj = GetObject("Word.Basic")
    If WordObj Is Nothing Then
        ' try and create one
        Set WordObj = CreateObject("Word.Basic")
    End If
    If WordObj Is Nothing Then
        MsgBox "Unable to establish connection with Microsoft Word"
        Exit Sub
    End If
    ' create a temporary document that we can work with
    WordObj.FileNew
    Temporary_WindowName$ = WordObj.WindowName$()
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If Not (WordObj Is Nothing) Then
        ' close down our temporary file
        WordObj.Activate Temporary_WindowName$
        WordObj.DocClose 2
    End If
    Set WordObj = Nothing
    VdraftEvents1.Disconnect
End Sub
Private Sub PickObject_Click()
    ' connect to vdraft
    If VdraftEvents1.Connect = False Then
        MsgBox "Could not connect with Vdraft"
        Exit Sub
    End If
    ' make sure that at least one document is available
    If VdraftEvents1.vdraft.Documents.Count = 0 Then
        MsgBox "No drawings currently loaded."
        Exit Sub
    End If
    ' get a handle on the active document
    Set SelectEvents = VdraftEvents1.vdraft.ActiveDocument.SelectionEvents
    SelectEvents.statusbar = "Select text object to spell check"
    SelectEvents.Name = "to spell check"
    ' we want to know when the user has selected an object
    VdraftEvents1.RequestSingleSelect SelectEvents, 0
End Sub
Private Sub VdraftEvents1_SelectDone(ByVal info As Long)
    Dim Selection As Object
    Set Selection = VdraftEvents1.vdraft.ActiveDocument.Selection
    ' try to spell check the first entity in the selection
    ' set, if it can not be checked let the user try again
    If Selection.HasItems Then
        SpellCheckEntity Selection(1)
        Selection.RemoveAll
    End If
    PickObject_Click  ' have them pick again
End Sub