home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / PGUIDE / MDI / MDINOTE.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-11-14  |  7.6 KB  |  222 lines

  1. Attribute VB_Name = "Module1"
  2. '*** Global module for MDI Notepad sample application.  ***
  3. '**********************************************************
  4. Option Explicit
  5.  
  6. ' User-defined type to store information about child forms
  7. Type FormState
  8.     Deleted As Integer
  9.     Dirty As Integer
  10.     Color As Long
  11. End Type
  12.  
  13. Public FState()  As FormState           ' Array of user-defined types
  14. Public Document() As New frmNotePad     ' Array of child form objects
  15. Public gFindString As String            ' Holds the search text.
  16. Public gFindCase As Integer             ' Key for case sensitive search
  17. Public gFindDirection As Integer        ' Key for search direction.
  18. Public gCurPos As Integer               ' Holds the cursor location.
  19. Public gFirstTime As Integer            ' Key for start position.
  20. Public gToolsHidden As Boolean          ' Holds toolbar state.
  21. Public Const ThisApp = "MDINote"        ' Registry App constant.
  22. Public Const ThisKey = "Recent Files"   ' Registry Key constant.
  23.  
  24.  
  25. Function AnyPadsLeft() As Integer
  26.     Dim i As Integer        ' Counter variable
  27.  
  28.     ' Cycle through the document array.
  29.     ' Return true if there is at least one open document.
  30.     For i = 1 To UBound(Document)
  31.         If Not FState(i).Deleted Then
  32.             AnyPadsLeft = True
  33.             Exit Function
  34.         End If
  35.     Next
  36. End Function
  37.  
  38.  
  39. Sub EditCopyProc()
  40.     ' Copy the selected text onto the Clipboard.
  41.     Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
  42. End Sub
  43.  
  44. Sub EditCutProc()
  45.     ' Copy the selected text onto the Clipboard.
  46.     Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
  47.     ' Delete the selected text.
  48.     frmMDI.ActiveForm.ActiveControl.SelText = ""
  49. End Sub
  50.  
  51. Sub EditPasteProc()
  52.     ' Place the text from the Clipboard into the active control.
  53.     frmMDI.ActiveForm.ActiveControl.SelText = Clipboard.GetText()
  54. End Sub
  55.  
  56. Sub FileNew()
  57.     Dim fIndex As Integer
  58.  
  59.     ' Find the next available index and show the child form.
  60.     fIndex = FindFreeIndex()
  61.     Document(fIndex).Tag = fIndex
  62.     Document(fIndex).Caption = "Untitled:" & fIndex
  63.     Document(fIndex).Show
  64.  
  65.     ' Make sure the toolbar edit buttons are visible.
  66.     frmMDI.imgCutButton.Visible = True
  67.     frmMDI.imgCopyButton.Visible = True
  68.     frmMDI.imgPasteButton.Visible = True
  69. End Sub
  70.  
  71. Function FindFreeIndex() As Integer
  72.     Dim i As Integer
  73.     Dim ArrayCount As Integer
  74.  
  75.     ArrayCount = UBound(Document)
  76.  
  77.     ' Cycle through the document array. If one of the
  78.     ' documents has been deleted, then return that index.
  79.     For i = 1 To ArrayCount
  80.         If FState(i).Deleted Then
  81.             FindFreeIndex = i
  82.             FState(i).Deleted = False
  83.             Exit Function
  84.         End If
  85.     Next
  86.  
  87.     ' If none of the elements in the document array have
  88.     ' been deleted, then increment the document and the
  89.     ' state arrays by one and return the index to the
  90.     ' new element.
  91.     ReDim Preserve Document(ArrayCount + 1)
  92.     ReDim Preserve FState(ArrayCount + 1)
  93.     FindFreeIndex = UBound(Document)
  94. End Function
  95.  
  96. Sub FindIt()
  97.     Dim intStart As Integer
  98.     Dim intPos As Integer
  99.     Dim strFindString As String
  100.     Dim strSourceString As String
  101.     Dim strMsg As String
  102.     Dim intResponse As Integer
  103.     Dim intOffset As Integer
  104.     
  105.     ' Set offset variable based on cursor position.
  106.     If (gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart) Then
  107.         intOffset = 1
  108.     Else
  109.         intOffset = 0
  110.     End If
  111.  
  112.     ' Read the public variable for start position.
  113.     If gFirstTime Then intOffset = 0
  114.     ' Assign a value to the start value.
  115.     intStart = frmMDI.ActiveForm.ActiveControl.SelStart + intOffset
  116.         
  117.     ' If not case sensitive, convert the string to upper case
  118.     If gFindCase Then
  119.         strFindString = gFindString
  120.         strSourceString = frmMDI.ActiveForm.ActiveControl.Text
  121.     Else
  122.         strFindString = UCase(gFindString)
  123.         strSourceString = UCase(frmMDI.ActiveForm.ActiveControl.Text)
  124.     End If
  125.             
  126.     ' Search for the string.
  127.     If gFindDirection = 1 Then
  128.         intPos = InStr(intStart + 1, strSourceString, strFindString)
  129.     Else
  130.         For intPos = intStart - 1 To 0 Step -1
  131.             If intPos = 0 Then Exit For
  132.             If Mid(strSourceString, intPos, Len(strFindString)) = strFindString Then Exit For
  133.         Next
  134.     End If
  135.  
  136.     ' If the string is found...
  137.     If intPos Then
  138.         frmMDI.ActiveForm.ActiveControl.SelStart = intPos - 1
  139.         frmMDI.ActiveForm.ActiveControl.SelLength = Len(strFindString)
  140.     Else
  141.         strMsg = "Cannot find " & Chr(34) & gFindString & Chr(34)
  142.         intResponse = MsgBox(strMsg, 0, App.Title)
  143.     End If
  144.     
  145.     ' Reset the public variables
  146.     gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart
  147.     gFirstTime = False
  148. End Sub
  149.  
  150. Sub GetRecentFiles()
  151.     ' This procedure demonstrates the use of the GetAllSettings function,
  152.     ' which returns an array of values from the Windows registry. In this
  153.     ' case, the registry contains the files most recently opened.  Use the
  154.     ' SaveSetting statement to write the names of the most recent files.
  155.     ' That statement is used in the WriteRecentFiles procedure.
  156.     Dim i, j As Integer
  157.     Dim varFiles As Variant ' Varible to store the returned array.
  158.     
  159.     ' Get recent files from the registry using the GetAllSettings statement.
  160.     ' ThisApp and ThisKey are constants defined in this module.
  161.     If GetSetting(ThisApp, ThisKey, "RecentFile1") = Empty Then Exit Sub
  162.     
  163.     varFiles = GetAllSettings(ThisApp, ThisKey)
  164.     
  165.     For i = 0 To UBound(varFiles, 1)
  166.         
  167.         frmMDI.mnuRecentFile(0).Visible = True
  168.         frmMDI.mnuRecentFile(i).Caption = varFiles(i, 1)
  169.         frmMDI.mnuRecentFile(i).Visible = True
  170.             ' Iterate through all the documents and update each menu.
  171.             For j = 1 To UBound(Document)
  172.                 If Not FState(j).Deleted Then
  173.                     Document(j).mnuRecentFile(0).Visible = True
  174.                     Document(j).mnuRecentFile(i + 1).Caption = varFiles(i, 1)
  175.                     Document(j).mnuRecentFile(i + 1).Visible = True
  176.                 End If
  177.             Next j
  178.     Next i
  179.  
  180. End Sub
  181.  
  182. Sub OptionsToolbarProc(CurrentForm As Form)
  183.     ' Toggle the check
  184.     CurrentForm.mnuOptionsToolbar.Checked = Not CurrentForm.mnuOptionsToolbar.Checked
  185.     ' If not the MDI form, set the MDI form's check.
  186.     If Not TypeOf CurrentForm Is MDIForm Then
  187.         frmMDI.mnuOptionsToolbar.Checked = CurrentForm.mnuOptionsToolbar.Checked
  188.     End If
  189.     ' Toggle the toolbar based on the value.
  190.     If CurrentForm.mnuOptionsToolbar.Checked Then
  191.         frmMDI.picToolbar.Visible = True
  192.     Else
  193.         frmMDI.picToolbar.Visible = False
  194.     End If
  195. End Sub
  196.  
  197. Sub WriteRecentFiles(OpenFileName)
  198.     ' This procedure uses the SaveSettings statement to write the names of
  199.     ' recently opened files to the System registry. The SaveSetting
  200.     ' statement requires three parameters. Two of the parameters are
  201.     ' stored as constants and are defined in this module.  The GetAllSettings
  202.     ' function is used in the GetRecentFiles procedure to retrieve the
  203.     ' file names stored in this procedure.
  204.     
  205.     Dim i, j As Integer
  206.     Dim strFile, key As String
  207.  
  208.     ' Copy RecentFile1 to RecentFile2, and so on.
  209.     For i = 3 To 1 Step -1
  210.         key = "RecentFile" & i
  211.         strFile = GetSetting(ThisApp, ThisKey, key)
  212.         If strFile <> "" Then
  213.             key = "RecentFile" & (i + 1)
  214.             SaveSetting ThisApp, ThisKey, key, strFile
  215.         End If
  216.     Next i
  217.   
  218.     ' Write the open file to first recent file.
  219.     SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
  220. End Sub
  221.  
  222.