module2.bas

vb曲线功能,详细的代码分析了如何绘制动态曲线

Attribute VB_Name = "Module2"

'数据库连接
Public LocalName As String
Public LocalPwd As String

Public Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Public Const SW_SHOWNORMAL = 1
Public Const WM_CLOSE = &H10
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Function SetTopMostWindow(hwnd As Long, TopMost As Boolean)
    If TopMost = True Then
        SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    Else
        SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
        SetTopMostWindow = False
    End If
End Function


Public Function BasePara()  '基本参数初始化
    Dim ConnAccess  As ADODB.Connection
    Dim Rst As ADODB.Recordset
 
 On Error GoTo ErrDbtemp
 
   Set ConnAccess = New ADODB.Connection
   ConnAccess.CursorLocation = adUseClient
   ConnAccess.Provider = "Microsoft.Jet.OLEDB.4.0"
   ConnAccess.ConnectionString = "Data Source=" & App.Path & "\DbT.mdb"
   ConnAccess.Open
   
   Set Rst = New ADODB.Recordset
   Rst.Open "select * from Tconn order by ID", ConnAccess, adOpenStatic, adLockOptimistic
   
   If Rst.RecordCount > 1 Then
        Rst.MoveFirst
      If Not IsNull(Rst.Fields(2).Value) Then
        LocalName = Trim(Rst.Fields(2).Value)
      Else
        LocalName = ""
      End If
      
      If Not IsNull(Rst.Fields(3).Value) Then
        LocalPwd = Trim(Rst.Fields(3).Value)
      Else
        LocalPwd = ""
      End If
      
   Else
     LocalName = "sa"
   End If
   
Exit Function
ErrDbtemp:
  Set Rst = Nothing
  Set ConnAccess = Nothing
  MsgBox Err.Description, vbExclamation, "警告"
   
End Function

Sub Main()
    If App.PrevInstance = True Then
      MsgBox "实时曲线窗口已经打开", vbInformation, "信息提示"
      End
      Exit Sub
    End If
   frmRealCurve.Visible = True
   SetTopMostWindow frmRealCurve.hwnd, True
End Sub