form02.frm

用VB编写的家庭理财程序

      End
      Begin VB.Menu mnuD6 
         Caption         =   "D6.重整帐目"
      End
   End
   Begin VB.Menu mnuT 
      Caption         =   "T.退出"
   End
End
Attribute VB_Name = "Form02"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'     ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
'     ┃         Form02      操作员权限菜单窗口                 ┃
'     ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

Dim strDat As String, datDat As Date, nS_Dy As Integer
Dim strDa1 As String, strDa2 As String
Dim strTName As String, StrSQL As String, strMcd As String, strJcd As String, strBzd As String
Dim intNsc As Integer
Dim strDmp, strTmp, strPmp As String
Dim strFmm, strFdb As String
Dim Rq As String, Je As Single
'


Private Sub Form_Load()                                                       ' 初始化

    If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub       ' 连接库 T
             
    Me.Caption = " " & StrGum & StrShm
    Label1.Caption = Format(Now, "yyyy.mm.dd   hh:mm'ss")
    Label4.Visible = False
    Label5.Caption = StrDwm
    
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    Frame1.Top = 2 * (Me.Height - Frame1.Height) / 5
    Frame1.Left = (Me.Width - Frame1.Width) / 2

mnuD6.Enabled = False

End Sub

Private Sub Form_Activate()                                                   ' ???
    StrT2 = "T_zm"
    If myF_ExistT(StrT2) < 1 Then                         ' 检查帐目表
       ' Me.mnuA.Item.Enabled = False
       Command3.Enabled = False
       Text3 = " " & StrCrq
       Text4 = ""
       Frame2.Top = Frame1.Top
       Frame2.Left = Frame1.Left
       Frame2.Visible = True
       Text4.SetFocus
    Else
       Command2.SetFocus
    End If
End Sub

Private Sub Text3_Change()
    If Len(Trim(Text3)) > 10 Then
       MsgBox "  应输入" & StrCrq & " 格式的日期 ...  ", 48, "  请注意"
       Text3 = ""
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Text4.SetFocus
    End If
End Sub

Private Sub Text3_LostFocus()
'
    Text3 = " " & Format(Trim(Text3), "yyyy.mm.dd")
End Sub

Private Sub Text4_Change()
    Command3.Enabled = False
    If Text4 = "" Then Exit Sub
    If IsNumeric(Text4) Then
       If Val(Text4) < 0 Then
          MsgBox "  应输入大于 0 的数字 ...  ", 48, "  请注意"
          Text4 = ""
       Else
          Command3.Enabled = True
       End If
    Else
       MsgBox "  应输入大于 0 的数字 ...  ", 48, "  请注意"
       Text4 = ""
    End If
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Command3.SetFocus
    End If
End Sub

Private Sub Text4_LostFocus()
    Text4 = Format(Text4, " 0.00")
End Sub

Private Sub Command3_Click()
    Rq = Trim(Text3)
    Je = Val(Text4)
    Frame2.Visible = False
    If myF_ExistT(StrT2) < 0 Then                                ' 帐目表
       StrSQL = "CREATE TABLE " & StrT2 & " ( " & _
                "  Rq text(10),Xh short," & _
                "  Sz text(1),Lb text(1),Mc text(40)," & _
                "  Dj single,Sl short,Sr single,Zc single,Ye single," & _
                "  Bh short,Bz text(30) )"
       cnnTce.Execute StrSQL, , adCmdText
    End If
    StrSQL = "INSERT Into " & StrT2 & "( Rq,Xh,Sz,Lb,Mc,Dj,Sl,Sr,Zc,Ye,Bh,Bz ) " & _
               " VALUES( '" & Rq & "',0,' ',' ','前余',0,0,0,0," & Je & ",0,' ')"
             cnnTce.Execute StrSQL, , adCmdText
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub mnuA_Click(Index As Integer)
     FormA0.Show                                          ' 帐目录入
End Sub

Private Sub mnuB_Click(Index As Integer)
     FormB0.Show                                          ' 修改
End Sub

Private Sub mnuC1_Click()
    FormC1.Show                                           ' 分类查询
End Sub

Private Sub mnuC2_Click()
    FormC2.Show                                           ' 查询药费
End Sub

Private Sub mnuD1_Click()
    FormD1.Show                                           ' 更名
End Sub

Private Sub mnuD2_Click()
    FormD2.Show                                           ' 条目
End Sub

Private Sub mnuD4_Click()
    FormD4.Show                                           ' 备份
End Sub

Private Sub mnuD5_Click()
    FormD5.Show                                           ' 修改密码
End Sub

Private Sub mnuD6_Click()                                 ' 重整帐目
    FormD6.Show
End Sub

Private Sub mnuT_Click()
    Unload Me                                             ' Exit Quit  结束程序
End Sub

Private Sub Form_Unload(Cancel As Integer)
 On Error Resume Next
    MyDb1.Close
    MyDb2.Close
End Sub

Private Sub Timer1_Timer()                                ' 定时器   interval = 900   约 1 秒
    Label1.Caption = Format(Now, "yyyy.mm.dd   hh:mm'ss")
End Sub

Private Sub Command1_Click()                              ' 调整系统时间
    If Command1.Caption Like "*调*" Then
       Label1.Caption = Format(Now, "yyyy.mm.dd   hh:mm'ss")
       Label2.Visible = True
       Label3.Visible = True
       Label4.Visible = False
       Text1.Text = Format(Date, "yyyy.mm.dd")
       Text2.Text = Time
       Text1.Visible = True
       Text2.Visible = True
       Text2.SetFocus
       Command1.Caption = "确  认 "
       Command2.Caption = "放  弃"
    Else                                                  ' 确认存盘
       Call P_Dtcp
    End If
End Sub

Private Sub Command2_Click()                              ' 放弃调整
    If Command2.Caption Like "*弃*" Then
       Label2.Visible = False
       Label3.Visible = False
       Label4.Visible = False
       Text1.Visible = False
       Text2.Visible = False
       Command1.Caption = "调  整"
       Command2.Caption = "关  闭"
    Else
       Timer1.Enabled = False
       Frame1.Visible = False                             ' 关闭  Frame1  timer ? ?
       mnuD1.Enabled = True
     '  mnuE5.Enabled = True
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Text2.SetFocus
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Command1.SetFocus
    End If
End Sub

Private Sub Command1_KeyPress(KeyAscii As Integer)             ' 确认存盘
    If KeyAscii = 13 Then
       Call P_Dtcp
    End If
End Sub

Private Sub P_Dtcp()                                           ' 系统时间确认存盘
    strDat = Text1.Text
    Date = myF_ctod(strDat)
    Time = Text2.Text
    Label1.Caption = Now
    Label2.Visible = False
    Label3.Visible = False
    Text1.Visible = False
    Text2.Visible = False
    Command1.Caption = "调  整"
    Command2.Caption = "关  闭"
End Sub

'%**************************************************

Private Sub mnuE5_Click()                 ' 调整系统时间
    Timer1.Enabled = True
    Frame1.Visible = True
    mnuD1.Enabled = False
    mnuE5.Enabled = False
End Sub

Private Sub bak()                         ' 关闭对象 ???
    Dim Ws As Workspace
    Dim Db As Database
    Dim Rs As Recordset
    For Each Ws In Workspaces
        For Each Db In Ws.Databases
            'For Each Rs In Db.Recordset
            '    Rs.Close
            '    Set Rs = noting
            'Next
            Db.Close
            Set Db = noting
        Next
    Next
    End
End Sub