PC Plus SuperCD (UK) 1995 October/SUPERCD.BIN/PCPLUS/VBWK/VBSPY/VBSPY.ZIP/VBSPY.FRM

Visual Basic Form | 1995-07-03 | 31.5 KB | 979 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "VB-SPY"
   ClientHeight    =   4212
   ClientLeft      =   96
   ClientTop       =   2028
   ClientWidth     =   7716
   Height          =   4956
   Icon            =   VBSPY.FRX:0000
   Left            =   48
   LinkTopic       =   "Form1"
   ScaleHeight     =   4212
   ScaleWidth      =   7716
   Tag             =   "Loading"
   Top             =   1332
   Width           =   7812
   Begin PictureBox pctStatusBar
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      ScaleHeight     =   276
      ScaleWidth      =   7692
      TabIndex        =   12
      Top             =   3912
      Width           =   7710
      Begin Shape Shape1
         BorderColor     =   &H00FFFFFF&
         Height          =   225
         Left            =   30
         Top             =   30
         Width           =   7620
      End
      Begin Label lblStatus
         AutoSize        =   -1  'True
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   7.8
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   195
         Left            =   55
         TabIndex        =   13
         Top             =   40
         Width           =   45
      End
   End
   Begin PictureBox Picture1
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Height          =   540
      Left            =   0
      ScaleHeight     =   516
      ScaleWidth      =   7692
      TabIndex        =   7
      Top             =   0
      Width           =   7710
      Begin SSCommand btnToolbar
         AutoSize        =   1  'Adjust Picture Size To Button
         Enabled         =   0   'False
         Font3D          =   0  'None
         Height          =   495
         Index           =   4
         Left            =   2205
         TabIndex        =   14
         TabStop         =   0   'False
         Top             =   0
         Width           =   555
      End
      Begin SSCommand btnToolbar
         AutoSize        =   1  'Adjust Picture Size To Button
         Font3D          =   0  'None
         Height          =   495
         Index           =   3
         Left            =   1650
         TabIndex        =   11
         TabStop         =   0   'False
         Top             =   0
         Width           =   555
      End
      Begin CommonDialog CMDialog1
         CancelError     =   -1  'True
         DefaultExt      =   ".mak"
         DialogTitle     =   "Open project file"
         Filename        =   "D:\VB\GORAN\VBSPY10\VBSPY10.MAK"
         Filter          =   "Project (*.mak)|*.mak|All files (*.*)|*.*"
         FilterIndex     =   1
         Flags           =   1028
         Left            =   7200
         Top             =   30
      End
      Begin SSCommand btnToolbar
         AutoSize        =   1  'Adjust Picture Size To Button
         Font3D          =   0  'None
         Height          =   495
         Index           =   2
         Left            =   1095
         TabIndex        =   10
         TabStop         =   0   'False
         Top             =   0
         Width           =   555
      End
      Begin SSCommand btnToolbar
         Font3D          =   0  'None
         Height          =   495
         Index           =   1
         Left            =   540
         TabIndex        =   9
         TabStop         =   0   'False
         Top             =   0
         Width           =   555
      End
      Begin SSCommand btnToolbar
         Font3D          =   0  'None
         Height          =   495
         Index           =   0
         Left            =   0
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   0
         Width           =   555
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   6
      Left            =   0
      Top             =   1360
      Visible         =   0   'False
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2700
         Index           =   6
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   6
         Top             =   0
         Width           =   7758
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   5
      Left            =   0
      Top             =   1360
      Visible         =   0   'False
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2600
         Index           =   5
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   5
         Top             =   0
         Width           =   7758
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   4
      Left            =   0
      Top             =   1360
      Visible         =   0   'False
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2500
         Index           =   4
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   4
         Top             =   0
         Width           =   7758
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   3
      Left            =   0
      Top             =   1360
      Visible         =   0   'False
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2400
         Index           =   3
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   3
         Top             =   0
         Width           =   7758
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   2
      Left            =   0
      Top             =   1360
      Visible         =   0   'False
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2300
         Index           =   2
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   2
         Top             =   0
         Width           =   7758
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   1
      Left            =   0
      Top             =   1360
      Visible         =   0   'False
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2200
         Index           =   1
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   1
         Top             =   0
         Width           =   7758
      End
   End
   Begin IFRAME IFrame1
      BackColor       =   &H00C0C0C0&
      Height          =   2874
      Index           =   0
      Left            =   0
      Top             =   1360
      Width           =   7758
      Begin TextBox txtInfo
         BorderStyle     =   0  'None
         Height          =   2874
         HelpContextID   =   2100
         Index           =   0
         Left            =   0
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   0
         Top             =   0
         Width           =   7758
      End
   End
   Begin TABBED Tabbed1
      ActiveTab       =   0
      Captions        =   "&Subs,&Functions,&Global Var.,&Module Var.,&Local Var.,&Declarations,&Summary"
      Height          =   3234
      Left            =   0
      NumberOfTabs    =   7
      Rows            =   2
      TabHeight       =   360
      TabPosition     =   0  'Top
      Top             =   615
      Width           =   7730
   End
   Begin Image imgStop
      Height          =   480
      Left            =   2205
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgNotOnTop
      Height          =   480
      Left            =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgOnTop
      Height          =   480
      Left            =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgNoStop
      Height          =   480
      Left            =   1545
      Top             =   3615
      Visible         =   0   'False
      Width           =   480
   End
   Begin Menu mnuArkiv
      Caption         =   "&File"
      HelpContextID   =   110
      Begin Menu mnuFile_Open
         Caption         =   "&Open..."
         HelpContextID   =   110
         Shortcut        =   ^O
      End
      Begin Menu mnuFile_Update
         Caption         =   "&Update Project"
         HelpContextID   =   110
         Shortcut        =   ^U
      End
      Begin Menu mnuzz
         Caption         =   "-"
      End
      Begin Menu mnuFile_Exit
         Caption         =   "&Exit"
         HelpContextID   =   110
      End
   End
   Begin Menu mnuAlternativ
      Caption         =   "O&ptions"
      HelpContextID   =   200
      Begin Menu mnuA_LoadLast
         Caption         =   "&Load Last File On Start "
         HelpContextID   =   200
      End
      Begin Menu mnuAllways_On_Top
         Caption         =   "&On Top"
         HelpContextID   =   200
      End
   End
   Begin Menu mnuhelp
      Caption         =   "&Help"
      HelpContextID   =   300
      Begin Menu mnuHcontents
         Caption         =   "&Contents"
         HelpContextID   =   300
      End
      Begin Menu mnuHsearch
         Caption         =   "&Search Help On..."
         HelpContextID   =   300
      End
      Begin Menu mnuz
         Caption         =   "-"
      End
      Begin Menu mnuH_About
         Caption         =   "&About VB SPY"
         HelpContextID   =   300
      End
   End
