📄 mdiform1.frm

📁 用VB做的一个数据库管理系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
         TempArray(2) = Ef.Fields(2).Value
      End If
      If Not IsNull(Ef.Fields(3).Value) Then
         TempArray(3) = Ef.Fields(3).Value
      End If
      If Val(TempArray(3)) <= AlertNo Then
         TempStr = "Insert into AlKcK Select * From KcK Where 仓库类型='" & TempArray(0) & "' and 产品类型='" & TempArray(1) & "' and 产品名称='" & TempArray(2) & "'"
         DB.Execute TempStr
         AlertT = True
      End If
      If Ef.EOF Then Exit Do
      Ef.MoveNext
    Loop
  DB.Close
 If AlertT = True And Trim(TempFile) = "启动时显示" Then
    AlertForm.Show
 End If
 
 Exit Sub
NoValible:
  MsgBox "报警配置文件没有找到!", vbOKOnly + 16, "警告!"
  Exit Sub
NoData:
  MsgBox "配置数据造破坏,不能配置完整的系统!", vbOKOnly + 16, "警告!"
  Exit Sub
PhotoValible:
  MsgBox "桌面图片配置有错误,请重新配置桌面!", vbOKOnly + 16, "警告!"
  
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim SureQ As Integer
SureQ = MsgBox("真的退出该系统吗(Y/N)？", vbYesNo + 32, "请确认...")
  If SureQ = 6 Then
     Cancel = 0
     Else
     Cancel = -1
  End If
End Sub


Private Sub MDIForm_Resize()
'配置工具栏的直线
 Line1.X1 = 0
 Line1.X2 = Me.ScaleWidth
 Line1.Y1 = 10
 Line1.Y2 = 10
 Line2.X1 = 0
 Line2.X2 = Me.ScaleWidth
 Line2.Y1 = 30
 Line2.Y2 = 30
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
 SaveSetting App.EXEName, "Option", "Windows", MDIForm1.WindowState
End Sub

Private Sub MnuCon_Click()
MDIForm1.MousePointer = 11
If ConfigForm.Visible = True Then
  ConfigForm.SetFocus
  MDIForm1.MousePointer = 0
  Exit Sub
End If
ConfigForm.Show
MDIForm1.MousePointer = 0
End Sub

Private Sub MnuExi_Click()
Unload Me
End Sub


Private Sub MnuKcAlert_Click()
MDIForm1.MousePointer = 11
 Dim AlertNo As Single
 On Error GoTo NoValible
 Dim DB As Database, Ef As Recordset, TempArray(3) As String
 Dim TempFile As String, TempStr As String
    TempFile = Browser + "ALERT.YSL"
    InNum = FreeFile
    Open TempFile For Input As #InNum
    Line Input #InNum, TempStr
    Close #InNum
    AlertNo = Val(TempStr)
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    TempStr = "Delete * From AlKcK"
    DB.Execute TempStr
    AlertT = False
Set Ef = DB.OpenRecordset("Select 仓库类型,产品类型,产品名称,数量 From KCK", dbOpenDynaset)
    Do Until Ef.EOF
      If Not IsNull(Ef.Fields(0).Value) Then
         TempArray(0) = Ef.Fields(0).Value
      End If
      If Not IsNull(Ef.Fields(1).Value) Then
         TempArray(1) = Ef.Fields(1).Value
      End If
      If Not IsNull(Ef.Fields(2).Value) Then
         TempArray(2) = Ef.Fields(2).Value
      End If
      If Not IsNull(Ef.Fields(3).Value) Then
         TempArray(3) = Ef.Fields(3).Value
      End If
      If Val(TempArray(3)) <= AlertNo Then
         TempStr = "Insert into AlKcK Select * From KcK Where 仓库类型='" & TempArray(0) & "' and 产品类型='" & TempArray(1) & "' and 产品名称='" & TempArray(2) & "'"
         DB.Execute TempStr
      End If
      If Ef.EOF Then Exit Do
      Ef.MoveNext
    Loop
  Ef.Close
  DB.Close
If AlertForm.Visible = True Then
     AlertForm.SetFocus
     MDIForm1.MousePointer = 0
   Else
     AlertForm.Show
     MDIForm1.MousePointer = 0
End If

Exit Sub
NoValible:
  MsgBox "数据文件造破坏!", vbOKOnly + 16, "警告!"
  MDIForm1.MousePointer = 0
  Exit Sub
End Sub

Private Sub MnuOperation_Click()
MDIForm1.MousePointer = 11
If Operationer.Visible = True Then
     Operationer.SetFocus
     MDIForm1.MousePointer = 0
   Else
     Operationer.Show
     MDIForm1.MousePointer = 0
