formd7.frm

用VB编写的家庭理财程序

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FormD7 
   BackColor       =   &H00FFFF80&
   Caption         =   "  设置用户"
   ClientHeight    =   6495
   ClientLeft      =   3855
   ClientTop       =   2640
   ClientWidth     =   11475
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   6495
   ScaleWidth      =   11475
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command4 
      Caption         =   "添加用户"
      Height          =   320
      Left            =   3720
      TabIndex        =   8
      Top             =   4920
      Width           =   975
   End
   Begin VB.CommandButton Command3 
      Caption         =   "删除用户"
      Enabled         =   0   'False
      Height          =   320
      Left            =   4800
      TabIndex        =   7
      Top             =   4920
      Width           =   975
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   1335
      Left            =   3240
      TabIndex        =   6
      Top             =   840
      Width           =   4095
      _ExtentX        =   7223
      _ExtentY        =   2355
      _Version        =   393216
   End
   Begin VB.CommandButton Command2 
      Caption         =   "确  认"
      Enabled         =   0   'False
      Height          =   320
      Left            =   5880
      TabIndex        =   3
      Top             =   4920
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退  出"
      Height          =   320
      Left            =   6960
      TabIndex        =   2
      Top             =   4920
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   6240
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   3720
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   6240
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   3240
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFF80&
      Caption         =   "密    码："
      Height          =   180
      Left            =   5280
      TabIndex        =   5
      Top             =   3780
      Visible         =   0   'False
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFF80&
      Caption         =   "用户名称："
      Height          =   180
      Left            =   5280
      TabIndex        =   4
      Top             =   3300
      Visible         =   0   'False
      Width           =   900
   End
End
Attribute VB_Name = "FormD7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'     ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
'     ┃         FormD7           设置用户                      ┃
'     ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

Option Explicit

'   Public strUsd, strUsm, strUsk, strUsj As String    ' 用户名、密码、级别及代码
    
Const intCn1 = &HC0C0FF, intCy1 = &H80000005
Dim bytLgn As Byte, bolTc As Boolean
Dim arrUsn() As String, bytUss As Byte, strUsk As String, StrUsm As String
Dim arrQxn() As String
Dim bytMod As Byte
Dim strDmp As String, strXhp As String, strMcp As String, strJcp As String, strBzp As String
Dim strDmk As String, strXhk As String, strMck As String, strJck As String, strBzk As String
Dim Qx As String, Q0 As String, Q1 As String, Q2 As String, Q3 As String, Q4 As String, Q5 As String, Q6 As String
Dim intRow As Integer
'

Private Sub Form_Load()
       
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
' !! 打开数据库
Db_fN2 = App.Path & StrDir & Db_Name2
    If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub        ' 连接库 T                                               ' 打开数据库 2
    
       strT0 = "T_tm"                                            ' 条目表 MyRs0
       
'    StrT1 = "A_qx" '( Dm char(4) Not Null Primary key,Xh char(4),Mc char(6),Kl char(6),Jb char(1),
                    '  Q0 char(10),Q1 char(10),Q2 char(10),Q3 char(10),Q4 char(10),
                    '  Q5 char(10),Q6 char(10),Bz char(30))
'    If M_fucExistT(StrT1) < 0 Then
'       If M_fucCreat(StrT1) < 0 Then
'          MsgBox "  很抱歉，建立表 " & StrT1 & " 失败 ...  ", 48, " 请注意"
'          Exit Sub
'       End If
'    End If
    
    Set MyRs0 = New Recordset
    StrSQL = "Select * From " & strT0 & " Where Left(Dm,2)='Kl' Order By Dm"
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
    If MyRs0.RecordCount > 0 Then
       MyRs0.MoveLast
       strDmk = Trim(MyRs0![dm])                                 ' 代码
    Else
       MsgBox "  Not Find Datas In " & strT0 & " ...  ", 48, " Error !!"
       bolTc = True
       Exit Sub
    End If
    
    Set MyRs1 = New Recordset
    StrSQL = "Select * From " & strT0 & " Where Left(Dm,2)='Kl' Order By Xh"
    MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
    If MyRs1.RecordCount > 0 Then
       MyRs1.MoveLast
       strXhk = Trim(MyRs1![Xh])                                 ' 序号
    Else
       MsgBox "  Not Find Datas In " & StrT1 & " ...  ", 48, " Error !!"
       bolTc = True
       Exit Sub
    End If
    
    Me.Left = (Screen.Width - Me.Width) / 2
 '   Frame2.Left = (Me.Width - Frame2.Width) / 2
    Command4.Left = (Me.Width - Command4.Width * 4 - 100 * 3) / 2
    Command3.Left = Command4.Left + Command4.Width + 100
    Command2.Left = Command3.Left + Command3.Width + 100
    Command1.Left = Command2.Left + Command2.Width + 100
    
End Sub

Private Sub Form_Activate()
    If bolTc = True Then
       Unload Me
    End If
    Call P_RecorSet
    strBzk = "2"                                                  ' 用户级别
    bytLgn = 3
    Text2.Text = ""
    Text1.Text = ""
    Command4.SetFocus
    
End Sub

Private Sub P_RecorSet()
    Set MyRs0 = New Recordset
    StrSQL = "Select * From " & strT0 & " Where Left(Dm,2)='Kl' And (Left(Bz,1)='2' Or Left(Bz,1)='3') Order By Xh"
    MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
    If MyRs0.RecordCount > 0 Then
       MyRs0.MoveLast
       bytUss = MyRs0.RecordCount: ReDim arrUsn(bytUss, 3)
       With MSFlexGrid1
           .Clear
           .Cols = 4
           .Rows = bytUss + 1
           .Height = 225 * IIf(bytUss > 5, 6, bytUss + 1) + 90
           .Width = 4200 + IIf(bytUss > 5, 270, 0)
           .Left = (Me.Width - .Width) / 2
           .Row = 0: .Col = 0: .Text = "  序号":    .ColWidth(0) = 800
                     .Col = 1: .Text = "  用户名":  .ColWidth(1) = 1200
                     .Col = 2: .Text = "  密  码":  .ColWidth(2) = 1200
                     .Col = 3: .Text = "  备  注 ": .ColWidth(2) = 1200
            MyRs0.MoveFirst
            For i = 1 To bytUss
               .Row = i:                             arrUsn(i, 0) = Trim(MyRs0![dm])
               .Col = 0: .Text = "  " & i:           arrUsn(i, 1) = Trim(MyRs0![Mc])
               .Col = 1: .Text = " " & MyRs0![Mc]:   arrUsn(i, 2) = Trim(MyRs0![Jc])
               .Col = 2: .Text = " ******":          arrUsn(i, 3) = Trim(MyRs0![Bz])
                MyRs0.MoveNext
            Next
           .Visible = True
       End With
    Else
       bytUss = 0
       MSFlexGrid1.Visible = False
    End If
    intRow = 1