module1.bas

汽修厂管理软件

Dim strLabor() As String
Dim sngTabLeftPart(4) As Single
Dim sngTabLeftLabor(7) As Single
Dim intX As Integer
Dim intY As Integer
Dim Page_i As Integer
Dim Row_i As Integer
Dim sngCenter As Single '表的中线位置
Dim TabLeft As Single
Dim TabRight As Single
Dim tabTop As Single
Dim tabBottom As Single
Dim sngShouldIncome As Single '应收
TabLeft = Left + 2
TabRight = Right - 2
tabTop = 0.1789 * (Bottom - Top) + Top
tabBottom = 0.81 * (Bottom - Top) + Top
intMaxRows = (tabBottom - tabTop - 8) \ 4.5
intRows = mgrid_Part.Rows - 1
If mGrid_Labor.Rows > mgrid_Part.Rows Then intRows = mGrid_Labor.Rows
If intRows Mod intMaxRows > 0 Then
   intPages = intRows \ intMaxRows + 1
   Else
   intPages = intRows \ intMaxRows
End If

'ReDim strPart(mgrid_Part.Cols)
'ReDim strLabor(mGrid_Labor.Cols)
sngCenter = (TabLeft + TabRight) / 2
'设置单位
Printer.ScaleMode = vbMillimeters
 Printer.ScaleHeight = 99
 Printer.ScaleWidth = 210
 
 
sngTabLeftPart(0) = 0
sngTabLeftPart(1) = 0.253
sngTabLeftPart(2) = 0.493 + 0.253
sngTabLeftPart(3) = 0.113 + 0.253 + 0.493
sngTabLeftLabor(0) = 0
sngTabLeftLabor(2) = 0.4
sngTabLeftLabor(3) = 0.52
sngTabLeftLabor(4) = 0.64
sngTabLeftLabor(5) = 0.76
sngTabLeftLabor(6) = 0.88
 
For Page_i = 1 To intPages
'画四边的边框
Printer.DrawWidth = 8
Printer.Line (TabLeft, tabTop)-(TabRight, tabTop)
Printer.Line (TabLeft, tabTop)-(TabLeft, tabBottom)
Printer.Line -(TabRight, tabBottom)
Printer.Line -(TabRight, tabTop)
'画中竖线
Printer.DrawWidth = 8
Printer.Line ((TabLeft + TabRight) / 2, tabTop)-((TabLeft + TabRight) / 2, tabBottom)
'画第二条横线
Printer.DrawWidth = 2
Printer.Line (TabLeft, tabTop + 7)-(TabRight, tabTop + 7)



With Printer
.CurrentX = sngCenter - (CSng(Len(STRGARAGE) + 5)) * 7 / 2
.CurrentY = Top
.FontSize = 20
End With
Printer.Font.Underline = True
Printer.Print STRGARAGE & "结算保修单"
Printer.CurrentX = TabLeft + 1
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.FontSize = 10
Printer.Font.Underline = False
Printer.Print "车牌："
Printer.CurrentX = 0.175 * (TabRight - TabLeft) + TabLeft
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print "车主姓名："
Printer.CurrentX = 0.34 * (TabRight - TabLeft) + TabLeft
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print "送修时间："
Printer.CurrentX = 0.52 * (TabRight - TabLeft) + TabLeft
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print "出厂时间："

Printer.Font.Underline = True
Printer.CurrentX = TabLeft + 10
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print STRCURRENTCARNUMBER
Printer.CurrentX = 0.175 * (TabRight - TabLeft) + TabLeft + 17
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print strDriver
Printer.CurrentX = 0.34 * (TabRight - TabLeft) + TabLeft + 17
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print CStr(inDate)
Printer.CurrentX = 0.52 * (TabRight - TabLeft) + TabLeft + 17
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print CStr(Now)