Option Explicit
DefInt A-Z
'---This is the main form for VB-Spy 1.00
'---API declaration for the 'On Top' function
Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Dim NL As String 'New Line
'---IFrame and txtInfo constants
Const SUBS = 0
Const FUNCTIONS = 1
Const GLOBAL_VAR = 2
Const MODULE_VAR = 3
Const VARIABLES = 4
Const DECLARATIONS = 5
Const SUMMARY = 6
'---Search$ constants
Const SUB_S = 0
Const FUNCTION_S = 1
Const DIMS = 2
Const STATICS = 3
Const CONSTANTS = 4
Const DECLARATION_S = 5
Const GLOBALS = 6
'---Array for search string e.g. "Sub "
Dim Search$(6)
'---Flag to keep module and procedure-
'---level variables apart
Dim IsVarModuleLevel
'---Summary Info variables.
Dim Total_Number_Of_Lines
Dim Nr_Of_Subs
Dim Total_Nr_Of_Subs
Dim Nr_Of_Functions
Dim Total_Nr_Of_Functions
Dim Nr_Of_Module_Vars
Dim Total_Nr_Of_Module_Vars
Dim Nr_Of_Vars
Dim Total_Nr_Of_Vars
Dim Total_Nr_Of_Declarations
Dim Nr_Of_Declarations
Dim Nr_Of_Global_Vars
Dim Total_Nr_Of_Global_Vars
'---String for *.Mak file in Summary
Dim Mak_File_In_Summary$
Sub btnToolbar_Click (Index As Integer)
'---Toolbar buttons has corresponding
'---menus, except the stop button.

Select Case Index
   Case 0
      mnuFile_Open_click
   Case 1
      mnuFile_Exit_Click
   Case 2 '---Stop button is using the tag property
      btnToolbar(2).Enabled = Not btnToolbar(2).Enabled
      btnToolbar(2).Tag = "STOP"
      lblStatus = "OPERATION CANCELED!"
   Case 3
      mnuAllways_On_Top_click
   Case 4
      mnuFile_Update_Click
