form1.frm

VB库存管理系统

      Begin VB.Menu mnuCheckUser 
         Caption         =   "查看用户"
      End
      Begin VB.Menu mnucxdl 
         Caption         =   "重新登录"
      End
      Begin VB.Menu mnuEnd 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnuinfo 
      Caption         =   "【信息设置】"
      Begin VB.Menu mnuwpmx 
         Caption         =   "物品明细设置"
      End
      Begin VB.Menu mnuwplx 
         Caption         =   "物品类型设置"
      End
      Begin VB.Menu mnuyonghu 
         Caption         =   "用户信息设置"
      End
   End
   Begin VB.Menu mnuhwmanger 
      Caption         =   "【货位设置】"
      Begin VB.Menu mnufphw 
         Caption         =   "货位编号分配"
      End
      Begin VB.Menu mnuhwcheck 
         Caption         =   "查询货位"
      End
   End
   Begin VB.Menu mnuKC 
      Caption         =   "【库存总表】"
   End
   Begin VB.Menu mnuruku 
      Caption         =   "【入库设置】"
      Begin VB.Menu mnuAddrk 
         Caption         =   "入库单管理"
      End
      Begin VB.Menu mnuCheckrk 
         Caption         =   "查询入库"
      End
   End
   Begin VB.Menu mnuchuku 
      Caption         =   "【出库设置】"
      Begin VB.Menu mnuAddChuKu 
         Caption         =   "添加出库"
      End
      Begin VB.Menu mnuCheckChuKu 
         Caption         =   "查询出库"
      End
   End
   Begin VB.Menu mnuData 
      Caption         =   "【数据操作】"
      Begin VB.Menu mnubackdata 
         Caption         =   "备份数据库"
      End
      Begin VB.Menu mnuredata 
         Caption         =   "恢复数据库"
      End
      Begin VB.Menu mnufarmatdata 
         Caption         =   "初始化数据库"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "【帮助】"
      Begin VB.Menu mnuAbout 
         Caption         =   "关于"
      End
   End
   Begin VB.Menu mnuExit 
      Caption         =   "【退出系统】"
   End
End
Attribute VB_Name = "frmMDIMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'本模块是系统的主界面
'整个系统的各个功能都是在这个界面上运行的
'
'
'
'
'************************调用API关闭"X"按钮*********************************
    Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

    Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

    Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long

    Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long

    Private Const MF_BYPOSITION = &H400&
    Private Const MF_DISABLED = &H2&
'调用堆剁机
Private Sub Command11_Click()
Shell "堆剁机.exe"
End Sub
'调用主机
Private Sub Command12_Click()
Shell "主机.exe"
End Sub

Private Sub Form_Load()
Call DisableX(Me)
End Sub

'调用"关于"界面

Private Sub mnuAbout_Click()
frmAbout.Show 1
End Sub
'调用出库管理界面
Private Sub mnuAddChuKu_Click()
frmChuKu.Show 1
End Sub
'调用入库管理界面
Private Sub mnuAddrk_Click()
FrmRuKu.Show 1
End Sub
'调用添加用户名称界面
Private Sub mnuAdduser_Click()
frmAdduser.Show 1
End Sub
'调用备份数据库界面
Private Sub mnubackdata_Click()
FrmBackDate.Show 1
End Sub
'调用修改密码界面
Private Sub mnuChangePwd_Click()
frmChangePWD.Show 1
End Sub
'调用查询出库界面
Private Sub mnuCheckChuKu_Click()
FrmchukuCheck.Show 1
End Sub
'调用入库查询界面
Private Sub mnuCheckrk_Click()
frmrukucheck.Show 1
End Sub
'调用查询用户界面
Private Sub mnuCheckUser_Click()
FrmCheckUser.Show 1
End Sub



Private Sub mnuEnd_Click()
msg = MsgBox("是否要退出?", vbQuestion + vbYesNo, "询问")
If msg = vbNo Then
    Exit Sub
Else
    End
End If
End Sub

Private Sub mnuExit_Click()
msg = MsgBox("是否要退出?", vbQuestion + vbYesNo, "询问")
If msg = vbNo Then
    Exit Sub
Else
    End
End If
End Sub

'调用初始化数据库表
Private Sub mnufarmatdata_Click()
frmFormatData.Show 1
End Sub

'调用分配货位编号
Private Sub mnufphw_Click()
frmfphw.Show 1
End Sub

'调用查询货位编号
Private Sub mnuhwcheck_Click()
frmfphwCheck.Show 1
End Sub

'调用库存总表界面
Private Sub mnuKC_Click()
frmKCZB.Show 1
End Sub

