LinSys.vbp
©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.
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 modified 1999 10 04 by
Dr. G.H. George