📄 frmshowall.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmShowAll
BorderStyle = 3 'Fixed Dialog
Caption = "用户数据列表"
ClientHeight = 5115
ClientLeft = 45
ClientTop = 330
ClientWidth = 8535
ControlBox = 0 'False
Icon = "frmShowAll.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5115
ScaleWidth = 8535
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdOK
Caption = "返回 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7155
TabIndex = 3
Top = 4605
Width = 975
End
Begin VB.CommandButton cmdPrint
Caption = "打印 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6075
TabIndex = 2
Top = 4605
Width = 975
End
Begin VB.CommandButton cmdPrePrint
Caption = "打印预览 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4995
TabIndex = 1
Top = 4605
Width = 975
End
Begin VB.CommandButton cmdSave
Caption = "保存 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3915
TabIndex = 0
Top = 4605
Visible = 0 'False
Width = 975
End
Begin VB.PictureBox rptUserData
Height = 480
Left = 2955
ScaleHeight = 420
ScaleWidth = 1140
TabIndex = 9
Top = 4680
Width = 1200
End
Begin MSFlexGridLib.MSFlexGrid grdData1
Height = 4140
Left = 0
TabIndex = 4
Top = 0
Width = 8520
_ExtentX = 15028
_ExtentY = 7303
_Version = 393216
End
Begin VB.Label lblUserInfo
Height = 345
Left = 90
TabIndex = 8
Top = 4290
Width = 3855
End
Begin VB.Label lblCurDate
Height = 255
Left = 4365
TabIndex = 7
Top = 4290
Visible = 0 'False
Width = 1740
End
Begin VB.Label lblLastDate
Height = 255
Left = 6435
TabIndex = 6
Top = 4290
Visible = 0 'False
Width = 2070
End
Begin VB.Label lblUserSum
Height = 255
Left = 90
TabIndex = 5
Top = 4740
Width = 1575
End
End
Attribute VB_Name = "frmShowAll"
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 rcUserRpt As Recordset '用量及费用数据表
Dim rcDevsMap As Recordset
Dim rcUserMap As Recordset
Dim curGrid As MSFlexGrid '当前表格,(用于prePaint)
Dim DateFormer As Date
Dim DateLater As Date
Dim LatestDate As Date
Dim curDevType As Integer
Dim SumUser As Integer
Sub FillgrdData1()
Dim rcData As Recordset
Dim rcUserDev As Recordset
Dim rcDevsMap As Recordset
Dim rowSum As Integer
Dim curUserID As Integer
Dim curValue As Single
Dim curDevID As Integer
Dim curQuan As Single
curQuan = 1
Set rcData = dbCbb.OpenRecordset(QData, dbOpenSnapshot)
Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
'填充表格grdData1
rowSum = 2
rcQUser.MoveFirst
Do While Not rcQUser.EOF '依次填充符合条件用户的数据
If CancelBrowse Then
Exit Sub
End If
grdData1.Rows = rowSum
grdData1.Row = grdData1.Rows - 1
grdData1.Col = 0
grdData1.Text = rcQUser!UserID
grdData1.Col = 1
grdData1.Text = rcQUser!Door
grdData1.Col = 2
grdData1.Text = rcQUser!userName
'查询等于日期一的数据
curUserID = rcQUser!UserID
If DevName <> "所有" Then
rcData.FindFirst "DevID=" + Format(DevIDQ) _
& " and UserID=" + Format(curUserID) _
& " and format(date,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") + """"
Else
rcData.FindFirst "UserID=" + Format(curUserID) _
& " and format(Date,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") & """"
End If
Do While Not rcData.NoMatch
If DevName <> "所有" Then
curDevID = DevIDQ
Else
curDevID = rcData!devID
End If
'查找设备类型号
rcUserDev.FindFirst "UserID=" + Format(curUserID) + " and DevID=" + Format(curDevID)
If Not rcUserDev.NoMatch Then
curDevType = rcUserDev!DevType
rcDevsMap.FindFirst "TypeID=" + Format(curDevType)
If rcDevsMap.NoMatch Then
curQuan = 1
Else
If IsNull(rcDevsMap!Quan) Then
curQuan = 1
rcDevsMap.Edit
rcDevsMap!Quan = 1
rcDevsMap.Update
Else
curQuan = rcDevsMap!Quan
End If
End If
curValue = Format(rcData!Value * curQuan)
If DevName <> "所有" Then
grdData1.Col = 3
grdData1.Text = curValue
Else
If curDevType <= grdData1.Cols - 2 And curDevType <> 0 Then '防止指定超出表格总列数的列号
grdData1.Col = (3 + curDevType) - 1
grdData1.Text = curValue
End If
End If
End If
If DevName <> "所有" Then
rcData.FindNext "DevID=" + Format(DevIDQ) _
& " and UserID=" + Format(curUserID) _
& " and format(date,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") + """"
Else
rcData.FindNext "UserID=" + Format(curUserID) _
& " and format(Date,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") & """"
End If
DoEvents
Loop
If (100 - Val(frmWait.prgCollected.Value)) > 100 / Val(SumUser) / 2 Then
frmWait.prgCollected.Value = frmWait.prgCollected.Value + 100 / Val(SumUser) / 2
Else
frmWait.prgCollected.Value = 100
End If
rowSum = rowSum + 1
rcQUser.MoveNext
DoEvents
Loop
grdData1.Refresh
End Sub
Sub fillUserRpt() '生成用户数据报表库
Dim rcUserRpt As Recordset
SQL = "delete * from UserRpt"
dbCbb.Execute SQL
rcQUser.MoveLast
rcQUser.MoveFirst
SumUser = rcQUser.RecordCount
Set rcUserRpt = dbCbb.OpenRecordset("UserRpt", dbOpenDynaset)
rcQUser.MoveFirst
Do While Not rcQUser.EOF
If CancelBrowse Then
Exit Sub
End If
rcUserRpt.AddNew
rcUserRpt!UserID = rcQUser!UserID
rcUserRpt!Date1 = DateLater
If DateFormer <> 0 Then
rcUserRpt!Date2 = DateFormer
End If
rcUserRpt.Update
frmWait.prgCollected.Value = frmWait.prgCollected.Value + 100 / Val(SumUser) / 2
rcQUser.MoveNext
DoEvents
Loop
End Sub
Sub paintGrd()
Dim colSum As Integer
curGrid.Cols = 4
curGrid.Rows = 2
curGrid.FixedRows = 1
curGrid.FixedCols = 3
curGrid.Col = 0
curGrid.Row = 0
curGrid.Text = "用户号"
curGrid.ColWidth(0) = 675
curGrid.Col = 1
curGrid.Text = "门牌号"
curGrid.ColWidth(1) = 675
curGrid.Col = 2
curGrid.Text = "用户名"
curGrid.ColWidth(2) = 930
If DevName <> "所有" Then
curGrid.Col = 3
curGrid.Text = Trim(DevName)
Else
rcDevsMap.MoveFirst
colSum = curGrid.Cols
Do While Not rcDevsMap.EOF
curGrid.Cols = colSum
curGrid.Col = curGrid.Cols - 1
curGrid.ColWidth(curGrid.Col) = 810
curGrid.Text = Trim(rcDevsMap!Name)
colSum = colSum + 1
rcDevsMap.MoveNext
DoEvents
Loop
End If
End Sub
Sub prePaint()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -