module1.bas

汽修厂管理软件

Attribute VB_Name = "Module1"


Public WKSGRG As Workspace
Public DBSGRG As Database
Public CNTGRG As Connection
Public mrsFormRecordset As Recordset
Global DBPATH As String
Global SYSTEMDBPATH As String
Dim pmCURRENTCARNumber As Parameter
Global STRCURRENTCARNUMBER As String
Public Const TblFinance = "财务登记表"
Public Const TblCarType = "车型表"
Public Const TblWareHouse = "库存表"
Public Const TblCarRecord = "来车登记表"
Public Const TblHardWare = "设备表"
Public Const TblFixRecord = "维修记录表"
Public Const TblFixPrice = "维修价格表"
Public Const TblWorkers = "职员表"
Public Const TblWait = "待修表"
Public Const TblColor = "颜色表"
Public Const WORKPATH = "d:\kcs"

Public Const TtlFinance = "财务登记表"
Public Const TtlCarType = "车型表"
Public Const TtlWareHouse = "库存表"
Public Const TtlCarRecord = "来车登记表"
Public Const TtlHardWare = "设备表"
Public Const TtlFixRecord = "维修记录表"
Public Const TtlFixPrice = "维修价格表"
Public Const TtlWorkers = "职员维护"
Public Const TtlWait = "待修表"
Public Const WRITEPART = 1 '写入待修表的选项,用于Writetotable函数中使用
Public Const WRITELABOR = 2
Global STRGARAGE As String '定义车行名
Global STRGRGINFO As String '定义车行的信息
Public Const KcsBuyPart = 1 '在仓管中part_inout()中使用
Public Const KcsSalePart = 2
Public Const KcsBackPart = 3
Public Const KcsDisCardPart = 4
Public Const KcsForWeiXiu = 5
Public Const KcsAdd = 6
Public Const KcsShowAllPart = 0
Public Const KcsShowNeedPart = 1
Public Const KcsShowExistPart = 2
Public Const KcsShowDeducePart = 3

Global strOkorEsc As String

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As Any, ByVal cbData As Long) As Long        ' Note that if you declare the lpData parameter as String, you must pass it By Value.

 Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Const HKEY_CLASSES_ROOT = -2147483648#
Public Const HKEY_CURRENT_USER = -2147483647#
Public Const HKEY_LOCAL_MACHINE = -2147483646#
Public Const HKEY_USERS = -2147483645#
Public Const UsersTable = ";hwHy?+r]Kk65$)97,.ttrRD"
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerial_Numberber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public Const GETDI_SERIAL = 1
Public Const GETDI_LABEL = 2
Public Const GETDI_TYPE = 3


'键值类型
Public Const REG_SZ = 1&           '字符串值
Public Const REG_BINARY = 3&       '二进制值
Public Const REG_DWORD = 4&        'DWORD 值
Global IsRegistered As Boolean


Function GetDriveInfo(strDrive As String, iType As Integer)
    
    Dim Serial_Number As Long
    Dim Drive_Label As String
    Dim Fat_Type As String
    
    Dim Return_Value As Long
    
    Drive_Label = Space(256)
    Fat_Type = Space(256)
    
    Return_Value = GetVolumeInformation(strDrive, Drive_Label, Len(Drive_Label), Serial_Number, 0, 0, Fat_Type, Len(Fat_Type))
    
    GetDriveInfo = CStr(Serial_Number)

End Function




'待修表中维修项目是一个MEMO型,它含盖了维修项目\所需耗材名称\所需耗材编号\所需耗材价格\所需耗材折扣
'                                          \人工\人工价格\人工折扣\班组\质量负责人\保修期
'格式为:<<PART:xxx><TYPE:xxx><PNUM:xxx><PPRICE:111><PDISC:0.xx>>
'       <<LBR:xxx><LPRICE:111><LDISC:0.xx><UNIT:xxx><Q:XXX><DURING:XXX>>
'其中\所需耗材名称\所需耗材编号\所需耗材价格\所需耗材折扣 可以重复
'----------------------------------

