main.bas

美容院管理系统

Attribute VB_Name = "mymain"
Public AppPath As String
Public byk_maxno As String
Public lck_maxno As String
Public mfbyk_maxno As String
Public mfxj_maxno As String
Public mfsj_maxno As String
Public lygxj_maxno As String
Public hzpxj_maxno As String
 Public hzpsj_maxno As String
Public dcsj_maxno As String
Public dcxj_maxno As String
Public jjj As Integer
Public ttt As Boolean
Public Pczy As String
Public db As Database
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 '打印
 Public nj As String '三
Public js As String '1997
Public lj As String 'path
Public yh As String
Public nj_alb As String
Public kkk(13) As String
'Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
 'Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public njws As String
Public xws As String
Public zyws As String
Public bjws As String
Public xhws As String
Public xhzws As String
Public dynr() As String
Public dyys As Integer '打印页数
Public dqys As Integer
Public dqwz_vscroll As Integer
Public dqwz_hscroll As Integer
Public ym_fontname As String
Public ym_fontsize As String
Public ym_fontbold As String
 Public ym_fontitalic As String
 Public ym_fontunderline As String
Public ym_nr As String
Public yw_nr As String
 Public zw_fontname As String
 Public zw_fontsize As String
 Public zw_fontbold As String
 Public zw_fontitalic As String
 Public zw_fontunderline As String
  Public yw_fontname As String
 Public yw_fontsize As String
 Public yw_fontbold As String
 Public yw_fontitalic As String
 Public yw_fontunderline As String
 Public bt_fontbold As String
 Public color_ym As String
 Public color_yw As String
 Public color_zw As String
 Public color_bg As String
 Public grid_print As String
 Public grid_sx As String
 Public grid_hx As String
 Public grid_spjz As String
 Public grid_czjz As String
 Public grid_zbj As String
 Public grid_dbj As String
 Public grid_width As String
 Public zw_dyhs As String '正文打印行数
 Public ymyw_ym_print As String
 Public ymyw_ym_center As String
 Public ymyw_ym_zbj As String
 Public ymyw_ym_dbj As String
 
 Public ymyw_yw_print As String
 Public ymyw_yw_center As String
 Public ymyw_yw_zbj As String
 Public ymyw_yw_dbj As String
 
 Public ymyw_date As String
 Public ymyw_time As String
 
 Public ymyw_ys As String
 Public ymyw_ys_ys As String
 Public ymys_ys_dbj As String
 Public paper_size As String
 Public paper_height As String
 Public paper_width As String


Private Sub print_glq_zw(n As Integer, s As String)
 With print_frm
   Load .zw_label(n)
   .zw_label(n) = s
   .zw_label(n).Visible = True
 End With
End Sub
Private Sub print_glq_bt(ByVal n As Integer, s As String)
 With print_frm
   Load .bt_label(n)
   .bt_label(n) = s
   .bt_label(n).Visible = True
 End With
End Sub

