📄 main.frm

📁 音像制品出租及销售管理系统,用VB实现
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23

  Dim bi As BROWSEINFO '声明必要的变量
  Dim rtn&, pidl&, path$, pos%, t%, SpecIn$, specout$
  bi.hOwner = Me.hwnd '使对话框处于屏幕中心
  bi.lpszTitle = "请选择文件夹........" '设置标题文字
  bi.ulFlags = BIF_RETURNONLYFSDIRS '返回文件夹的类型
  pidl& = SHBrowseForFolder(bi) '显示对话框
  path = Space(512) '设置字符数的最大值
  t = SHGetPathFromIDList(ByVal pidl&, ByVal path) '获得所选的路径
  pos% = InStr(path$, Chr$(0)) '从字符串中提取路径
  SpecIn$ = Left(path$, pos - 1)
  If Right$(SpecIn, 1) = "\" Then
    specout$ = SpecIn$
  Else
    specout$ = SpecIn$ & "\"
  End If
 VBA.FileCopy App.path & "\cd.mdb", specout$ & "cd.mdb"

End Sub


Private Sub delema_Click()

  msg = "删除管理员"
  manger.Show vbModal

End Sub

Private Sub deleuser_Click()

  msg = "删除会员"
  user.Show vbModal

End Sub

Private Sub dfer_Click()

End Sub

Private Sub Form_Load()
 
  If App.PrevInstance = True Then
  End
  End If
  loadma.Show vbModal
  msg = "销售音像"
  Me.Label1.Caption = "销售音像"
End Sub

Private Sub Form_Resize()

  If Me.WindowState = 1 Then
  Else
    Me.Height = 8130
    Me.Width = 11325
  End If
  
End Sub

Private Sub nvx_Click()

End Sub

Private Sub gpcx_Click()

  msg = "音像查询"
  cdm.Show vbModal

End Sub

Private Sub Label1_Click()

  If Me.txtselect(0).Text <> "" And Me.txtselect(1).Text <> "" Then
  Select Case Me.Label1.Caption
    Case Is = "销售音像"
      Call yn.opendb("select * from 影片资料 where 影片名称='" & Me.txtselect(0).Text & "'")
      yn.myrec.Fields("总数") = yn.myrec.Fields("总数") - 1
      Call yn.myrec.Update
      Call yn.closedb
      MsgBox "销售音像成功！！！", vbInformation + vbOKOnly, "音像制品出租及销售管理系统"
      
    Case Is = "出租音像"
      Call yn.opendb("select * from 影片资料 where 影片名称='" & Me.txtselect(0).Text & "'")
      yn.myrec.Fields("总数") = yn.myrec.Fields("总数") - 1
      Call yn.myrec.Update
      Call yn.closedb
      Call yn.opendb("select * from 客户日志")
      Call yn.myrec.AddNew
      yn.myrec.Fields("客户姓名") = Me.txtselect(1).Text
      yn.myrec.Fields("影片编号") = Me.txtinfo(0).Text
      yn.myrec.Fields("借出时期") = VBA.Date
      Call yn.myrec.Update
      MsgBox "出租音像成功！！！", vbInformation + vbOKOnly, "音像制品出租及销售管理系统"
      Call yn.closedb
    
    Case Is = "归还音像"
      Call yn.opendb("select * from 客户日志 where 客户姓名='" & Me.txtselect(1).Text & "' and 影片编号='" & Me.txtinfo(0).Text & "'")
      If yn.myrec.EOF Then
        MsgBox "此用户没租出或已还回！！！", vbInformation + vbOKOnly, "音像制品出租及销售管理系统"
        Call yn.closedb
      Else
        Call yn.myrec.Delete
        Call yn.closedb
        Call yn.opendb("select * from 影片资料 where 影片名称='" & Me.txtselect(0).Text & "'")
        yn.myrec.Fields("总数") = yn.myrec.Fields("总数") + 1
        Call yn.myrec.Update
        Call yn.closedb
        MsgBox "归还音像成功！！！", vbInformation + vbOKOnly, "音像制品出租及销售管理系统"
      End If
  End Select
  Else
    MsgBox "请输入影片名称和会员名称！！！", vbInformation + vbOKOnly, "音像制品出租及销售管理系统"
    Exit Sub
  End If

End Sub

Private Sub modicd_Click()

  msg = "修改音像"
  cdm.Show vbModal

End Sub

Private Sub modima_Click()

  msg = "修改管理员"
  manger.Show vbModal

End Sub

Private Sub modiuser_Click()

  msg = "修改会员"
  user.Show vbModal

End Sub

Private Sub pd_Click()  '判断是否为会员

     msg = "查询会员"
     user.Show vbModal
  

End Sub

Private Sub pd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) '判断是否为会员
 
 pd.ForeColor = &HFF0000
 
End Sub

Private Sub quit_Click()
 
  End
 
End Sub

