frmmain.frm

用于电子行业打印复杂报表格式和不干胶标签

  
  '**初始化ADO对象，用于储存操作记录，还有待于优化
  Set rsMain = New ADODB.Recordset    '先利用 rsMain 获得有关系数
  rsMain.CursorType = adOpenKeyset
  rsMain.LockType = adLockOptimistic
  
  Set rsPrint = New ADODB.Recordset    '用于报表的打印
  rsPrint.CursorType = adOpenKeyset
  rsPrint.LockType = adLockOptimistic
   
  rsMain.Open "Select * From 系统日志", cnSys  '用Open打开表
End Sub

Private Sub LoadNewDoc()
  Static lDocumentCount As Long
  Dim frmD As frmDocument
  lDocumentCount = lDocumentCount + 1
  Set frmD = New frmDocument
  frmD.Caption = "文档 " & lDocumentCount
  frmD.Show
  frmD.Move 1000, 500, 9000, 5500      '调整位置及大小
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
  If Me.WindowState <> vbMinimized Then
    SaveSetting App.Title, "Settings", "MainLeft", Me.Left
    SaveSetting App.Title, "Settings", "MainTop", Me.Top
    SaveSetting App.Title, "Settings", "MainWidth", Me.Width
    SaveSetting App.Title, "Settings", "MainHeight", Me.Height
  End If
End Sub

Private Sub mnuabfw_Click()
  Doitem ("安标范围管理")
  frmabfw.Show
End Sub

Private Sub mnuabgl_Click()
  Doitem ("安标管理")
  frmabgl.Show
End Sub

Private Sub mnuAutoBackup_Click()
  Doitem ("定时备份")
  MsgBox "该功能是通过在服务器上设置的！", 0 = 64, "信息窗"
End Sub

Private Sub mnubqprint_Click()
  Doitem ("标签打印")
  frmbqdy.Show
End Sub

Private Sub mnubqsl_Click()
  Doitem ("标签数量管理")
  frmbqsl.Show
End Sub

Private Sub mnuddsj_Click()
  Doitem ("生产任务管理")
  frmScrw.Show
End Sub

Private Sub mnuexit_Click()
  '卸载窗体
  Doitem ("退出系统")
  If MsgBox("真的要关闭本系统吗(Y/N)？", vbYesNo + vbQuestion, "关闭系统", 0, 0) = vbYes Then
    
    rsMain.Close
    Set rsMain = Nothing    '清除设置的变量
    Set rsTmp = Nothing
    Set rsPrint = Nothing
    
    cnSys.Close
    Set cnSys = Nothing
    Set fMainForm = Nothing
    Unload Me
    End
  End If
End Sub

Private Sub mnuhb_Click()
  Doitem ("环标数据管理")
  frmhb.Show
End Sub

Private Sub mnuManuBackup_Click()
  Doitem ("手工备份")
  frmBackup.Show
End Sub

Private Sub mnuFaxMail_Click()
  Doitem ("发送邮件")
  Dim sadd As String
  Dim nRet As Integer
  
  On Error Resume Next
  sadd = "mailto: "
  '一定得赋值,即使不会用到该返回值
  nRet = ShellExecute(GetDesktopWindow(), "Open", sadd, " ", "", SW_SHOWNORMAL)
  If Err Then
    MsgBox Err.Description
  End If
End Sub

Private Sub mnuOrganDat_Click()
  Doitem ("器件资料")
  frmOrganDat.Show
End Sub

Private Sub mnuOrganEdt1_Click()
  Doitem ("测试记录(一)")
  frmOrganEdt1.Show
End Sub

Private Sub mnuOrganEdt2_Click()
  If UserRole = "批准者" Then
    Doitem ("测试记录(二)")
    frmOrganEdt2.Show
  Else
    MsgBox "对不起！您不能使用本模块。", 0 + 16, "提示窗"
    Exit Sub
  End If
End Sub

Private Sub mnuOrganPrn_Click()
  Doitem ("记录打印")
  frmOrganPrn.Show
End Sub

Private Sub mnuPeopSet_Click()
  Doitem ("人员设置")
  frmPeopSet.Show
End Sub

Private Sub mnupn_Click()
  Doitem ("PN表管理")
  frmpnb.Show
End Sub


Private Sub mnuprint_Click()
  Doitem ("打印机纸张类型")
  frmprint.Show
End Sub

Private Sub mnuPswdChg_Click()
  Doitem ("密码更改")
  If UserRole = "系统管理员" Then  '系统管理员可修改所有用户的密码
    frmChgPswd.Show
  Else
    frmPswdChg.Show  '用户只能改变自己的密码
  End If
End Sub

Private Sub mnuPurviewSet_Click()
  Doitem ("权限设置")
  frmPurveSet.Show
End Sub

Private Sub mnuRelogin_Click()
  Dim i As Integer
  
  Doitem ("重新登录")
  frmRelogin.Show vbModal, Me
  
  sbStatusBar.Panels(2).Text = "当前用户： " + UserName
  
  rsTmp.Open "Select * From 用户权限", cnSys
  rsTmp.Find "用户帐号='" & UserName & "'"
  If IsNull(rsTmp("使用模块")) Or IsEmpty(rsTmp("使用模块")) Then
    PurvString = "111111111111111"  '缺省值为拥有所有模块
  Else
    PurvString = Trim(rsTmp("使用模块"))
  End If
  rsTmp.Close
  
  For i = 1 To Len(PurvString)
    If Mid(PurvString, i, 1) = "1" Then
      Call MenuButtSet(i, True)
    Else
      Call MenuButtSet(i, False)
    End If
  Next i
  
