home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / VB6_Viewer20275910292006.psc / VBEd.bas < prev   
BASIC Source File  |  2006-11-29  |  4KB  |  129 lines
  1. Attribute VB_Name = "modVBEd"
  2. Option Explicit
  3. Public sR()         As String   'Array to hold contents of modeul
  4. Public sfName       As String   'Selected font name
  5. Public nFSize       As Long     'Selected fontsize
  6. Public bBold        As Boolean  'Bold / Not bold selected
  7. Public bColors      As Boolean  'Colours have been changed
  8. Public fName        As String   'Filename to save options to
  9. Public sFile        As String   'Name of loaded module
  10. Public nExtNum      As Long     'Number to append to bu filename
  11. Public gnCol(10)    As Long     'Text colours selected
  12. Public sT()                     'Variants to assign to an array
  13. Public sE()
  14. Public sD()
  15. Public VbPath       As String   ' The path selected to work with
  16.  
  17. Public Sub SaveOptions()
  18. ' Save the changes to the options
  19. ' Options that need to be saved are
  20. ' Fontname, Fontsize, Bold y/n
  21. ' numbers of the 7 font colours
  22. Dim fNum        As Long
  23. Dim N           As Long
  24.     
  25.     fNum = FreeFile
  26.     Open fName For Output As #fNum
  27.         Print #fNum, sfName
  28.         Print #fNum, Str(nFSize)
  29.         Print #fNum, bBold
  30.         For N = 0 To 7
  31.             Print #fNum, gnCol(N)
  32.         Next
  33.         Print #fNum, nExtNum
  34.     Close #fNum
  35. End Sub
  36. Private Sub GetOptions()
  37. ' Recall the most recent option settings
  38. Dim fNum        As Long
  39. Dim N           As Long
  40.     
  41.     On Error GoTo FileReadError
  42.     fNum = FreeFile
  43.     fName = App.Path & "\Options.txt"
  44.     Open fName For Input As #fNum
  45.         Input #fNum, sfName
  46.         Input #fNum, nFSize
  47.         Input #fNum, bBold
  48.         For N = 0 To 7
  49.             Input #fNum, gnCol(N)
  50.         Next
  51.         Input #fNum, nExtNum
  52.     Close #fNum
  53.     
  54. Exit Sub
  55. FileReadError:
  56.     Close #fNum
  57.     MsgBox "No Options file found"
  58. End Sub
  59. Private Sub SetArrays()
  60.     
  61.     ' Lazy way to put several items into an array
  62.     ' Start of Nests
  63.     ' These have a space after them to avoid
  64.     ' a hit on words like Forecolor, Double etc.
  65.     sT = Array("For ", "If ", "Do ", "Open ")
  66.     
  67.     ' End of nests
  68.     sE = Array("Next ", "End If", "Loop ", "Close ", "End Property")
  69.     
  70.     ' Procedure level declarations
  71.     sD = Array("Dim", "Static", "ReDim")
  72. End Sub
  73. Private Sub Main()
  74.     
  75.     SetArrays
  76.     GetOptions
  77.     frmMain.Show
  78. End Sub
  79.  
  80. 'ò This module returns just the code
  81. 'ò for the .bas, .frm and .cls and .ctl files
  82. 'ò That are selected from the current Application Path
  83. Public Sub GetModule(sF As String)
  84. Dim fN          As Long
  85. Dim N           As Long
  86. Dim S           As String
  87. Dim sTart       As Boolean
  88. ReDim sR(3000)
  89.     
  90.     On Error GoTo FileReadError
  91.     
  92.     fN = FreeFile
  93.     sR(0) = sF
  94.     'sF is the file name of each module selected
  95.     sFile = VbPath & sF
  96.     N = 2
  97.     ' Read ALL of the code lines
  98.     ' Note sR(1) is project name
  99.     ' sR(2) will be first module name
  100.     
  101.     Open sFile For Input As #fN
  102.         Do While Not EOF(fN)
  103.             Line Input #fN, S
  104.             S = Trim(S)
  105.             If Left$(S, 13) = "Begin VB.Form" Then
  106.                 sR(N) = Mid$(S, 14, 12)
  107.             End If
  108.             'ò Skip over lines that are about controls
  109.             If S = "Option Explicit" Then
  110.                 sTart = True
  111.             End If
  112.             
  113.             'ò Skip Blank lines
  114.             If sTart And Len(S) > 1 Then
  115.                 N = N + 1
  116.                 sR(N) = S 'Option Explicit should be sR(3)
  117.             End If
  118.             If Left$(sF, 3) = "cls" Then
  119.                 sTart = True
  120.             End If
  121.         Loop
  122.     Close #fN
  123.     ReDim Preserve sR(N)
  124.     Exit Sub
  125.     
  126. FileReadError:
  127.     MsgBox "Error retrieving File", vbCritical + vbOKOnly, "FILE ERROR"
  128. End Sub
  129.