meetcarhistory.frm

来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 1,767 行 · 第 1/5 页

FRM
1,767
字号
            FullRowSelect   =   -1  'True
            GridLines       =   -1  'True
            _Version        =   393217
            ForeColor       =   8388608
            BackColor       =   -2147483643
            BorderStyle     =   1
            Appearance      =   1
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            NumItems        =   4
            BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               Text            =   "Name"
               Object.Width           =   2540
            EndProperty
            BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   1
               Text            =   "Address"
               Object.Width           =   2540
            EndProperty
            BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   2
               Text            =   "City, State, Zip"
               Object.Width           =   2540
            EndProperty
            BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
               SubItemIndex    =   3
               Text            =   "Notes"
               Object.Width           =   2540
            EndProperty
         End
      End
   End
   Begin BSE_Engine.BSE BSE1 
      Left            =   7320
      Top             =   8280
      _ExtentX        =   6588
      _ExtentY        =   1085
   End
   Begin VB.Frame frameInfo 
      Height          =   855
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   11775
      Begin VB.CommandButton Command1 
         Height          =   495
         Index           =   0
         Left            =   4200
         Picture         =   "MeetCarHistory.frx":01D6
         Style           =   1  'Graphical
         TabIndex        =   2
         ToolTipText     =   "搜索"
         Top             =   240
         Width           =   495
      End
      Begin VB.CommandButton Command1 
         Height          =   495
         Index           =   5
         Left            =   7200
         Picture         =   "MeetCarHistory.frx":0320
         Style           =   1  'Graphical
         TabIndex        =   1
         ToolTipText     =   "审梳"
         Top             =   240
         Width           =   495
      End
      Begin VB.Label Label10 
         Caption         =   "维修档案(已结算的维修单)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   3135
      End
   End
End
Attribute VB_Name = "MeetCarHistory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click(Index As Integer)
 Dim TempSQL As String
 Dim TempRS As MYSQL_RS
 Dim i As Long
 Select Case Index
  Case 5
  
 End Select

End Sub

Private Sub Form_Load()
  Dim i As Integer
  Dim TempStr As String
  VarInitData.InitBSE BSE1
  VarInitData.LoadData lstAddress, VarInitData.DisplaySQLVal(37)
  InitListView2
  If lstAddress.SelectedItem Is Nothing Then
   TempStr = ""
  Else
   TempStr = lstAddress.SelectedItem.Text
  End If
  LoadPartBill TempStr, lstBillDocu(1)
  For i = 0 To 2
   If i <> 1 Then VarInitData.LoadData lstBillDocu(i), VarInitData.DisplaySQLVal(i + 34) & " Where billnum = " & Quote(TempStr)
  Next i
End Sub

Private Sub Form_Resize()
 On Error Resume Next
 Dim i As Integer
 If Me.ScaleHeight > 0 And Me.ScaleWidth > 0 Then
  frameInfo.left = Me.ScaleLeft
  frameInfo.top = Me.ScaleTop
  frameInfo.Width = Me.ScaleWidth
  SSMeetHistory.Width = Me.ScaleWidth - 100
  SSMeetHistory.Height = Me.ScaleHeight - frameInfo.Height
  
  lstAddress.Width = SSMeetHistory.Width - 100
  lstAddress.Height = SSMeetHistory.Height * 3 \ 7
  SSTab1.top = lstAddress.top + lstAddress.Height
'  SSTab1.left = SSMeetHistory.left + 70
  SSTab1.Width = SSMeetHistory.Width - 140
  SSTab1.Height = SSMeetHistory.Height - lstAddress.Height - 400    'Screen.Height - 2650
  For i = 0 To 2
   lstBillDocu(i).top = 400
   lstBillDocu(i).left = 70
   lstBillDocu(i).Width = SSTab1.Width - 140
   lstBillDocu(i).Height = SSTab1.Height - 500
  Next i
 End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
 If BSE1.EngineStarted Then BSE1.EndSubClassing
End Sub

Private Sub lstAddress_Click()
 Dim TempStr As String, i As Long
  If lstAddress.SelectedItem Is Nothing Then
   TempStr = ""
  Else
   TempStr = lstAddress.SelectedItem.Text
  End If
  LoadPartBill TempStr, lstBillDocu(1)
  For i = 0 To 2
   If i <> 1 Then VarInitData.LoadData lstBillDocu(i), VarInitData.DisplaySQLVal(i + 34) & " Where billnum = " & Quote(TempStr)
  Next i
End Sub

Private Sub SSMeetHistory_Click(PreviousTab As Integer)
Dim TempSQL As String
 Dim TempStr As String
 Dim TempRS As MYSQL_RS
 Dim TempBillType As Integer
 Dim i As Integer
 If PreviousTab <> 0 Then
  lstAddress.Visible = True
  For i = 0 To 2
   lstBillDocu(i).Visible = True
  Next i
  Frame1.Visible = False
  Text2.Visible = False
 Else
  lstAddress.Visible = False
  For i = 0 To 2
   lstBillDocu(i).Visible = False
  Next i
  ClearFrame
  Frame1.Visible = True
  Text2.Visible = True
  If Not lstAddress.SelectedItem Is Nothing Then
    LoadTableToText lstAddress.SelectedItem.Text
  End If
 End If
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
Dim TempIndex As Long
 TempIndex = SSTab1.Tab
 Select Case TempIndex
  Case 0, 1, 2
   lstBillDocu(TempIndex).ZOrder 0
 End Select
End Sub
Private Sub LoadPartBill(ByVal BillNum As String, lstBillDocu As ListView)
 Dim TempSQL As String
 Dim TempRS As MYSQL_RS
 Dim TempRS2 As MYSQL_RS
 Dim i As Long, TempIndex As Long
  lstBillDocu.ListItems.Clear
  Set TempRS = New MYSQL_RS
  TempSQL = VarInitData.DisplaySQLVal(38) & " Where workbillnum = " & Quote(BillNum)
  TempRS.OpenRs TempSQL, gCnn
    
  With TempRS
  
   Do Until .EOF
    TempSQL = VarInitData.DisplaySQLVal(39) & " Where drawbillnum = " & Quote(.Fields("drawbillnum"))
    Set TempRS2 = New MYSQL_RS
    TempRS2.OpenRs TempSQL, gCnn
    With TempRS2
     Do Until .EOF
      
       lstBillDocu.ListItems.Add
       TempIndex = lstBillDocu.ListItems.Count
       With lstBillDocu.ListItems(TempIndex)
        .Text = TempRS2.Fields("goodscoding")
        .SubItems(1) = TempRS2.Fields("goodsname")
        .SubItems(2) = TempRS2.Fields("goodsstandard")
        .SubItems(3) = TempRS2.Fields("brand")
        .SubItems(4) = TempRS2.Fields("producehere")
        .SubItems(5) = TempRS2.Fields("goodscount")
        .SubItems(6) = TempRS2.Fields("unit")
        .SubItems(7) = TempRS2.Fields("sellprice")
        .SubItems(8) = TempRS2.Fields("money")
       End With
       .MoveNext
     Loop
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS2 = Nothing
    .MoveNext
   Loop
   .CloseRecordset
   .ReleaseMemory
  End With
  Set TempRS = Nothing
End Sub
Private Sub InitListView2()
 lstBillDocu(1).ColumnHeaders.Clear
 With lstBillDocu(1).ColumnHeaders
  .Add , , "货物编码"
  .Add , , "货品名称"
  .Add , , "型号规格"
  .Add , , "品牌商标"
  .Add , , " 产地"
  .Add , , "数量"
  .Add , , "单位"
  .Add , , "销售定价"
  .Add , , "金额"
 End With
End Sub
Private Sub LoadTableToText(BillNum As String)
 Dim i As Long
 Dim TempRS As MYSQL_RS
 Dim TempSQL As String
 
 TempSQL = VarInitData.DisplaySQLVal(33) & "Where billnum = " & Quote(BillNum)
 Set TempRS = New MYSQL_RS
 TempRS.OpenRs TempSQL, gCnn

 With TempRS
 If .RecordCount > 0 Then
  Label2(0) = .Fields("billnum")
  Combo1(0) = .Fields("meetcarman")
  DTPicker1(0) = .Fields("meetcardate")
  DTPicker1(1) = .Fields("plandate")
  Combo1(1) = .Fields("principal")
  Text1(0) = .Fields("budgetcost")
  Text1(1) = .Fields("earnest")
  Text1(2) = .Fields("vin_no")
  Text1(3) = .Fields("carno")
  Text1(4) = .Fields("sendmaintainman")
  Combo1(2) = .Fields("maintainman")
  Text1(5) = .Fields("mileage")
 ' Text1(6) = .Fields("workrebate")
 ' Text1(7) = .Fields("partrebate")
 ' Text1(8) = .Fields("otherrebate")
  Label2(1) = .Fields("workcost")
  Label2(3) = .Fields("partcost")
  Label2(5) = .Fields("othercost")
  
  Label2(9) = .Fields("carproduceno")
  Label2(10) = .Fields("cartype")
  Label2(11) = .Fields("carhostname")
  Label2(12) = .Fields("carzone")
  Label2(13) = .Fields("phone")
  'Label2 (14)

  Text2 = .Fields("bakintro")
  
'  Label2(2) = Format(Val(Label2(1)) * Val(Text1(6)) / 100, "0.00")
'  Label2(4) = Format(Val(Label2(3)) * Val(Text1(7)) / 100, "0.00")
'  Label2(6) = Format(Val(Label2(5)) * Val(Text1(8)) / 100, "0.00")
'  Label2(7) = Format(Val(Label2(1)) + Val(Label2(3)) + Val(Label2(5)), "0.00")
'  Label2(8) = Format(Val(Label2(2)) + Val(Label2(4)) + Val(Label2(6)), "0.00")
  
  If .Fields("typebs") = 3 Then
   Label4 = "已经结算"
  End If
 End If
 .CloseRecordset
 .ReleaseMemory
 End With
 Set TempRS = Nothing
 LoadListToText
End Sub
Private Sub LoadListToText()
 Dim i As Long
  With lstAddress.SelectedItem
   Text1(6) = .SubItems(12)
   Text1(7) = .SubItems(13)
   Text1(8) = .SubItems(14)
   
   Label2(2) = .SubItems(5)
   Label2(4) = .SubItems(6)
   Label2(6) = .SubItems(7)
   Label2(7) = Format(Val(Label2(1)) + Val(Label2(3)) + Val(Label2(5)), "0.00")
   Label2(8) = Format(Val(Label2(2)) + Val(Label2(4)) + Val(Label2(6)), "0.00")
  
  End With

End Sub
Private Sub ClearFrame()
 Dim i As Integer
 For i = 0 To 8
  Text1(i) = ""
 Next i
 Text2 = ""
 For i = 0 To 2
  Combo1(i) = ""
 Next i
 For i = 0 To 1
  DTPicker1(i) = Date
 Next i
 For i = 0 To 13
  Label2(i) = ""
 Next i
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?