formb41d.frm

用VB编写的家庭理财程序

       Text3.Visible = False
       Option3(0).Visible = False
       Option3(1).Visible = False
    Else
       Option3(0).Value = True
       Option3(0).Caption = bytWm
       Option3(1).Caption = bytWm / 2
       Text2.Visible = False
       Text3 = " " & bytWm - bytRs
    End If

    Me.Caption = " " & srtGm & " " & strPm & "  ( 参赛数:" & bytRs & IIf(bytZs > 0, "  种子数:" & bytZs, "") & " )"

End Sub

Private Sub OptioN3_Click(Index As Integer)
    If Index = 0 Then
       Label8 = "轮空人数："
       bytWs = bytWm
       Text3 = " " & bytWm - bytRs
    Else
       Label8 = "预选赛人数："
       bytWs = bytWm / 2
       bytYs = 2 * (bytRs - bytWs)
       Text3 = " " & bytYs
    End If
End Sub

Private Sub Command9_Click()                                       ' 确定位数及预选
    blnYx = IIf(bytWs < bytRs, True, False)
    blnLk = IIf(bytWs > bytRs, True, False)
    Frame3.Visible = False
    StrMsg = ""
       If blnYx Then
          StrMsg = "  预选位数:" & bytYs / 2 & " "
       Else
          If blnLk Then
             StrMsg = "  轮空位数:" & bytWs - bytRs & " "
          End If
       End If
    Me.Caption = " " & srtGm & " " & strPm & "  ( 参赛数:" & bytRs & "  位置数:" & bytWs & IIf(bytZs > 0, "  种子数:" & bytZs, "") & StrMsg & " )"
    Call P_mmm
End Sub

Private Sub P_mmm()
    
    ReDim arrWz(bytWs), arrBg(bytWs, 6)
          For i = 1 To bytRs
              arrYm(i, 5) = ""                                   ' 清除标志
          Next
    
    For i = 1 To bytDs
        arrDs(i, 1) = arrDw(i, 1)                                ' 抽签用队名数组
        arrDs(i, 2) = arrDw(i, 2)
        arrDs(i, 3) = arrDw(i, 3)
    Next
 
    Call P_grid
    
 If blnZz Then
 
    Command4.Enabled = False
    bytZs = 0                                                    ' Zs: 种子数
    
    Set MyRsT = New Recordset                                    ' T_pm 表
    StrSQL = "Select * From " & StrT1 & _
             " Where Ph='" & strPh & "' " & strTj1
    MyRsT.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       bytZs = MyRsT![zs]                                        ' bytZs: 种子数
    
    Set MyRs2 = New Recordset                                    ' T_zz 表
    StrSQL = "Select a.Yh,b.Hm,b.Ym,a.Dh " & _
             "  From " & StrT2 & " a," & StrT4 & " b" & _
             " Where a.Yh=b.Yh And a.Gh='" & strGh & "' And a.Ph='" & strPh & "'" & _
             " Order By a.Xh"
    MyRs2.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       bytZs = MyRs2.RecordCount                                 ' bytZs: 种子数
    
    If bytZs > 0 Then
       ReDim arrZm(bytZs, 4)                                     ' 种子数组
       MyRs2.MoveFirst
       For k = 1 To bytZs
           strYh = MyRs2![yh]
           arrZm(k, 1) = MyRs2![yh]
           arrZm(k, 2) = MyRs2![Ym]
           arrZm(k, 3) = MyRs2![Hm]
           arrZm(k, 4) = MyRs2![Dh]
           For i = 1 To bytRs
               If strYh = arrYm(i, 1) Then
                  arrYm(i, 5) = k: Exit For                      ' 种子标志
               End If
           Next
           MyRs2.MoveNext
       Next
       ReDim arrZz(bytZs, 4)
       Zm = Log(bytZs) / Log(2)                                  ' Zm: 种子抽签轮数
       Call P_mmzz
    Else
       MsgBox "  ???  ", 48, "  Error":  Exit Sub
    End If
            
 Else
 
    MSFlexGrid1.Visible = True
    Label10 = IIf(bytWs = 64, "64", "")
    Frame2.Visible = True
    Command8.SetFocus
 
 End If
    
    If blnYx Then Call P_yxcl                                    ' 预选赛处理
    
    If blnLk Then Call P_lkcl                                    ' 轮空位处理

    bytFs = bytRs - bytZs: ReDim arrFz(bytFs, 4)
       For i = 1 To bytFs
           arrFz(i, 0) = 2 * Zn + i                              ' 非种子数组
           For j = 1 To bytRs
               If Trim(arrYm(j, 5)) = "" Then
                  arrFz(i, 1) = arrYm(j, 1)
                  arrFz(i, 2) = arrYm(j, 2)
                  arrFz(i, 3) = arrYm(j, 3)
                  arrFz(i, 4) = arrYm(j, 4)
                  arrYm(j, 5) = "*": Exit For
               End If
           Next
       Next
    
    If bytWs = 64 Then Label10 = "64"
    