End If
End Sub

Private Sub MnuProductConfig_Click()
MDIForm1.MousePointer = 11
If CKCPGL.Visible = True Then
     CKCPGL.SetFocus
     MDIForm1.MousePointer = 0
   Else
     CKCPGL.Show
     MDIForm1.MousePointer = 0
End If
End Sub

Private Sub MnuProductE_Click()
MDIForm1.MousePointer = 11
     CKCancel = False
If SelectMethod.Visible = True Then
     SelectMethod.SetFocus
     MDIForm1.MousePointer = 0
   Else
     SelectMethod.Show
     MDIForm1.MousePointer = 0
End If
End Sub

Private Sub MnuProductO_Click()
MDIForm1.MousePointer = 11
  CKCancel = True
  SelectStore.Show 1
  If RKCancel = False Then
     MDIForm1.MousePointer = 0
     Exit Sub
     ElseIf SelectMethod.Visible = True Then
         SelectMethod.SetFocus
     Else
     SelectMethod.Show
  End If
MDIForm1.MousePointer = 0
End Sub

Private Sub MnuProductType_Click()
MDIForm1.MousePointer = 11
If ProductType.Visible = True Then
     ProductType.SetFocus
     MDIForm1.MousePointer = 0
   Else
     ProductType.Show
     MDIForm1.MousePointer = 0
End If
End Sub

Private Sub MnuSof_Click()
MDIForm1.MousePointer = 11
If frmAbout.Visible = True Then
  frmAbout.SetFocus
  MDIForm1.MousePointer = 0
  Exit Sub
End If
frmAbout.Show
MDIForm1.MousePointer = 0
End Sub

Private Sub MnuStoreF_Click()
MDIForm1.MousePointer = 11
     SelectStore.Show 1
  If RKCancel = False Then
     MDIForm1.MousePointer = 0
     Exit Sub
  Else
     SearchKC.Show 1
     MDIForm1.MousePointer = 0
     Exit Sub
  End If
MDIForm1.MousePointer = 0
End Sub

Private Sub MnuStoreR_Click()
MDIForm1.MousePointer = 11
   ProductMove.Show 1
MDIForm1.MousePointer = 0
End Sub

Private Sub MnuStoreRerence_Click()
MDIForm1.MousePointer = 11
If Main.Visible = True Then
     Main.SetFocus
     MDIForm1.MousePointer = 0
   Else
     Main.Show
     MDIForm1.MousePointer = 0
End If
End Sub

Private Sub MnuStoreType_Click()
MDIForm1.MousePointer = 11
If StoreType.Visible = True Then
     StoreType.SetFocus
     MDIForm1.MousePointer = 0
   Else
     StoreType.Show
     MDIForm1.MousePointer = 0
End If
End Sub

Private Sub MnuTip_Click()
MDIForm1.MousePointer = 11
If frmTip.Visible = True Then
  frmTip.SetFocus
  MDIForm1.MousePointer = 0
  Exit Sub
End If
SaveSetting App.EXEName, "Options", "Show Tips at Startup", -1

If frmTip.Visible = True Then
   frmTip.SetFocus
End If
frmTip.Show
MDIForm1.MousePointer = 0
End Sub



Private Sub mnuTools_Click()
If mnuTools.Checked = False Then
   picTools.Visible = True
   mnuTools.Checked = True
 Else
   picTools.Visible = False
   mnuTools.Checked = False
End If
   SaveSetting App.EXEName, "Option", "Tools", mnuTools.Checked
End Sub

Private Sub MnuWxy_Click()
MDIForm1.MousePointer = 11
Dim WxyNo As Long
WxyNo = ShellExecute(Me.hwnd, "open", "Http://www.donghua.com", "", App.Path, 1)
If WxyNo = 0 Then
   MsgBox "浏览器没有正确安装或其它错误。", vbOKOnly + 16, "登录错误"