End Select
End Sub
Sub btnToolbar_MouseMove (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
'---Status bar text
Select Case Index
   Case 0
   lblStatus = "Open a new file"
   Case 1
   lblStatus = "Exit"
   Case 2
   lblStatus = "Interrupt the reading of files"
   Case 3
   lblStatus = "Window always on top, toggle"
   Case 4
   lblStatus = "Update current project"
End Select
End Sub
Sub DrawLineIntxtVar (cl$, Category)
'---Draws a line to keep the different
'   procedures apart
Dim SubName$, Pos
'---Find the second space
Pos = InStr(Len(Search$(Category)) + 2, cl$, " ")
SubName$ = Left$(cl$, Pos)
'---We have to use mid$ to avoid the linefeed at the end of the row.
If Mid$(txtInfo(VARIABLES), Len(txtInfo(VARIABLES)) - 15, 4) <> "----" Then
   txtInfo(VARIABLES) = txtInfo(VARIABLES) & NL & String$(20, "-") & " " & SubName$ & " " & String$(20, "-") & NL
End If
End Sub
Sub Form_Load ()
'---New Line
NL = Chr$(13) & Chr$(10)
'---Init keyword Array
Search$(0) = "Sub "
Search$(1) = "Function "
Search$(2) = "Dim "
Search$(3) = "Static "
Search$(4) = "Const "
Search$(5) = "Declare "
Search$(6) = "Global "
'---Read window positions from last session
ReadFromIni
'---We start with Activetab SUBS
tabbed1.ActiveTab = SUBS
IFrame1(SUBS).Visible = True
GetToolbarPictures
'---Helpsystem
app.HelpFile = app.Path & "\vbspy.hlp"
'---Putting a backspace in front of the menu caption,
'---puts it at the rightmost position on the menubar
mnuHelp.Caption = Chr(8) + mnuHelp.Caption
Form1.Show
DoEvents
'---Run the openfile dialog
mnuFile_Open_click
'---Update button enable
btnToolbar(4).Enabled = True
End Sub
Sub Form_Paint ()
'---Shape1 gives a little 3-D look to the statusbar
Shape1.Width = pctStatusBar.Width - 100
End Sub
Sub Form_Resize ()
'---Here we adjust frame,Tab and textboxes
'---with values'fr
n form width.
Dim i, ScreenW, ScreenH, ResW!, ResH!
'---No adjustment when minimized
If Me.WindowState <> MINIMIZED Then
   '---The text box scrollbars will end up outside the form
   '---if we don't adjust
   '---SVGA-VGA
   If screen.Height <= 7200 Then
      ResW! = 55  '---VGA
      ResH! = 4.2
   Else
      ResW! = 60 '---SVGA
      ResH! = 5.2
   End If
   ScreenW = screen.Width / ResW!
   ScreenH = screen.Height / ResH!
   tabbed1.Width = Form1.Width - ScreenW
   tabbed1.Height = Form1.Height - ScreenH
   For i = 0 To tabbed1.NumberOfTabs - 1
      '---The value '280' is found with the trial & error method!
      IFrame1(i).Width = tabbed1.Width + Form1.Width / 280
      IFrame1(i).Height = tabbed1.Height - tabbed1.TabHeight
      txtInfo(i).Width = IFrame1(i).Width
      txtInfo(i).Height = IFrame1(i).Height - pctStatusBar.Height
   Next
   Shape1.Width = pctStatusBar.Width - 100
End If
End Sub
Sub Form_Unload (Cancel As Integer)
'---Quit
'---Write ini functions
writeToIni
HelpQuit
End Sub
Sub GetToolbarPictures ()
'---This sub loads the pictures in the toolbar.
'---The LoadPicture provides a easier way to handle pictures
'---when using VB in design mode.
'---If I loaded the pictures in designmode, You would get an
'---error message because you have a diffrent path!
'---This is no problem when distributing only the exefile!
imgNostop.Picture = LoadPicture(app.Path & "\nostop.ico")
btnToolbar(2).Picture = imgNostop.Picture
imgstop.Picture = LoadPicture(app.Path & "\trffc14.ico")
imgNotOnTop.Picture = LoadPicture(app.Path & "\notontop.bmp")
imgOnTop.Picture = LoadPicture(app.Path & "\ontop.bmp")
'---On top toolbar button have two different pictures
If mnuAllways_On_Top.Checked Then
   btnToolbar(3).Picture = imgOnTop.Picture
   btnToolbar(3).Picture = imgNotOnTop.Picture
End If
btnToolbar(0).Picture = LoadPicture(app.Path & "\folder02.ico")
btnToolbar(1).Picture = LoadPicture(app.Path & "\folder01.ico")
btnToolbar(4).Picture = LoadPicture(app.Path & "\litening.ico")
End Sub
Sub IFrame1_Click (Index As Integer)
'---Set focus to the appropriate textbox
'---according to the tab clicked
txtInfo(Index).SetFocus
End Sub
Function IsKeyWordInString (st$, KeyIdx) As Integer
'---8.10.94
'---Check if keyword is in string.
'---This to avoid hardcoded strings to be taken for subs,functions or whatever.
'---'RETURN: False = Outside string
'            True  = Inside string
Dim ApoPos, Apo$, i, NumOfApo, ch$, KeyWordPos
Apo$ = Chr$(34)
'---Check if there are any strings in the codeline
If InStr(st$, Apo$) = 0 Then
   IsKeyWordInString = False
   Exit Function
End If
'---Where is Keyword? Discard the string to the right of KeyWord
KeyWordPos = InStr(st$, Search$(KeyIdx))
ApoPos = InStr(Left$(st$, KeyWordPos), Apo$)
'---Count apostrophe's
For i = ApoPos To 1 Step -1
    ch = Mid$(st$, i, 1)
    If ch = Apo$ Then
      NumOfApo = NumOfApo + 1
    End If
'---If we get a uneven number then the
'---keyword has to be in a string!
Select Case NumOfApo
   Case 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29
         IsKeyWordInString = True
   Case Else
         IsKeyWordInString = False
End Select
End Function
Sub mnuA_LoadLast_Click ()
'---Toggle the 'load last file on start' option
mnuA_LoadLast.Checked = Not mnuA_LoadLast.Checked
End Sub
Sub mnuAllways_On_Top_click ()
'---Always on top function
'---Using the API SetWindowPos call
Dim success
If mnuAllways_On_Top.Checked Then
   success = SetWindowPos(Form1.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
   '---Change picture
   btnToolbar(3).Picture = imgNotOnTop.Picture
   success = SetWindowPos(Form1.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
   btnToolbar(3).Picture = imgOnTop.Picture
End If
'Toggle Checked
mnuAllways_On_Top.Checked = Not mnuAllways_On_Top.Checked
End Sub
Sub mnuFile_Exit_Click ()
Unload Me
End Sub
Sub mnuFile_Open_click ()
'---Open a MAK file for processing
Dim pt, FileAction, Fname$, i
'---Reset global variables
Nr_Of_Subs = 0
Total_Number_Of_Lines = 0
Total_Nr_Of_Subs = 0
Total_Nr_Of_Functions = 0
Total_Nr_Of_Module_Vars = 0
Total_Nr_Of_Vars = 0
Total_Nr_Of_Declarations = 0
Total_Nr_Of_Global_Vars = 0
Nr_Of_Global_Vars = 0
Nr_Of_Declarations = 0
Nr_Of_Module_Vars = 0
Nr_Of_Vars = 0
Nr_Of_Functions = 0
Nr_Of_Subs = 0
On Error GoTo CMDialogerr
'---8.10.94  Activate Stop button
btnToolbar(2).Tag = ""
btnToolbar(2).Enabled = True
btnToolbar(2).Picture = imgstop.Picture
screen.MousePointer = HOURGLASS
'---Load last used file in previous session
'---or open dialog
'---The Form1.tag is put to loading in design mode.
If Form1.Tag = "Loading" And mnuA_LoadLast.Checked Then
   '---Get the last filename
   Fname$ = ReadIni("Last File", "")
   Form1.Tag = "" '---reset tag
   '---If we dont get a filename (=No INI file)
   '---We run this procedure recursively WITHOUT
   '---the Form1.tag
   If Len(Dir$(Fname$)) = 0 Then mnuFile_Open_click
   '---Open filedialog
   CMdialog1.Action = 1
   '---Mak files don't tell the path when in default directory
   '---Instead we have to change to the directory were the
   '---mak file is.
   pt = InStr(CMdialog1.Filename, CMdialog1.Filetitle)
   ChDir Left$(CMdialog1.Filename, pt - 2)
   Fname$ = CMdialog1.Filename
End If
'---Clear possible old info
For i = 0 To SUMMARY
   txtInfo(i) = ""
'---Write the filename to the VBSPY.INI file
writeIni "Last File", Fname$
Form1.Caption = "VB-SPY: " & Fname$
OpenMakFile (Fname$)
'---Deactivate Stop button
btnToolbar(2).Enabled = False
btnToolbar(2).Picture = imgNostop.Picture
lblStatus = "OK"
'---30.10.94 Summary info
txtInfo(SUMMARY) = txtInfo(SUMMARY) & String$(60, "-") & " TOTAL " & String$(150, "-") & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Code Lines : " & Total_Number_Of_Lines & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Sub : " & Total_Nr_Of_Subs & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Function : " & Total_Nr_Of_Functions & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Declare : " & Total_Nr_Of_Declarations & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Global Var. : " & Total_Nr_Of_Global_Vars & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Module Var. : " & Total_Nr_Of_Module_Vars & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Local Var. : " & Total_Nr_Of_Vars & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & String$(60, "-") & " Project File " & String$(150, "-") & NL
'---Simply append the variable
txtInfo(SUMMARY) = txtInfo(SUMMARY) & Mak_File_In_Summary$
screen.MousePointer = DEFAULT
Exit Sub
'Cancel pressed
CMDialogerr:
screen.MousePointer = DEFAULT
'---Deactivate Stop button
btnToolbar(2).Enabled = False
btnToolbar(2).Picture = imgNostop.Picture
FileAction = FileErrors(Err)
Select Case FileAction
   Case 0
      Resume
   Case Else
    Close
    Exit Sub
End Select
Exit Sub
End Sub
Sub mnuFile_Update_Click ()
'---Update current .mak file
Dim Chk
'---Current value of the checked menu
Chk = mnuA_LoadLast.Checked
'---This is fooling the mnuFile_Open procedure
'---to belive that we started the program with the
'---Load last file option active (Yes...that's cheating!)
mnuA_LoadLast.Checked = True
Form1.Tag = "Loading"
mnuFile_Open_click
'---The old value back
mnuA_LoadLast.Checked = Chk
End Sub
Sub mnuH_About_Click ()
AboutBox.Show MODAL
End Sub
Sub mnuHcontents_Click ()
'---Help contents
Help 0
'MsgBox "Hj
lp-Systemet inte gjort
nnu!", 64, "VB Spy"
End Sub
Sub mnuHsearch_Click ()
'---TODO
'MsgBox "Hj
lp-Systemet inte gjort
nnu!", 64, "VB Spy"
HelpSearch
End Sub
Function Nr_Of_Commas (s As String)
'---Counting number of commas
Dim i, Num_Of_Comma, ch As String
For i = Len(s) To 1 Step -1
    ch = Mid$(s, i, 1)
    If ch = "," Then
      Num_Of_Comma = Num_Of_Comma + 1
    End If
Nr_Of_Commas = Num_Of_Comma
End Function
Sub OpenCodeFile (Filename$)
'---Open Your Code-file (.frm,.bas...) FileName$ and reads it one row at a time
'---and checks if we have someting from Search$
Dim CodeLine$, FileAction, FileNum, i, Check, x
'---Reset variables
Nr_Of_Module_Vars = 0
Nr_Of_Vars = 0
Nr_Of_Global_Vars = 0
Nr_Of_Functions = 0
Nr_Of_Subs = 0
Nr_Of_Declarations = 0
On Error GoTo openCodeFileErr
For i = 0 To SUMMARY '---SUMMARY is the highest constant
   '---Cosmetics
   If Len(txtInfo(i)) = 0 Then
      txtInfo(i) = txtInfo(i) & "<<<<  " & Filename$ & "  >>>>" & NL
   Else
      txtInfo(i) = txtInfo(i) & NL & "<<<<  " & Filename$ & "  >>>>" & NL
   End If
FileNum = FreeFile
Open Filename$ For Input As #FileNum
'---Module-level variables comes before any sub or function so...
'---Set flag
IsVarModuleLevel = True
'---If it is a form-file then we loop thru the control definitions
If Right$(UCase$(Filename$), 3) = "FRM" Then
   Do
      Line Input #FileNum, CodeLine$
   '---Control definitions end with a END in the first column
   Loop Until Left$(UCase$(CodeLine$), 3) = "END"
End If
'---One row at a time
Do While Not EOF(FileNum)
   DoEvents
   '---Interrupt the process
   If btnToolbar(2).Tag = "STOP" Then
      Close #FileNum
      Exit Sub
   End If
   Line Input #FileNum, CodeLine$
   lblStatus = "Reading File:  " & Filename$ & " Row nr:  " & x & NL & NL
   '---We have no use for strings shorter the 4 letters
   If Len(Trim$(CodeLine$)) > 4 Then
      '---Never mind about comment lines
      If Left$(LTrim$(CodeLine$), 1) <> "'" Then
      For i = 0 To GLOBALS '---Globals is the highest constant
         Check = InStr(CodeLine$, Search$(i))
         If Check <> 0 Then
            '---Yes, we have a valid keyword in the string
            ParseCodeLine CodeLine$, i
         End If
      Next
      End If
   End If
   x = x + 1
'---When the whole file is processed we can present the
'---statistics for the file
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Codelines : " & x & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Subs : " & Nr_Of_Subs & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Functions : " & Nr_Of_Functions & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Declarations : " & Nr_Of_Declarations & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Global Vars. : " & Nr_Of_Global_Vars & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Module Vars. : " & Nr_Of_Module_Vars & NL
txtInfo(SUMMARY) = txtInfo(SUMMARY) & "Num. of Local Vars. : " & Nr_Of_Vars & NL
'---Add up the number of total code lines
Total_Number_Of_Lines = Total_Number_Of_Lines + x
Close #FileNum
Exit Sub
openCodeFileErr:
FileAction = FileErrors(Err)
Select Case FileAction
   Case 0
      Resume
   Case Else
    Exit Sub
End Select
End Sub
Sub OpenMakFile (Makfile$)
'---Opens the .MAK file and checks if it is
'---a valid file(extension)
Dim TextLine$, FileAction, Check, i, FileNum
On Error GoTo openMakFileErr
Mak_File_In_Summary$ = ""
FileNum = FreeFile
Open Makfile$ For Input As #FileNum
Do While Not EOF(FileNum)
   '---STOP button pushed
   If btnToolbar(2).Tag = "STOP" Then
      btnToolbar(2).Tag = ""
      Close #FileNum
      Exit Sub
   End If
   Line Input #FileNum, TextLine$
   '---Reads in the whole project file in the string for viewing in
   '---the summary section.
   Mak_File_In_Summary$ = Mak_File_In_Summary$ & TextLine$ & NL
   Select Case Right$(UCase$(TextLine$), 3)
     '---Reading only files with these extensions.
     '---You can add more if You like, but I didnt want to read
     '---CONSTANTS.TXT so...
      Case "FRM", "BAS", "GLB", "GBL"
         OpenCodeFile TextLine$
   End Select
Close #FileNum
Exit Sub
openMakFileErr:
FileAction = FileErrors(Err)
Select Case FileAction
   Case 0
      Resume
   Case Else
    Exit Sub
End Select
End Sub
Sub ParseCodeLine (CodeLine$, cat)
'---Peal away unnecessary info
'---Codeline$ = current line in process
'---Cat = category
Dim txt$, EndChar, dta$, CancelLine, Nr_Comma
'---Take away remarks
CodeLine$ = TakeAwayRem(CodeLine$)
'--Check if keyword is in string
CancelLine = IsKeyWordInString(CodeLine$, cat)
If Not CancelLine Then
   Select Case cat

      Case SUB_S
         '---To avoid GOSUB...Yes, people are still using that! (I've heard)
         '---All sub declarations ends with a ')'
         EndChar = InStr(CodeLine$, ")")
         If EndChar <> 0 Then
            '---'Declare Sub' dont belong here
            If InStr(Left$(CodeLine$, EndChar), "Declare ") = 0 Then
               txtInfo(SUBS) = txtInfo(SUBS) & Left$(CodeLine$, EndChar) & NL
               DrawLineIntxtVar CodeLine$, cat
               Nr_Of_Subs = Nr_Of_Subs + 1
               Total_Nr_Of_Subs = Total_Nr_Of_Subs + 1
               '---When we have reached a sub or function we can't
               '---have any more modul-level variables
               IsVarModuleLevel = False
            End If
         End If

      Case FUNCTION_S
            '---'Declare function' dont belong here
            If InStr(CodeLine$, "Declare ") = 0 Then
               txtInfo(FUNCTIONS) = txtInfo(FUNCTIONS) & CodeLine$ & NL
               '---When we have reached a sub or function we can't
               '---have any more modul-level variables
               IsVarModuleLevel = False
               DrawLineIntxtVar CodeLine$, cat
               Nr_Of_Functions = Nr_Of_Functions + 1
               Total_Nr_Of_Functions = Total_Nr_Of_Functions + 1
            End If
      Case DIMS, STATICS, CONSTANTS
            '---Put module level in the right section
            If IsVarModuleLevel Then
               '---No Globals here
               If InStr(CodeLine, "Global ") = 0 Then
                  txtInfo(MODULE_VAR) = txtInfo(MODULE_VAR) & CodeLine & NL
                  '---Count commas: One comma means two variables...
                  Nr_Comma = Nr_Of_Commas(CodeLine) + 1
                  Nr_Of_Module_Vars = Nr_Of_Module_Vars + Nr_Comma
                  Total_Nr_Of_Module_Vars = Total_Nr_Of_Module_Vars + Nr_Comma
               End If
            Else
               '---Local variables
               txtInfo(VARIABLES) = txtInfo(VARIABLES) & CodeLine & NL
               Nr_Comma = Nr_Of_Commas(CodeLine) + 1
               Nr_Of_Vars = Nr_Of_Vars + Nr_Comma
               Total_Nr_Of_Vars = Total_Nr_Of_Vars + Nr_Comma
            End If
      Case DECLARATION_S
           txtInfo(DECLARATIONS) = txtInfo(DECLARATIONS) & CodeLine$ & NL
           Nr_Of_Declarations = Nr_Of_Declarations + 1
           Total_Nr_Of_Declarations = Total_Nr_Of_Declarations + 1

      Case GLOBALS
           txtInfo(GLOBAL_VAR) = txtInfo(GLOBAL_VAR) & CodeLine$ & NL
           Nr_Comma = Nr_Of_Commas(CodeLine) + 1
           Nr_Of_Global_Vars = Nr_Of_Global_Vars + Nr_Comma
           Total_Nr_Of_Global_Vars = Total_Nr_Of_Global_Vars + Nr_Comma
   End Select
End If
End Sub
Sub Picture1_MouseMove (Button As Integer, Shift As Integer, x As Single, Y As Single)
lblStatus = ""
End Sub
Sub ReadFromIni ()
'---Read ini-file
'---Last window positions
ReadFromIni_Window_Pos Form1
mnuA_LoadLast.Checked = ReadIni_Int("Last File Checked", 0)
If ReadIni_Int("Allways On Top", 0) Then
   mnuAllways_On_Top_click
End If
End Sub
Sub Tabbed1_MouseMove (Button As Integer, Shift As Integer, x As Single, Y As Single)
lblStatus = ""
End Sub
Sub Tabbed1_TabChange (ActiveTab As Integer)
'---This is dealing w
th the tab.vbx
'---ActiveTab is the one clicked
Dim i As Integer
    For i = 0 To tabbed1.NumberOfTabs - 1
        If i = ActiveTab Then
            IFrame1(i).Visible = True
        Else
            IFrame1(i).Visible = False
        End If
    Next
txtInfo(ActiveTab).SetFocus
End Sub
Function TakeAwayRem (st$) As String
'---Takes away text to the right of the remark sign
'---RETURN: The shortened string
Dim SearchCh
'---PLEASE NOTE:
'---If we have a codeline like this -> Dim x: Dim xx <- then the variable
'---xx will NOT be noted!
'---If You use this kind of notation you have to work out a solution for it!
SearchCh = InStr(st$, ":")
If SearchCh <> 0 Then
   st$ = Left$(st$, SearchCh - 1)
End If
'Comments with '
SearchCh = InStr(st$, "'")
If SearchCh <> 0 Then
   st$ = Left$(st$, SearchCh - 1)
End If
'Comments with Rem
SearchCh = InStr(UCase$(st$), " REM ")
If SearchCh <> 0 Then
   st$ = Left$(st$, SearchCh - 1)
End If
TakeAwayRem = st$
End Function
Sub txtInfo_MouseMove (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
lblStatus = ""
End Sub
Sub writeToIni ()
'---Ini file writing
'---Current window positions
writeToIni_Window_pos Form1
writeIni "Last File Checked", Str$(mnuA_LoadLast.Checked)
writeIni "Allways On Top", Str$(mnuAllways_On_Top.Checked)
End Sub