End Sub

Private Sub P_grid()
    With MSFlexGrid1
        .Clear
        .Rows = bytWs + 1
        .Cols = 6
        .Height = 225 * IIf(bytWs > 32, 33, bytWs + 1) + 90
        .Width = 4820
         MSFlexGrid2.Left = .Left + .Width + 600
         MSFlexGrid3.Left = MSFlexGrid2.Left
         MSFlexGrid4.Left = MSFlexGrid2.Left
        .Row = 0: .Col = 0: .Text = "位号":      .ColWidth(0) = 470
                  .Col = 1: .Text = " 区号":     .ColWidth(1) = 620
                  .Col = 2: .Text = "种子号":    .ColWidth(2) = 620
                  .Col = 3: .Text = "  姓 名 ":  .ColWidth(3) = 1000
                  .Col = 4: .Text = " 号码 ":    .ColWidth(4) = 620
                  .Col = 5: .Text = " 代 表 队": .ColWidth(5) = 1400 - IIf(bytWs > 32, 270, 0)
               w = bytWs / 16
               For i = 1 To bytWs
                   arrWz(i) = i                                  ' 位号
                  .TextMatrix(i, 0) = i & " "
                   k = Int((i + 15) / 16)
                  .TextMatrix(i, 1) = k & "/" & w & " "
               Next
        .MergeCol(1) = True
        .MergeCells = flexMergeRestrictColumns                   ' 单元格合并
         Frame2.Left = .Left + .Width + 600
    End With
    If bytWs = 64 Then
       With MSFlexGrid2
           .Clear
           .Rows = 33
           .Cols = 6
           .Height = 225 * 33 + 90
           .Width = 4980
           .Row = 0: .Col = 0: .Text = "位号":      .ColWidth(0) = 470
                     .Col = 1: .Text = " 区号":     .ColWidth(1) = 620
                     .Col = 2: .Text = "种子号":    .ColWidth(2) = 620
                     .Col = 3: .Text = "  姓 名 ":  .ColWidth(3) = 1000
                     .Col = 4: .Text = " 号码 ":    .ColWidth(4) = 620
                     .Col = 5: .Text = " 代 表 队": .ColWidth(5) = 1400 + 160
           .MergeCol(1) = True
           .MergeCells = flexMergeRestrictColumns                ' 单元格合并
       End With
    End If
End Sub

Private Sub P_lkcl()                                             ' 轮空位处理
    With MSFlexGrid1
         n = bytWs - bytRs                                       ' n: 轮空位数
         If n > bytZs Then
            Call P_mzfb
            For i = 1 To n
                m = Val(.TextMatrix(Val(arrWh(i)), 0))
                m = m + IIf(m Mod 2 = 1, 1, -1): .TextMatrix(m, 3) = " 轮空"
            Next
         Else
            For i = 1 To .Rows - 1
                m = Val(.TextMatrix(i, 2))
                If m > 0 And m <= n Then
                   m = .TextMatrix(i, 0)
                   m = m + IIf(m Mod 2 = 1, 1, -1): .TextMatrix(m, 3) = " 轮空"
                End If
            Next
         End If
    End With
End Sub

