小妹请教一个问题：关于消息提示！望解答~

呵呵
妹妹把B/S结构搞清楚先
你是要所有访问你网站的人都安装这样一个VB程序吗？不太现实吧但要实现你这种到时间就缩回去的东东，用VB是可以实现的，但跟ASP有什么关系呢？用在网站也不现实。
以下代码是以前我写的，想法跟你类似，不过我做成了淡出效果：Dim ValTm, InFrm As Boolean
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long '捕捉Mouse输入焦点
Private Declare Function ReleaseCapture Lib "user32" () As Long '释放Mouse输入焦点
'自由拖动窗体
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
'最顶层窗体
Private 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 LongPrivate Sub Form_Load()
'最顶层窗体
Call SetWindowPos(hWnd, -1, 0, 0, 0, 0, &H2 Or &H1)
Dim rtn As Long
rtn = GetWindowLong(Me.hWnd, GWL_EXSTYLE)    '取的窗口原先的样式
rtn = rtn Or WS_EX_LAYERED     '使窗体添加上新的样式WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn    '把新的样式赋给窗体ValTm = 200 '初始化为不透明窗体
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Me
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then '说明鼠标位于本窗体之外
            ReleaseCapture '释放焦点
            InFrm = False
        Else '说明鼠标位于控件之内了
            SetCapture .hWnd '取得鼠标控件权
            InFrm = True
        End If
    End With
End SubPrivate Sub Form_Paint()
'渐变色
DrawWidth = 2
X2 = Me.ScaleWidth
Y2 = Me.ScaleHeight
If X2 > Y2 Then t2 = Y2 \ 2 Else t2 = X2 \ 2
ScaleMode = twip
DrawStyle = solid
FillStyle = transparent
For i2 = 0 To t2
Line (i2, i2)-(X2 - i2, Y2 - i2), RGB(0, (i2 * 255) \ t2, 0), BF
Next i2
End SubPrivate Sub label1_Change()
On Error Resume Next
    Label1.Top = (Me.Height - Label1.Height) / 2
    Label1.Left = (Me.Width - Label1.Width) / 2

End Sub
Private Sub Label1_Click()
    FrmMain.Show
    FrmMain.StartPing
    Unload Me
End Sub
Private Sub Timer1_Timer()
If InFrm Then
    ValTm = 200
Else
    ValTm = ValTm - 1
End If
SetLayeredWindowAttributes Me.hWnd, 0, ValTm, LWA_ALPHA
'把窗体设置成半透明样式,第二个参数表示透明程度
'取值范围0--255,为0时就是一个全透明的窗体了
If Me.Top > Screen.Height - Me.Height Then Me.Top = Screen.Height - 1
If ValTm < 1 Then
    If FrmMain.Command1.Enabled = False Then FrmMain.StartPing
    Unload Me
End If
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
              If Button = 1 Then
                     Dim ReturnVal As Long
                     X = ReleaseCapture() '为当前的应用程序释放鼠标捕获非0成功
                     ReturnVal = SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
              End If
End Sub

上边的代码有点问题，下面改过：Dim ValTm, InFrm As Boolean
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long '捕捉Mouse输入焦点
Private Declare Function ReleaseCapture Lib "user32" () As Long '释放Mouse输入焦点
'自由拖动窗体
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
'最顶层窗体
Private 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'以下为了设置半透明Form
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long'Timer
Private WithEvents myTime As Timer
Private Sub Form_Load()
  Set myTime = Me.Controls.Add("VB.Timer", "myTimer") '动态加载一Timer
  myTime.Interval = 10


  '最顶层窗体
  Call SetWindowPos(hWnd, -1, 0, 0, 0, 0, &H2 Or &H1)


  Dim rtn As Long
  rtn = GetWindowLong(Me.hWnd, GWL_EXSTYLE)    '取的窗口原先的样式
  rtn = rtn Or WS_EX_LAYERED     '使窗体添加上新的样式WS_EX_LAYERED
  SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn    '把新的样式赋给窗体

  ValTm = 200 '初始化为不透明窗体
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Me
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then '说明鼠标位于本窗体之外
            ReleaseCapture '释放焦点
            InFrm = False
        Else '说明鼠标位于控件之内了
            SetCapture .hWnd '取得鼠标控件权
            InFrm = True
        End If
    End With
End SubPrivate Sub Form_Paint()
'渐变色
DrawWidth = 2
X2 = Me.ScaleWidth
Y2 = Me.ScaleHeight
If X2 > Y2 Then t2 = Y2 \ 2 Else t2 = X2 \ 2
ScaleMode = twip
DrawStyle = solid
FillStyle = transparent
For i2 = 0 To t2
Line (i2, i2)-(X2 - i2, Y2 - i2), RGB(0, (i2 * 255) \ t2, 0), BF
Next i2
End SubPrivate Sub myTime_Timer()
  If InFrm Then
      ValTm = 200
  Else
      ValTm = ValTm - 1
  End If
  SetLayeredWindowAttributes Me.hWnd, 0, ValTm, LWA_ALPHA
  '把窗体设置成半透明样式,第二个参数表示透明程度
  '取值范围0--255,为0时就是一个全透明的窗体了
  If Me.Top > Screen.Height - Me.Height Then Me.Top = Screen.Height - 1
  If ValTm < 1 Then
      Unload Me
  End If
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
         Dim ReturnVal As Long
         X = ReleaseCapture() '为当前的应用程序释放鼠标捕获非0成功
         ReturnVal = SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub

to yechat(点尘不惊) 哥哥：
首先感谢你的帮助，你可能不了解我的应用，我做的不是普通的网站，只是一个公司内部使用的一个管理站点而已，因为有些即时的消息需要随时通知个人，但是又不想随时开着页面（因为还要做其它工作）所以才想用VB做一个这样的程序用来随时检测数据库里是否有新消息！偶也知道这个和ASP没有什么关系，只要共用数据库就行~ 呵呵~~~~

思路是这样的：
1 做一个 C/S 架构的东东。客户端程序随操作系统启动，并最小化在系统托盘中。（这里需要两项技术，写注册表的 Run 键和使用 SysTray 控件，这个控件在 VB 光盘上有。）2 客户和服务都采用 WinSock 来通讯。如果你的服务器 IP 或主机名是固定不变的，也可以写成硬代码，否则采用设置的方法，如 .ini 文件，注册表等等。还有就是采用遍历网络计算机，找到服务器主机名。3 客户端启动后立即向服务器请求连接。如果失败，每隔一段事件再次请求。这样就可以避免服务器后开机不能连接的问题。比较完善的程序，在客户端退出时（关机）应向服务器发消息，断开连接。4 服务器使用一个 Winsock 控件的成员 0 侦听，在收到客户连接请求后，添加一个成员，对应该客户的连接。客户退出时，删除该成员。5 服务器向客户发消息。客户收到后，弹出一个对话框。

to of123
能否帮我把代码写出来呀？我不太会VB
我只要实现检测到数据库里a字段有值时就从屏幕右下角弹出一个提示窗口，过会儿自动关闭就行了！(实在不行手动关闭也行！)

=.=!
我说的怎么看着你最开始的要求那么别扭呢做个托盘程序,提示窗口的vb代码网上也有,然后在程序里边用个timer控件,设定好时间检测数据库.自己搜搜~``

我想建立一个数据库连接
Private Sub Form_Load()
Dim rsNew As ADODB.Recordset
Dim CnNew As ADODB.ConnectionEnd Sub为什么运行时总是提示
Dim rsNew As ADODB.Recordset
Dim CnNew As ADODB.Connection
这两句
编译错误：
用户定义类型未定义这是为什么？？

为什么运行时总是提示
Dim rsNew As ADODB.Recordset
Dim CnNew As ADODB.Connection
这两句
编译错误：
用户定义类型未定义VB 中，菜单“工程”—“引用”，勾选“Microsoft ActiveX Data Object Library 2.x”，确定。

to if123 窗口的问题大概可以了，但是我现在连接不上数据库Private Sub Form_Load()
Dim rsNew As ADODB.Recordset
Dim CnNew As ADODB.ConnectionEnd Sub为什么运行时总是提示
Dim rsNew As ADODB.Recordset
Dim CnNew As ADODB.Connection
这两句
编译错误：
用户定义类型未定义这是为什么？？

Dim rsNew As new ADODB.Recordset
Dim CnNew As new ADODB.Connection

还有最后一个问题,怎么在form1窗体上加上超连接？实现点击后调用浏览器打开相应的地址！

Private Sub Label1_Click()
Shell ("explorer.exe http://192.168.1.107")
End Sub这样可以实现调用IE打开地址!可是我想实现用一个变量代替http://192.168.1.107这样可以从数据库里读出要打开的地址可是怎么不行呢
比如:
Private Sub Label1_Click()
Dim strUrl As String
strUrl = "http://192.168.1.107"
Shell ("explorer.exe ????") '我该怎么把strUrl这个变量加进去啊?? 我试了几次老是出错!End Sub

调试易

小妹请教一个问题：关于消息提示！望解答~

解决方案 »