'调用恢复数据库界面
Private Sub mnuredata_Click()
frmDataHuan.Show 1
End Sub
'调用物品类型信息设置界面
Private Sub mnuwplx_Click()
frmhwxx.Show 1
End Sub
'调用物品明细信息设置界面
Private Sub mnuwpmx_Click()
frmwpmx.Show 1
End Sub

Private Sub mnuyonghu_Click()
frmYongHu.Show 1
End Sub

'调用快捷方式图标
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "a"
            
                mnuAddrk_Click
        Case "b"
            mnuAddChuKu_Click

        Case "c"
            mnuCheckrk_Click
        Case "d"
            mnuCheckChuKu_Click
        Case "e"
            msg = MsgBox("是否要退出?", vbQuestion + vbYesNo, "退出")
            If msg = vbYes Then
                End
            Else
                Cancel = True
            End If
    End Select
End Sub
'任务栏第三栏显示的系统时钟
Private Sub Timer1_Timer()
StatusBar1.Panels(3).Text = "当前系统时间是: " & Format(Date, "long date") & " " & Time
End Sub
Private Sub Command1_Click()
Command2.Enabled = True
Command1.Enabled = False
Vid.CaptureFile = Text1.Text
Vid.CaptureVideo
End Sub


'以下所有程序均是摄像机程序

Private Sub Command10_Click()
ShowDialog:
cmd.InitDir = CurDir
cmd.FileName = "*.bmp"
cmd.DefaultExt = "bmp"
cmd.DialogTitle = "Save .bmp As..."
cmd.Filter = "Bitmap Files (*.bmp)"
cmd.ShowSave
Text2.Text = cmd.FileName
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Recording When Picture Is Moving"
End Sub

Private Sub Command2_Click()
Command1.Enabled = True
Command2.Enabled = False
Vid.CaptureEnd
Form2.Show
Form2.Playback.FileName = Text1.Text
End Sub


Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Stop Recording"
End Sub


Private Sub Command3_Click()
Vid.ShowDlgVideoSource
End Sub


Private Sub Command3_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Video Source Options"
End Sub


Private Sub Command4_Click()
cmd.InitDir = CurDir
cmd.FileName = "*.avi"
cmd.DefaultExt = "avi"
cmd.DialogTitle = "Save .Avi As..."
cmd.Filter = "AVI Files (*.avi)"
cmd.ShowSave
Text1.Text = cmd.FileName
End Sub

Private Sub Command5_Click()
Vid.ShowDlgVideoFormat
End Sub


Private Sub Command5_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Video Format Options"
End Sub


Private Sub Command6_Click()
Vid.ShowDlgAudioFormat
End Sub


Private Sub Command6_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "View Sound Format Options"
End Sub


Private Sub Command7_Click()
Vid.ShowDlgCompressionOptions
End Sub


Private Sub Command7_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "View Video Compression Options"
End Sub


Private Sub Command8_Click()
If Command8.Caption = "Freeze" Then
Command8.Caption = "UnFreeze"
Vid.Preview = False
Exit Sub
End If
If Command8.Caption = "UnFreeze" Then
Command8.Caption = "Freeze"
Vid.Preview = True
Exit Sub
End If
End Sub


Private Sub Command8_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Freeze/UnFreeze Video"
End Sub


Private Sub Command9_Click()
On Error GoTo erh
Picture1.Cls
Vid.SaveDIB (Text2.Text)
Result = Shell("start.exe " & Text2.Text, vbHide)
erh:
Exit Sub
End Sub

Private Sub Command9_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Capture Image To A File"
End Sub





Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Welcome To Cam-Cap v1.0"
End Sub


Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Welcome To Cam-Cap v1.0"
End Sub


Private Sub HScroll1_Change()
Label1.Caption = "Current Frame Rate (" & HScroll1.Value & " fps)"
Vid.PreviewRate = HScroll1.Value
Vid.CaptureRate = HScroll1.Value
End Sub


Private Sub HScroll1_Scroll()
Label1.Caption = "Current Frame Rate (" & HScroll1.Value & " fps)"
Vid.PreviewRate = HScroll1.Value
Vid.CaptureRate = HScroll1.Value
End Sub


Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Label3.Caption = "Welcome To Cam-Cap v1.0"
End Sub

'**********************关闭按钮显示为灰色****************
    Private Sub DisableX(Frm As Form)

    Dim hMenu As Long, nCount As Long

    hMenu = GetSystemMenu(Frm.hwnd, 0)

    nCount = GetMenuItemCount(hMenu)

    Call RemoveMenu(hMenu, nCount - 1, MF_DISABLED Or MF_BYPOSITION)

    DrawMenuBar Frm.hwnd

    End Sub