'将Grid_SelectedPart中所选的零配件按规定格式写入待修表中
'在Frm_AddPart中使用
Function WriteToTBLWait(MGrid As MSFlexGrid, WriteOpnion As Integer) As Boolean

  Dim intGridRows As Integer
  Dim intFlagRow As Integer
  Dim intFlagCol As Integer
  Dim strLine As String
  Dim strEach() As String
  Dim intColLimit As Integer
  Dim strTitle() As String
  Dim mRsWaiting As Recordset
  Dim intRsCount As Integer
  Dim strMemo As String
  Dim strFieldName As String
  ' 如果WriteOpnion=1 则写零配件部分 ;如果WriteOpnion=2 则写人工部分
' On Error GoTo ERRORHANDLE
  If WriteOpnion = 1 Then
       intColLimit = 6
       Else
       intColLimit = 7
  End If
  ReDim strEach(intColLimit)
  ReDim strTitle(intColLimit)
  If WriteOpnion = 1 Then
            strTitle(0) = "PI" '编号
            strTitle(1) = "PT" '零配件名称
            strTitle(2) = "PP" '零配件型号
            strTitle(3) = "PN" '零配件数量
            strTitle(4) = "PR" '零配件价格
            strTitle(5) = "PD" '零配件折扣
            
     Else
            strTitle(0) = "LB" '人工项目名称
           
            strTitle(1) = "LU" '班组名称
            strTitle(2) = "LQ" '质量负责人
            strTitle(3) = "LC" '人工折扣LD
            strTitle(4) = "LD" '外加工费用
             strTitle(5) = "LP" '人工价格
            strTitle(6) = "LR" '保修期
            
  End If
  
  intGridRows = MGrid.Rows
  '打开待修表
  
    Set mRsWaiting = DBSGRG.OpenRecordset("Select *  from " & TblWait & " where 车牌 = '" & STRCURRENTCARNUMBER & "'", dbOpenDynaset)
        intRsCount = mRsWaiting.Fields.Count
   strMemo = ""
  For intFlagRow = 1 To intGridRows - 1
    strLine = ""
    For intFlagCol = 0 To intColLimit - 1
         strEach(intFlagCol) = strTitle(intFlagCol) & MGrid.TextMatrix(intFlagRow, intFlagCol)
         strLine = strLine & strEach(intFlagCol)
    Next intFlagCol
    strLine = "<" & strLine & ">"
    strMemo = strMemo & strLine
  Next intFlagRow
    
    mRsWaiting.Edit
    mRsWaiting.Fields(intRsCount - WriteOpnion - 1) = strMemo
    mRsWaiting.Update
  WriteToTable = True
  mRsWaiting.Close
  'Exit Function
'ERRORHANFDLE:
 ' WriteToTable = False
End Function



Function ReadFromTBLWait(mRsWaiting As Recordset, MGrid As MSFlexGrid, strName As String) As Boolean
'strName :"材料" or  "人工"
  Dim intLineFlag As Integer
  Dim intLineFirst As Integer
  Dim intLineEnd As Integer
  Dim intFlagRow As Integer
  Dim intFlagCol As Integer
  Dim strLine As String
  Dim strEach() As String
  Dim intColLimit As Integer
  Dim strTitle() As String
 
  Dim intRsCount As Integer
  Dim strMemo As String
  Dim strPI As String
  Dim strPT As String
  Dim strPP As String
  Dim strPY As String
  Dim strPN As String
  Dim strPR As String  '零配件价格标志
  Dim strPD As String '零配件折扣标志
  
  Dim strLB As String '人工名称
  Dim strLP As String   '人工价格标志
  Dim strLU As String '班组名称标志
  Dim strLQ As String '质量负责人标志
  Dim strLC As String '外加公费
  Dim strLD  As String ' '人工折扣标志
  Dim strLR As String '保修期标志
  
  Dim strLineFirst3 As String
  Dim intPI As Integer
  Dim intPT As Integer
  Dim intPP As Integer
  Dim intPN As Integer
  Dim intPR As Integer
  Dim intPD As Integer
  
  Dim intLB As Integer
  Dim intLP As Integer
  Dim intLU As Integer
  Dim intLQ As Integer
  Dim intLC As Integer
  Dim intLD As Integer
  Dim intLR As Integer
  Dim intL As Integer
  Dim intP As Integer
  Dim intPositionP As Integer
  
  Dim strMemoEnd As String
  ReadFromTBLWait = False
  MGrid.Rows = 1 '清零
  MGrid.Rows = 1
 'On Error GoTo ERRORHANDLE
   ReDim strEach(intColLimit)
  ReDim strTitle(intColLimit)
           strPI = "<PI" '零配件名称标志
            strPT = "PT"
            strPP = "PP" '零配件型号标志
            strPN = "PN" '零配件数量标志
            strPR = "PR" '零配件价格标志
            strPD = "PD" '零配件折扣标志
            
            strLB = "<LB" '人工项目名称标志
            strLP = "LP" '人工价格标志
            strLU = "LU" '班组名称标志
            strLQ = "LQ" '质量负责人标志
            strLC = "LC" '外加工费
            strLD = "LD" '人工折扣标志
            strLR = "LR" '保修期标志
            strLineEnd = ">"
            strMemoEnd = "$%"
   '打开待修表
       intRsCount = mRsWaiting.Fields.Count
   If mRsWaiting.RecordCount > 0 Then
            strMemo = mRsWaiting.Fields(strName) & strMemoEnd
           ' mRsWaiting.Close
            If Len(strMemo) > 5 Then
            intLineFirst = 1
               Do
               strLineFirst3 = Mid(strMemo, 1, 3)
                intLineFirst = 1
               If strLineFirst3 = "<PI" Then
                '是零配件项目
                     intLineFirst = 4
                     intPT = InStr(1, strMemo, strPT)
                     intPP = InStr(1, strMemo, strPP)
                     intPN = InStr(1, strMemo, strPN)
                     intPR = InStr(1, strMemo, strPR)
                     intPD = InStr(1, strMemo, strPD)
                     intLineEnd = InStr(1, strMemo, strLineEnd)
                     intP = InStr(intLineFirst, strMemo, "P")
                     strLine = Mid(strMemo, intLineFirst, intP - intLineFirst)
                     If InStr(intPT + 2, strMemo, "P") > 0 Then
                         intP = InStr(intPT + 2, strMemo, "P")
                        Else
                         intP = InStr(intPT + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intPT + 2, intP - intPT - 2)
                     If InStr(intPT + 2, strMemo, "P") > 0 Then
                         intP = InStr(intPP + 2, strMemo, "P")
                        Else
                         intP = InStr(intPP + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intPP + 2, intP - intPP - 2)
                     If InStr(intPN + 2, strMemo, "P") > 0 Then
                         intP = InStr(intPN + 2, strMemo, "P")
                        Else
                         intP = InStr(intPN + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intPN + 2, intP - intPN - 2)
                     If InStr(intPR + 2, strMemo, "P") > 0 Then
                         intP = InStr(intPR + 2, strMemo, "P")
                        Else
                         intP = InStr(intPR + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intPR + 2, intP - intPR - 2)
                     
                      intP = InStr(intPD + 2, strMemo, ">")
                     
                     strLine = strLine & vbTab & Mid(strMemo, intPD + 2, intP - intPD - 2)
                     
                     MGrid.AddItem strLine
                  Else '是人工项目
                     intLineFirst = 4
                     intLP = InStr(1, strMemo, strLP)
                     intLU = InStr(1, strMemo, strLU)
                     intLQ = InStr(1, strMemo, strLQ)
                     intLC = InStr(1, strMemo, strLC)
                     intLD = InStr(1, strMemo, strLD)
                     intLR = InStr(1, strMemo, strLR)
                     intLineEnd = InStr(1, strMemo, strLineEnd)
                     If InStr(intLineFirst + 1, strMemo, "P") > 0 Then
                         intL = InStr(intLineFirst + 1, strMemo, "L")
                        Else
                         intL = InStr(intLineFirst + 1, strMemo, ">")
                     End If
                     strLine = Mid(strMemo, intLineFirst, intL - intLineFirst)
                      If InStr(intLU + 2, strMemo, "L") > 0 Then
                         intL = InStr(intLU + 2, strMemo, "L")
                        Else
                         intL = InStr(intLU + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intLU + 2, intL - intLU - 2)
                      If InStr(intLQ + 2, strMemo, "L") > 0 Then
                         intL = InStr(intLQ + 2, strMemo, "L")
                        Else
                         intL = InStr(intLQ + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intLQ + 2, intL - intLQ - 2)
                      If InStr(intLC + 2, strMemo, "L") > 0 Then
                         intL = InStr(intLC + 2, strMemo, "L")
                        Else
                         intL = InStr(intLC + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intLC + 2, intL - intLC - 2)
                      If InStr(intLD + 2, strMemo, "L") > 0 Then
                         intL = InStr(intLD + 2, strMemo, "L")
                        Else
                         intL = InStr(intLD + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intLD + 2, intL - intLD - 2)
                    If InStr(intLP + 2, strMemo, "L") > 0 Then
                         intL = InStr(intLP + 2, strMemo, "L")
                        Else
                         intL = InStr(intLP + 2, strMemo, ">")
                     End If
                     strLine = strLine & vbTab & Mid(strMemo, intLP + 2, intL - intLP - 2)
                      
                     
                         intL = InStr(intLR + 2, strMemo, ">")
                      strLine = strLine & vbTab & Mid(strMemo, intLR + 2, intL - intLR - 2)
                     
                     MGrid.AddItem strLine
                End If
                strMemo = Mid(strMemo, intLineEnd + 1)
                
            
              Loop Until strMemo = strMemoEnd
             ReadFromTBLWait = True
             End If
      Else
        MGrid.Rows = 1
       ' Grid_Labor.Rows = 1
 End If
    
    Exit Function
    
    
ERRORHANDLE:
    MsgBox (Err.Description)
    MGrid.Rows = 1
End Function

'从一个显示零配件的GRID控件中计算价格总额
Function sngSumFee(mgrid_Part As MSFlexGrid) As Single

Dim intCols As Integer
Dim intX As Integer
Dim intY As Integer
Dim sngF_dis '折扣因子
Dim sngF_Num '数量因子
Dim sngF_SPrice '单价
Dim sngF_CoPrice
sngSumFee = 0
  intCols = mgrid_Part.Cols
  intX = 0
sngF_dis = 100
sngF_CoPrice = 0
sngF_Num = 1
If mgrid_Part.Rows > 1 Then
     For intY = 1 To mgrid_Part.Rows - 1
        For intX = 0 To intCols - 1
          If mgrid_Part.TextMatrix(0, intX) = "单价" Or mgrid_Part.TextMatrix(0, intX) = "价格" Then
          sngF_SPrice = CSng(mgrid_Part.TextMatrix(intY, intX))
          End If
          If mgrid_Part.TextMatrix(0, intX) = "数量" Then sngF_Num = CSng(mgrid_Part.TextMatrix(intY, intX))
          If mgrid_Part.TextMatrix(0, intX) = "折扣" Then sngF_dis = CSng(mgrid_Part.TextMatrix(intY, intX))
          If mgrid_Part.TextMatrix(0, intX) = "外加工" Then sngF_CoPrice = CSng(mgrid_Part.TextMatrix(intY, intX))
          
        Next intX
        sngSumFee = sngSumFee + sngF_SPrice * sngF_Num * sngF_dis / 100 + sngF_CoPrice
     Next intY
  
  Else
   sngSumFee = 0
End If
End Function



Sub PrintJieSuan(mgrid_Part As MSFlexGrid, mGrid_Labor As MSFlexGrid, Left As Single _
                , Top As Single, Right As Single, Bottom As Single _
                , strMyInfo As String, sngIncome As Single, strDriver As String, inDate As Date, FixId As Long)
                'sngIncome:实际收到
                
'left为打印区的X坐标，top为打印区的Y坐标
Dim intRows  As Integer
Dim intMaxRows
Dim intPages As Integer
Dim strPart() As String