home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / VBUTIL / VBUTIL.ZIP / MDINOTE.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-10-19  |  4.7 KB  |  173 lines
  1. Option Explicit
  2.  
  3. Global Const modal = 1
  4. Global Const CASCADE = 0
  5. Global Const TILE_HORIZONTAL = 1
  6. Global Const TILE_VERTICAL = 2
  7. Global Const ARRANGE_ICONS = 3
  8.  
  9. Type FormState
  10.     Deleted As Integer
  11.     Dirty As Integer
  12.     Color As Long
  13. End Type
  14. Global FState()  As FormState
  15. Global Document() As New frmNotePad
  16. Global gFindString, gFindCase As Integer, gFindDirection As Integer
  17. Global gCurPos As Integer, gFirstTime As Integer
  18.  
  19. Function AnyPadsLeft () As Integer
  20.     Dim i As Integer
  21.  
  22.     ' Cycle throught the document array.
  23.     ' Return True if there is at least one
  24.     ' open document remaining.
  25.     For i = 1 To UBound(Document)
  26.         If Not FState(i).Deleted Then
  27.             AnyPadsLeft = True
  28.             Exit Function
  29.         End If
  30.     Next
  31.  
  32. End Function
  33.  
  34. Sub CenterForm (frmParent As Form, frmChild As Form)
  35. ' This procedure centers a child form over a parent form.
  36. ' Calling this routine loads the dialog. Use the Show method
  37. ' to display the dialog after calling this routine ( ie MyFrm.Show 1)
  38.  
  39. Dim l, t
  40.   ' get left offset
  41.   l = frmParent.Left + ((frmParent.Width - frmChild.Width) / 2)
  42.   If (l + frmChild.Width > screen.Width) Then
  43.     l = screen.Width = frmChild.Width
  44.   End If
  45.  
  46.   ' get top offset
  47.   t = frmParent.Top + ((frmParent.Height - frmChild.Height) / 2)
  48.   If (t + frmChild.Height > screen.Height) Then
  49.     t = screen.Height - frmChild.Height
  50.   End If
  51.  
  52.   ' center the child formfv
  53.   frmChild.Move l, t
  54.  
  55. End Sub
  56.  
  57. Sub EditCopyProc ()
  58.     ' Copy selected text to Clipboard.
  59.     ClipBoard.SetText frmMDI.ActiveForm.ActiveControl.SelText
  60. End Sub
  61.  
  62. Sub EditCutProc ()
  63.     ' Copy selected text to Clipboard.
  64.     ClipBoard.SetText frmMDI.ActiveForm.ActiveControl.SelText
  65.     ' Delete selected text.
  66.     frmMDI.ActiveForm.ActiveControl.SelText = ""
  67. End Sub
  68.  
  69. Sub EditPasteProc ()
  70.     ' Place text from Clipboard into active control.
  71.     frmMDI.ActiveForm.ActiveControl.SelText = ClipBoard.GetText()
  72. End Sub
  73.  
  74. Sub FileNew ()
  75.     Dim fIndex As Integer
  76.  
  77.     fIndex = FindFreeIndex()
  78.     Document(fIndex).Tag = fIndex
  79.     Document(fIndex).Caption = "Untitled:" & fIndex
  80.     Document(fIndex).Show
  81.  
  82.     ' Make sure toolbar edit buttons are visible
  83.     frmMDI!imgCutButton.Visible = True
  84.     frmMDI!imgCopyButton.Visible = True
  85.     frmMDI!imgPasteButton.Visible = True
  86.     
  87. End Sub
  88.  
  89. Function FindFreeIndex () As Integer
  90.     Dim i As Integer
  91.     Dim ArrayCount As Integer
  92.  
  93.     ArrayCount = UBound(Document)
  94.  
  95.     ' Cycle throught the document array. If one of the
  96.     ' documents has been deleted, then return that
  97.     ' index.
  98.     For i = 1 To ArrayCount
  99.         If FState(i).Deleted Then
  100.             FindFreeIndex = i
  101.             FState(i).Deleted = False
  102.             Exit Function
  103.         End If
  104.     Next
  105.  
  106.     ' If none of the elements in the document array have
  107.     ' been deleted, then increment the document and the
  108.     ' state arrays by one and return the index to the
  109.     ' new element.
  110.  
  111.     ReDim Preserve Document(ArrayCount + 1)
  112.     ReDim Preserve FState(ArrayCount + 1)
  113.     FindFreeIndex = UBound(Document)
  114. End Function
  115.  
  116. Sub FindIt ()
  117.     Dim start, pos, findstring, sourcestring, msg, response, Offset
  118.     
  119.     If (gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart) Then
  120.         Offset = 1
  121.     Else
  122.         Offset = 0
  123.     End If
  124.  
  125.     If gFirstTime Then Offset = 0
  126.  
  127.     start = frmMDI.ActiveForm.ActiveControl.SelStart + Offset
  128.         
  129.     If gFindCase Then
  130.         findstring = gFindString
  131.         sourcestring = frmMDI.ActiveForm.ActiveControl.Text
  132.     Else
  133.         findstring = UCase(gFindString)
  134.         sourcestring = UCase(frmMDI.ActiveForm.ActiveControl.Text)
  135.     End If
  136.             
  137.     If gFindDirection = 1 Then
  138.         pos = InStr(start + 1, sourcestring, findstring)
  139.     Else
  140.         For pos = start - 1 To 0 Step -1
  141.             If pos = 0 Then Exit For
  142.             If Mid(sourcestring, pos, Len(findstring)) = findstring Then Exit For
  143.         Next
  144.     End If
  145.  
  146.     ' If string is found
  147.     If pos Then
  148.         frmMDI.ActiveForm.ActiveControl.SelStart = pos - 1
  149.         frmMDI.ActiveForm.ActiveControl.SelLength = Len(findstring)
  150.     Else
  151.         msg = "Cannot find " & Chr(34) & gFindString & Chr(34)
  152.         response = MsgBox(msg, 0, App.Title)
  153.     End If
  154.     
  155.     gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart
  156.     gFirstTime = False
  157.  
  158. End Sub
  159.  
  160. Sub OptionsToolbarProc (CurrentForm As Form)
  161.     CurrentForm.mnuOToolbar.Checked = Not CurrentForm.mnuOToolbar.Checked
  162.     If TypeOf CurrentForm Is MDIForm Then
  163.     Else
  164.         frmMDI.mnuOToolbar.Checked = CurrentForm.mnuOToolbar.Checked
  165.     End If
  166.     If CurrentForm.mnuOToolbar.Checked Then
  167.         frmMDI.picToolbar.Visible = True
  168.     Else
  169.         frmMDI.picToolbar.Visible = False
  170.     End If
  171. End Sub
  172.  
  173.