modautosize.bas

Fix通用外接报表程序,读取fix中的实时数据 生成相关报表曲线

Attribute VB_Name = "ModAutoSize"
'Public sDotInfo(0 To 23, 1 To 2) As String '点信息
'Public isUseDot(0 To 23) As Boolean '是否使用点
Public sDotInfo() As String '点信息
Public isUseDot() As Boolean '是否使用点
Public isWrong() As Boolean '点错误状态

Public iCurrentDot As Integer '当前点 用于单独设置点信息
Public sNode As String '默认节点
Public sLand As String '默认域
Public sFixPath As String 'Fix目录
Public isUseServerTime As Boolean '是否使用服务器时间
Public iSaveInteval As Integer '保存数据间隔时间

Public isDataBaseErr As Boolean
Public uDb As New ClassData

Private FormOldWidth As Long
   '保存窗体的原始宽度
Private FormOldHeight As Long
   '保存窗体的原始高度

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
   Dim Obj As Control
   FormOldWidth = FormName.ScaleWidth
   FormOldHeight = FormName.ScaleHeight
   On Error Resume Next
   For Each Obj In FormName
     Obj.Tag = Obj.Left & " " & Obj.Top & " " _
           & Obj.Width & " " & Obj.Height & " "
   Next Obj
   On Error GoTo 0
End Sub

'按比例改变表单内各元件的大小，在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
   Dim Pos(4) As Double
   Dim i As Long, TempPos As Long, StartPos As Long
   Dim Obj As Control
   Dim ScaleX As Double, ScaleY As Double

   ScaleX = FormName.ScaleWidth / FormOldWidth
   '保存窗体宽度缩放比例
   ScaleY = FormName.ScaleHeight / FormOldHeight
   '保存窗体高度缩放比例
   On Error Resume Next
   For Each Obj In FormName
     StartPos = 1
     For i = 0 To 4
     '读取控件的原始位置与大小

       TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
       If TempPos > 0 Then
         Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
         StartPos = TempPos + 1
       Else
         Pos(i) = 0
       End If
       '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
       Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, _
               Pos(2) * ScaleX, Pos(3) * ScaleY
     Next i
   Next Obj
   On Error GoTo 0
End Sub

Public Sub ShowError(strModule As String, strProcedure As String, _
lngErrorNumber As Long, strErrorDescription As String, _
Optional blnLogFile As Boolean = False)

'Call ShowError(Me.Name, "frmMain_Click", Err.Number, Err.Description)
    On Error GoTo PROC_ERR
    Dim strMessage As String
    Dim strCaption As String
    Dim intLogFile As Integer
    
    If blnLogFile Then
        intLogFile = FreeFile
    
        Open g_strErrorLogFileName For Append As #intLogFile
            Print #intLogFile, "*** Error Encountered " & VBA.Now & "***"
            Print #intLogFile, "错误号: " & lngErrorNumb
            Print #intLogFile, "详细信息: " & strErrorDescripti
            Print #intLogFile, "模块: " & strModu
            Print #intLogFile, "位置: " & strProcedu
            Print #intLogFile, ""
        Close #intLogFile
    End If
    
    strMessage = "错 误 号: " & lngErrorNumber & vbNewLine & _
                "详细信息: " & strErrorDescription & vbNewLine & vbNewLine & _
                "模    块: " & strModule & vbNewLine & _
                "位    置: " & strProcedure & vbNewLine & vbNewLine & _
                "    程序发生了异常错误，我们对此给您带来的" & vbNewLine & _
                "不便表示歉意请参考用户手册或帮助文件，查对" & vbNewLine & _
                "以上的错误号与错误信息寻找解决方案，如没有" & vbNewLine & _
                "相关信息或无法解决请联系我们的客服人员与技。" & vbNewLine & _
                "术支持" & vbNewLine & vbNewLine & "    感谢您对我们的支持！"
                    
    strCaption = "意外中断! 程序版本: " & _
                Str$(App.Major) & "." & Str$(App.Minor) & "." & _
                Format(App.Revision, "0000")
                
    MsgBox strMessage, vbCritical, strCaption: End
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Resume Next
End Sub