frmmain.frm

一个用VB编写的订单系统

 
End Sub

Private Sub ActiveBar1_Click(ByVal Tool As ActiveBarLibraryCtl.Tool)
If Tool.Name = "BJFS" Then
   frm报价方式.Show 1
End If
If Tool.Name = "LBWH" Then
   frm样品类别.Show 1
End If
 If Tool.Name = "AB" Then
    frmAbout.Show 1
 End If

 If Tool.Name = "xtwh" Then
    frm单位信息.Show 1
    Me.Data6.Refresh
    Me.Data6.Recordset.MoveFirst
    hxfpiclj = Data6.Recordset("图编目录")
    hxftplj = Data6.Recordset("图形目录")
    hxfcjyhm = Data6.Recordset("超级用户名")
    hxfcjyhkl = Data6.Recordset("超级用户口令")
 End If
 If Tool.Name = "quit" Then
       If Me.Data2.Recordset.RecordCount > 0 Then
         Me.Data2.Recordset.MoveFirst
       End If
    If Data1.Recordset.RecordCount > 0 Then
       Me.Data1.Recordset.MoveFirst
    End If
    End
 End If
 If Tool.Name = "fist" Then
       If Me.Data2.Recordset.RecordCount > 0 Then
         Me.Data2.Recordset.MoveFirst
       End If
   If Me.Data1.Recordset.RecordCount > 0 Then
         Me.Data1.Recordset.MoveFirst
   End If
   Call rest
 End If
 If Tool.Name = "pest" Then
    Call Command7_Click
 End If
If Tool.Name = "next" Then
   Call Command8_Click
End If
If Tool.Name = "last" Then
    If Me.Data2.Recordset.RecordCount > 0 Then
       Me.Data2.Recordset.MoveFirst
    End If
  If Me.Data1.Recordset.RecordCount > 0 Then
     Me.Data1.Recordset.MoveLast
  End If
  Call rest
End If
If Tool.Name = "appkh" Then
   Call Command5_Click
End If
If Tool.Name = "delekh" Then
   Call Command6_Click
End If
If Tool.Name = "appyp" Then
   Me.Data1.Recordset.AddNew
   Me.Data1.Recordset.Update
   Me.Data1.Recordset.MoveLast
   Call rest
End If
If Tool.Name = "deleyp" Then
   Call DELEYP
End If
If Tool.Name = "findyp" Then
   Call findyp
End If
End Sub


Private Sub Combo3_DblClick()
    Me.Data2.Recordset.Edit
       Data2.Recordset("客户编号") = Left(Me.Combo3.Text, 5)
       Data2.Recordset("客户简称") = Right(Me.Combo3.Text, Len(Combo3.Text) - 5)
    Me.Data2.Recordset.Update
    Me.DBGrid1.Text = Left(Me.Combo3.Text, 5)
    Combo3.Visible = False
End Sub

Private Sub DBGrid1_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
  If DBGrid1.Col = 1 Then
     Me.Combo3.Left = 1770
     Me.Combo3.Top = (Me.DBGrid1.Row - 1) * 30 + 3810
     Me.Combo3.Visible = True
  Else
     Me.Combo3.Visible = flase
  End If
  
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyHome
       If Me.Data2.Recordset.RecordCount > 0 Then
         Me.Data2.Recordset.MoveFirst
       End If
       If Me.Data1.Recordset.RecordCount > 0 Then
         Me.Data1.Recordset.MoveFirst
       End If
       Call rest
    Case vbKeyPageUp
        Call Command7_Click
    Case vbKeyPageDown
        Call Command8_Click
    Case vbKeyEnd
        If Me.Data2.Recordset.RecordCount > 0 Then
         Me.Data2.Recordset.MoveFirst
       End If
     If Me.Data1.Recordset.RecordCount > 0 Then
         Me.Data1.Recordset.MoveLast
      End If
      Call rest
    Case vbKeyF11
       Call Command5_Click
    Case vbKeyF12
       Call Command6_Click
    Case vbKeyF4
          Me.Data1.Recordset.AddNew
          Me.Data1.Recordset.Update
          Me.Data1.Recordset.MoveLast
          Call rest
    Case vbKeyF5
          Call DELEYP
    Case vbKeyF6
       Call findyp
    Case vbKeyEscape
       HXFYN = MsgBox("是否退出系统?", 36, "信息提示")
       If HXFYN = vbYes Then
         If Me.Data2.Recordset.RecordCount > 0 Then
            Me.Data2.Recordset.MoveFirst
         End If
         If Me.Data1.Recordset.RecordCount > 0 Then
            Me.Data1.Recordset.MoveFirst
         End If
         End
      End If
    End Select

End Sub

Private Sub Form_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    Me.Data1.DatabaseName = App.Path & "\订单资料.mdb"
    Me.Data1.RecordSource = "select * from 样品资料"
    Me.Data1.Refresh
    Me.Data2.DatabaseName = App.Path & "\订单资料.mdb"
    Me.Data2.RecordSource = "select * from 厂商报价 where 型体='" & Me.Data1.Recordset("型体") & "'"
    Me.Data2.Refresh
    Me.Data3.DatabaseName = App.Path & "\订单资料.mdb"
    Me.Data3.RecordSource = "select *  from 样品类别"
    Me.Data3.Refresh
    If Me.Data3.Recordset.RecordCount > 0 Then
       Me.Data3.Recordset.MoveFirst
       Me.Combo1.Clear
       Do While Not Me.Data3.Recordset.EOF
         If Not IsNull(Me.Data3.Recordset("样品类别")) Then
          Me.Combo1.AddItem (Me.Data3.Recordset("样品类别"))
        End If
        Me.Data3.Recordset.MoveNext
       Loop
    End If
    Me.Data4.DatabaseName = App.Path & "\订单资料.mdb"
    Me.Data4.RecordSource = "select *  from 报价方式"
    Me.Data4.Refresh
    If Me.Data4.Recordset.RecordCount > 0 Then
       Me.Data4.Recordset.MoveFirst
       Me.Combo2.Clear
       Do While Not Me.Data4.Recordset.EOF
         If Not IsNull(Me.Data4.Recordset("报价方式")) Then
          Me.Combo2.AddItem (Me.Data4.Recordset("报价方式"))
        End If
        Me.Data4.Recordset.MoveNext
       Loop
    End If
    Me.Data5.DatabaseName = App.Path & "\订单资料.mdb"
    Me.Data5.RecordSource = "select *  from 客户资料"
    Me.Data5.Refresh
    
    If Me.Data5.Recordset.RecordCount > 0 Then
       Me.Data5.Recordset.MoveFirst
       Me.Combo3.Clear
       Do While Not Me.Data5.Recordset.EOF
          If Not IsNull(Me.Data5.Recordset("客户编号")) Then
             Me.Combo3.AddItem (Left(Trim(Me.Data5.Recordset("客户编号")) & "     ", 5) & Me.Data5.Recordset("客户简称"))
          End If
          Me.Data5.Recordset.MoveNext
       Loop
    End If
    
    Me.Data6.DatabaseName = App.Path & "\订单资料.mdb"
    Me.Data6.RecordSource = "select *  from 单位信息"
    Me.Data6.Refresh
    Call rest

End Sub

Private Sub Combo1_Click()
   Me.Text2.Text = Me.Combo1.Text

End Sub


Private Sub Combo2_Click()
   Me.Text7.Text = Me.Combo2.Text
End Sub

Private Sub Command5_Click()
    If Data2.Recordset.RecordCount > 0 Then
       Me.Data2.Recordset.MoveLast
    End If
    Me.Data2.Recordset.AddNew
    Me.Data2.Recordset("型体") = Me.Data1.Recordset("型体")
    Me.Data2.Recordset.Update
    'Me.DBGrid1.Refresh
    Me.Data2.Recordset.MoveLast
End Sub

Private Sub Command6_Click()
    If Me.Data2.Recordset.RecordCount > 0 And Not Me.Data2.Recordset.BOF And Not Me.Data2.Recordset.EOF Then
       HXFYN = MsgBox("是否删除?", 36, "信息提示")
       If HXFYN = vbYes Then
          Me.Data2.Recordset.Delete
          If Not Me.Data2.Recordset.BOF Then
             Me.Data2.Recordset.MovePrevious
          Else
             If Me.Data2.Recordset.RecordCount > 0 Then
                Me.Data2.Recordset.MoveLast
             End If
          End If
       End If
    End If
End Sub

Private Sub Command7_Click()
  If Data2.Recordset.RecordCount > 0 Then
     Data2.Recordset.MoveFirst
  End If
  If Me.Data1.Recordset.RecordCount > 0 Then
   If Not Me.Data1.Recordset.BOF Then
      Me.Data1.Recordset.MovePrevious
      If Me.Data1.Recordset.BOF Then
         Me.Data1.Recordset.MoveFirst
      End If
   End If
   Call rest
End If
End Sub

Private Sub Command8_Click()
  If Data2.Recordset.RecordCount > 0 Then
     Data2.Recordset.MoveFirst
  End If
  If Me.Data1.Recordset.RecordCount > 0 Then
   If Not Me.Data1.Recordset.EOF Then
      Me.Data1.Recordset.MoveNext
      If Me.Data1.Recordset.EOF Then
         Me.Data1.Recordset.MoveLast
      End If
   End If
   Call rest
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    'close all sub forms
         If Me.Data2.Recordset.RecordCount > 0 Then
            Me.Data2.Recordset.MoveFirst
         End If
         If Me.Data1.Recordset.RecordCount > 0 Then
            Me.Data1.Recordset.MoveFirst
         End If
    
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub Image1_Click()
    Dim hxfxx
    hxfxx = Shell(hxfpiclj & " " & hxftplj & "\" & Trim(Text3.Text), vbMaximizedFocus)

End Sub


Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Me.Text4.SetFocus
    End If

End Sub

Private Sub Text3_LostFocus()
       If Len(Trim(Text3.Text)) > 0 Then
          If filef(hxftplj & "\" & Trim(Me.Text3)) Then   '判断文件是否存在
             Me.Image1 = LoadPicture(hxftplj & "\" & Trim(Me.Text3))
          Else
             Me.Image1 = LoadPicture(App.Path & "\no.jpg")
          End If
       Else
          Me.Image1 = LoadPicture(App.Path & "\no.jpg")
       End If

End Sub