form11.frm

该系统为空车计量系统.完成对空车的自动计量.附串口处理程序.

         TabIndex        =   30
         Top             =   120
         Width           =   1335
      End
      Begin VB.Label Label13 
         BackColor       =   &H00FF0000&
         Caption         =   "Label13"
         Height          =   735
         Left            =   1440
         TabIndex        =   29
         Top             =   1920
         Width           =   7215
      End
      Begin VB.Label Label27 
         BackColor       =   &H00FF0000&
         Caption         =   "Label27"
         Height          =   2655
         Left            =   1440
         TabIndex        =   15
         Top             =   2880
         Width           =   7215
      End
   End
   Begin VB.Menu work 
      Caption         =   "工作方式"
      NegotiatePosition=   2  'Middle
      WindowList      =   -1  'True
      Begin VB.Menu one 
         Caption         =   "正常计量"
         Shortcut        =   {F5}
      End
      Begin VB.Menu two 
         Caption         =   "二次计量"
         Shortcut        =   {F6}
      End
      Begin VB.Menu null1 
         Caption         =   "-"
      End
      Begin VB.Menu print 
         Caption         =   "打印"
         Shortcut        =   {F12}
      End
      Begin VB.Menu null2 
         Caption         =   "-"
      End
      Begin VB.Menu quit1 
         Caption         =   "退出"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu null 
      Caption         =   "视图"
      Begin VB.Menu htts 
         Caption         =   "显示/隐藏合同提示"
      End
      Begin VB.Menu tools 
         Caption         =   "工具条设置"
         Begin VB.Menu bv 
            Caption         =   "顶部显示"
         End
         Begin VB.Menu tv 
            Caption         =   "底部显示"
         End
         Begin VB.Menu lw 
            Caption         =   "左边显示"
         End
         Begin VB.Menu rv 
            Caption         =   "右部显示"
         End
      End
   End
   Begin VB.Menu chaun 
      Caption         =   "查询"
      Begin VB.Menu rtj 
         Caption         =   "日统计"
      End
      Begin VB.Menu ytj 
         Caption         =   "月统计"
      End
   End
   Begin VB.Menu wh 
      Caption         =   "系统维护"
      Begin VB.Menu qyxx 
         Caption         =   "系统信息库"
      End
      Begin VB.Menu hwm 
         Caption         =   "货物名库"
      End
      Begin VB.Menu dhdd 
         Caption         =   "到货地点库"
      End
      Begin VB.Menu cres 
         Caption         =   "建立收货人库"
      End
      Begin VB.Menu cref 
         Caption         =   "建立发货人库"
      End
   End
   Begin VB.Menu hlep 
      Caption         =   "帮助"
      Begin VB.Menu about 
         Caption         =   "关于"
      End
      Begin VB.Menu hlp 
         Caption         =   "帮助"
         Shortcut        =   {F1}
      End
   End
   Begin VB.Menu calc 
      Caption         =   "计算器"
   End
End
Attribute VB_Name = "mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim inp As Long
Dim bh As Boolean
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

Private Sub about_Click()
'frmAbout.Show
End Sub

Private Sub bv_Click()
Toolbar1.Align = 1

End Sub

Private Sub calc_Click()
Calculator.Show
End Sub

Private Sub chkwh_Click()

frmLogin1.Show
frmLogin1.txtPassword.SetFocus
End Sub



Private Sub cref_Click()
Me.Picture1.Visible = False
frmshr1.Show
End Sub

Private Sub cres_Click()
Me.Picture1.Visible = False
frmfhr1.Show
End Sub

Private Sub cresb_Click()

End Sub



Private Sub cx_Click()
frmcx.Show
End Sub

Private Sub czrk_Click()
czr.Show
End Sub

Private Sub d_Click()
'MsgBox "暂时无该功能"
frmjlk.Show
End Sub

Private Sub DBList1_Click()
Text3.Text = DBList1.Text

End Sub

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

Private Sub DBList2_Click()
Text5.Text = DBList2.Text
End Sub



Private Sub DBList3_Click()
Text10.Text = DBList3.Text
End Sub

Private Sub DBList3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text5.SetFocus
End Sub

Private Sub DBList4_Click()
Text4.Text = DBList4.Text
'DBList4.Visible = False
End Sub

Private Sub DBList4_GotFocus()
Frame3.Caption = "******输入到货地点******"
End Sub

Private Sub del_Click()
End Sub

Private Sub DBCombo1_LostFocus()



If InStr(DBCombo1.Text, "煤") > 0 And bh = True Then
    MsgBox "没有按排发运计划，无法进行工作"
DBCombo1.SetFocus
End If

End Sub

Private Sub dhdd_Click()
Me.Picture1.Visible = False
frmdhdd.Show
End Sub

Private Sub Form_Load()
On Error Resume Next
Form_Resize
jl_ye = False
Dim week1 As Integer
Label10.Caption = Format(Now, "yyyy年m月")
Label28.Caption = Format(Now, "d")
week1 = Weekday(Date - 1)
Select Case Weekday(Date - 1)
Case 1
Label29.Caption = "星期一"
Case 2
Label29.Caption = "星期二"

Case 3
Label29.Caption = "星期三"

Case 4
Label29.Caption = "星期四"

Case 5
Label29.Caption = "星期五"

Case 6
Label29.Caption = "星期六"

Case 7
Label29.Caption = "星期日"

End Select
data6.Refresh
data6.Recordset.MoveLast
Text3.Text = data6.Recordset.Fields("slh")

 MSComm1.CommPort = 1
MSComm1.PortOpen = True
gb$ = MSComm1.Input
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
'Me.PopupMenu work, , X, Y
Else
'Me.PopupMenu chearch, , X, Y
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next

Picture1.Left = (Me.Width - Picture1.Width) / 2 - 400
'Picture1.Height = Me.Height - Picture1.Top - 1300 - Toolbar1.Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call quit1_Click
End
End Sub

Private Sub g_Click()
MsgBox "暂时无该功能"

End Sub

Private Sub Frame4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Frame4.MousePointer = 99
x1 = x
y1 = y

End Sub




Private Sub hlp_Click()
frmBrowser.StartingAddress = App.Path & "\index0.htm"
frmBrowser.Show
'Form2.Show
'frmBrowser.Show
End Sub

Private Sub htk_Click()
'frmhtk.Show
End Sub

Private Sub jr_Click()
frmhtk1.Show
End Sub

Private Sub htts_Click()
If htts.Checked = True Then
Frame4.Visible = False
Label13.Visible = False
'Picture2.Top = 1200
'Frame2.Top = 1200
'Label27.Top = 1250
'Frame3.Top = 1200
'Frame3.Height = Frame1.Height
htts.Checked = False
'‘Shape4.Height = Shape4.Height - 90
Else
Frame4.Visible = True
Label13.Visible = True
'Picture2.Top = 2690
'Frame2.Top = 2690
'Label27.Top = 3100
htts.Checked = True
'Shape4.Height = Shape4.Height + 90

End If
End Sub

Private Sub hwm_Click()
Me.Picture1.Visible = False
frmhwm1.Show
End Sub

Private Sub kc_Click()
'Text9.SetFocus
Picture2.Visible = False
Frame2.Visible = True
pr_p = True
End Sub

Private Sub ll_Click()
Me.Picture1.Visible = False
frmhtk.Show
End Sub

Private Sub Label1_Change()
'将表头数据写入临时库
On Error Resume Next
Adodc3.Refresh
Adodc3.RecordSource = "select * from chetmp where ch=1"
Adodc3.Refresh
Adodc3.Recordset.Fields("zhongliang") = Val(Label1.Caption)
Adodc3.Recordset.UpdateBatch adAffectAllChapters
End Sub

Private Sub lw_Click()
Toolbar1.Align = 3
End Sub

Private Sub MSComm1_OnComm()

'On Error Resume Next
Select Case MSComm