frm_main.frm

美容院管理系统

      Begin VB.Menu ckpl 
         Caption         =   "窗口横排(&H)"
         Index           =   1
      End
      Begin VB.Menu ckpl 
         Caption         =   "窗口竖排(&S)"
         Index           =   2
      End
      Begin VB.Menu s8 
         Caption         =   "-"
      End
      Begin VB.Menu bjys 
         Caption         =   "背景颜色...(&O)"
      End
   End
   Begin VB.Menu bz 
      Caption         =   "帮助(&H)"
      Begin VB.Menu ztbz 
         Caption         =   "主题帮助(&H)"
         Shortcut        =   {F1}
      End
      Begin VB.Menu gy 
         Caption         =   "关于...(&A)"
      End
   End
End
Attribute VB_Name = "frm_main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public db As Database
Private Sub bjtp_Click()
End Sub

Private Sub bfhf_Click()
frm_bfhf.Show 1
End Sub

Private Sub bjys_Click()

CommonDialog1.CancelError = True
On Error GoTo myerr
CommonDialog1.Color = Me.BackColor
CommonDialog1.ShowColor

Me.BackColor = CommonDialog1.Color
If MsgBox("下次启动时是否使用该颜色作背景？", vbYesNo + vbQuestion, "提示") = vbNo Then
Else
SaveSetting App.title, "Options", "backcolor", Me.BackColor
End If
Exit Sub
myerr:
    
End Sub

Private Sub byk_Click()
Unload frm_bykgl
jjj = 0
frm_bykgl.Show
End Sub

Private Sub byxm_Click()
frm_yhgz.Show 1
End Sub

Private Sub ckpl_Click(Index As Integer)
For i = 0 To 2
   
   ckpl(i).Checked = False
   Next i

ckpl(Index).Checked = True

Me.Arrange Index
End Sub

Private Sub czy_Click()
frm_czy.Show
End Sub

Private Sub dccz_Click()
frm_dcczgl.Show
End Sub

Private Sub dwzc_Click()
frm_zc.Show
End Sub

Private Sub dysz_Click()
On Error GoTo printerr
     CommonDialog1.ShowPrinter
Exit Sub
printerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub

Private Sub gy_Click()
frm_about.Show 1
End Sub

Private Sub hzp_Click()
frm_hzp.Show
End Sub

Private Sub hzpkc_Click()
frm_hzpkc.Show
End Sub

Private Sub hzprk_Click()
frm_hzprk.Show 1
End Sub

Private Sub hzprkcx_Click()
frm_hzprkcx.Show
End Sub

Private Sub jl_Click()
frm_jl.Show 1
End Sub

Private Sub jsq_Click()
On Error GoTo myerr
Dim s As String * 80
Dim length As Long
Dim winpath As String
length = GetWindowsDirectory(s, Len(s))
winpath = Left(s, length)
clc = winpath + "\calc.exe"
Shell clc, vbNormalFocus
Exit Sub
myerr:
  MsgBox "系统没有计算器程序", vbInformation + vbOKOnly, "提示"
End Sub

Private Sub jsryzj_Click()
frm_jsryzj.Show
End Sub

Private Sub krcx_Click()

End Sub

Private Sub khb_Click()
End Sub

Private Sub lck_Click()
Unload frm_bykgl
jjj = 1
frm_bykgl.Show
End Sub

Private Sub MDIForm_Load()
Set db = OpenDatabase(AppPath + "datas\mry.mdb", True, False, ";PWD=miracle")
Me.StatusBar1.Panels(4).Text = Format(Date, "yyyy-mm-dd")
Me.BackColor = GetSetting(App.title, "Options", "backcolor", "8421504")
Me.Caption = "『美容院管理系统』— " + GetSetting(App.title, "Options", "user", "沈阳市第七人民医院高级医学美容院")
Me.rjyl.Checked = GetSetting(App.title, "Options", "在启动时显示提示", 1)
gy.Caption = "关于 " + App.title + "..."
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
yn = MsgBox("真的想退出『美容院管理系统』吗？", vbYesNo + vbQuestion, "提示")
If yn = vbNo Then
   Cancel = True