End Sub

Private Sub mnuRestore_Click()
  Doitem ("数据恢复")
  frmRestore.Show
End Sub

Private Sub mnuHelpTopic_Click()
  Dim nRet As Integer

  '如果这个工程没有帮助文件，显示消息给用户
  '可以在“工程属性”对话框中为应用程序设置帮助文件
  If Len(App.HelpFile) = 0 Then
    MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
  Else
    On Error Resume Next
    nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
    If Err Then
      MsgBox Err.Description
    End If
  End If
End Sub

Private Sub mnuHelpWhat_Click()
  Dim nRet As Integer

  '如果这个工程没有帮助文件，显示消息给用户
  '可以在“工程属性”对话框中为应用程序设置帮助文件
  If Len(App.HelpFile) = 0 Then
    MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
  Else
    On Error Resume Next
    nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
    If Err Then
      MsgBox Err.Description
    End If
  End If
End Sub

Private Sub mnuSystemlog_Click()
  Doitem ("系统日志")
  frmSystemlog.Show
End Sub

Private Sub mnuxjbab_Click()
  Doitem ("新加坡安标")
  frmxjbab.Show
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
'工具条
  On Error Resume Next
  Select Case Button.Key
    Case "退出系统"
      mnuProgExit_Click
    Case "标签打印"
      mnubqprint_Click
    Case "人员设置"
      mnuPeopSet_Click
    Case "权限设置"
      mnuPurviewSet_Click
    Case "密码更改"
      mnuPswdChg_Click
    Case "重新登录"
      mnuRelogin_Click
    Case "系统日志"
      mnuSystemlog_Click
  End Select
End Sub

Private Sub mnuHelpAbout_Click()
  frmAbout.Show
End Sub

Private Sub mnuViewStatusBar_Click()
  mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
  sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
  mnuViewToolBar.Checked = Not mnuViewToolBar.Checked
  tbToolBar.Visible = mnuViewToolBar.Checked
End Sub

Private Sub mnuProgExit_Click()
  '卸载窗体
  Doitem ("退出系统")
  If MsgBox("真的要关闭本系统吗(Y/N)？", vbYesNo + vbQuestion, "关闭系统", 0, 0) = vbYes Then
    
    rsMain.Close
    Set rsMain = Nothing    '清除设置的变量
    Set rsTmp = Nothing
    Set rsPrint = Nothing
    
    cnSys.Close
    Set cnSys = Nothing
    Set fMainForm = Nothing
    Unload Me
    End
  End If
End Sub

Private Sub mnuFilePageSetup_Click()
  On Error Resume Next
  
  Doitem ("页面设置")
  With dlgCommonDialog
    .DialogTitle = "页面设置"
    .CancelError = True
    .ShowPrinter
  End With
End Sub

'**根据权限模块设置菜单及按钮。注：分隔符也算一个 index,第一个按钮的 index=1
Private Sub MenuButtSet(k As Integer, byesno As Boolean)
  Select Case k
    Case 1
    '  mnuOrganEdt1.Enabled = byesno
    '  tbToolBar.Buttons(3).Enabled = byesno
    Case 2
    '  mnuOrganEdt2.Enabled = byesno
    '  tbToolBar.Buttons(4).Enabled = byesno
    Case 3
    '  mnuOrganPrn.Enabled = byesno
    '  tbToolBar.Buttons(5).Enabled = byesno
    Case 4
    '  mnuFaxMail.Enabled = byesno
    '  tbToolBar.Buttons(6).Enabled = byesno
    Case 5
    '  mnuFilePageSetup.Enabled = byesno
    Case 6
    '  mnuProgExit.Enabled = byesno
    '  tbToolBar.Buttons(1).Enabled = byesno
    Case 7
    '  mnuOrganDat.Enabled = byesno
    '  tbToolBar.Buttons(8).Enabled = byesno
    Case 8
    '  mnuPeopSet.Enabled = byesno
    '  tbToolBar.Buttons(9).Enabled = byesno
    Case 9
   '   mnuPurviewSet.Enabled = byesno
    '  tbToolBar.Buttons(10).Enabled = byesno
    Case 10
    '  mnuPswdChg.Enabled = byesno
    '  tbToolBar.Buttons(11).Enabled = byesno
    Case 11
    '  mnuRelogin.Enabled = byesno
    '  tbToolBar.Buttons(13).Enabled = byesno
    Case 12
    '  mnuAutoBackup.Enabled = byesno
    Case 13
   '   mnuManuBackup.Enabled = byesno
    Case 14
   '   mnuRestore.Enabled = byesno
    Case 15
   '   mnuSystemlog.Enabled = byesno
    '  tbToolBar.Buttons(14).Enabled = byesno
  End Select
End Sub

'**记录使用者操作模块的信息
Private Sub Doitem(menuitem As String)
  rsMain.AddNew
  rsMain("日期") = Date
  rsMain("时间") = Time
  rsMain("用户帐号") = UserName
  rsMain("用户角色") = UserRole
  rsMain("使用模块") = menuitem
  rsMain.Update
  rsMain.Requery
End Sub