已经改过了,也试了,编译有错误
Dim m_udtInitFile As udt_InitFileStruct
Dim m_udtRealData() As udt_MeterRealDataStruct '* 实时数据
Dim m_udtDataGrid As udt_CollectDataStruct
Dim m_udtDataCelect As udt_CollectDataStruct '* 采集时,扇区数据的结构
'Dim m_udtAddressList() As udt_AddressListStruct
'Dim m_clsSelect As New clsSelect '* 报表的时间范围
Dim m_blnCellect As Boolean
Private Sub Form_Load()
Me.Caption = Con_AppTitle
'* 获取配置文件名称
Dim strTempIniName As String
strTempIniName = GetIniFileName
'* 加载配置信息
Call GetIni(m_udtInitFile)
m_udtDataGrid.udtReports = m_udtInitFile.udtReports
m_clsSelect.Address = m_udtInitFile.udtReports.udtAddress
m_clsSelect.StartTime = m_udtInitFile.udtReports.udtStartTime
m_clsSelect.EndTime = m_udtInitFile.udtReports.udtEndTime
Call mfReadAddressList '* 读通讯录
Call m_clsSelect.PutList(m_udtAddressList) '* 把通讯录填写到类clsSelect中
'* 初始化状态栏
StatusBar1.Panels(1).Text = " 铁路工务线路状态监测管理系统..."
StatusBar1.Panels(2).Text = "登录时间: " & strDLTime
StatusBar1.Panels(3).Text = "现在时间: " & Now
End Sub
Private Sub Form_Initialize()
'* 初始化窗体大小
Me.Height = Screen.Height - StatusBar1.Height
Me.Width = Screen.Width
lngHH = Me.Height - tbarmain.Height - 2 * StatusBar1.Height - 100
lngWW = Me.Width
lngTT = tbarmain.Top + tbarmain.Height + StatusBar1.Height
lngLL = 0
'* 初始化状态栏
StatusBar1.Panels(1).MinWidth = Me.Width / 3
StatusBar1.Panels(2).MinWidth = Me.Width / 3
StatusBar1.Panels(3).MinWidth = Me.Width / 3
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("是否要退出本系统?", vbOKCancel + vbQuestion, "退出系统") = vbOK Then
m_udtInitFile.udtReports = m_udtDataGrid.udtReports
Call PutIni(m_udtInitFile)
'* 关闭帮助文件
Call AppActivate(Con_AppTitle, False)
Call SendKeys("%{F4}", True)
Set m_clsSelect = Nothing
Set m_clsLogon = Nothing
Set m_clsSelect = Nothing
Set m_clsLogon = Nothing
End
Else
Cancel = 1
End If
End Sub
Private Sub tbarMain_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim lngOptionOk As Long
'* 定义对象
Dim frmObjOpt As New frmOption
Dim clsPrintGrid As New clsPrint
Dim frmPrtOpt As New frmPrintOption
Dim clsPrtOpt As New clsPrintOption
Dim frmcaiji As New frmcj
Dim lngIndex As Long
Dim strUserName As String
Select Case Button.Key
Case "tlwdxs"
Call ShowForm(frmwdxs)
Case "tlqx"
Call ShowForm(frmxsqx)
Case "tlfx"
Call ShowForm(frmsjfx)
Case "tltxl"
frmtxl.Show 1
Case "tlcj"
frmcaiji.strCurrentAddress = ""
frmcaiji.Show 1
'* 如果选择了地址,则采集
If 0 <> StrComp(frmcaiji.strCurrentAddress, "") Then
m_udtDataCelect.udtCellectAddress.udtAddress = frmcaiji.strCurrentAddress
m_udtDataCelect.udtCellectAddress.udtPhone = frmcaiji.strCurrentPhone
m_blnCellect = True
End If
Case "tlss"
Call ShowForm(frmssxs)
Case "tldy"
If PrintFrm = "曲线" Then
mfScrnCap 10, 90, frmxsqx.QQHistCurve1.Width / 15 + 10, frmxsqx.QQHistCurve1.Height / 15 + 60
picBackTemp = Clipboard.GetData()
picBackTemp.Height = frmxsqx.QQHistCurve1.Height - 400
'picBackTemp.Width = frmxsqx.QQHistCurve1.Width + 50
End If
If PrintFrm = "实时" Or PrintFrm = "温度" Or PrintFrm = "分析" Or PrintFrm = "曲线" Then
frmPrtOpt.Initialize clsPrtOpt
If frmPrtOpt.lngOK = 0 Then
Exit Sub
End If
End If
If PrintFrm = "" Then
MsgBox "当前没有可供打印的窗体!", vbOKOnly + vbExclamation, "打印错误"
Exit Sub
End If
If strCurrentUserName = "" Then
strCurrentUserName = "哈尔滨铁路局齐齐哈尔铁路科学技术研究所"
End If
clsPrintGrid.Title = strSite & strSTime & strETime
If PrintFrm = "温度" Then '* 打印温度显示
Call clsPrintGrid.PrintSaveDat(frmwdxs.QQGrid1, clsPrtOpt, strCurrentUserName)
End If
If PrintFrm = "分析" Then '* 打印数据分析
Call clsPrintGrid.PrintSaveDat(frmsjfx.QQGrid1, clsPrtOpt, strCurrentUserName)
End If
If PrintFrm = "实时" Then '* 打印实时数据
Call clsPrintGrid.PrintSaveDat(frmssxs.QQGrid1, clsPrtOpt, strCurrentUserName)
End If
If PrintFrm = "曲线" Then '* 打印曲线
Call clsPrintGrid.PrintCurve(picBackTemp.Picture, clsPrtOpt, strCurrentUserName)
End If
Case "tlexit"
Unload Me
Case "jyl"
Call ShowForm(frmQryRainfall)
Case "sw"
Call ShowForm(frmswcx)
End Select
End Sub
Private Sub mfScrnCap(lngLeft As Long, lngTop As Long, lngRight As Long, lngBottom As Long)
'* 曲线抓图函数
Dim rWidth As Long
Dim rHeight As Long
Dim SourceDC As Long
Dim DestDC As Long
Dim BHandle As Long
Dim DHandle As Long
Dim lngWnd As Long
rWidth = lngRight - lngLeft
rHeight = lngBottom - lngTop
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, lngLeft, lngTop, &HCC0020
lngWnd = Screen.ActiveForm.hWnd
OpenClipboard lngWnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub
Private Sub tbarmain_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Dim frmPWObj As New frmPassWord
Dim clsSel As New clsSelect
Dim frmSelect As New frmSelectSet
Select Case Trim(ButtonMenu.Key)
Case "UManage"
frmUserManager.Show
Case "ReadRealData"
Call mfCellectTime
Case "InitialM"
Dim frmModem As New frmModemInit
frmModem.Show 1
Set frmModem = Nothing
Case "DelData"
frmPWObj.Show 1
If frmPWObj.lngOK = 1 Then
Call clsSel.PutList(m_udtAddressList())
Call frmSelect.Initialize(clsSel)
End If
Case "Option"
frmPWObj.Show 1
If frmPWObj.lngOK = 1 Then
frmOption.Show 1
End If
Case "About"
frmAbout.Show 1
Case "Help"
Call DoHelp
End Select
End Sub
Private Sub mfCellectTime()
'* 定时读实时数据
On Err GoTo Err_Proc
Dim clsTmpDev As New clsDevice
Dim clsTmpDB As New clsDataBase
Dim clsCellReal As New clsRealProgress
Dim frmReadReal As frmRealProgress
ReDim m_udtRealData(0 To 0)
Dim lngIndex As Long
Set frmReadReal = New frmRealProgress
'clsTmpDev.SetComInit m_udtInitFile.udtComOption
clsCellReal.HighAlarm = m_udtInitFile.udtAlarmOption.udtHigh
clsCellReal.LowAlarm = m_udtInitFile.udtAlarmOption.udtLow
frmReadReal.Initialize clsTmpDev, clsTmpDB, clsCellReal, m_udtAddressList()
Err_Proc:
Set frmReadReal = Nothing
Set clsCellReal = Nothing
Set clsTmpDev = Nothing
Set clsTmpDB = Nothing
End Sub
Private Sub Timer1_Timer()
'* 从仪表读扇区数据
If m_blnCellect = True Then
m_blnCellect = False
Timer1.Enabled = False
Call mfReadMeterSectorData
Timer1.Enabled = True
End If
End Sub
Private Sub mfReadMeterSectorData()
On Error Resume Next
'* 双击读扇区数据
Dim clsDev As New clsDevice
Dim clsDB As New clsDataBase
Dim clsCellHist As New clsCellectHistory
Dim frmCellHist As New frmCellectHistory
ReDim m_udtRealData(0 To 0)
'* 设置电话号码
Call clsDev.SetComInit(m_udtInitFile.udtComOption)
clsDev.Phone = m_udtDataCelect.udtCellectAddress.udtPhone
clsDev.Name = m_udtDataCelect.udtCellectAddress.udtAddress
clsDev.MeterAddress = 1
clsCellHist.Lately = m_udtInitFile.udtReadDataMode.udtLatelyData
clsCellHist.NewData = m_udtInitFile.udtReadDataMode.udtNewData
clsCellHist.DayNumber = m_udtInitFile.udtReadDataMode.udtDayNumber
Call frmCellHist.Initialize(clsDev, clsCellHist)
If frmCellHist.lngOK = 0 Then
GoTo Err_Proc
End If
Call clsCellHist.GetData(m_udtRealData(), m_udtDataCelect)
Call clsDB.DBTargetOpen(m_udtDataCelect.udtCellectAddress.udtAddress)
Call mfCalTempAverage(m_udtDataCelect)
Call clsDB.DBTargetSaveData(m_udtDataCelect)
Err_Proc:
Set clsCellHist = Nothing
Set frmCellHist = Nothing
Set clsDev = Nothing
Set clsDB = Nothing
End Sub
Private Sub mfCalTempAverage(New_udtData As udt_CollectDataStruct)
On Error Resume Next
'* 计算历史数据平均温度
Dim lngIndex As Long
Dim TmpStruct As udt_MeterDataStruct
With New_udtData
For lngIndex = LBound(.udtMeterData) To UBound(.udtMeterData)
TmpStruct = .udtMeterData(lngIndex)
'* 轨温1正常,轨温2正常
TmpStruct.udtRailTempAverage = (TmpStruct.udtRailTemp1 + TmpStruct.udtRailTemp2) / 2
'* 轨温1越限,轨温2正常
If True = mfAlarmState(TmpStruct.udtAlarmState1) And False = mfAlarmState(TmpStruct.udtAlarmState2) Then TmpStruct.udtRailTempAverage = TmpStruct.udtRailTemp2
'* 轨温1正常,轨温2越限
If False = mfAlarmState(TmpStruct.udtAlarmState1) And True = mfAlarmState(TmpStruct.udtAlarmState2) Then TmpStruct.udtRailTempAverage = TmpStruct.udtRailTemp1
'* 轨温1越限,轨温2越限
If True = mfAlarmState(TmpStruct.udtAlarmState1) And True = mfAlarmState(TmpStruct.udtAlarmState2) Then TmpStruct.udtRailTempAverage = -1
'* 计算湿度
Call mfCallHumidity(TmpStruct)
.udtMeterData(lngIndex) = TmpStruct
Next lngIndex
End With
End Sub
Private Sub mfCallRealHumidity(New_udtData As udt_MeterRealDataStruct)
'* 如果湿度的数值 >= 100,则等于99.9
If New_udtData.udtAtmosphereHumidity >= 100 Then
New_udtData.udtAtmosphereHumidity = 99.9
End If
If New_udtData.udtAtmosphereHumidity <= 0 Then
New_udtData.udtAtmosphereHumidity = 0.1
End If
End Sub
Private Sub mfCallHumidity(New_udtData As udt_MeterDataStruct)
'* 如果湿度的数值 >= 100,则等于99.9
If New_udtData.udtAtmosphereHumidity >= 100 Then
New_udtData.udtAtmosphereHumidity = 99.9
End If
If New_udtData.udtAtmosphereHumidity <= 0 Then
New_udtData.udtAtmosphereHumidity = 0.1
End If
End Sub
Private Function mfAlarmState(New_Value As Long) As Boolean
On Error Resume Next
'* 在计算平均温度时,判断两个温度的报警状态,返回True表示越限
Dim TmpBool As Boolean
TmpBool = False
If (New_Value And Con_AlarmLowState > 0) Or (New_Value And Con_AlarmHighState > 0) Then mfAlarmState = True
End Function
Private Sub Timer2_Timer()
StatusBar1.Panels(3).Text = "现在时间: " & Now
End Sub
把修改好的代码全部粘进去,再把原来窗口中所有控件一起copy过来,hehe