form1.frm

能 实现 线性规划 各种计算 简单方便 操作简单

VERSION 5.00
Begin VB.Form form1 
   AutoRedraw      =   -1  'True
   Caption         =   "单纯行法"
   ClientHeight    =   8160
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11205
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8160
   ScaleWidth      =   11205
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   855
      Left            =   9120
      TabIndex        =   1
      Top             =   6240
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "计算"
      Height          =   735
      Left            =   9120
      TabIndex        =   0
      Top             =   7200
      Width           =   1815
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 0
Private Sub Command1_Click()
Dim a!(), c!(), b!(), cb!(), xb!(), cba!()
n = Val(InputBox("请输入线性方程的变量个数"))
m = Val(InputBox("请输入线性方程的方程个数"))
ReDim a(m + 1, n + 2), c(n), b(m), cb(m), xb(m), cba(n)
 For i = 1 To m
    For j = 1 To n
      a(i, j) = Val(InputBox("输入方程系数a(" + Trim(Str(i)) + "," + Trim(Str(j)) + ")"))
      Print a(i, j);
    Next
  Print
 Next
  Print
         
         For i = 1 To m
           b(i) = Val(InputBox("请输入线性方程常数b(" + Trim(Str(i)) + ")"))
           a(i, n + 1) = b(i)
         Next
    For i = 1 To n
        c(i) = Val(InputBox("请输入目标函数系数数"))
        a(0, i) = c(i)
    Next
    
  For i = 1 To m
     cb(i) = c(n - m + i)
     a(i, 0) = cb(i)
     xb(i) = n - m + i
  Next
star:      For i = 1 To n
            cba(i) = 0
           Next
    
 For i = 1 To n
    For j = 1 To m
     
     cba(i) = cba(i) + a(j, 0) * a(j, i)
    Next
  a(m + 1, i) = a(0, i) - cba(i)
 Next
       z = 0
  For i = 1 To m
    z = z + a(i, 0) * a(i, n + 1)
    Next
  a(m + 1, n + 1) = z
   For i = 0 To m + 1
      For j = 0 To n + 2
    
     Print a(i, j); Space(4);
      Next
    Print
   Next
   Print
   
  cc = 0
  cm = 0
   For i = 1 To n
     If a(m + 1, i) <= 0 Then
     cc = cc + 1
     End If
     If a(m + 1, i) = 0 Then
     cm = cm + 1
     End If
   Next

  Print "cc="; cc, "cm="; cm    '一会删除
  
   Do While cc < n
      qq = 0
      mqq = 1E+38
       l = 0
    For i = 1 To n
      If a(m + 1, i) > qq Then
        qq = a(m + 1, i)
         l = i
      End If
    Next
     ka = 0
   For i = 0 To m
      If a(i, l) <= 0 Then ka = ka + 1
   Next
          If ka = m Then
              MsgBox "线性方程无界"
              Exit Do
          End If
              
             For i = 1 To m
              If a(i, l) > 0 Then
                 a(i, n + 2) = a(i, n + 1) / a(i, l)
              End If
             Next
             
             ll = 0
             For i = 1 To m
                 If a(i, l) > 0 Then
                     If a(i, n + 2) < mqq Then
                        mqq = a(i, n + 2)
                        ll = i            '初级行
                    
                      End If
                
                 End If
             Next i
             
                                     
             a(ll, 0) = c(l)
             
            ppp = a(ll, l)
         For i = 1 To n + 1
            
             a(ll, i) = a(ll, i) / ppp
            
         Next
         
         
         
         For i = 1 To m
         
            If i <> ll Then
               pppp = a(i, l)
                  For j = 1 To n + 1
                 
                    a(i, j) = a(i, j) - a(ll, j) * pppp
                 
                  Next
          
          End If
         
         Next
         
         
         
         
                                     
      
        GoTo star
   Loop
   
    If cc = n Then
           If cm = m Then
             MsgBox "线性方程有唯一解"
             
             Else
             MsgBox "线性方程有多解"
           End If
    End If
  Print "方程结果为："

  Print
For i = 0 To m + 1
   For j = 0 To n + 2
    Print a(i, j); Space(4);
  Next
  Print
Next
   
End Sub


Private Sub Command2_Click()
End
End Sub