📄 frmquery.frm
字号:
Left = 45
TabIndex = 0
Top = 915
Width = 2040
_ExtentX = 3598
_ExtentY = 9260
_Version = 393217
Indentation = 441
LabelEdit = 1
Style = 7
ImageList = "ilsUserMap"
Appearance = 1
End
Begin MSComctlLib.ImageList ilsGrey
Left = 3000
Top = 5520
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":3ACA
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":3E66
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":4202
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ilsColor
Left = 2280
Top = 5520
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":435E
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":46FA
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":4A96
Key = ""
EndProperty
EndProperty
End
Begin ComCtl3.CoolBar clbQuery
Align = 1 'Align Top
Height = 810
Left = 0
TabIndex = 1
Top = 0
Width = 11475
_ExtentX = 20241
_ExtentY = 1429
BandCount = 6
BackColor = -2147483648
FixedOrder = -1 'True
VariantHeight = 0 'False
_CBWidth = 11475
_CBHeight = 810
_Version = "6.7.9782"
Caption1 = "选择日期：从"
Child1 = "cmbDate1"
MinHeight1 = 300
Width1 = 3060
NewRow1 = 0 'False
Caption2 = "到"
Child2 = "cmbDate2"
MinHeight2 = 300
Width2 = 2325
NewRow2 = 0 'False
Caption3 = "表类型："
Child3 = "cmbDevName"
MinHeight3 = 300
Width3 = 3000
NewRow3 = 0 'False
Child4 = "chkAll"
MinHeight4 = 195
Width4 = 3390
NewRow4 = 0 'False
MinHeight5 = 360
Width5 = 6210
NewRow5 = -1 'True
Child6 = "tlbQuery"
MinHeight6 = 330
Width6 = 6495
NewRow6 = 0 'False
Begin VB.ComboBox cmbDevName
Height = 300
Left = 6390
Style = 2 'Dropdown List
TabIndex = 7
Top = 60
Width = 2025
End
Begin VB.ComboBox cmbDate1
Height = 300
Left = 1230
Style = 2 'Dropdown List
TabIndex = 6
Top = 60
Width = 1800
End
Begin VB.ComboBox cmbDate2
Height = 300
Left = 3495
Style = 2 'Dropdown List
TabIndex = 5
Top = 60
Width = 1890
End
Begin MSComctlLib.Toolbar tlbQuery
Height = 330
Left = 6405
TabIndex = 4
Top = 435
Width = 4980
_ExtentX = 8784
_ExtentY = 582
ButtonWidth = 2064
ButtonHeight = 582
AllowCustomize = 0 'False
Wrappable = 0 'False
Style = 1
TextAlignment = 1
ImageList = "ilsGrey"
HotImageList = "ilsColor"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 3
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印预览"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = " 直接打印"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出查询"
ImageIndex = 3
EndProperty
EndProperty
End
Begin MSComctlLib.ProgressBar prgQuery
Height = 195
Left = 180
TabIndex = 3
Top = 495
Visible = 0 'False
Width = 6000
_ExtentX = 10583
_ExtentY = 344
_Version = 393216
Appearance = 1
Max = 1000
End
Begin VB.CheckBox chkAll
Caption = "查看所有用户"
Height = 195
Left = 8640
TabIndex = 2
Top = 105
Width = 2745
End
Begin VB.Label Label3
Caption = "请选择以下需要查看的用户：ghhghh"
Height = 195
Left = 1845
TabIndex = 8
Top = 2025
Width = 4830
End
End
End
Attribute VB_Name = "frmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim glbfrmInSizeX As Long
Dim curGrid As MSFlexGrid
Dim DevName As String
Dim DevIDQ As String
Dim DateFormer As Date
Dim DateLater As Date
Dim curDevName As String
Dim ClmXData1 As ColumnHeader
Dim itmXData1 As ListItem
Dim ClmXData2 As ColumnHeader
Dim itmXData2 As ListItem
Dim clmXWaste As ColumnHeader
Dim itmXWaste As ListItem
Dim clmXUsed As ColumnHeader
Dim itmXUsed As ListItem
Dim clmXFee As ColumnHeader
Dim itmXFee As ListItem
Dim curDevType As Integer
Dim rcWaste As Recordset
Dim curlvw As ListView
Dim curClmX As ColumnHeader
Dim SQLDev As String
Dim rcDevsMap As Recordset
Dim UserSum As Integer
Dim curBrowInterval As Integer
Dim curBrowStartUser As Long
Dim curBrowStartDev As Integer
Dim curBrowLine As Long
Dim curBrowCol As Integer
Dim curBrowUserID As Long
Dim curBrowDevType As Integer
Dim curBrowDevID As Integer
Dim curJPGDir As String
Dim curJPGFile As String
Dim sDevaddr As String
Dim rcBrowUserDev As Recordset
Dim rcBrowUserMap As Recordset
Dim rcBrowUserData As Recordset
Dim rcBrowUserData2 As Recordset
Private Type RECT ' 用 来 定 义 一 个 区 域 的 坐 标。
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function ValidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Sub findNextDevData(userLine As Long, devCol As Integer, UserID As Long, DevType As Integer, devID As Integer, devData As Long, userName As String, DevName As String, userDoor As String)
With lvwData1
Do While True
If userLine > .ListItems.Count Then
UserID = -1
devID = -1
devData = -1
Exit Do
End If
If devCol > .ColumnHeaders.Count - 1 Then
devCol = 3
If userLine >= .ListItems.Count Then
UserID = -1
devID = -1
devData = -1
Exit Do
Else
userLine = userLine + 1
End If
End If
If Trim(lvwData1.ListItems(userLine).SubItems(devCol)) <> "" Then
UserID = Val(.ListItems(userLine).Text)
DevType = devCol - 2
devID = 0
rcBrowUserDev.FindFirst "UserID=" & UserID & " and devType=" & DevType
If Not rcBrowUserDev.NoMatch Then
devID = rcBrowUserDev!devID
End If
devData = Val(.ListItems(userLine).SubItems(devCol))
userDoor = Trim(.ListItems(userLine).SubItems(1))
userName = Trim(.ListItems(userLine).SubItems(2))
DevName = Trim(.ColumnHeaders(devCol + 1).Text)
Exit Do
End If
devCol = devCol + 1
Loop
End With
End Sub
Private Sub cmdModify_Click()
If MsgBox("确定要修改当前数据吗？", vbOKCancel + vbQuestion, "修改数据") = vbcancle Then
Exit Sub
End If
Feedback Val(txtJPG.Text)
lvwData1.ListItems(curBrowLine).SubItems(curBrowCol) = Val(txtJPG.Text)
rcBrowUserData.FindFirst "UserID=" & curBrowUserID _
& " and DevID=" & curBrowDevID _
& " and format(date,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") & """"
If Not rcBrowUserData.NoMatch Then
rcBrowUserData.Edit
rcBrowUserData!Value = Val(txtJPG.Text)
rcBrowUserData.Update
End If
rcBrowUserData2.FindFirst "UserID=" & curBrowUserID _
& " and DevID=" & curBrowDevID _
& " and format(date,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") & """"
If Not rcBrowUserData2.NoMatch Then
rcBrowUserData2.Edit
rcBrowUserData2!Value = Val(txtJPG.Text)
rcBrowUserData2.Update
End If
End Sub
Private Sub cmdPause_Click()
With timerJPG
.Enabled = False
.Interval = 0
End With
cmdTranslate.Enabled = True
cmdModify.Enabled = True
cmdPause.Enabled = False
cmdStart.Enabled = True
cmdReStart.Enabled = True
cmdView.Enabled = True
End Sub
Private Sub cmdReStart_Click()
If lvwData1.ListItems.Count <= 0 Then
Exit Sub
End If
With timerJPG
.Enabled = False
.Interval = Val(txtSpeed) * 1000
curBrowStartUser = Val(txtStartUser)
curBrowStartDev = Val(txtStartDev) - 1
curBrowLine = 1
curBrowCol = 2
For i = 1 To lvwData1.ListItems.Count
If Val(lvwData1.ListItems(i).Text) = curBrowStartUser Then
curBrowLine = i
curBrowCol = curBrowStartDev + 2
Exit For
End If
Next i
.Enabled = True
End With
cmdTranslate.Enabled = False
cmdModify.Enabled = False
cmdPause.Enabled = True
cmdStart.Enabled = False
cmdReStart.Enabled = False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -