+ʢk

模糊数学基础及实用算法 (源码) 科学出版社 www.sciencep.com

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmResu 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "模糊物元"
   ClientHeight    =   8370
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11610
   LinkTopic       =   "Form1"
   ScaleHeight     =   8370
   ScaleWidth      =   11610
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdPrint 
      Caption         =   "打  印"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2760
      TabIndex        =   3
      Top             =   0
      Width           =   1170
   End
   Begin VB.CommandButton cmdCata 
      Caption         =   "模糊物元分析"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1080
      TabIndex        =   2
      Top             =   0
      Width           =   1695
   End
   Begin RichTextLib.RichTextBox rTxt 
      Height          =   7995
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   8415
      _ExtentX        =   14843
      _ExtentY        =   14102
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   2
      DisableNoScroll =   -1  'True
      Appearance      =   0
      TextRTF         =   $"模糊物元F2.frx":0000
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退  出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1095
   End
End
Attribute VB_Name = "frmResu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'模糊物元
'计算并显示计算结果
Option Explicit
Dim intI As Integer, intJ As Integer
Dim strR As String                      '回车换行符

Private Sub Form_Load()
    strR = Chr(13) + Chr(10)            '回车换行符
    cmdPrint.Visible = False
End Sub

'评判或求加权系数
Private Sub cmdCata_Click()
    Dim C As Double, intC As Integer
    Dim W As Double, T As Double
'显示数据
'显示模糊物元数据矩阵的各元素
    rTxt.Text = rTxt.Text & "事物数为：" & N & "；  " & "特征数为：" & M & strR
    For intI = 1 To N                                           'N为事物数
        For intJ = 1 To M                                       'M为特征数
            rTxt.Text = rTxt.Text & "  " & R(intI, intJ) & " "
        Next intJ
        rTxt.Text = rTxt.Text & strR
    Next intI
'显示加权向量的各元素
    rTxt.Text = rTxt.Text & "共有" & M & "个加权向量元素：" & strR
    For intI = 1 To M                                           'M是加权向量元素的个数
        rTxt.Text = rTxt.Text & "  " & A(intI) & " "
    Next intI
    rTxt.Text = rTxt.Text & strR
'显示优化向量的各元素
    rTxt.Text = rTxt.Text & "共有" & M & "个优化向量元素：" & strR
    For intI = 1 To M                                           'M是优化向量元素的个数
        rTxt.Text = rTxt.Text & "  " & V(intI) & " "
    Next intI
    rTxt.Text = rTxt.Text & strR
'模糊物元分析
'将事物数据矩阵变换为隶属度矩阵
    For intJ = 1 To M
        For intI = 1 To N
            X(intI) = R(intI, intJ)
        Next intI
        If intModel = 1 Then                        '按模式1求隶属度
            If V(intJ) = 1 Then Method1 X           '越大越优
            If V(intJ) = 0 Then Method0 X           '越小越优
            If V(intJ) < 0 Then Method2 X, -V(intJ) '近常数为优
        End If
        If intModel = 2 Then                       '按模式2求隶属度
            If V(intJ) = 1 Then Method21 X          '越大越优
            If V(intJ) = 0 Then Method20 X          '越小越优
            If V(intJ) < 0 Then Method2 X, -V(intJ) '近常数为优
        End If
        For intI = 1 To N
            R(intI, intJ) = X(intI)
        Next intI
    Next intJ
'显示隶属度矩阵
    rTxt.Text = rTxt.Text & "隶属度矩阵：" & strR
    For intI = 1 To N
        For intJ = 1 To M
            rTxt.Text = rTxt.Text & "  " & R(intI, intJ) & " "
        Next intJ
        rTxt.Text = rTxt.Text & strR
    Next intI
'计算关联度
    If intOpt = 1 Then
        rTxt.Text = rTxt.Text & "----------" & "先乘后加" & "----------" & strR
        Model1 A, R, B
    End If
    If intOpt = 2 Then
        rTxt.Text = rTxt.Text & "----------" & "先取小后取大" & "----------" & strR
        Model2 A, R, B
    End If
    If intOpt = 3 Then
        rTxt.Text = rTxt.Text & "----------" & "先乘后取大" & "----------" & strR
        Model3 A, R, B
    End If
'显示隶属度计算结果
    rTxt.Text = rTxt.Text & "共有" & N & "个关联度：" & strR
    For intI = 1 To N
        rTxt.Text = rTxt.Text & "  " & B(intI) & " "
    Next intI
    rTxt.Text = rTxt.Text & strR
'显示模糊物元分析结果
    rTxt.Text = rTxt.Text & "----------" & "答案" & "----------" & strR
    C = B(1): intC = 1
    For intI = 2 To N
        If B(intI) > C Then
            C = B(intI)
            intC = intI
        End If
    Next intI
    rTxt.Text = rTxt.Text & "在给定的条件下第" & intC & "个事物是最优的" & strR
    W = 0: T = 0
    For intI = 1 To N
        W = W + B(intI): T = T + B(intI) * D(intI)
    Next intI
    W = T / W
    W = Int(W * 100 + 0.5) / 100
    rTxt.Text = rTxt.Text & "在给定的条件下关联度加权事物量值是：" & W & strR
    cmdCata.Visible = False: cmdPrint.Visible = True
End Sub

'打印
Private Sub cmdPrint_Click()
    rTxt.SelLength = 0
    rTxt.SelPrint Printer.hDC
    cmdPrint.Visible = False
End Sub

'退出
Private Sub cmdExit_Click()
    Unload Me
    End
End Sub