LinSys.vbp
©1999 and 2009 Dr. Glyn George
Program to carry out the tedious arithmetic of row operations in
the reduction of a linear system of equations (or a matrix) to
echelon form. The user must decide what row operation to perform
at each step.
Screen and file version, with user choice of file name.
linsys.frm".
The code is split between four files:
linsys.vbp linsys.vbw linsys.frx linsys.frm (formatting code) linsys.frm (main code)Contents of the file "linsys.vbp":
Type=Exe
Form=linsys.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="Linsys"
Command32=""
Name="Linsys"
HelpContextID="0"
Description="Row Reduction of Linear Systems"
CompatibleMode="0"
MajorVer=6
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Faculty of Engineering"
CompilationType=-1
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
ThreadPerObject=0
MaxNumberOfThreads=1
Contents of the file "linsys.vbw":
Form1 = 23, 23, 449, 360, Z, 46, 46, 472, 383, C
Contents of the file "linsys.frx"
(all on one line):
ï Enter the rational coefficients (numerator / denominator) of the
linear system of equations. Select the row to change [and the
row to use and row factor if applicable]. Then click the button
corresponding to your chosen row operation.
Contents of the file "linsys.frm"
(the majority of the code):
VERSION 5.00
Begin VB.Form Form1
Caption = "Row Reduction of a Linear System"
ClientHeight = 6045
ClientLeft = 75
ClientTop = 435
ClientWidth = 11310
LinkTopic = "Form1"
ScaleHeight = 6045
ScaleWidth = 11310
Begin VB.TextBox txtNumCols
Height = 285
Left = 9720
TabIndex = 116
Text = "7"
Top = 5160
Width = 375
End
Begin VB.TextBox txtNumRows
Height = 285
Left = 9720
TabIndex = 115
Text = "6"
Top = 4920
Width = 375
End
Begin VB.Frame fraUse
Caption = "Row to Use"
Height = 1815
Left = 5880
TabIndex = 17
Top = 4200
Width = 1335
Begin VB.OptionButton optRowB
Caption = "Row 6"
Height = 255
Index = 6
Left = 240
TabIndex = 118
Top = 1440
Width = 855
End
Begin VB.OptionButton optRowB
Caption = "Row 5"
Height = 255
Index = 5
Left = 240
TabIndex = 22
Top = 1200
Width = 855
End
Begin VB.OptionButton optRowB
Caption = "Row 4"
Height = 255
Index = 4
Left = 240
TabIndex = 21
Top = 960
Width = 855
End
Begin VB.OptionButton optRowB
Caption = "Row 3"
Height = 255
Index = 3
Left = 240
TabIndex = 20
Top = 720
Width = 855
End
Begin VB.OptionButton optRowB
Caption = "Row 2"
Height = 255
Index = 2
Left = 240
TabIndex = 19
Top = 480
Value = -1 'True
Width = 855
End
Begin VB.OptionButton optRowB
Caption = "Row 1"
Height = 255
Index = 1
Left = 240
TabIndex = 18
Top = 240
Width = 855
End
End
Begin VB.Frame fraFactor
Caption = "Row factor"
Height = 1335
Left = 7320
TabIndex = 14
Top = 4200
Width = 1095
Begin VB.TextBox txtDenFactor
Height = 285
Left = 240
TabIndex = 16
Text = "1"
Top = 840
Width = 615
End
Begin VB.TextBox txtNumFactor
Height = 285
Left = 240
TabIndex = 15
Text = "1"
Top = 360
Width = 615
End
Begin VB.Line Line1
X1 = 240
X2 = 840
Y1 = 720
Y2 = 720
End
End
Begin VB.Frame fraOperation
Caption = "Row Operation to Perform"
Height = 1815
Left = 1680
TabIndex = 9
Top = 4200
Width = 4095
Begin VB.CommandButton cmdLinComb
Caption = "&Subtract multiple of 2nd row from 1st"
Height = 495
Left = 1680
TabIndex = 13
Top = 1200
Width = 2175
End
Begin VB.CommandButton cmdSwap
Caption = "&Interchange two rows"
Height = 375
Left = 1680
TabIndex = 12
Top = 720
Width = 2175
End
Begin VB.CommandButton cmdDiv
Caption = "&Divide Row by Constant"
Height = 375
Left = 1680
TabIndex = 11
Top = 240
Width = 2175
End
Begin VB.CommandButton cmdReduce
BackColor = &H00004000&
Caption = "&Reduce Fractions Now"
Default = -1 'True
Height = 1215
Left = 120
TabIndex = 10
Top = 240
Width = 1335
End
End
Begin VB.Frame fraChange
Caption = "Row to Change"
Height = 1815
Left = 120
TabIndex = 3
Top = 4200
Width = 1455
Begin VB.OptionButton optRowA
Caption = "Row 6"
Height = 255
Index = 6
Left = 240
TabIndex = 117
Top = 1440
Width = 855
End
Begin VB.OptionButton optRowA
Caption = "Row 5"
Height = 255
Index = 5
Left = 240
TabIndex = 8
Top = 1200
Width = 855
End
Begin VB.OptionButton optRowA
Caption = "Row 4"
Height = 255
Index = 4
Left = 240
TabIndex = 7
Top = 960
Width = 855
End
Begin VB.OptionButton optRowA
Caption = "Row 3"
Height = 255
Index = 3
Left = 240
TabIndex = 6
Top = 720
Width = 855
End
Begin VB.OptionButton optRowA
Caption = "Row 2"
Height = 255
Index = 2
Left = 240
TabIndex = 5
Top = 480
Width = 855
End
Begin VB.OptionButton optRowA
Caption = "Row 1"
Height = 255
Index = 1
Left = 240
TabIndex = 4
Top = 240
Value = -1 'True
Width = 855
End
End
Begin VB.CommandButton cmdQuit
BackColor = &H000000FF&
Caption = "&Quit"
Height = 495
Left = 8520
Style = 1 'Graphical
TabIndex = 2
Top = 4200
Width = 735
End
Begin VB.Frame fraMatrix
Caption = "Matrix of Coefficients of the Linear System (numerator/denominator) "
Height = 3495
Left = 0
TabIndex = 1
Top = 600
Width = 11175
Begin VB.TextBox txtDen
Height = 285
Index = 42
Left = 9720
TabIndex = 107
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 41
Left = 9720
TabIndex = 106
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 40
Left = 9720
TabIndex = 105
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 39
Left = 9720
TabIndex = 104
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 38
Left = 9720
TabIndex = 103
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 37
Left = 9720
TabIndex = 102
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 42
Left = 9000
TabIndex = 101
Text = "0"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 41
Left = 9000
TabIndex = 100
Text = "0"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 40
Left = 9000
TabIndex = 99
Text = "0"
Top = 1920
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 39
Left = 9000
TabIndex = 98
Text = "0"
Top = 1440
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 38
Left = 9000
TabIndex = 97
Text = "0"
Top = 960
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 37
Left = 9000
TabIndex = 96
Text = "0"
Top = 480
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 36
Left = 8280
TabIndex = 95
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 35
Left = 8280
TabIndex = 94
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 34
Left = 8280
TabIndex = 93
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 33
Left = 8280
TabIndex = 92
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 32
Left = 8280
TabIndex = 91
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 31
Left = 8280
TabIndex = 90
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 36
Left = 7560
TabIndex = 89
Text = "1"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 35
Left = 7560
TabIndex = 88
Text = "0"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 34
Left = 7560
TabIndex = 87
Text = "0"
Top = 1920
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 33
Left = 7560
TabIndex = 86
Text = "1"
Top = 1440
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 32
Left = 7560
TabIndex = 85
Text = "0"
Top = 960
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 31
Left = 7560
TabIndex = 84
Text = "0"
Top = 480
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 30
Left = 6840
TabIndex = 83
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 29
Left = 6840
TabIndex = 82
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 28
Left = 6840
TabIndex = 81
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 27
Left = 6840
TabIndex = 80
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 26
Left = 6840
TabIndex = 79
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 25
Left = 6840
TabIndex = 78
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 30
Left = 6120
TabIndex = 77
Text = "0"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 29
Left = 6120
TabIndex = 76
Text = "1"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 28
Left = 6120
TabIndex = 75
Text = "0"
Top = 1920
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 27
Left = 6120
TabIndex = 74
Text = "0"
Top = 1440
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 26
Left = 6120
TabIndex = 73
Text = "1"
Top = 960
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 25
Left = 6120
TabIndex = 72
Text = "0"
Top = 480
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 24
Left = 5400
TabIndex = 71
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 23
Left = 5400
TabIndex = 70
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 22
Left = 5400
TabIndex = 69
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 21
Left = 5400
TabIndex = 68
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 20
Left = 5400
TabIndex = 67
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 19
Left = 5400
TabIndex = 66
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 24
Left = 4680
TabIndex = 65
Text = "0"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 23
Left = 4680
TabIndex = 64
Text = "0"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 22
Left = 4680
TabIndex = 63
Text = "1"
Top = 1920
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 21
Left = 4680
TabIndex = 62
Text = "0"
Top = 1440
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 20
Left = 4680
TabIndex = 61
Text = "0"
Top = 960
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 19
Left = 4680
TabIndex = 60
Text = "1"
Top = 480
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 18
Left = 3960
TabIndex = 59
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 17
Left = 3960
TabIndex = 58
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 16
Left = 3960
TabIndex = 57
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 15
Left = 3960
TabIndex = 56
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 14
Left = 3960
TabIndex = 55
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 13
Left = 3960
TabIndex = 54
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 18
Left = 3240
TabIndex = 53
Text = "0"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 17
Left = 3240
TabIndex = 52
Text = "0"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 16
Left = 3240
TabIndex = 51
Text = "0"
Top = 1920
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 15
Left = 3240
TabIndex = 50
Text = "1"
Top = 1440
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 14
Left = 3240
TabIndex = 49
Text = "0"
Top = 960
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 13
Left = 3240
TabIndex = 48
Text = "0"
Top = 480
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 12
Left = 2520
TabIndex = 47
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 11
Left = 2520
TabIndex = 46
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 10
Left = 2520
TabIndex = 45
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 9
Left = 2520
TabIndex = 44
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 8
Left = 2520
TabIndex = 43
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 7
Left = 2520
TabIndex = 42
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 6
Left = 1080
TabIndex = 41
Text = "1"
Top = 2880
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 5
Left = 1080
TabIndex = 40
Text = "1"
Top = 2400
Width = 495
End
Begin VB.TextBox txtDen
Height = 285
Index = 4
Left = 1080
TabIndex = 39
Text = "1"
Top = 1920
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 12
Left = 1800
TabIndex = 38
Text = "0"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 11
Left = 1800
TabIndex = 37
Text = "0"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 10
Left = 1800
TabIndex = 36
Text = "0"
Top = 1920
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 9
Left = 1800
TabIndex = 35
Text = "0"
Top = 1440
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 8
Left = 1800
TabIndex = 34
Text = "1"
Top = 960
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 7
Left = 1800
TabIndex = 33
Text = "0"
Top = 480
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 6
Left = 360
TabIndex = 32
Text = "0"
Top = 2880
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 5
Left = 360
TabIndex = 31
Text = "0"
Top = 2400
Width = 615
End
Begin VB.TextBox txtNum
Height = 285
Index = 4
Left = 360
TabIndex = 30
Text = "0"
Top = 1920
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 3
Left = 1080
TabIndex = 29
Text = "1"
Top = 1440
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 3
Left = 360
TabIndex = 28
Text = "0"
Top = 1440
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 2
Left = 1080
TabIndex = 27
Text = "1"
Top = 960
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 2
Left = 360
TabIndex = 26
Text = "0"
Top = 960
Width = 615
End
Begin VB.TextBox txtDen
Height = 285
Index = 1
Left = 1080
TabIndex = 25
Text = "1"
Top = 480
Width = 495
End
Begin VB.TextBox txtNum
Height = 285
Index = 1
Left = 360
TabIndex = 24
Text = "1"
Top = 480
Width = 615
End
Begin VB.Label lblColNumber
Caption = "7"
Height = 255
Index = 7
Left = 9600
TabIndex = 125
Top = 240
Width = 255
End
Begin VB.Label lblColNumber
Caption = "6"
Height = 255
Index = 6
Left = 8160
TabIndex = 124
Top = 240
Width = 255
End
Begin VB.Label lblColNumber
Caption = "5"
Height = 255
Index = 5
Left = 6720
TabIndex = 123
Top = 240
Width = 255
End
Begin VB.Label lblColNumber
Caption = "4"
Height = 255
Index = 4
Left = 5280
TabIndex = 122
Top = 240
Width = 255
End
Begin VB.Label lblColNumber
Caption = "3"
Height = 255
Index = 3
Left = 3840
TabIndex = 121
Top = 240
Width = 255
End
Begin VB.Label lblColNumber
Caption = "2"
Height = 255
Index = 2
Left = 2400
TabIndex = 120
Top = 240
Width = 255
End
Begin VB.Label lblColNumber
Caption = "1"
Height = 255
Index = 1
Left = 960
TabIndex = 119
Top = 240
Width = 255
End
Begin VB.Label lblRowNumber
Caption = "6"
Height = 255
Index = 6
Left = 120
TabIndex = 112
Top = 2920
Width = 255
End
Begin VB.Label lblRowNumber
Caption = "5"
Height = 255
Index = 5
Left = 120
TabIndex = 111
Top = 2440
Width = 255
End
Begin VB.Label lblRowNumber
Caption = "4"
Height = 255
Index = 4
Left = 120
TabIndex = 110
Top = 1960
Width = 255
End
Begin VB.Label lblRowNumber
Caption = "3"
Height = 255
Index = 3
Left = 120
TabIndex = 109
Top = 1480
Width = 255
End
Begin VB.Label lblRowNumber
Caption = "2"
Height = 255
Index = 2
Left = 120
TabIndex = 108
Top = 1000
Width = 255
End
Begin VB.Label lblRowNumber
Caption = "1"
Height = 255
Index = 1
Left = 120
TabIndex = 23
Top = 520
Width = 255
End
End
Begin VB.Label lblDim2
Alignment = 1 'Right Justify
Caption = "# columns: "
Height = 255
Left = 8520
TabIndex = 114
Top = 5200
Width = 1095
End
Begin VB.Label lblDim1
Alignment = 1 'Right Justify
Caption = "# rows: "
Height = 255
Left = 8640
TabIndex = 113
Top = 4960
Width = 975
End
Begin VB.Label lblInstructions
Caption = $"linsys.frx":0000
Height = 495
Left = 120
TabIndex = 0
Top = 120
Width = 9135
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=======================================================================
' LinSys.vbp (c)1999 Dr. Glyn George
' Program to carry out the tedious arithmetic of row operations in
' the reduction of a linear system of equations (or a matrix) to
' echelon form. The user must decide what row operation to perform
' at each step.
' Screen and file version, with user choice of file name.
'=======================================================================
' List of procedures created for this program:
'
' Form_Load() welcome message boxes; open output file.
' IntroBox() print introductory information in a message box
' OpenFile() open the user's chosen output file
' Dimension(numRows as Integer, numCols as Integer)
' - get and validate # rows & columns from user
' SetUpForm(numRows as Integer, numCols as Integer)
' - initialize the form with the chosen # rows & columns
'
' cmdReduce_Click() reduce all fractions to lowest terms.
' cmdLinComb_Click() From rowA subtract the chosen multiple of rowB.
' cmdDiv_Click() Divide all coeff'ts in a row by a constant.
' cmdSwap_Click() Swap the two chosen rows.
' cmdQuit_Click() Terminate program execution.
'
' ReduceAll(zeroDen As Integer):
' - Reduce all 43 fractions to lowest terms.
' ReduceFraction(num As Long, den As Long):
' - cancels (num/den) down to lowest terms.
' SelectedRowA() Returns index number of row to change.
' SelectedRowB() Returns index number of row to use.
' PrintSystem() Print the linear system to the output file.
' Format5R$(num As Long)
' - returns num as 5 digit right-adjusted string.
' Format5L$(num As Long)
' - returns num as 5 digit left-adjusted string.
'
Sub ReduceAll(zeroDen As Integer)
'----------------------------------------------------------------------
' Reduce all 43 fractions to lowest terms.
'----------------------------------------------------------------------
' Parameters:
' zeroDen: Error flag = # zero denominators.
' Procedures:
' ReduceFraction: reduce one fraction to lowest terms
' Local Variables:
' i: loop counter = array subscript in matrix of coefficients
' num: numerator of new entry in row A
' den: denominator of new entry in row A
Dim i As Integer
Dim num As Long, den As Long
Let zeroDen = 0
For i = 1 To 42
Let num = Val(txtNum(i).Text)
Let den = Val(txtDen(i).Text)
Call ReduceFraction(num, den)
Let txtNum(i).Text = Str(num)
Let txtDen(i).Text = Str(den)
If den = 0 Then Let zeroDen = zeroDen + 1
Next i
' Reduce row factor also.
Let num = Val(txtNumFactor.Text)
Let den = Val(txtDenFactor.Text)
Call ReduceFraction(num, den)
Let txtNumFactor.Text = Str(num)
Let txtDenFactor.Text = Str(den)
If den = 0 Then Let zeroDen = zeroDen + 1
End Sub
Sub ReduceFraction(num As Long, den As Long)
'-----------------------------------------------------------------------------
' ** SUBprogram ** (c) 1991, 1998 **>> G.H. George <<**
' Old QuickBASIC routine, adapted to this VisualBASIC program.
' - cancels the fraction (num/den) down to lowest terms.
'-----------------------------------------------------------------------------
' Procedures:
' NextPrime: returns the next prime number after the argument
' [eliminated from this version]
' Parameters: (both should be from arguments passed by reference)
' num: numerator of the fraction to be reduced
' den: denominator of the fraction to be reduced
' Local Variables:
' Proceed: logical variable (= true if further reduction may be needed)
' Prime: prime number; used to test num & den for common factors
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
Dim Proceed As Boolean, Prime As Long
Dim Prompt As String, Title As String
Let Proceed = True ' no special cases - yet.
If den = 0 Then
Let Proceed = False ' Avoid zero denominator entirely.
Let Prompt = "A fraction has a zero denominator. "
Let Prompt = Prompt + "Change any zero denominators to non-zero "
Let Prompt = Prompt + "before proceeding any further."
Let Title = "Error: Division by zero."
Call MsgBox(Prompt, vbExclamation, Title)
ElseIf num = 0 Then ' Check for zero numerator.
Let den = 1
Let Proceed = False ' and no need to reduce further.
ElseIf den < 0 Then ' Make denominator positive.
Let num = -num ' - but further reduction may
Let den = -den ' be needed.
ElseIf Abs(num) = 1 Or den = 1 Then
Let Proceed = False ' No reduction needed for unit
End If ' numerator or denominator.
If Proceed Then ' Proceed with main routine ONLY
Let Prime = 2 ' when no special cases detected.
Do
Do
If num / Prime = Int(num / Prime) Then
Let Proceed = True ' Test divisibility of numerator.
Else
Let Proceed = False
End If
'
If den / Prime <> Int(den / Prime) Then
Let Proceed = False ' Test divisibility of denominator.
End If
'
If Proceed Then ' Divide out by common factor found.
Let num = num / Prime
Let den = den / Prime
End If
Loop While Proceed ' Try same prime again if it's
' a common factor of num & den.
' Let Prime = NextPrime&(Prime) ' else go to next prime number.
Let Prime = Prime + 1
Loop Until Prime > Abs(num) Or Prime > den
' until lowest terms.
End If
End Sub
Function SelectedRowA()
'----------------------------------------------------------------------
' Return the row index number of the row the user has chosen to change.
'----------------------------------------------------------------------
' No explicit parameters or procedures.
' Local Variables:
' i: loop counter = subscript of array of radio buttons
Dim i As Integer
Let i = 1
Do
If optRowA(i).Value = True Then
Let SelectedRowA = i
Exit Do
End If
Let i = i + 1
Loop
End Function
Function SelectedRowB()
'----------------------------------------------------------------------
' Return the row index number of the row the user has chosen to use.
'----------------------------------------------------------------------
' No explicit parameters or procedures.
' Local Variables:
' i: loop counter = subscript of array of radio buttons
Dim i As Integer
Let i = 1
Do
If optRowB(i).Value = True Then
Let SelectedRowB = i
Exit Do
End If
Let i = i + 1
Loop
End Function
Sub PrintSystem()
'----------------------------------------------------------------------
' Print the linear system to the output file.
'----------------------------------------------------------------------
' No explicit parameters.
' Procedures:
' Format5R$: print integer in exactly 5 spaces, right-adjusted
' Format5L$: print integer in exactly 5 spaces, left-adjusted
' Local Variables:
' numRows: number of rows in the linear system
' numCols: number of columns in the linear system
' row: outer loop counter = row number in matrix
' col: inner loop counter = column number in matrix
' num: numerator of current array element to be printed
' den: denominator of current array element to be printed
Dim numRows As Integer, numCols As Integer
Dim row As Integer, col As Integer
Dim num As Long, den As Long
Let numRows = Val(txtNumRows.Text)
Let numCols = Val(txtNumCols.Text)
Print #1, "Linear System:"
Print #1,
For row = 1 To numRows
Print #1, "Row"; RTrim$(Str(row)); ":";
For col = 1 To numCols
Let num = Val(txtNum(row + (col - 1) * 6).Text)
Let den = Val(txtDen(row + (col - 1) * 6).Text)
Print #1, Format5R$(num); "/"; Format5L$(den);
Next col
Print #1,
Next row
Print #1,
Print #1, String$(77, "-")
End Sub
Function Format5R$(num As Long)
'----------------------------------------------------------------------
' Format an integer for printing as a right-adjusted string in
' exactly 5 spaces. Where necessary, pad with leading spaces.
' Note: number will overflow without any error message if
' num < -9999 or num > 99999
' [This was so much easier with "PRINT USING" in QuickBASIC!]
'----------------------------------------------------------------------
' Parameters:
' num: the integer to be printed in 5 spaces.
' No procedures or local variables.
Select Case num
Case 0 To 9
Let Format5R$ = " " + LTrim$(RTrim$(Str(num)))
Case -9 To -1, 10 To 99
Let Format5R$ = " " + LTrim$(RTrim$(Str(num)))
Case -99 To -10, 100 To 999
Let Format5R$ = " " + LTrim$(RTrim$(Str(num)))
Case -999 To -100, 1000 To 9999
Let Format5R$ = " " + LTrim$(RTrim$(Str(num)))
Case Else
Let Format5R$ = LTrim$(RTrim$(Str(num)))
End Select
End Function
Function Format5L$(num As Long)
'----------------------------------------------------------------------
' Format an integer for printing as a left-adjusted string in
' exactly 5 spaces. Where necessary, pad with trailing spaces.
' Note: number will overflow without any error message if
' num < -99999 or num > 999999
' [This was so much easier with "PRINT USING" in QuickBASIC!]
'----------------------------------------------------------------------
' Parameters:
' num: the integer to be printed in 5 spaces.
' No procedures or local variables.
Select Case num
Case 0 To 9
Let Format5L$ = LTrim$(RTrim$(Str(num))) + " "
Case -9 To -1, 10 To 99
Let Format5L$ = LTrim$(RTrim$(Str(num))) + " "
Case -99 To -10, 100 To 999
Let Format5L$ = LTrim$(RTrim$(Str(num))) + " "
Case -999 To -100, 1000 To 9999
Let Format5L$ = LTrim$(RTrim$(Str(num))) + " "
Case Else
Let Format5L$ = LTrim$(RTrim$(Str(num)))
End Select
End Function
Private Sub Form_Load()
'----------------------------------------------------------------------
' Start up: show welcome message boxes and open output file.
'----------------------------------------------------------------------
' No explicit parameters or local variables.
' Procedures:
' IntroBox: print introductory information in a message box
' OpenFile: open the user's chosen output file
' Dimension: get and validate # rows & columns from user
' SetUpForm: initialize the form with the chosen # rows & columns
' Local Variables:
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
' fileName: name of the output file.
' NumRows: number of rows in the linear system.
' NumCols: number of columns in the linear system.
Dim Prompt As String, Title As String, fileName As String
Dim numRows As Integer, numCols As Integer
Call IntroBox
Call OpenFile
Call Dimension(numRows, numCols)
Call SetUpForm(numRows, numCols)
End Sub
Private Sub cmdReduce_Click()
'----------------------------------------------------------------------
' Reduce all 31 fractions on screen to lowest terms.
'----------------------------------------------------------------------
' No explicit parameters.
' Procedures:
' ReduceAll: reduce all 31 fractions to lowest terms
' Local variables:
' zeroDen: number of zero denominators on screen (must be 0!)
Dim zeroDen As Integer
Call ReduceAll(zeroDen)
End Sub
Private Sub cmdLinComb_Click()
'----------------------------------------------------------------------
' From row A subtract the chosen multiple of row B.
'----------------------------------------------------------------------
' No explicit parameters.
' Procedures:
' SelectedRowA: find out which row the user has chosen to change
' SelectedRowB: find out which row the user has chosen to use
' ReduceAll: reduce all fractions to lowest terms
' ReduceFraction: reduce one fraction to lowest terms
' PrintSystem: print the entire linear system as it now stands
' to the output file
' Local variables:
' rowA: index number of the row that the user wishes to change
' rowB: index number of the other row
' zeroDen: number of zero denominators on screen (must be 0!)
' numFac: numerator of the factor multiplying row B
' denFac: denominator of the factor multiplying row B
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
' col: loop counter = column number in matrix of coefficients
' i, j: array index numbers (i for row A, j for row B)
' Num1: numerator of current entry in row A
' Den1: denominator of current entry in row A
' Num2: numerator of fraction to be subtracted from current entry
' Den2: denominator of fraction to be subtracted from current entry
' num: numerator of new entry in row A
' den: denominator of new entry in row A
Dim rowA As Integer, rowB As Integer, zeroDen As Integer
Dim col As Integer, i As Integer, j As Integer
Dim Num1 As Long, Den1 As Long, Num2 As Long, Den2 As Long
Dim numFac As Long, denFac As Long, num As Long, den As Long
Dim Prompt As String, Title As String
Call ReduceAll(zeroDen)
Let rowA = SelectedRowA
Let rowB = SelectedRowB
Let numFac = Val(txtNumFactor.Text)
Let denFac = Val(txtDenFactor.Text)
' Error traps:
If zeroDen > 0 Then
' An error message was presented in SUB ReduceFraction.
' Simply skip all code in this SUB.
ElseIf rowA = rowB Then
Let Prompt = "You have chosen to subtract a multiple "
Let Prompt = Prompt + "of row " + Str(rowB) + " from itself! "
Let Prompt = Prompt + "This is a forbidden row operation."
Let Title = "Error: Same row chosen twice"
Call MsgBox(Prompt, vbExclamation, Title)
ElseIf numFac = 0 Then
Let Prompt = "You have chosen a trivial multiple (zero) of row "
Let Prompt = Prompt + Str(rowB) + " to subtract from row"
Let Prompt = Prompt + Str(rowA) + ". Try again."
Let Title = "Error: No change to linear system"
Call MsgBox(Prompt, vbExclamation, Title)
' Here only if choices are valid:
Else
Call PrintSystem
For col = 0 To 6
Let i = rowA + 6 * col
Let j = rowB + 6 * col
Let Num1 = Val(txtNum(i).Text)
Let Den1 = Val(txtDen(i).Text)
Let Num2 = Val(txtNum(j).Text) * numFac
Let Den2 = Val(txtDen(j).Text) * denFac
Let num = Num1 * Den2 - Den1 * Num2
Let den = Den1 * Den2
Call ReduceFraction(num, den)
Let txtNum(i).Text = Str(num)
Let txtDen(i).Text = Str(den)
Next col
Print #1, "Selected row operation: Subtract ";
Print #1, numFac; "/"; denFac; "times row"; rowB;
Print #1, "from row"; rowA; "."
Print #1,
End If
End Sub
Private Sub cmdDiv_Click()
'----------------------------------------------------------------------
' Divide all coefficients in the chosen row by the chosen factor.
'----------------------------------------------------------------------
' No explicit parameters.
' Procedures:
' ReduceAll: reduce all fractions to lowest terms
' ReduceFraction: reduce one fraction to lowest terms
' PrintSystem: print the entire linear system as it now stands
' to the output file
' SelectedRowA: find out which row the user has chosen to change
' Local variables:
' rowA: index number of the row that the user wishes to change
' zeroDen: number of zero denominators on screen (must be 0!)
' numFac: numerator of the factor multiplying the chosen row
' denFac: denominator of the factor multiplying the chosen row
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
' i: loop counter = array subscript in matrix of coefficients
' num: numerator of new entry in row A
' den: denominator of new entry in row A
Dim rowA As Integer, zeroDen As Integer, i As Integer
Dim numFac As Long, denFac As Long, num As Long, den As Long
Dim Prompt As String, Title As String
Call ReduceAll(zeroDen)
Let numFac = Val(txtNumFactor.Text)
Let denFac = Val(txtDenFactor.Text)
' Error traps:
If zeroDen > 0 Then
' An error message was presented in SUB ReduceFraction.
' Simply skip all code in this SUB.
ElseIf denFac = 0 Then
Let Prompt = "To multiply a row by zero is an invalid row "
Let Prompt = Prompt + "operation! Try another factor."
Let Title = "Error: Row multiplication by zero"
Call MsgBox(Prompt, vbExclamation, Title)
ElseIf numFac = 0 Then
Let Prompt = "To divide a row by zero is an invalid arithmetic "
Let Prompt = Prompt + "operation! Try another factor."
Let Title = "Error: Division by zero"
Call MsgBox(Prompt, vbExclamation, Title)
ElseIf numFac = 1 And denFac = 1 Then
Let Prompt = "You have chosen a trivial factor (one) by which "
Let Prompt = Prompt + "to divide a row! Try another factor."
Let Title = "Error: No change to linear system"
Call MsgBox(Prompt, vbExclamation, Title)
' Here only if choices are valid:
Else
Call PrintSystem
Let rowA = SelectedRowA
For i = rowA To 42 Step 6
Let num = Val(txtNum(i).Text) * denFac
Let den = Val(txtDen(i).Text) * numFac
Call ReduceFraction(num, den)
Let txtNum(i).Text = Str(num)
Let txtDen(i).Text = Str(den)
Next i
Print #1, "Selected row operation: Divide row"; rowA;
Print #1, "by "; numFac; "/"; denFac; "."
Print #1,
End If
End Sub
Private Sub cmdSwap_Click()
'----------------------------------------------------------------------
' Swap the two chosen rows.
'----------------------------------------------------------------------
' No explicit parameters.
' Procedures:
' SelectedRowA: find out which row the user has chosen to change
' SelectedRowB: find out which row the user has chosen to use
' ReduceAll: reduce all fractions to lowest terms
' ReduceFraction: reduce one fraction to lowest terms
' PrintSystem: print the entire linear system as it now stands
' to the output file
' Local variables:
' rowA: index number of the row that the user wishes to change
' rowB: index number of the other row
' zeroDen: number of zero denominators on screen (dummy here)
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
' j: loop counter; related to array subscript number
' a: entry from row A to be placed in row B
' b: entry from row B to be placed in row A
Dim rowA As Integer, rowB As Integer, j As Integer, zeroDen As Integer
Dim Prompt As String, Title As String
Dim a As Long, b As Long
Call ReduceAll(zeroDen)
Let rowA = SelectedRowA
Let rowB = SelectedRowB
If rowA = rowB Then
Let Prompt = "Error: you have chosen to swap a row with itself!"
Let Prompt = Prompt + " Choose a pair of distinct rows to swap."
Let Title = "Error: Same row chosen twice"
Call MsgBox(Prompt, vbExclamation, Title)
Else
Call PrintSystem
For j = 0 To 36 Step 6
Let a = Val(txtNum(j + rowA).Text)
Let b = Val(txtNum(j + rowB).Text)
Let txtNum(j + rowA).Text = Str(b)
Let txtNum(j + rowB).Text = Str(a)
Let a = Val(txtDen(j + rowA).Text)
Let b = Val(txtDen(j + rowB).Text)
Let txtDen(j + rowA).Text = Str(b)
Let txtDen(j + rowB).Text = Str(a)
Next j
Print #1, "Selected row operation: Swap rows"; rowA;
Print #1, "and"; rowB; "."
Print #1,
End If
End Sub
Private Sub cmdQuit_Click()
'----------------------------------------------------------------------
' Termination subprogram - last chance for user to abort exit.
'----------------------------------------------------------------------
' No explicit parameters.
' Procedures:
' PrintSystem: print the entire linear system as it now stands
' to the output file
' Local variables:
' flag: option in message box clicked by the user.
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
Dim Prompt As String, Title As String
Dim flag As Integer
Let Prompt = "Do you really, really want to terminate this program?"
Let Title = "Confirm exit"
Let flag = MsgBox(Prompt, vbYesNo, Title)
If flag = vbYes Then ' Return to program if "No" clicked
If FreeFile > 1 Then ' Can't print if no file open!
Call PrintSystem
Print #1,
Print #1, "Program execution terminated."
End If
Close
End
End If
End Sub
Sub IntroBox()
'----------------------------------------------------------------------
' Print introductory information in a message box.
'----------------------------------------------------------------------
' No explicit parameters or procedures.
' Local Variables:
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
Dim Prompt As String, Title As String
Let Prompt = "This program is *not* a black box for solving linear "
Let Prompt = Prompt + "systems. "
Let Prompt = Prompt + "You must decide what row operations to "
Let Prompt = Prompt + "perform and in what order. "
Let Prompt = Prompt + "This program will then carry out the "
Let Prompt = Prompt + "tedious arithmetic."
Let Title = "Welcome to the LINSYS.VBP program"
Call MsgBox(Prompt, vbInformation, Title)
End Sub
Sub OpenFile()
'----------------------------------------------------------------------
' Open the user's chosen output file + chance to abort run.
'----------------------------------------------------------------------
' No explicit parameters or procedures.
' Local Variables:
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
' fileName: name of the output file.
Dim Prompt As String, Title As String, fileName As String
Let Prompt = "In addition to screen output, results will be sent "
Let Prompt = Prompt + "to a file of your choice. "
Let Prompt = Prompt + "Be sure that the file name that you choose "
Let Prompt = Prompt + "is valid, with write access. If you "
Let Prompt = Prompt + "select a floppy or zip drive for your output, "
Let Prompt = Prompt + "then ensure that you have a diskette ready in "
Let Prompt = Prompt + "that drive. Note that this program can't "
Let Prompt = Prompt + "cope with invalid file names."
Let Title = "Select a filename for the output"
Let fileName = InputBox(Prompt, Title, "A:\t.txt")
If fileName = "" Then ' User chooses to abort run.
Let Prompt = "Program execution cancelled." + Chr$(13)
Let Prompt = Prompt + Chr$(13) + "Have a nice day."
Let Title = "Cancel program execution"
Call MsgBox(Prompt, vbCritical, Title)
End
Else
Open fileName For Output As #1
Print #1, "Program to handle the Arithmetic in the Row Reduction ";
Print #1, "of a Linear System"
Print #1, "VisualBASIC version (c)1999, Glyn George."
Print #1,
End If
End Sub
Sub Dimension(numRows As Integer, numCols As Integer)
'----------------------------------------------------------------------
' Input and validate # rows & columns in the linear system.
'----------------------------------------------------------------------
' Parameters:
' numRows: number of rows in the linear system.
' numCols: number of columns in the linear system.
' No procedures.
' Local Variables:
' Prompt: text of the prompt for a message box.
' Title: text of the title bar for a message box.
' n: number entered by the user (for numRows or numCols).
Dim Prompt As String, Title As String
Dim n As Double
Let Prompt = "How many rows (2-6) in your linear system?"
Let Title = "Enter # rows of linear system"
Let n = InputBox(Prompt, Title, 3)
Do While n < 2 Or n > 6 Or n <> Int(n)
Let Prompt = "The number of rows must be one of 2, 3, 4, 5 or 6."
Let Prompt = Prompt + Chr$(13) + "Try again."
Let Title = "Error: Invalid number of rows"
Call MsgBox(Prompt, vbExclamation, Title)
Let Prompt = "How many rows (2-6) in your linear system?"
Let Title = "Enter # rows of linear system"
Let n = InputBox(Prompt, Title, 3)
Loop
Let numRows = CInt(n)
Let txtNumRows.Text = Str(numRows)
Let txtNumRows.Locked = True ' Hide # rows info on form
Let txtNumRows.Visible = False
Let lblDim1.Visible = False
Let Prompt = "How many columns (2-7) (including any right side constants)"
Let Prompt = Prompt + Chr$(13) + "in your linear system?"
Let Title = "Enter # columns of linear system"
Let n = InputBox(Prompt, Title, 4)
Do While n < 2 Or n > 7 Or n <> Int(n)
Let Prompt = "The number of columns must be one of 2, 3, 4, 5, 6 or 7."
Let Prompt = Prompt + Chr$(13) + "Try again."
Let Title = "Error: Invalid number of columns"
Call MsgBox(Prompt, vbExclamation, Title)
Let Prompt = "How many columns (2-7) in your linear system?"
Let Title = "Enter # columns of linear system"
Let n = InputBox(Prompt, Title, 4)
Loop
Let numCols = CInt(n)
Let txtNumCols.Text = Str(numCols)
Let txtNumCols.Locked = True ' Hide # cols info on form
Let txtNumCols.Visible = False
Let lblDim2.Visible = False
End Sub
Sub SetUpForm(ByVal numRows As Integer, ByVal numCols As Integer)
'----------------------------------------------------------------------
' Initialize the form with the chosen # rows & columns.
'----------------------------------------------------------------------
' Parameters:
' numRows: number of rows in the linear system.
' numCols: number of columns in the linear system.
' No procedures.
' Local Variables:
' row: outer loop counter = current row #
' col: inner loop counter = current column #
Dim row As Integer, col As Integer
For row = 1 To 6
' Hide labels of unwanted row.
If row > numRows Then
Let lblRowNumber(row).Visible = False
Let optRowA(row).Visible = False
Let optRowB(row).Visible = False
End If
For col = 1 To 7 ' Numerators
' Identity is default
If col = row Or col = row + numRows Then
Let txtNum((col - 1) * 6 + row).Text = Str$(1)
Else
Let txtNum((col - 1) * 6 + row).Text = Str$(0)
End If
' Denominators (all = 1)
Let txtDen((col - 1) * 6 + row).Text = Str$(1)
' Hide unwanted elements
If row > numRows Or col > numCols Then
Let txtNum((col - 1) * 6 + row).Visible = False
Let txtDen((col - 1) * 6 + row).Visible = False
End If
Next col
Next row
For col = (numCols + 1) To 7 ' Hide unwanted column labels
Let lblColNumber(col).Visible = False
Next col
End Sub
Created 1999 08 13 and most recently modified 2008 12 08 by
Dr. G.H. George