End If
MDIForm1.MousePointer = 0
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
       Case "Close"
            Unload Me
       Case "StoreType"
       MDIForm1.MousePointer = 11
        If StoreType.Visible = True Then
           StoreType.SetFocus
           MDIForm1.MousePointer = 0
           Else
           StoreType.Show
           MDIForm1.MousePointer = 0
        End If
       Case "ProductType"
       MDIForm1.MousePointer = 11
        If ProductType.Visible = True Then
           ProductType.SetFocus
           MDIForm1.MousePointer = 0
           Else
           ProductType.Show
           MDIForm1.MousePointer = 0
        End If
       Case "ProductKind"
       MDIForm1.MousePointer = 11
        If CKCPGL.Visible = True Then
           CKCPGL.SetFocus
           MDIForm1.MousePointer = 0
           Else
           CKCPGL.Show
           MDIForm1.MousePointer = 0
        End If
       Case "AlertRef"
       MDIForm1.MousePointer = 11
        If Main.Visible = True Then
           Main.SetFocus
           MDIForm1.MousePointer = 0
           Else
           Main.Show
           MDIForm1.MousePointer = 0
        End If
       Case "Import"
       MDIForm1.MousePointer = 11
       CKCancel = False
       If SelectMethod.Visible = True Then
          SelectMethod.SetFocus
          MDIForm1.MousePointer = 0
           Else
          SelectMethod.Show
          MDIForm1.MousePointer = 0
        End If
       Case "Export"
       MDIForm1.MousePointer = 11
       CKCancel = True
       SelectStore.Show 1
         If RKCancel = False Then
            MDIForm1.MousePointer = 0
            Exit Sub
         ElseIf SelectMethod.Visible = True Then
                SelectMethod.SetFocus
             Else
                SelectMethod.Show
         End If
         MDIForm1.MousePointer = 0
       Case "Adjust"
       MDIForm1.MousePointer = 11
       ProductMove.Show 1
       MDIForm1.MousePointer = 0
       Case "FindStore"
       MDIForm1.MousePointer = 11
     SelectStore.Show 1
        If RKCancel = False Then
           MDIForm1.MousePointer = 0
           Exit Sub
        Else
           SearchKC.Show 1
           MDIForm1.MousePointer = 0
           Exit Sub
        End If
        MDIForm1.MousePointer = 0
       Case "Alert"
       MDIForm1.MousePointer = 11
         Dim AlertNo As Single
         On Error GoTo NoValible
         Dim DB As Database, Ef As Recordset, TempArray(3) As String
         Dim TempFile As String, TempStr As String
             TempFile = Browser + "ALERT.YSL"
             InNum = FreeFile
             Open TempFile For Input As #InNum
             Line Input #InNum, TempStr
             Close #InNum
             AlertNo = Val(TempStr)
        Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
            TempStr = "Delete * From AlKcK"
            DB.Execute TempStr
            AlertT = False
        Set Ef = DB.OpenRecordset("Select 仓库类型,产品类型,产品名称,数量 From KCK", dbOpenDynaset)
            Do Until Ef.EOF
              If Not IsNull(Ef.Fields(0).Value) Then
                 TempArray(0) = Ef.Fields(0).Value
              End If
              If Not IsNull(Ef.Fields(1).Value) Then
                 TempArray(1) = Ef.Fields(1).Value
              End If
              If Not IsNull(Ef.Fields(2).Value) Then
                 TempArray(2) = Ef.Fields(2).Value
              End If
              If Not IsNull(Ef.Fields(3).Value) Then
                 TempArray(3) = Ef.Fields(3).Value
              End If
              If Val(TempArray(3)) <= AlertNo Then
                 TempStr = "Insert into AlKcK Select * From KcK Where 仓库类型='" & TempArray(0) & "' and 产品类型='" & TempArray(1) & "' and 产品名称='" & TempArray(2) & "'"
                 DB.Execute TempStr
              End If
              If Ef.EOF Then Exit Do
              Ef.MoveNext
            Loop
          Ef.Close
          DB.Close
        If AlertForm.Visible = True Then
             AlertForm.SetFocus
             MDIForm1.MousePointer = 0
           Else
             AlertForm.Show
             MDIForm1.MousePointer = 0
        End If
       Case "Day"
       MDIForm1.MousePointer = 11
        If frmTip.Visible = True Then
           frmTip.SetFocus
           MDIForm1.MousePointer = 0
          Exit Sub
        End If
        SaveSetting App.EXEName, "Options", "Show Tips at Startup", -1
        If frmTip.Visible = True Then
           frmTip.SetFocus
        End If
        frmTip.Show
        MDIForm1.MousePointer = 0
       Case "SystemSet"
       MDIForm1.MousePointer = 11
        If ConfigForm.Visible = True Then
          ConfigForm.SetFocus
          MDIForm1.MousePointer = 0
          Exit Sub
        End If
        ConfigForm.Show
        MDIForm1.MousePointer = 0
        End Select

Exit Sub
NoValible:
  MsgBox "数据文件造破坏!", vbOKOnly + 16, "警告!"
  MDIForm1.MousePointer = 0
  Exit Sub
End Sub
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -