home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
code_b
/
browser.frm
next >
Wrap
Text File
|
1993-08-18
|
14KB
|
447 lines
VERSION 2.00
Begin Form Form1
Caption = "Code Browser using VideoSoft VSAWK"
Height = 5880
Left = 390
LinkTopic = "Form1"
ScaleHeight = 5415
ScaleWidth = 7680
Top = 825
Width = 7860
Begin VideoSoftElastic VSElastic1
Align = 5 'Fill Container
AutoSizeChildren= 4 'Uneven Vertically
BackColor = &H0000FF00&
BevelInner = 3 'Inset
BevelInnerWidth = 1
BevelOuter = 2 'Raised Outlined
BevelOuterWidth = 2
BorderWidth = 0
Caption = ""
CaptionPos = 1 'Left Center
ChildSpacing = 6
FloodColor = &H000000C0&
FloodDirection = 0 'None
FloodPercent = 0
Height = 4485
Index = 5
Left = 0
Splitter = 1 'Yes (with uneven spacing)
TabIndex = 5
Top = 930
Width = 7680
Begin VideoSoftElastic VSElastic1
Align = 0 'None
AutoSizeChildren= 4 'Uneven Vertically
BackColor = &H00C0C0C0&
BevelInner = 3 'Inset
BevelInnerWidth = 1
BevelOuter = 2 'Raised Outlined
BevelOuterWidth = 2
BorderWidth = 0
Caption = ""
CaptionPos = 1 'Left Center
ChildSpacing = 6
FloodColor = &H000000C0&
FloodDirection = 0 'None
FloodPercent = 0
Height = 1725
Index = 1
Left = 0
Splitter = 1 'Yes (with uneven spacing)
TabIndex = 9
Top = 2760
Width = 7680
Begin VideoSoftElastic VSElastic1
Align = 0 'None
AutoSizeChildren= 2 'Uneven Horizontally
BackColor = &H0000FF00&
BevelInner = 3 'Inset
BevelInnerWidth = 1
BevelOuter = 2 'Raised Outlined
BevelOuterWidth = 2
BorderWidth = 1
Caption = ""
CaptionPos = 1 'Left Center
ChildSpacing = 6
FloodColor = &H000000C0&
FloodDirection = 0 'None
FloodPercent = 0
Height = 1725
Index = 2
Left = 0
Splitter = 1 'Yes (with uneven spacing)
TabIndex = 12
Top = 0
Width = 7680
Begin ListBox List1
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Courier New"
FontSize = 9
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 1605
Left = 15
Sorted = -1 'True
TabIndex = 10
Top = 15
Width = 2415
End
Begin ListBox List2
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Courier New"
FontSize = 9
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 1605
Left = 2520
Sorted = -1 'True
TabIndex = 11
Top = 15
Width = 5145
End
End
End
Begin VideoSoftElastic VSElastic1
Align = 0 'None
AutoSizeChildren= 4 'Uneven Vertically
BackColor = &H00C0C0C0&
BevelInner = 3 'Inset
BevelInnerWidth = 1
BevelOuter = 2 'Raised Outlined
BevelOuterWidth = 2
BorderWidth = 0
Caption = ""
CaptionPos = 1 'Left Center
ChildSpacing = 6
FloodColor = &H000000C0&
FloodDirection = 0 'None
FloodPercent = 0
Height = 2670
Index = 4
Left = 0
Splitter = 0 'No
TabIndex = 6
Top = 0
Width = 7680
Begin TextBox Text1
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Courier New"
FontSize = 9
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 2115
Left = 0
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 7
Top = 555
Width = 7680
End
Begin VideoSoftElastic VSElastic1
Align = 0 'None
AutoSizeChildren= 0 'None
BackColor = &H00000000&
BevelInner = 3 'Inset
BevelInnerWidth = 0
BevelOuter = 2 'Raised Outlined
BevelOuterWidth = 0
BorderWidth = 6
Caption = "Visual Basic Code"
CaptionPos = 4 'Center Center
ChildSpacing = 6
FloodColor = &H000000C0&
FloodDirection = 0 'None
FloodPercent = 0
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 13.5
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H000000FF&
Height = 465
Index = 3
Left = 0
Splitter = 0 'No
TabIndex = 8
Top = 0
Width = 7680
End
End
End
Begin VideoSoftAwk VSAwk3
Case = 0 'No Change
FS = " , "
Left = 2025
Top = 4500
End
Begin VideoSoftAwk VSAwk2
Case = 0 'No Change
FS = " , "
Left = 1530
Top = 4500
End
Begin VideoSoftAwk VSAwk1
Case = 0 'No Change
FS = " , "
Left = 990
Top = 4500
End
Begin CommonDialog CMDialog
Left = 450
Top = 4455
End
Begin VideoSoftElastic VSElastic3
Align = 1 'Align Top
AutoSizeChildren= 0 'None
BackColor = &H00C0C0C0&
BevelInner = 3 'Inset
BevelInnerWidth = 1
BevelOuter = 1 'Raised
BevelOuterWidth = 2
BorderWidth = 6
Caption = ""
CaptionPos = 4 'Center Center
ChildSpacing = 6
FloodColor = &H0080FFFF&
FloodDirection = 1 'Right
FloodPercent = 0
Height = 420
Left = 0
Splitter = 0 'No
TabIndex = 4
Top = 510
Width = 7680
End
Begin VideoSoftElastic VSElastic1
Align = 1 'Align Top
AutoSizeChildren= 1 'Even Horizontally
BackColor = &H00C0C0C0&
BevelInner = 3 'Inset
BevelInnerWidth = 1
BevelOuter = 1 'Raised
BevelOuterWidth = 2
BorderWidth = 6
Caption = ""
CaptionPos = 1 'Left Center
ChildSpacing = 6
FloodColor = &H000000C0&
FloodDirection = 0 'None
FloodPercent = 0
Height = 510
Index = 0
Left = 0
Splitter = 0 'No
TabIndex = 3
Top = 0
Width = 7680
Begin CommandButton Command1
BackColor = &H00C0C0C0&
Caption = "&Open.."
Default = -1 'True
Height = 330
Index = 0
Left = 90
TabIndex = 0
Top = 90
Width = 2430
End
Begin CommandButton Command1
BackColor = &H00C0C0C0&
Caption = "&Print..."
Height = 330
Index = 2
Left = 5130
TabIndex = 2
Top = 90
Width = 2460
End
Begin CommandButton Command1
BackColor = &H00C0C0C0&
Caption = "&Copy"
Height = 330
Index = 1
Left = 2610
TabIndex = 1
Top = 90
Width = 2430
End
End
End
Option Explicit
Dim subtext$
' Example using nested VideoSoft VSAWK
' Projects need to be saved as TEXT be parsed by VSAWK.
' Once the project is loaded, just click on the desired
' subroutine name on list2 and the code will be place on
' the text box.
' VSElastic is used to automatically resize the form and
' for flooding status when parsing the file.
' CMDialog is used to open the file.
Sub Command1_Click (Index%)
Select Case Index
Case 0 'Open Button
' get file name
cmdialog.Filename = ""
cmdialog.DefaultExt = "MAK"
cmdialog.Filter = "VB Projects (*.mak)|*.MAK|All Files (*.*)|*.*"
cmdialog.Flags = &H1800&
cmdialog.Action = 1
If cmdialog.Filename = "" Then Exit Sub
' read project
text1 = ""
vsawk1.FileName = cmdialog.Filename
vsawk1.Tag = Left(cmdialog.Filename, Len(cmdialog.Filename) - Len(cmdialog.Filetitle))
vsawk1.Action = 0
vselastic3.FloodPercent = 0
vselastic3 = "Ready"
Case 1 ' Clipboard
If text1 = "" Then MsgBox "Sorry, no code selected": Exit Sub
clipboard.SetText text1, 1
vselastic3 = "Code copied to clipboard"
Case 2 'Print
MsgBox "printing routine not implemented"
End Select
End Sub
Sub Form_Resize ()
vselastic1(0).Left = 0
End Sub
Sub List2_DblClick ()
vsawk3 = list2
vsawk3.FileName = vsawk3.F(3)
vsawk3.Tag = Val(vsawk3.F(4))
vsawk3.Action = 0
End Sub
Sub VSAwk1_Begin ()
list1.Clear
End Sub
Sub VSAwk1_End ()
Dim i%
list1.Refresh
list2.Clear
For i = 0 To list1.ListCount - 1
list1.ListIndex = i
vsawk2.FileName = list1.List(i)
vselastic3 = vsawk2.FileName
vsawk2.Action = 0
list1.Refresh
list2.Refresh
Next
End Sub
Sub VSAwk1_Scan ()
'add .FRM files to List1
If InStr(vsawk1, "=") > 0 Or InStr(vsawk1, "VBX") > 0 Then Exit Sub
If InStr(vsawk1, "\") > 0 Then
list1.AddItem vsawk1
Else
list1.AddItem vsawk1.Tag + vsawk1
End If
End Sub
Sub VSAwk2_Scan ()
Static insub%, a$, lp%
If vsawk2.PercentDone <> lp Then
lp = vsawk2.PercentDone
vselastic3.FloodPercent = lp
vselastic3.Refresh
End If
'=====================================================
'Search for subroutines/Functions/Variable definitions
'=====================================================
If vsawk2.F(1) = "Sub" Then
insub = True
a = vsawk2.F(2) + Chr(9) + "(sub)" + Chr(9) + vsawk2.FileName + Chr(9) + Format(vsawk2.CurrPos)
list2.AddItem a
Exit Sub
End If
If vsawk2.F(1) = "Function" Then
insub = True
a = vsawk2.F(2) + Chr(9) + "(fun)" + Chr(9) + vsawk2.FileName + Chr(9) + Format(vsawk2.CurrPos)
list2.AddItem a
Exit Sub
End If
If vsawk2.F(1) = "Global" And vsawk2.F(2) <> "Const" Then
a = vsawk2.F(2) + Chr(9) + "(gvar)" + Chr(9) + vsawk2.FileName + Chr(9) + Format(vsawk2.CurrPos)
list2.AddItem a
Exit Sub
End If
If vsawk2.F(1) = "Dim" And Not insub Then
a = vsawk2.F(2) + Chr(9) + "(fvar)" + Chr(9) + vsawk2.FileName + Chr(9) + Format(vsawk2.CurrPos)
list2.AddItem a
Exit Sub
End If
If vsawk2.F(1) = "End" And (vsawk2.F(2) = "Sub" Or vsawk2.F(2) = "Function") Then
insub = False
Exit Sub
End If
End Sub
Sub VSAwk3_Begin ()
vsawk3.CurrPos = Val(vsawk3.Tag)
subtext = ""
End Sub
Sub VSAwk3_End ()
text1 = subtext
End Sub
Sub VSAwk3_Scan ()
' accumulate text
If subtext = "" Then
subtext = vsawk3
Else
subtext = subtext + Chr(13) + Chr(10) + vsawk3
End If
' stop if only a var
If vsawk3.RN = 0 Then
If vsawk3.F(1) <> "Sub" And vsawk3.F(1) <> "Function" Then vsawk3.Action = 2
End If
' stop at end of functions and subs
If vsawk3.F(1) = "End" Then
If vsawk3.F(2) = "Sub" Then vsawk3.Action = 2
If vsawk3.F(2) = "Function" Then vsawk3.Action = 2
End If
End Sub