Printer.Font.Underline = False
Printer.CurrentX = TabRight - 23
Printer.CurrentY = 0.1052 * (Bottom - Top) + Top
Printer.Print "共" & CStr(intPages) & "页，第" & CStr(Page_i) & "页"

 

   Printer.FontSize = 8
  
   For intX = 1 To mgrid_Part.Cols - 2
      Printer.CurrentY = tabTop + 2
      Printer.CurrentX = TabLeft + (TabRight - TabLeft) / 2 * sngTabLeftPart(intX - 1) + 2
      Printer.Print mgrid_Part.TextMatrix(0, intX)
   Next intX
    
   For intY = intMaxRows * (Page_i - 1) + 1 To intMaxRows * (Page_i - 1) + intMaxRows
    If intY < mgrid_Part.Rows Then
        For intX = 1 To mgrid_Part.Cols - 2
           Printer.CurrentX = TabLeft + (TabRight - TabLeft) / 2 * sngTabLeftPart(intX - 1) + 2
           Printer.CurrentY = tabTop + 4 * (intY - (Page_i - 1) * intMaxRows - 1) + 8
           Select Case mgrid_Part.TextMatrix(0, intX)
              Case "单价"
                Printer.Print mgrid_Part.TextMatrix(intY, intX) & "元"
              Case "价格"
                  Printer.Print mgrid_Part.TextMatrix(intY, intX) & "元"
              Case "外加工"
                  Printer.Print mgrid_Part.TextMatrix(intY, intX) & "元"
              Case "折扣"
                    Printer.Print mgrid_Part.TextMatrix(intY, intX) & "%"
              Case "保修期"
                      Printer.Print mgrid_Part.TextMatrix(intY, intX) & "m"
              Case Else
                  Printer.Print mgrid_Part.TextMatrix(intY, intX)
           End Select
        Next intX
   End If
   Next intY
   
   For intX = 0 To mGrid_Labor.Cols - 1
    If intX <> 1 Then
      Printer.CurrentY = tabTop + 2
      Printer.CurrentX = (TabRight - TabLeft) / 2 * sngTabLeftLabor(intX) + 2 + sngCenter
      Printer.Print mGrid_Labor.TextMatrix(0, intX)
      End If
   Next intX
   
   For intY = intMaxRows * (Page_i - 1) + 1 To intMaxRows * (Page_i - 1) + intMaxRows
    If intY < mGrid_Labor.Rows Then
        For intX = 0 To mGrid_Labor.Cols - 1
          If intX <> 1 Then
           Printer.CurrentX = (TabRight - TabLeft) / 2 * sngTabLeftLabor(intX) + 2 + sngCenter
           Printer.CurrentY = tabTop + 8 + 4 * (intY - (Page_i - 1) * intMaxRows - 1)
           Select Case mGrid_Labor.TextMatrix(0, intX)
              Case "单价"
                Printer.Print mGrid_Labor.TextMatrix(intY, intX) & "元"
              Case "价格"
                  Printer.Print mGrid_Labor.TextMatrix(intY, intX) & "元"
              Case "外加工"
                  Printer.Print mGrid_Labor.TextMatrix(intY, intX) & "元"
              Case "折扣"
                    Printer.Print mGrid_Labor.TextMatrix(intY, intX) & "%"
              Case "保修期"
                      Printer.Print mGrid_Labor.TextMatrix(intY, intX) & "m"
              Case Else
                  Printer.Print mGrid_Labor.TextMatrix(intY, intX)
            End Select
           End If
        Next intX
   End If
   Next intY
   
   
   
   If Page_i = intPages Then
    Printer.CurrentX = TabLeft + 1
    Printer.CurrentY = tabBottom + 1
    sngShouldIncome = sngSumFee(mgrid_Part) + sngSumFee(mGrid_Labor)
    If sngShouldIncome - sngIncome > 0 Then
        Printer.Print "总计金额：" & CStr(sngShouldIncome) & "元；实收：" & CStr(sngIncome) & "；欠资：" & CStr(sngShouldIncome - sngIncome) & "元    维修ID：" & CStr(FixId)
       Else
        Printer.Print "总计金额：" & CStr(sngShouldIncome) & "元；实收：" & CStr(sngIncome) & "元     维修ID号：" & CStr(FixId)
   End If
   Printer.FontSize = 6
   Printer.CurrentX = Right - CSng(Len(strMyInfo) + 2) * 3.6 * Printer.FontSize / 10
   Printer.CurrentY = tabBottom + 1
   Printer.Print "*" & strMyInfo & "*"
 End If
   Printer.EndDoc
   
Next Page_i
End Sub


