📄 线形规划求解.frm
字号:
VERSION 5.00
Object = "{D76D7130-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSFLEX7D.OCX"
Begin VB.Form frmghqj
BorderStyle = 3 'Fixed Dialog
Caption = "线形规划求解"
ClientHeight = 4395
ClientLeft = 45
ClientTop = 345
ClientWidth = 7035
Icon = "线形规划求解.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4395
ScaleWidth = 7035
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Caption = "计算结果"
Height = 3120
Left = 3960
TabIndex = 10
Top = 740
Width = 3015
Begin VB.ListBox List1
Height = 2760
Left = 120
TabIndex = 11
Top = 240
Width = 2775
End
End
Begin VSFlex7DAOCtl.VSFlexGrid VSFlexGrid1
Height = 3495
Left = 0
TabIndex = 4
Top = 840
Width = 3855
_cx = 6800
_cy = 6165
_ConvInfo = 1
Appearance = 1
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = 14737632
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 3
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 3
SelectionMode = 0
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 2
Cols = 3
FixedRows = 1
FixedCols = 1
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 2
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 3
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
End
Begin VB.Frame Frame1
Caption = "原始数据"
Height = 660
Left = 0
TabIndex = 7
Top = 40
Width = 6975
Begin VB.TextBox Text2
Height = 270
Left = 3240
TabIndex = 1
Text = "Text2"
Top = 240
Width = 855
End
Begin VB.TextBox Text1
Height = 270
Left = 960
TabIndex = 0
Text = "Text1"
Top = 260
Width = 855
End
Begin VB.OptionButton Option2
Caption = "求最小值"
Height = 180
Left = 5760
TabIndex = 3
Top = 280
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "求最大值"
Height = 180
Left = 4560
TabIndex = 2
Top = 280
Width = 1095
End
Begin VB.Label Label2
Caption = "约束方程个数＝"
Height = 255
Left = 2040
TabIndex = 9
Top = 280
Width = 1335
End
Begin VB.Label Label1
Caption = "变量个数＝"
Height = 255
Left = 120
TabIndex = 8
Top = 280
Width = 1095
End
End
Begin VB.CommandButton Command2
Caption = "关闭"
Height = 375
Left = 6120
TabIndex = 6
Top = 3960
Width = 855
End
Begin VB.CommandButton Command1
Caption = "计算"
Height = 375
Left = 5160
TabIndex = 5
Top = 3960
Width = 855
End
End
Attribute VB_Name = "frmghqj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a(), x(), l() As Double
Private Sub Command1_Click()
'计算
Dim sjjl As Integer '当sjjl达到2万次退出。
On Error GoTo handlerror
If Option1.Value = False And Option2.Value = False Then
xiansh = MsgBox("请选定求最大值还是求最小值，然后再计算。", vbInformation, "问题提示")
Exit Sub
End If
m = Val(Text1.Text)
n = Val(Text2.Text)
If Option1.Value = True Then p = 1
If Option2.Value = True Then p = -1
sjjl = 1
ReDim a(n + 2, n + m + 1), x(m), l(n + 1)
For i = 1 To VSFlexGrid1.Rows - 2
For j = 1 To VSFlexGrid1.Cols - 1
a(i + 1, j) = Val(VSFlexGrid1.TextMatrix(i, j))
Next j
Next i
For i = 1 To VSFlexGrid1.Cols - 1
a(1, i) = Val(VSFlexGrid1.TextMatrix(VSFlexGrid1.Rows - 1, i))
Next i
For i = 2 To n + 1
For j = 1 To m + 2
a(i, j) = a(i, j) * Sgn(a(i, m + 2))
Next j
Next i
e = 0.0001
For i = 1 To m
a(1, i) = -p * a(1, i)
Next i
If n = 1 Then GoTo b14
For i = 2 To n + 1
a(i, n + m + 1) = a(i, m + 2)
a(i, m + 2) = 0
If i = 2 Then GoTo b12
a(i, m + i - 1) = a(i, m + 1)
a(i, m + 1) = 0
b12: Next i
b14: r = 1
For i = 2 To n + 1
l(i) = m + i - 1
If a(i, m + i - 1) = 1 Then GoTo b16
l(i) = n + m + 1
For j = 1 To n + m
a(n + 2, j) = a(n + 2, j) - a(i, j)
Next j
r = n + 2
b16: Next i
bl10: t = 1
For i = 2 To n + m45
sjjl = sjjl + 1
If sjjl = 20000 Then
List1.AddItem " 本题目无解"
Exit Sub
End If
If a(r, i) - a(r, t) > e Then GoTo bl25
If a(r, i) - a(r, t) < -e Then GoTo bl20
If r = 1 Then GoTo bl25
If a(1, i) - a(1, t) = -e Then GoTo bl25
bl20: t = i
bl25: Next i
If a(r, t) < -e Then GoTo bl40
For i = 1 To n + m
If a(r, i) > e Then GoTo bl30
Next i
r = 1
GoTo bl10
bl30: For i = 2 To n + 1
If l(i) <= n + m Then GoTo bl35
If a(i, n + m + 1) > e Then
List1.AddItem " 本题目无解": Exit Sub
End If
bl35: Next i
GoTo bl60
bl40: S = 1
For i = 2 To n + 1
If a(i, t) <= e Then GoTo bl50
y = a(i, n + m + 1) / a(i, t)
If S = 1 Then GoTo bl45
If y >= a(S, n + m + 1) / a(S, t) Then GoTo bl50
bl45: S = i
bl50: Next i
If S = 1 Then List1.AddItem " 本题目无解": Exit Sub
l(S) = t
y = a(S, t)
For i = 1 To n + m + 1
a(S, i) = a(S, i) / y
Next i
For i = 1 To n + 2
If i = S Then GoTo bl55
y = a(i, t)
For j = 1 To n + m + 1
a(i, j) = a(i, j) - y * a(S, j)
Next j
bl55: Next i
GoTo bl10
bl60: For i = 2 To n + 1
If l(i) > m Then GoTo bl70
S = l(i)
x(S) = a(i, n + m + 1)
bl70: Next i
y = p * a(1, n + m + 1)
If p = -1 Then d$ = "min" Else d$ = "max"
List1.Clear
List1.AddItem " 目标函数的最优解为："
List1.AddItem " F" + d$ + "=" + Str(Int(y * 1000 + 0.5) / 1000)
List1.AddItem ""
List1.AddItem " 最优解时各变量的数值为："
For i = 1 To m
List1.AddItem " X" + Trim(Str(i)) + "＝" + Str(Int(x(i) * 1000 + 0.5) / 1000)
Next i
Exit Sub
handlerror:
xianshi = MsgBox("请检查输入的数据后再计算。", vbInformation, "问题提示")
End Sub
Private Sub Command2_Click()
'关闭
On Error GoTo handlerror
If List1.ListCount > 1 And rjsfzc = 88 Then
frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 《线性规划求解计算结果》："
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 变量个数 ＝" + Text1.Text
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 约束方程个数＝" + Text2.Text
For i = 0 To List1.ListCount - 1
frmMain.Text1 = frmMain.Text1 & vbCrLf & " " + List1.List(i)
Next i
frmMain.Text1 = frmMain.Text1 & vbCrLf & " --------------------------------------"
End If
Unload Me
Exit Sub
handlerror:
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
On Error GoTo handlerror
If KeyAscii = 27 Then
Unload Me
End If
Exit Sub
handlerror:
End Sub
Private Sub Form_Load()
'启动
Text1.Text = ""
Text2.Text = ""
List1.Clear
VSFlexGrid1.TextMatrix(0, 0) = "序号"
VSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter
VSFlexGrid1.ColWidth(0) = 500
End Sub
Private Sub Text1_Change()
'表格列数
If Val(Text1.Text) >= 1 Then
VSFlexGrid1.Cols = Val(Text1.Text) + 3
For i = 1 To VSFlexGrid1.Cols - 1
VSFlexGrid1.TextMatrix(0, i) = "x" + Trim$(Str(i))
Next i
For i = 1 To VSFlexGrid1.Cols - 1
VSFlexGrid1.ColAlignment(i) = flexAlignCenterCenter
Next i
End If
End Sub
Private Sub Text2_Change()
'方程个数
If Val(Text2.Text) >= 2 Then
VSFlexGrid1.Rows = Val(Text2.Text) + 2
For i = 1 To VSFlexGrid1.Rows - 2
VSFlexGrid1.TextMatrix(i, 0) = i
Next i
VSFlexGrid1.TextMatrix(VSFlexGrid1.Rows - 1, 0) = "Ci"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -