formd2.frm

用VB编写的家庭理财程序

    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
    
    ReDim arrTmp(20, 1 To 5)
        
End Sub

Private Sub Form_Activate()

    If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub            ' 连接库 T
    
    strDmt = "Lb":  StrMsg = "代号"
    StrMsg = "备注"
      
    Command1(1).SetFocus
    
End Sub

Private Sub Command1_Click(Index As Integer)
    bytMod = 1
    Frame1.Visible = True
    Select Case Index
           Case 1
                strDm = "Lb": Call P_ini0
                Call P_ini1
                Call P_grd1
           Case 2
                strDm = "Xm": Call P_ini0
                Call P_ini2
                Call P_grd2
           Case 0
                Unload Me: Exit Sub
    End Select
    Yuu = 225
    Ydd = 225 * (N1 + 1)
    Text1(0).Enabled = True
    Text1(0).SetFocus
End Sub

Private Sub P_ini0()
    StrSQL = "Select Dm From " & strT0 & " Where Dm Like '" & strDm & "%' Order By Dm"
    Set MyRs0 = New Recordset
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       If MyRs0.RecordCount > 0 Then
          MyRs0.MoveLast
          strDmp = MyRs0![dm]                           ' 最后代码
       Else
          strDmp = strDm & "000"
       End If
    StrSQL = "Select Xh From " & strT0 & " Where Dm Like '" & strDm & "%' Order By Xh"
    Set MyRs0 = New Recordset
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       If MyRs0.RecordCount > 0 Then
          MyRs0.MoveLast
          strXhp = MyRs0![Xh]                           ' 最后序号
       Else
          strXhp = "100"
       End If
    Sz = IIf(Option1(0), "s", "z")
End Sub

Private Sub P_ini1()
    For i = 0 To 2
        Text1(i) = ""
    Next
    StrSQL = "Select * From " & strT0 & _
             " Where Dm Like '" & strDm & "%' And Jc Like '" & Sz & "%'" & _
             " Order By Bz"
    Set MyRs1 = New Recordset
    MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       N1 = MyRs1.RecordCount
       If N1 > 0 Then
          MyRs1.MoveLast
          strDh = Trim(MyRs1![Bz])                       ' 最后代号
          If N1 > 1 Then Command2.Enabled = True
       Else
          strDh = "A"
       End If
       Text1(2) = " " & F_ascm(strDh): Text1(2).Enabled = False
    Text1(1).Visible = False
    Label1 = "请输入条目名称："
    Label2 = "收支："
    Label3 = "代号："
End Sub

Private Sub P_ini2()
    For i = 0 To 2
        Text1(i) = ""
    Next
    Text1(1).Visible = True: Text1(2).Enabled = True
    Label1 = "    请输入姓名："
    Label2 = "简称："
    Label3 = "备注："
End Sub

Private Sub P_grd1()
    Text1(1) = IIf(Option1(0), "s", "z")
    With MSFlexGrid1
        .Clear
        .Cols = 5
        .Row = 0
        .Col = 0: .Text = " 序号":   .ColWidth(0) = 580
        .Col = 1: .Text = " 代 码":  .ColWidth(1) = 680
        .Col = 2: .Text = " 名  称": .ColWidth(2) = 1600
        .Col = 3: .Text = " 收支":   .ColWidth(3) = 800
        .Col = 4: .Text = " 代号":   .ColWidth(4) = 1140
    End With
    strDm = "Lb"
    strSz = IIf(Option1(0), "收入", "支出")
       Sz = IIf(Option1(0), "s", "z")
    StrSQL = "Select * From " & strT0 & _
             " Where Dm Like '" & strDm & "%' And Jc Like '" & Sz & "%'" & _
             " Order By Xh"
    Set MyRs1 = New Recordset
    MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
    If MyRs1.RecordCount > 0 Then
       N1 = MyRs1.RecordCount
       If N1 > 0 Then
          ReDim arrLb(N1, 4), arrTx(N1), arrTy(N1)
          MyRs1.MoveLast
             strXhp = MyRs1![Xh]                                    ' 最后序号
          Label4.Caption = "现已有 " & N1 & " 个条目"
          With MSFlexGrid1
              .Height = 225 * IIf(N1 > 8, 9, N1 + 1) + 90
              .Width = 4900 + IIf(N1 > 8, 270, 0)
              .Left = (Frame1.Width - .Width) / 2
              .Rows = N1 + 1
               MyRs1.MoveFirst
               For i = 1 To N1
                   arrLb(i, 1) = MyRs1![dm]
                   arrLb(i, 2) = MyRs1![Mc]
                   arrLb(i, 3) = MyRs1![Jc]
                   arrLb(i, 4) = MyRs1![Bz]
                  .Row = i
                  .Col = 0: .Text = i & "  "
                       For j = 1 To 4
                          .Col = j: .Text = " " & arrLb(i, j)
                       Next
                   MyRs1.MoveNext
               Next
              .Visible = True
          End With
       Else
          N1 = 0
          strDmp = strDm & "00"                                       ' 新代码
          strXhp = "100"                                              ' 新序号
          Label4 = ""
       End If
    End If
End Sub

Private Sub P_grd2()
    With MSFlexGrid1
        .Clear
        .Cols = 5
        .Row = 0
        .Col = 0: .Text = " 序号":   .ColWidth(0) = 580
        .Col = 1: .Text = " 代 码":  .ColWidth(1) = 680
        .Col = 2: .Text = " 名  称": .ColWidth(2) = 1600
        .Col = 3: .Text = " 简称":   .ColWidth(3) = 800
        .Col = 4: .Text = " 备注":   .ColWidth(4) = 1140
    End With
    strDm = "Xm"
    StrSQL = "Select * From " & strT0 & _
             " Where Dm Like '" & strDm & "%' Order By Xh"
    Set MyRs1 = New Recordset
    MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
    If MyRs1.RecordCount > 0 Then
       N1 = MyRs1.RecordCount
       If N1 > 0 Then
          ReDim arrLb(N1, 4)
          MyRs1.MoveLast
             strXhp = MyRs1![Xh]                          ' 最后序号
          Label4.Caption = "现已有 " & N1 & " 个条目"
          With MSFlexGrid1
              .Height = 225 * IIf(N1 > 8, 9, N1 + 1) + 90
              .Width = 4900 + IIf(N1 > 8, 270, 0)
              .Left = (Frame1.Width - .Width) / 2
              .Rows = N1 + 1
               MyRs1.MoveFirst
               For i = 1 To N1
                   arrLb(i, 1) = MyRs1![dm]
                   arrLb(i, 2) = MyRs1![Mc]
                   arrLb(i, 3) = MyRs1![Jc]
                   arrLb(i, 4) = MyRs1![Bz]
                  .Row = i
                  .Col = 0: .Text = i & " "
                       For j = 1 To 4
                          .Col = j: .Text = " " & arrLb(i, j)
                       Next
                   MyRs1.MoveNext
               Next
              .Visible = True
          End With
       Else
          N1 = 0
          strDmp = strDm & "00"                                       ' 新代码
          strXhp = "100"                                              ' 新序号
          Label4 = ""
       End If
    End If
End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call MSFlexGrid1_Click
End Sub

Private Sub MSFlexGrid1_Click()                                          ' 选中
    With MSFlexGrid1
         m = .Row                                                        ' 当前行
        .Row = bytRoy
         For j = 1 To 4: .Col = j: .CellBackColor = intCly: Next
        .Row = m: bytRoy = m
         For j = 1 To 4: .Col = j: .CellBackColor = intClx: Next
    End With
    If bytMod = 3 Then                                                   ' 模式 3: 排序
       '
    Else
       With MSFlexGrid1
            strDmd = arrLb(bytRoy, 1)
            For j = 2 To 4
               .Col = j: Text1(j - 2).Text = " " & Trim(.Text): Text1(j - 2).Enabled = True
            Next
       End With
       bytMod = 2                                                        ' 模式 2: 修改
       Command2.Caption = "放弃修改"
       Command3.Caption = "修改存盘"
       Command2.Enabled = True
       Command3.Enabled = True
       Command4.Enabled = True
       Text1(0).SetFocus
       Text1(0).SelStart = 0                                             ' 聚焦时反白显示
       Text1(0).SelLength = Len(Text1(0).Text)
    End If
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If bytMod = 3 And Button = 1 Then
       With MSFlexGrid1                                                  ' 鼠标左键 Down
            m = .Row
           .Row = bytRoy
                For j = 1 To 4: .Col = j: .CellBackColor = intCly: arrTy(j) = .Text: Next
           .Row = m: bytRoy = m
                For j = 1 To 4: .Col = j: .CellBackColor = intClx: arrTx(j) = .Text: Next
            bytRow = m
       End With
       y0 = y                                                            ' 拖动排序起点
       Rd = bytRow - Int(y / 225)                                        ' 行差
       yu = 225 * (bytRow - Rd)                                          ' 上限
       yd = 225 * (bytRow - Rd + 1)                                      ' 下限
    End If
End Sub

Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If bytMod <> 3 Or Button <> 1 Then Exit Sub
    If y < Yuu + 50 Or y > Ydd - 50 Then Exit Sub
    Dim blnJh As Boolean, bytRok As Byte
        blnJh = False
    yy = y - y0
    If yy < 0 Then
       If y < yu Then                                       ' ↑
          blnJh = True
          bytRok = bytRow - 1   '' ??0-1
       End If
    Else                                                    ' ↓
       If y > yd Then
          blnJh = True
          bytRok = bytRow + 1
       End If
    End If
    If blnJh Then                                           ' 交换
       With MSFlexGrid1
           .Row = bytRok
            For j = 1 To 4
               .Col = j: arrTy(j) = .Text: .Text = arrTx(j): .CellBackColor = intClx
            Next
           .Row = bytRow
            For j = 1 To 4
               .Col = j:  .Text = arrTy(j): .CellBackColor = intCly
            Next
           .Row = bytRok
            bytRow = bytRok
               y0 = y                                             ' 拖动排序终点 新的原位
               yu = yu + IIf(yy < 0, -225, 225)
               yd = yd + IIf(yy < 0, -225, 225)
            Command3.Enabled = True
       End With
       blnJh = False
    End If
End Sub

Private Sub Command2_Click()                                      ' 排序/放弃
    If Command2.Caption Like "排*" Then
       bytMod = 3
       With MSFlexGrid1
           .Row = bytRoy
            For i = 1 To 4
               .Col = i: .CellBackColor = intCly                  ' 原色
            Next
            Label5.Top = .Top + .Height + 200
       End With
       For i = 0 To 2
           Text1(i).Enabled = False
       Next
       Label5.Caption = "请用鼠标拖动 ...."
       Command2.Caption = "放弃排序"
       Command2.Enabled = True
       Command3.Enabled = True
       Command4.Enabled = False
    Else                                                          ' 放弃
       With MSFlexGrid1
           .Col = 1: .CellBackColor = intCly
            For i = 2 To 4
               .Col = i: Text1(i - 2).Text = "": Text1(i - 2).Enabled = IIf(i = 2, True, False)