Sub Part_In_Out(strPartName As String, strPartType As String, int_InOut As Integer, int_PartSum As Integer)
'库存进出处理,如果int_Inout=KCSPARTIN 表示进,=KCSPARTOUT表示出,int_PartSum 为进出数量


End Sub

Sub ShowParts(mRsPart As Recordset, Grid As MSFlexGrid, FirstCol As Integer, Cols As Integer, Mode As Integer)
'用此函数在Grid中显示零配件情况,mrspart是指向零配件表,cols是指显示的col数
'Mode=0 全显示;1显示缺货 2显示有的货3显示同类集合后的
Dim intFieldsSum As Integer
Dim intFieldPoint As Integer
Dim strEveryLine As String
Dim intFieldNo_Sum As Integer
Dim boFirstLine As Boolean
Dim intSameLineNo As Integer
Dim intPartSum As Integer
intFieldsSum = mRsPart.Fields.Count
If mRsPart.RecordCount = 0 Then Exit Sub
mRsPart.MoveFirst
'grid_showpart.Rows = 2
Grid.Cols = Cols
Grid.Rows = 1
FirstCol = 0
For i = 0 To mRsPart.Fields.Count - 1
If mRsPart.Fields(i).Name = "数量" Then intFieldNo_Sum = i
Next i
For i = FirstCol To Cols - 1
Grid.TextMatrix(0, i - FirstCol) = mRsPart.Fields(i).Name
Next i

Do Until mRsPart.EOF
  strEveryLine = ""
  
    If mRsPart.Fields("同品种ID") > 0 And Grid.Rows > 1 And Mode = KcsShowDeducePart Then
      boFirstLine = True
       For i = 1 To Grid.Rows - 1
        If Grid.TextMatrix(i, 0) = CStr(mRsPart.Fields("同品种ID")) Then boFirstLine = False
          intSameLineNo = i
       Next i
      If boFirstLine = False Then
        Grid.TextMatrix(intSameLineNo, intFieldNo_Sum) = CStr(CInt(Grid.TextMatrix(intSameLineNo, intFieldNo_Sum)) + mRsPart.Fields("数量"))
       Else
        For intFieldPoint = FirstCol To Cols - 1
         strEveryLine = strEveryLine & vbTab & mRsPart.Fields(intFieldPoint)
        Next intFieldPoint
        strEveryLine = Mid(strEveryLine, 2)
        Grid.AddItem strEveryLine
        
      End If
     Else
      For intFieldPoint = FirstCol To Cols - 1
       strEveryLine = strEveryLine & vbTab & mRsPart.Fields(intFieldPoint)
       
      Next intFieldPoint
      intPartSum = mRsPart.Fields("数量")
       Select Case Mode
       Case KcsShowAllPart
          strEveryLine = Mid(strEveryLine, 2)
          Grid.AddItem strEveryLine
       Case KcsShowDeducePart
          strEveryLine = Mid(strEveryLine, 2)
          Grid.AddItem strEveryLine
       
       Case KcsShowNeedPart
         If intPartSum < 1 Then
          strEveryLine = Mid(strEveryLine, 2)
          Grid.AddItem strEveryLine
         End If
       Case KcsShowExistPart
           If intPartSum > 0 Then
           strEveryLine = Mid(strEveryLine, 2)
           Grid.AddItem strEveryLine
           End If
       End Select
    End If
  mRsPart.MoveNext
Loop
'Grid.RemoveItem (1)
Grid.Row = 0

End Sub



Sub ShowRSByFlex(RS As Recordset, Grid As MSFlexGrid)
Dim i As Integer
Dim j As Integer
Dim strLine As String
Grid.Cols = RS.Fields.Count
Grid.Rows = 1

For i = 0 To RS.Fields.Count - 1
 Grid.TextMatrix(0, i) = RS.Fields(i).Name
If RS.Fields(i).Type = 4 Then Grid.ColWidth(i) = 300
Next i
If RS.RecordCount = 0 Then Exit Sub
Do Until RS.EOF
 strLine = ""
 For i = 0 To RS.Fields.Count - 1
 strLine = strLine & vbTab & RS.Fields(i)
 Next i
 RS.MoveNext
 strLine = Mid(strLine, 2)
 Grid.AddItem strLine
Loop
Grid.FixedRows = 1
End Sub

