📄 frmahpinput.frm
字号:
VERSION 5.00
Begin VB.Form frmAHPInput
BorderStyle = 1 'Fixed Single
Caption = "AHP"
ClientHeight = 3996
ClientLeft = 48
ClientTop = 336
ClientWidth = 5388
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3996
ScaleWidth = 5388
StartUpPosition = 1 'CenterOwner
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
FillStyle = 0 'Solid
FontTransparent = 0 'False
ForeColor = &H80000008&
Height = 735
Left = 2040
ScaleHeight = 732
ScaleWidth = 3372
TabIndex = 10
Top = 0
Width = 3375
End
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Left = 1680
TabIndex = 9
Top = 3480
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "确定"
Default = -1 'True
Height = 375
Left = 120
TabIndex = 8
Top = 3480
Width = 1215
End
Begin VB.ComboBox m_cbLayerCon
BeginProperty DataFormat
Type = 0
Format = "1 1 1"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 120
TabIndex = 7
Top = 2760
Width = 2295
End
Begin VB.CommandButton Cmd1
Caption = "输入"
Height = 375
Left = 2640
TabIndex = 6
Top = 2760
Width = 1215
End
Begin VB.CommandButton Cmd2
Caption = "删除"
Height = 375
Left = 4080
TabIndex = 5
Top = 2760
Width = 1215
End
Begin VB.CommandButton CmdDelete
Caption = "删除"
Height = 375
Index = 0
Left = 4080
TabIndex = 3
Top = 1320
Width = 1215
End
Begin VB.CommandButton CmdInput
Caption = "输入"
Height = 375
Index = 0
Left = 2640
TabIndex = 1
Top = 1320
Width = 1215
End
Begin VB.ComboBox m_cbLayer
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 0
Left = 120
TabIndex = 0
Top = 1320
Width = 2295
End
Begin VB.Line Line1
BorderColor = &H80000005&
X1 = 0
X2 = 5400
Y1 = 0
Y2 = 0
End
Begin VB.Line Line2
BorderColor = &H80000005&
X1 = 0
X2 = 5400
Y1 = 120
Y2 = 120
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "层次分析"
BeginProperty Font
Name = "华文新魏"
Size = 14.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 11
Top = 240
Width = 1335
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H8000000E&
BeginProperty Font
Name = "宋体"
Size = 9.6
Charset = 134
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 0
TabIndex = 12
Top = 0
Width = 2055
End
Begin VB.Label lblConnetion
Caption = "层次联系：输入(上层层号 上层位置 下层位置)"
ForeColor = &H8000000D&
Height = 255
Left = 120
TabIndex = 4
Top = 2280
Width = 3735
End
Begin VB.Label lblLayer
Caption = "第 1 层：输入目标名称"
ForeColor = &H8000000D&
Height = 375
Index = 0
Left = 120
TabIndex = 2
Top = 960
Width = 2175
End
End
Attribute VB_Name = "frmAHPInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim flag As Integer
Const length = 1000 '界面尺寸
Private Sub Cmd1_Click()
m_cbLayerCon.AddItem m_cbLayerCon.Text
End Sub
Private Sub Cmd2_Click()
If m_cbLayerCon.ListIndex > -1 Then
m_cbLayerCon.RemoveItem m_cbLayerCon.ListIndex
End If
End Sub
Private Sub CmdDelete_Click(Index As Integer)
If m_cbLayer(Index).ListIndex > -1 Then
m_cbLayer(Index).RemoveItem m_cbLayer(Index).ListIndex
End If
End Sub
Private Sub CmdInput_Click(Index As Integer)
m_cbLayer(Index).AddItem m_cbLayer(Index).Text
End Sub
Private Sub Command1_Click() '输入层次分析的元素
Dim i, j As Integer
Dim x() As String
For j = 1 To Layer
LayerNum(j) = m_cbLayer(j - 1).ListCount
For i = 1 To m_cbLayer(j - 1).ListCount
LayerValue(j, i) = m_cbLayer(j - 1).List(i - 1)
Next
Next
ConnectNum = m_cbLayerCon.ListCount
For i = 1 To m_cbLayerCon.ListCount
x = Split(m_cbLayerCon.List(i - 1))
AllConnection(i).CurLayer = CInt(x(0))
AllConnection(i).FatherLayerPos = CInt(x(1))
AllConnection(i).ChildLayerPos = CInt(x(2))
Next
Unload Me
quitErr = False
Call AHP
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
For i = 1 To Layer - 1
Load lblLayer(i)
Load m_cbLayer(i)
Load CmdDelete(i)
Load CmdInput(i)
lblLayer(i).Caption = "第 " + CStr(i + 1) + " 层"
If (i = Layer - 1) Then
lblLayer(i).Caption = lblLayer(i).Caption + "：输入方案代号"
Else
lblLayer(i).Caption = lblLayer(i).Caption + "：输入评价指标"
End If
lblLayer(i).Top = lblLayer(i - 1).Top + length
m_cbLayer(i).Top = m_cbLayer(i - 1).Top + length
CmdDelete(i).Top = CmdDelete(i - 1).Top + length
CmdInput(i).Top = CmdInput(i - 1).Top + length
lblLayer(i).Visible = True
m_cbLayer(i).Visible = True
CmdDelete(i).Visible = True
CmdInput(i).Visible = True
Next
If Layer = 3 Then
'm_cbLayer(0).AddItem "方案评价"
'm_cbLayer(1).AddItem "指标一"
'm_cbLayer(1).AddItem "指标二"
'm_cbLayer(1).AddItem "指标三"
'm_cbLayer(2).AddItem "方案一"
'm_cbLayer(2).AddItem "方案二"
'm_cbLayer(2).AddItem "方案三"
End If
lblConnetion.Top = lblLayer(Layer - 1).Top + length
m_cbLayerCon.Top = m_cbLayer(Layer - 1).Top + length
Cmd1.Top = CmdDelete(Layer - 1).Top + length
Cmd2.Top = CmdInput(Layer - 1).Top + length
Command1.Top = Cmd1.Top + 800
Command2.Top = Cmd2.Top + 800
Me.Height = Command1.Top - lblLayer(0).Top + 1900
With Line1
.BorderColor = &H808080
.x1 = 0
.y1 = Command1.Top - 200
.x2 = Me.ScaleWidth
.y2 = .y1
End With
With Line2
.BorderColor = vbWhite
.x1 = Line1.x1
.y1 = Line1.y1 + 20
.x2 = Line1.x2
.y2 = .y1
End With
'm_cbLayerCon.AddItem "1 1 1"
'm_cbLayerCon.AddItem "1 1 2"
'm_cbLayerCon.AddItem "1 1 3"
'm_cbLayerCon.AddItem "2 1 1"
'm_cbLayerCon.AddItem "2 1 2"
'm_cbLayerCon.AddItem "2 1 3"
'm_cbLayerCon.AddItem "2 2 1"
'm_cbLayerCon.AddItem "2 2 2"
'm_cbLayerCon.AddItem "2 2 3"
'm_cbLayerCon.AddItem "2 3 1"
'm_cbLayerCon.AddItem "2 3 2"
'm_cbLayerCon.AddItem "2 3 3"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -