Visual Basic 4 Unleashed/Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso/source/chap25/mdi/mdinote.bas

BASIC Source File | 1995-07-26 | 6.5 KB | 202 lines

Attribute VB_Name = "Module1"
Option Explicit

Type FormState
    Deleted As Integer
    Dirty As Integer
    Color As Long
End Type

Public FState()  As FormState
Public Document() As New frmNotePad
Public gFindString, gFindCase As Integer, gFindDirection As Integer
Public gCurPos As Integer, gFirstTime As Integer
Public ArrayNum As Integer
Public gToolsHidden As Boolean
Public Const ThisApp = "MDINote" ' Registry App constant.
Public Const ThisKey = "Recent Files" ' Registry Key constant.


Function AnyPadsLeft() As Integer
    Dim i As Integer

    ' Cycle through the document array.
    ' Return true if there is at least one open document.
    For i = 1 To UBound(Document)
        If Not FState(i).Deleted Then
            AnyPadsLeft = True
            Exit Function
        End If
    Next
End Function


Sub EditCopyProc()
    ' Copy the selected text onto the Clipboard.
    Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
End Sub

Sub EditCutProc()
    ' Copy the selected text onto the Clipboard.
    Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
    ' Delete the selected text.
    frmMDI.ActiveForm.ActiveControl.SelText = ""
End Sub

Sub EditPasteProc()
    ' Place the text from the Clipboard into the active control.
    frmMDI.ActiveForm.ActiveControl.SelText = Clipboard.GetText()
End Sub

Sub FileNew()
    Dim fIndex As Integer

    fIndex = FindFreeIndex()
    Document(fIndex).Tag = fIndex
    Document(fIndex).Caption = "Untitled:" & fIndex
    Document(fIndex).Show

    ' Make sure the toolbar edit buttons are visible.
    frmMDI!imgcutbutton.Visible = True
    frmMDI!imgcopybutton.Visible = True
    frmMDI!imgPasteButton.Visible = True
End Sub

Function FindFreeIndex() As Integer
    Dim i As Integer
    Dim ArrayCount As Integer

    ArrayCount = UBound(Document)

    ' Cycle through the document array. If one of the
    ' documents has been deleted, then return that index.
    For i = 1 To ArrayCount
        If FState(i).Deleted Then
            FindFreeIndex = i
            FState(i).Deleted = False
            Exit Function
        End If
    Next

    ' If none of the elements in the document array have
    ' been deleted, then increment the document and the
    ' state arrays by one and return the index to the
    ' new element.
    ReDim Preserve Document(ArrayCount + 1)
    ReDim Preserve FState(ArrayCount + 1)
    FindFreeIndex = UBound(Document)
End Function

Sub FindIt()
    Dim start, pos, findstring, sourcestring, Msg, Response, Offset

    If (gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart) Then
        Offset = 1
    Else
        Offset = 0
    End If

    If gFirstTime Then Offset = 0
    start = frmMDI.ActiveForm.ActiveControl.SelStart + Offset

    If gFindCase Then
        findstring = gFindString
        sourcestring = frmMDI.ActiveForm.ActiveControl.TEXT
    Else
        findstring = UCase(gFindString)
        sourcestring = UCase(frmMDI.ActiveForm.ActiveControl.TEXT)
    End If

    If gFindDirection = 1 Then
        pos = InStr(start + 1, sourcestring, findstring)
    Else
        For pos = start - 1 To 0 Step -1
            If pos = 0 Then Exit For
            If Mid(sourcestring, pos, Len(findstring)) = findstring Then Exit For
        Next
    End If

    ' If the string is found...
    If pos Then
        frmMDI.ActiveForm.ActiveControl.SelStart = pos - 1
        frmMDI.ActiveForm.ActiveControl.SelLength = Len(findstring)
    Else
        Msg = "Cannot find " & Chr(34) & gFindString & Chr(34)
        Response = MsgBox(Msg, 0, App.Title)
    End If

    gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart
    gFirstTime = False
End Sub

Sub GetRecentFiles()
    ' This procedure demonstrates the use of the GetAllSettings function,
    ' which returns an array of values from the Windows registry. In this
    ' case, the registry contains the files most recently opened.  Use the
    ' SaveSetting statement to write the names of the most recent files.
    ' That statement is used in the WriteRecentFiles procedure.
    Dim i, j As Integer
    Dim varFiles As Variant ' Varible to store the returned array.

    ' Get recent files from the registry using the GetAllSettings statement.
    ' ThisApp and ThisKey are constants defined in this module.
    If GetSetting(ThisApp, ThisKey, "RecentFile1") = Empty Then Exit Sub

    varFiles = GetAllSettings(ThisApp, ThisKey)

    For i = 0 To UBound(varFiles, 1)

        frmMDI!mnuRecentFile(0).Visible = True
        frmMDI!mnuRecentFile(i).Caption = varFiles(i, 1)
        frmMDI!mnuRecentFile(i).Visible = True
            ' Iterate through all the documents and update each menu.
            For j = 1 To UBound(Document)
                If Not FState(j).Deleted Then
                    Document(j).mnuRecentFile(0).Visible = True
                    Document(j).mnuRecentFile(i + 1).Caption = varFiles(i, 1)
                    Document(j).mnuRecentFile(i + 1).Visible = True
                End If
            Next j
    Next i

End Sub

Sub OptionsToolbarProc(CurrentForm As Form)
    CurrentForm.mnuOToolbar.Checked = Not CurrentForm.mnuOToolbar.Checked
    If TypeOf CurrentForm Is MDIForm Then
    Else
        frmMDI.mnuOToolbar.Checked = CurrentForm.mnuOToolbar.Checked
    End If
    If CurrentForm.mnuOToolbar.Checked Then
        frmMDI.picToolbar.Visible = True
    Else
        frmMDI.picToolbar.Visible = False
    End If
End Sub

Sub WriteRecentFiles(OpenFileName)
    ' This procedure uses the SaveSettings statement to write the names of
    ' recently opened files to the System registry. The SaveSetting
    ' statement requires three parameters. Two of the parameters are
    ' stored as constants and are defined in this module.  The GetAllSettings
    ' function is used in the GetRecentFiles procedure to retrieve the
    ' file names stored in this procedure.

    Dim i, j As Integer
    Dim strFile, key As String

    ' Copy RecentFile1 to RecentFile2, and so on.
    For i = 3 To 1 Step -1
        key = "RecentFile" & i
        strFile = GetSetting(ThisApp, ThisKey, key)
        If strFile <> "" Then
            key = "RecentFile" & (i + 1)
            SaveSetting ThisApp, ThisKey, key, strFile
        End If
    Next i

    ' Write the open file to first recent file.
    SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
End Sub