'------------------------------------------------------------
'this sub will open the appropriate data type form and
'display the appropriate msg in the status bar based on
'user selected options on the main MDI form
'------------------------------------------------------------
Sub OpenTable(rName As String)
  On Error GoTo OpenTableErr

  Dim rsTmp As Recordset
  Dim rsADOTmp As ADODB.Recordset
  Dim conADOConn As ADODB.Connection
  Dim sTmp As String
  Dim nAttach As Integer
  Dim frmTmp As Form
  
  If gsDataType = gsMSACCESS Then   'look for attached tables if it's an MDB
    If (gdbCurrentDB.TableDefs(rName).Attributes And dbAttachedTable) = dbAttachedTable Then
      nAttach = 1
    ElseIf (gdbCurrentDB.TableDefs(rName).Attributes And dbAttachedODBC) = dbAttachedODBC Then
      nAttach = 2
    End If
    If nAttach > 0 And gnRSType = gnRS_TABLE Then
      Beep
      If MsgBox(MSG10, vbYesNo + vbQuestion) = vbYes Then
        frmMDI.tlbToolBar.Buttons("Dynaset").Value = tbrPressed         'reset to dynaset
      Else
        Exit Sub
      End If
    End If
  End If
  
  If nAttach > 0 Then
    If gnRSType = gnRS_DYNASET Then
      sTmp = MSG11
    ElseIf gnRSType = gnRS_SNAPSHOT Then
      sTmp = MSG12
    End If
  Else
    If gnRSType = gnRS_TABLE Then
      sTmp = MSG13
    ElseIf gnRSType = gnRS_DYNASET Then
      sTmp = MSG14
    ElseIf gnRSType = gnRS_SNAPSHOT Then
      sTmp = MSG15
    ElseIf gnRSType = gnRS_PASSTHRU Then
      sTmp = MSG16
    End If
  End If
  
  MsgBox sTmp, True
  
  Screen.MousePointer = vbHourglass
  If gnRSType = gnRS_TABLE Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenTable)
    sTmp = "Table:"
  ElseIf gnRSType = gnRS_DYNASET Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenDynaset)
    sTmp = "Dynaset:"
  ElseIf gnRSType = gnRS_SNAPSHOT Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenSnapshot)
    sTmp = "Snapshot:"
  ElseIf gnRSType = gnRS_PASSTHRU Then
    Set rsTmp = gdbCurrentDB.OpenRecordset(rName, dbOpenSnapshot, dbSQLPassThrough)
    sTmp = "Passthrough Snapshot:"
  End If
  Screen.MousePointer = vbDefault
  
  If gnFormType = gnFORM_NODATACTL Then
    If gnRSType = gnRS_TABLE Then
    '  Set frmTmp = New frmTableObj
      sTmp = "Table:"
    Else
 '     Set frmTmp = New frmDynaSnap
    End If
    Set frmTmp.mrsFormRecordset = rsTmp
  ElseIf gnFormType = gnFORM_DATACTL Then
    Set frmTmp = New frmDataControl
    Set frmTmp.mrsFormRecordset = rsTmp
  ElseIf gnFormType = gnFORM_DATAGRID Then
    'Set frmTmp = New frmDataGrid
    'need to convert the recordset to an ADO recordset
    Set conADOConn = New ADODB.Connection
    With conADOConn
      If Len(gsODBCDatasource) = 0 Then
        If gsDataType = gsMSACCESS Then
          .ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & gsDBName
        Else
          .ConnectionString = "Provider=MSDASQL;Data Source=" & gsDBName
        End If
      Else
        .ConnectionString = "PROVIDER=MSDASQL;" & Mid$(gdbCurrentDB.Connect, 6)
      End If
      .Open
    End With
    Set rsADOTmp = New ADODB.Recordset
    With rsADOTmp
      .Open rsTmp.Name, conADOConn, adOpenStatic, adLockOptimistic, adCmdTable
    End With
    Set frmTmp.mrsFormRecordset = rsADOTmp
  End If
  
  frmTmp.Caption = sTmp & rName
  frmTmp.Show

  MsgBox vbNullString, False
  
  Exit Sub
OpenTableErr:
  MsgBox Err.Description, vbCritical + vbOKOnly, STRGARAGE
End Sub