Else
  
End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
On Error GoTo jgqerr
Unload frm_graph
 Unload print_frm
  Unload ymsz_frm
db.Close
Set db = Nothing
Exit Sub
jgqerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub

Private Sub mfbyk_Click()
Unload frm_bykgl
jjj = 2
frm_bykgl.Show
End Sub

Private Sub mmsg_Click()
frm_mmxg.Show 1
End Sub

Private Sub mrs_Click()
frm_mrs.Show
End Sub

Private Sub mrsyzj_Click()
frm_mrszj.Show
End Sub

Private Sub rgzl_Click()
frm_rbbtj.Show
End Sub

Private Sub rjyl_Click()
frm_tip.Show 1
End Sub

Private Sub rl_Click()
frm_rl.Show 1
End Sub

Private Sub shtx_Click()
frm_shtx.Show
End Sub

Private Sub sk_Click()
frm_sk.Show
End Sub

Private Sub srtj_Click()
frm_srcx.Show
End Sub

Private Sub tc_Click()
Unload frm_main

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "jsq"
    jsq_Click
Case "bjys"
    bjys_Click
Case "xgrq"
    rl_Click
Case "bzzt"
   ztbz_Click
Case "tcxt"
    tc_Click
End Select
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "czy"
    czy_Click
Case "mrs"
    mrs_Click
Case "bfhf"
    bfhf_Click
Case "byk"
    byk_Click
Case "dccz"
    dccz_Click
Case "srcx"
    srtj_Click
    
Case "bbdy"
         rgzl_Click
End Select
End Sub

Private Sub xk_Click()
On Error GoTo myerr
clc = App.Path + "\xk\LK602W.exe"
Shell clc, vbNormalFocus
Exit Sub
myerr:
  MsgBox "系统没有写卡程序", vbInformation + vbOKOnly, "提示"
End Sub

Private Sub xmsf_Click()
frm_xmsf.Show
End Sub

Private Sub xmxm_Click(Index As Integer)
 yn = MsgBox("真的想全部删除" + xmxm(Index).Caption + "记录吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示")
    If yn = vbNo Then
        Exit Sub
    End If
    If Index <> 7 Then
        sqlstr = "delete * from 单次处置表 where 类别='" + xmxm(Index).Caption + "'"
    Else
        sqlstr = "delete * from 单次处置表"
    End If
    db.Execute sqlstr
    
    Select Case Index
    Case 0
        dcsj_maxno = "0"
    Case 1
        dcxj_maxno = "0"
    Case 2
        hzpsj_maxno = "0"
    Case 3
        hzpxj_maxno = "0"
    Case 4
        mfsj_maxno = "0"
    Case 5
        mfxj_maxno = "0"
    Case 6
        lygxj_maxno = "0"
    Case 7
        dcsj_maxno = "0"
   
        dcxj_maxno = "0"
   
        hzpsj_maxno = "0"
   
        hzpxj_maxno = "0"
   
        mfsj_maxno = "0"
   
        mfxj_maxno = "0"
   
        lygxj_maxno = "0"
    
    End Select
    frm_dcczgl.ss

End Sub

Private Sub ylzpcx_Click()
frm_ylzpcx.Show
End Sub

Private Sub ztbz_Click()
If Dir(AppPath + "美容院help.hlp") = "" Then
    MsgBox "您没有安装主题帮助，请向开发商购买！", vbOKOnly + vbCritical, "错误"
    Exit Sub
End If
CommonDialog1.HelpFile = AppPath + "美容院help.hlp"
CommonDialog1.HelpCommand = cdlHelpContents
CommonDialog1.ShowHelp
End Sub

Private Sub zx_Click()
Load frm_login
frm_login.Caption = Left(zx.Caption, Len(zx.Caption) - 4)
frm_login.Show 1
End Sub