Private Sub P_yxcl()                                             ' 预选赛处理
    ReDim arrYx(bytYs, 5)
    With MSFlexGrid4
        .Clear
        .Rows = bytYs + 1
        .Cols = 6
        .Height = 225 * IIf(bytYs > 8, 9, bytYs + 1) + 90
        .Width = 4980
        .Top = 5020
         Label9.Top = .Top - 300: Label9.Visible = True
        .Left = MSFlexGrid3.Left
         Label9.Left = .Left + 200
         Label9 = "预选赛： " & bytYs
        .Row = 0: .Col = 0: .Text = " 序号":     .ColWidth(0) = 620
                  .Col = 1: .Text = " 位号":     .ColWidth(1) = 620
                  .Col = 2: .Text = " 区号":     .ColWidth(2) = 620
                  .Col = 3: .Text = "  姓 名 ":  .ColWidth(3) = 1000
                  .Col = 4: .Text = " 号码 ":    .ColWidth(4) = 620
                  .Col = 5: .Text = " 代 表 队": .ColWidth(5) = 1400 - IIf(bytYs > 8, 270, 0)
         For i = 1 To bytYs
            .TextMatrix(i, 0) = i & "  "
         Next
        .MergeCol(2) = True
        .MergeCol(1) = True
        .MergeCells = flexMergeRestrictColumns                   ' 单元格合并
        .Visible = True
         Frame2.Top = .Top - Frame2.Height - 800
    End With
    With MSFlexGrid1
         n = bytYs / 2                                           ' n: 预选赛位数
         If n > bytZs Then
            Call P_mzfb
            For i = 1 To n
                m = .TextMatrix(arrWh(i), 0)
                m = m + IIf(m Mod 2 = 1, 1, -1): .TextMatrix(m, 3) = " X" & i
            Next
         Else                                                    ' n < bytZs
            j = 0
            For i = 1 To .Rows - 1
                m = Val(.TextMatrix(i, 2))
                If m > 0 And m <= n Then
                   m = .TextMatrix(i, 0): j = j + 1
                   m = m + IIf(m Mod 2 = 1, 1, -1): .TextMatrix(m, 3) = " X" & j
                End If
            Next
         End If
         k = 0
         For i = 1 To .Rows - 1                                  '整理数组
             If .TextMatrix(i, 3) Like "*X*" Then
                 k = k + 1
                 m = .TextMatrix(i, 0)
                 arrYx(k, 1) = m & " "
                 arrYx(k, 2) = .TextMatrix(m, 1)
                 arrYx(k, 3) = ""
                 arrYx(k, 4) = ""
                 arrYx(k, 5) = ""
                 k = k + 1
                 arrYx(k, 1) = m & " "
                 arrYx(k, 2) = .TextMatrix(m, 1)
                 arrYx(k, 3) = ""
                 arrYx(k, 4) = ""
                 arrYx(k, 5) = ""
             End If
         Next
    End With
    ReDim arrCq(bytDs)
    m = bytDs
        For i = 1 To bytDs
            arrCq(i) = arrDw(i, 1)
        Next
    For i = 1 To bytYs                                           ' 建立预选抽签数组
        l = F_ranu(m)                                            ' 随机抽出一队代号
        s = arrCq(l)
        For j = bytRs To 1 Step -1
            If arrYm(j, 4) = s And arrYm(j, 5) = "" Then
               arrYx(i, 0) = " " & arrYm(j, 1)
               arrYx(i, 3) = " " & arrYm(j, 2)
               arrYx(i, 4) = " " & arrYm(j, 3)
               arrYx(i, 5) = " " & F_fhdw(arrYm(j, 4))
               arrYm(j, 5) = "Y" & n                             ' 预选标志
               Exit For
            End If
        Next
        m = m - 1
        For k = l To m                                           ' 调整代号数组
            arrCq(k) = arrCq(k + 1)
        Next
    Next
        
    With MSFlexGrid4
         For i = 1 To bytYs
             For j = 1 To 5
                .TextMatrix(i, j) = arrYx(i, j)
             Next
         Next
    End With

End Sub

Private Sub Label10_Click()                                      ' 显示 33-64 位
    If Label10 = "64" Then
       m = 0
       If Frame2.Visible Then
          Frame2.Visible = False: m = 8
       End If
       With MSFlexGrid2
            For i = 1 To .Rows - 1
               .Row = i: MSFlexGrid1.Row = i + 32
                For j = 0 To .Cols - 1
                   .Col = j: MSFlexGrid1.Col = j
                   .Text = MSFlexGrid1.Text
                   .CellBackColor = MSFlexGrid1.CellBackColor
                Next
            Next
           .Visible = True
       End With
       Label10 = "32": Frame4.Visible = False
    Else
       If m = 8 Then Frame2.Visible = True
       MSFlexGrid2.Visible = False
       Label10 = "64": Frame4.Visible = True
    End If
End Sub

Private Sub Command7_Click()                                     ' 无种子处理
    Frame2.Visible = False
    For i = 0 To 4                                               ' 0.随机分布
        If Option2(i).Value Then                                 ' 1.按序号分布
           strYz = i: StrMsg = Trim(Option2(i).Caption)          ' 2.参照种子方式分布
           Exit For                                              ' 3.均匀分布
        End If                                                   ' 4.同队选手分在相同的半区
    Next
    Call P_ww32
    Label3 = "全部抽签完毕 ..."
    Command3.Caption = "返  回"
    Command3.Enabled = True
    Command4.Enabled = True
End Sub

Private Sub Command8_Click()                                     ' 放弃