Public Sub dytr_main(ByVal Form As Form, nnn As Integer, title As String, ym_dy As String)
 If print_frm.Visible Then
   MsgBox "打印管理器已经运行，请关闭后再执行该程序", vbOKOnly + vbInformation, "提示"
  Exit Sub
  End If
  Form.MousePointer = 11
  Load print_frm
  print_frm.Caption = print_frm.Caption + "----" + title
  ym_nr = ym_dy
  Select Case nnn
  Case 1
        n = Form.ListView1.ColumnHeaders.Count
  Case 2
   n = Form.ListView2.ColumnHeaders.Count
  Case 3
     n = Form.ListView3.ColumnHeaders.Count
  End Select
  For i = 1 To n
     Select Case nnn
     Case 1
     print_glq_bt i, Form.ListView1.ColumnHeaders(i).Text
     Case 2
     print_glq_bt i, Form.ListView2.ColumnHeaders(i).Text
     Case 3
    print_glq_bt i, Form.ListView3.ColumnHeaders(i).Text
    End Select
  Next i
  Select Case nnn
  Case 1
  m = Form.ListView1.ListItems.Count
  Case 2
  m = Form.ListView2.ListItems.Count
  Case 3
  m = Form.ListView3.ListItems.Count
  End Select
  ReDim dynr(m * n) As String
  If m Mod Val(zw_dyhs) = 0 Then
     dyys = m \ Val(zw_dyhs)
  Else
     dyys = m \ Val(zw_dyhs) + 1
  End If
  For i = 0 To m - 1
    For j = 0 To n - 1
        If j = 0 Then
          Select Case nnn
          Case 1
          dynr(i * n + j + 1) = Form.ListView1.ListItems(i + 1).Text
          Case 2
          dynr(i * n + j + 1) = Form.ListView2.ListItems(i + 1).Text
          Case 3
          
         dynr(i * n + j + 1) = Form.ListView3.ListItems(i + 1).Text
         End Select
         If (i * n + j + 1) <= n * Val(zw_dyhs) Then
             print_glq_zw i * n + j + 1, dynr(i * n + j + 1)
         End If
        Else
        Select Case nnn
        Case 1
        dynr(i * n + j + 1) = Form.ListView1.ListItems(i + 1).ListSubItems(j)
        Case 2
        dynr(i * n + j + 1) = Form.ListView2.ListItems(i + 1).ListSubItems(j)
        Case 3
         dynr(i * n + j + 1) = Form.ListView3.ListItems(i + 1).ListSubItems(j)
         End Select
        If (i * n + j + 1) <= n * Val(zw_dyhs) Then
             print_glq_zw i * n + j + 1, dynr(i * n + j + 1)
         End If
        End If
     Next j
  Next i
  For i = 1 To n
    drbg i, False
  Next i
  For i = 1 To Val(zw_dyhs) + 1
     drbg i, True
  Next i
  print_frm.Show
  Form.MousePointer = 0
End Sub
Private Sub drbg(ByVal m As Integer, h As Boolean)
   With print_frm
     If h Then
        Load .h_line(m)
        .h_line(m).Visible = True
        
     Else
        Load .s_Line(m)
        .s_Line(m).Visible = True
     End If
   End With
End Sub

Private Sub main()
On Error GoTo myerr
byk_maxno = GetSetting(App.title, "Options", "byk_maxno", "0")
lck_maxno = GetSetting(App.title, "Options", "lck_maxno", "0")
mfbyk_maxno = GetSetting(App.title, "Options", "mfbyk_maxno", "0")
mfxj_maxno = GetSetting(App.title, "Options", "mfxj_maxno", "0")
mfsj_maxno = GetSetting(App.title, "Options", "mfsj_maxno", "0")
lygxj_maxno = GetSetting(App.title, "Options", "lygxj_maxno", "0")
hzpxj_maxno = GetSetting(App.title, "Options", "hzpxj_maxno", "0")
hzpsj_maxno = GetSetting(App.title, "Options", "hzpsj_maxno", "0")
dcsj_maxno = GetSetting(App.title, "Options", "dcsj_maxno", "0")
dcxj_maxno = GetSetting(App.title, "Options", "dcxj_maxno", "0")
AppPath = App.Path + "\"
frm_Splash.Show 1
Set db = OpenDatabase(AppPath + "datas\mry.mdb", True, False, ";PWD=miracle")
frm_main.Show
frm_login.Show 1


If GetSetting(App.title, "Options", "在启动时显示提示", 1) = 1 Then
   frm_tip.Show 1
Else
End If
'送花提醒
Dim rec As Recordset
sdfjks = False

n = GetSetting(App.title, "Options", "送花提醒", "3")
sqlstr = "select * from 客户表 where 是否已送花='否'"
Set rec = db.OpenRecordset(sqlstr)

Do While Not rec.EOF
    mm = Trim(Str(Month(rec.Fields("生日"))))
    dd = Trim(Str(Day(rec.Fields("生日"))))
    yy = Trim(Str(Year(Date)))
    ymd = yy + "-" + mm + "-" + dd
   
    If (CDate(ymd) - n <= Date) And (CDate(ymd) >= Date) Then
            sdfjks = True
    End If
    rec.MoveNext
Loop
rec.Close
Set rec = Nothing

If sdfjks = True Then
    

    frm_shtx.Show
End If
'送花提醒
Exit Sub
myerr:
 MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
 End
End Sub
Public Sub frmcen(f As Form)
f.Move (frm_main.ScaleWidth - f.Width) / 2, (frm_main.ScaleHeight - f.Height) / 2
End Sub