frmmain.frm

系统工程-层次分析法VB版

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{E7BFD767-0E95-485A-85BD-80AD75BB4A55}#8.0#0"; "XOYOMATHXP.OCX"
Begin VB.Form frmMain 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00F3F3F3&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统工程—层次分析法的计算机解决方案"
   ClientHeight    =   4665
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7935
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   4665
   ScaleWidth      =   7935
   StartUpPosition =   2  '屏幕中心
   Begin XoYoMatheXPression.XoYoMathXP XoYoMathXP 
      Height          =   660
      Left            =   3480
      TabIndex        =   16
      Top             =   3960
      Visible         =   0   'False
      Width           =   660
      _ExtentX        =   1164
      _ExtentY        =   1164
      ErrorShowEnabled=   0   'False
      ErrorWindowCaption=   "[逍遥表达式求值控件2.1]发现错误：("
   End
   Begin VB.CommandButton Command2 
      BackColor       =   &H00F3F3F3&
      Caption         =   "关于"
      Height          =   375
      Left            =   120
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   4200
      Width           =   1335
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   4440
      Top             =   4020
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":08CA
            Key             =   "root"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0E66
            Key             =   "file"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":1402
            Key             =   "close"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":199E
            Key             =   "open"
         EndProperty
      EndProperty
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00F3F3F3&
      Caption         =   "所使用的权值的求解算法"
      Height          =   555
      Left            =   3000
      TabIndex        =   4
      Top             =   3420
      Width           =   4815
      Begin VB.CommandButton cmdCal 
         BackColor       =   &H00F3F3F3&
         Caption         =   "计算当前表的权值"
         Height          =   315
         Left            =   2760
         Style           =   1  'Graphical
         TabIndex        =   11
         Top             =   180
         Width           =   1935
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00F3F3F3&
         Caption         =   "和积法"
         Height          =   255
         Index           =   2
         Left            =   1800
         TabIndex        =   7
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00F3F3F3&
         Caption         =   "方根法"
         Height          =   255
         Index           =   1
         Left            =   840
         TabIndex        =   6
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00F3F3F3&
         Caption         =   "幂法"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   5
         Top             =   240
         Value           =   -1  'True
         Width           =   735
      End
   End
   Begin VB.CommandButton cmdExit 
      BackColor       =   &H00F3F3F3&
      Caption         =   "退出"
      Height          =   375
      Left            =   6480
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton cmdShowResult 
      BackColor       =   &H00F3F3F3&
      Caption         =   "层次总排序表"
      Height          =   435
      Left            =   1560
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   3540
      Width           =   1335
   End
   Begin VB.CommandButton cmdNew 
      BackColor       =   &H00F3F3F3&
      Caption         =   "新建层次关系"
      Height          =   435
      Left            =   120
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   3540
      Width           =   1335
   End
   Begin MSComctlLib.TreeView LayerTree 
      Height          =   3015
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   5318
      _Version        =   393217
      Indentation     =   176
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin VB.PictureBox pBox 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   3015
      Left            =   2400
      ScaleHeight     =   2955
      ScaleWidth      =   5355
      TabIndex        =   12
      Top             =   360
      Width           =   5415
      Begin VB.TextBox txtOutPut 
         Height          =   1275
         Left            =   0
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   14
         Top             =   1680
         Width           =   5415
      End
      Begin MSFlexGridLib.MSFlexGrid TGrid 
         Height          =   1695
         Index           =   0
         Left            =   0
         TabIndex        =   13
         Top             =   0
         Visible         =   0   'False
         Width           =   5415
         _ExtentX        =   9551
         _ExtentY        =   2990
         _Version        =   393216
         BackColorFixed  =   -2147483638
         BackColorBkg    =   16777215
         GridColorFixed  =   12632256
         AllowUserResizing=   1
         Appearance      =   0
      End
      Begin VB.TextBox TxtCell 
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         Height          =   255
         Left            =   3720
         TabIndex        =   15
         Top             =   2520
         Visible         =   0   'False
         Width           =   855
      End
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000007&
      X1              =   120
      X2              =   7800
      Y1              =   4080
      Y2              =   4080
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "当前层次的判断矩阵:"
      Height          =   180
      Left            =   2520
      TabIndex        =   9
      Top             =   120
      Width           =   1710
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "层次关系树:"
      Height          =   180
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   990
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      BorderWidth     =   2
      X1              =   120
      X2              =   7800
      Y1              =   4080
      Y2              =   4080
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim CurRow As Long, CurCol As Long '当前表格的当前的行与列
Dim CurGridIndex As Long '当前表格的序号
Public First As Boolean  '是否为第一次运行程序
Dim OptIndex As Long '所选择的算法序号

'计算当前表的权值
Private Sub CmdCal_Click()
    CreateArr
End Sub
'由表格数据生成相应的数组
Sub CreateArr()
On Error GoTo errH
Dim i As Long, j As Long
Dim tempTxt As String
Dim tempB As Boolean

With vLayer(CurGridIndex)
    ReDim .GArray(1 To (.Grid.Rows - .Grid.FixedRows), 1 To (.Grid.Cols - .Grid.FixedCols - 1)) As Double
    ReDim .W(1 To (.Grid.Rows - .Grid.FixedRows)) As Double
    
    For i = 1 To .Grid.Rows - .Grid.FixedRows
        For j = 1 To .Grid.Cols - .Grid.FixedCols - 1
            If Trim(.Grid.TextMatrix(i, j)) = "" Then '对数据的完整性进行检验
                MsgBox "计算自动中止，因为当前判断矩阵的数据尚未输入完毕！", vbOKOnly + vbInformation, "提示信息"
                Exit Sub
            End If
            XoYoMathXP.GetExpressionValue .Grid.TextMatrix(i, j)
            .GArray(i, j) = XoYoMathXP.NumericalResult
        Next
    Next
    
    Calculate .GArray(), .W, .Property, OptIndex
    
    tempTxt = ""
    tempTxt = tempTxt & "当前判断矩阵中各行对应的权值ω:" & vbCrLf ' 输出ω的值
    For i = 1 To .Grid.Rows - .Grid.FixedRows
        .Grid.TextMatrix(i, j) = Trim(Format(.W(i), "0.00000"))
        tempTxt = tempTxt & Format(.W(i), "0.00000") & vbCrLf
    Next
    .Finished = True
    With .Property
        tempTxt = tempTxt & "最大特征值λmax:   " & Format(.vNmax, "0.00000") & vbCrLf
        tempTxt = tempTxt & "一次性指标CI:      " & Format$(.vCI, "0.00000") & vbCrLf
        tempTxt = tempTxt & "随机一次性指标RI:  " & Format$(.vRI, "0.00") & vbCrLf
        tempTxt = tempTxt & "一次性比率CR:      " & Format$(.vCR, "0.00000") & vbCrLf
        
        txtOutPut.Text = tempTxt
        vLayer(CurGridIndex).txtInf = tempTxt
        If .vCR > 0.1 Then
            MsgBox "一次性比率CR:" & Format$(.vCR, "0.00000") & ">0.1，不合要求，请调整输入的数据！", vbOKOnly + vbInformation, "CR不合要求"
            vLayer(CurGridIndex).Finished = False
        End If
    End With
End With


tempB = True
For i = 1 To TotalGridNum
    tempB = tempB And vLayer(i).Finished
    If Not tempB Then
        Exit For
    End If
Next
cmdShowResult.Enabled = tempB '设置显示层次总排序表的按钮的可用性
Exit Sub

errH:
    
End Sub