Private Sub search_Click(Index As Integer)

  On Error Resume Next
    Me.txtinfo(0).Text = ""
    Me.txtinfo(1).Text = ""
    Me.txtinfo(3).Text = ""
    Me.txtinfo(4).Text = ""
    Me.txtinfo(5).Text = ""
    Me.txtinfo(6).Text = ""
    Me.txtinfo(8).Text = ""
    Me.txtinfo(9).Text = ""
    Me.txtinfo(7).Text = ""
    Me.txtinfo(12).Text = ""
    Me.lstinfo.Clear

  Call yn.opendb("select * from 影片资料 where 影片名称='" & Me.txtselect(0).Text & "'")
  If yn.myrec.EOF Then
    MsgBox "没有此影片！！！", vbInformation + vbOKOnly, "音像制品出租及销售管理系统"
    Call yn.closedb
  Else
    Me.txtinfo(0).Text = yn.myrec.Fields("影片编号")
    Me.txtinfo(1).Text = yn.myrec.Fields("影片名称")
    Me.txtinfo(3).Text = yn.myrec.Fields("导演")
    Me.txtinfo(4).Text = yn.myrec.Fields("发行年度")
    Me.txtinfo(5).Text = yn.myrec.Fields("时间长度")
    Me.txtinfo(6).Text = yn.myrec.Fields("影片语言")
    Me.txtinfo(8).Text = yn.myrec.Fields("影片类型")
    Me.txtinfo(9).Text = yn.myrec.Fields("影片格式")
    Me.txtinfo(7).Text = yn.myrec.Fields("影片介绍")
    Me.txtinfo(12).Text = yn.myrec.Fields("总数")
    Call yn.closedb
    Call yn.opendb("select * from 演员 where 影片编号='" & Me.txtinfo(0).Text & "'")
    Do While Not yn.myrec.EOF
      Me.lstinfo.AddItem yn.myrec.Fields("演员").Value
      yn.myrec.MoveNext
    Loop
    Call yn.closedb
    Call yn.opendb("select * from 客户日志 where 客户姓名='" & Me.txtselect(1).Text & "' and 影片编号='" & Me.txtinfo(0).Text & "'")
    If Not yn.myrec.EOF Then
      Me.Text1.Text = yn.myrec.Fields("借出时期")
      Call yn.closedb
    Else
      Call yn.closedb
    End If
  End If

End Sub

Private Sub selema_Click()

  msg = "管理员查询"
  manger.Show vbModal

End Sub

Private Sub seleuser_Click()

  msg = "查询会员"
  user.Show vbModal

End Sub

Private Sub setf_Click()

   setff.Show vbModal

End Sub

Private Sub store_Click()
  
  Dim bi As BROWSEINFO '声明必要的变量
  Dim rtn&, pidl&, path$, pos%, t%, SpecIn$, specout$
  bi.hOwner = Me.hwnd '使对话框处于屏幕中心
  bi.lpszTitle = "请选择文件夹........" '设置标题文字
  bi.ulFlags = BIF_RETURNONLYFSDIRS '返回文件夹的类型
  pidl& = SHBrowseForFolder(bi) '显示对话框
  path = Space(512) '设置字符数的最大值
  t = SHGetPathFromIDList(ByVal pidl&, ByVal path) '获得所选的路径
  pos% = InStr(path$, Chr$(0)) '从字符串中提取路径
  SpecIn$ = Left(path$, pos - 1)
  If Right$(SpecIn, 1) = "\" Then
    specout$ = SpecIn$
  Else
    specout$ = SpecIn$ & "\"
  End If
 VBA.FileCopy specout$ & "cd.mdb", App.path & "\cd.mdb"

End Sub

Private Sub TabStrip1_Click()
  
  Me.Label1.Caption = Me.TabStrip1.SelectedItem.Caption
  Select Case Me.TabStrip1.SelectedItem.Index
    Case Is = "1"
      msg = "销售音像"
      Me.txtinfo(0).Text = ""
      Me.txtinfo(1).Text = ""
      Me.txtinfo(3).Text = ""
      Me.txtinfo(4).Text = ""
      Me.txtinfo(5).Text = ""
      Me.txtinfo(6).Text = ""
      Me.txtinfo(8).Text = ""
      Me.txtinfo(9).Text = ""
      Me.txtinfo(7).Text = ""
      Me.txtinfo(12).Text = ""
      Me.lstinfo.Clear
      Me.Label2.Visible = False
      Me.Text1.Visible = False
      
    Case Is = "2"
      msg = "出租音像"
      Me.txtinfo(0).Text = ""
      Me.txtinfo(1).Text = ""
      Me.txtinfo(3).Text = ""
      Me.txtinfo(4).Text = ""
      Me.txtinfo(5).Text = ""
      Me.txtinfo(6).Text = ""
      Me.txtinfo(8).Text = ""
      Me.txtinfo(9).Text = ""
      Me.txtinfo(7).Text = ""
      Me.txtinfo(12).Text = ""
      Me.lstinfo.Clear
      Me.Label2.Visible = False
      Me.Text1.Visible = False
      
    Case Is = "3"
      msg = "归还音像"
      Me.txtinfo(0).Text = ""
      Me.txtinfo(1).Text = ""
      Me.txtinfo(3).Text = ""
      Me.txtinfo(4).Text = ""
      Me.txtinfo(5).Text = ""
      Me.txtinfo(6).Text = ""
      Me.txtinfo(8).Text = ""
      Me.txtinfo(9).Text = ""
      Me.txtinfo(7).Text = ""
      Me.txtinfo(12).Text = ""
      Me.lstinfo.Clear
      Me.Label2.Visible = True
      Me.Text1.Visible = True
  End Select
   


End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

 Select Case Button.Index
   Case 1
     msg = "音像查询"
     cdm.Show vbModal
   Case 4
     load.Show vbModal
   Case 2
     msg = "查询会员"
     user.Show vbModal
   Case 3
     sp.Show vbModal
     
 End Select

End Sub



Private Sub vcbcvb_Click()

  msg = "删除音像"
  cdm.Show vbModal

End Sub

Private Sub xcvxcv_Click()
  helpf.Show vbModal
End Sub

Private Sub xsgp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

 Me.pd.ForeColor = vbBlack


End Sub
上一页 1 23
💿 文件大小 175 K
👤 上传用户 lwsnsfp17
📂 所属分类其他数据库
🏷️ 相关标签

#销售 #管理系统
⌨️ 快捷键说明

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