设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 21916|回复: 98
打印 上一主题 下一主题

透明提示框!

[复制链接]
跳转到指定楼层
1#
发表于 2009-3-11 14:47:30 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
  1. Option Compare Database

  2. Option Explicit
  3. Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
  4.                                 (ByVal dwExStyle As Long, _
  5.                                  ByVal lpClassName As String, _
  6.                                  ByVal lpWindowName As String, _
  7.                                  ByVal dwStyle As Long, _
  8.                                  ByVal x As Long, _
  9.                                  ByVal y As Long, _
  10.                                  ByVal nWidth As Long, _
  11.                                  ByVal nHeight As Long, _
  12.                                  ByVal hWndParent As Long, _
  13.                                  ByVal hMenu As Long, _
  14.                                  ByVal hInstance As Long, _
  15.                                  lpParam As Any) As Long

  16. Declare Function LoadIcon Lib "user32" Alias "LoadIconA" _
  17.                                 (ByVal hInstance As Long, _
  18.                                  ByVal lpIconName As String) As Long
  19. Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
  20.                                 (ByVal hInstance As Long, _
  21.                                 ByVal lpCursorName As String) As Long
  22. Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  23. Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" _
  24.                                 (pcWndClassEx As WNDCLASSEX) As Integer
  25. Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
  26.                                           ByVal nCmdShow As Long) As Long
  27. Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
  28. Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
  29. Declare Function PostMessage Lib "user32" Alias "ostMessageA" _
  30.                                         (ByVal hwnd As Long, _
  31.                                         ByVal wMsg As Long, _
  32.                                         ByVal wParam As Long, _
  33.                                         ByVal lParam As Long) As Long
  34. Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" _
  35.                                         (ByVal hwnd As Long, _
  36.                                         ByVal wMsg As Long, _
  37.                                         ByVal wParam As Long, _
  38.                                         ByVal lParam As Long) As Long
  39. Declare Function GetMessage Lib "user32" Alias "GetMessageA" _
  40.                                         (lpMsg As MSG, _
  41.                                         ByVal hwnd As Long, _
  42.                                         ByVal wMsgFilterMin As Long, _
  43.                                         ByVal wMsgFilterMax As Long) As Long
  44. Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
  45. Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
  46. Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
  47. Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
  48. Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
  49. Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  50. Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, _
  51.                                                           ByVal lpStr As String, _
  52.                                                           ByVal nCount As Long, _
  53.                                                           lpRect As RECT, _
  54.                                                           ByVal wFormat As Long) As Long
  55. Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, _
  56.                                                           ByVal crKey As Long, _
  57.                                                           ByVal bAlpha As Byte, _
  58.                                                           ByVal dwFlags As Long) As Long
  59. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  60.                                                 (ByVal hwnd As Long, _
  61.                                                 ByVal nIndex As Long) As Long

  62. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  63.                                                 (ByVal hwnd As Long, _
  64.                                                 ByVal nIndex As Long, _
  65.                                                 ByVal dwNewLong As Long) As Long

  66. Type WNDCLASSEX
  67. cbSize As Long
  68. style As Long
  69. lpfnWndProc As Long
  70. cbClsExtra As Long
  71. cbWndExtra As Long
  72. hInstance As Long
  73. hIcon As Long
  74. hCursor As Long
  75. hbrBackground As Long
  76. lpszMenuName As String
  77. lpszClassName As String
  78. hIconSm As Long
  79. End Type


  80. Type POINTAPI
  81. x As Long
  82. y As Long
  83. End Type

  84. Type MSG
  85. hwnd As Long
  86. message As Long
  87. wParam As Long
  88. lParam As Long
  89. time As Long
  90. pt As POINTAPI
  91. End Type

  92. Type RECT
  93. Left As Long
  94. Top As Long
  95. Right As Long
  96. Bottom As Long
  97. End Type

  98. Type PAINTSTRUCT
  99. hdc As Long
  100. fErase As Long
  101. rcPaint As RECT
  102. fRestore As Long
  103. fIncUpdate As Long
  104. rgbReserved(32) As Byte
  105. End Type

  106. Public Const WS_VISIBLE As Long = &H10000000
  107. Public Const WS_VSCROLL As Long = &H200000
  108. Public Const WS_TABSTOP As Long = &H10000
  109. Public Const WS_THICKFRAME As Long = &H40000
  110. Public Const WS_MAXIMIZE As Long = &H1000000
  111. Public Const WS_MAXIMIZEBOX As Long = &H10000
  112. Public Const WS_MINIMIZE As Long = &H20000000
  113. Public Const WS_MINIMIZEBOX As Long = &H20000
  114. Public Const WS_SYSMENU As Long = &H80000
  115. Public Const WS_BORDER As Long = &H800000
  116. Public Const WS_CAPTION As Long = &HC00000
  117. Public Const WS_CHILD As Long = &H40000000
  118. Public Const WS_CHILDWINDOW As Long = (WS_CHILD)
  119. Public Const WS_CLIPCHILDREN As Long = &H2000000
  120. Public Const WS_CLIPSIBLINGS As Long = &H4000000
  121. Public Const WS_DISABLED As Long = &H8000000
  122. Public Const WS_DLGFRAME As Long = &H400000
  123. Public Const WS_EX_ACCEPTFILES As Long = &H10&
  124. Public Const WS_EX_DLGMODALFRAME As Long = &H1&
  125. Public Const WS_EX_NOPARENTNOTIFY As Long = &H4&
  126. Public Const WS_EX_TOPMOST As Long = &H8&
  127. Public Const WS_EX_TRANSPARENT As Long = &H20&
  128. Public Const WS_GROUP As Long = &H20000
  129. Public Const WS_HSCROLL As Long = &H100000
  130. Public Const WS_ICONIC As Long = WS_MINIMIZE
  131. Public Const WS_OVERLAPPED As Long = &H0&
  132. Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or _
  133.                                             WS_CAPTION Or _
  134.                                             WS_SYSMENU Or _
  135.                                             WS_THICKFRAME Or _
  136.                                             WS_MINIMIZEBOX Or _
  137.                                             WS_MAXIMIZEBOX)
  138. Public Const WS_POPUP As Long = &H80000000
  139. Public Const WS_POPUPWINDOW As Long = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
  140. Public Const WS_SIZEBOX As Long = WS_THICKFRAME
  141. Public Const WS_TILED As Long = WS_OVERLAPPED
  142. Public Const WS_TILEDWINDOW As Long = WS_OVERLAPPEDWINDOW
  143. Public Const CW_USEDEFAULT As Long = &H80000000
  144. Public Const CS_HREDRAW As Long = &H2
  145. Public Const CS_VREDRAW As Long = &H1
  146. Public Const IDI_APPLICATION As Long = 32512&
  147. Public Const IDC_ARROW As Long = 32512&
  148. Public Const WHITE_BRUSH As Integer = 0
  149. Public Const BLACK_BRUSH As Integer = 4
  150. Public Const WM_KEYDOWN As Long = &H100
  151. Public Const WM_CLOSE As Long = &H10
  152. Public Const WM_DESTROY As Long = &H2
  153. Public Const WM_PAINT As Long = &HF
  154. Public Const SW_SHOWNORMAL As Long = 1
  155. Public Const DT_CENTER As Long = &H1
  156. Public Const DT_SINGLELINE As Long = &H20
  157. Public Const DT_VCENTER As Long = &H4
  158. Public Const WS_EX_PALETTEWINDOW As Long = &H188
  159. Public Const LWA_ALPHA = &H2
  160. Public Const GWL_EXSTYLE = (-20)
  161. Public Const WS_EX_LAYERED = &H80000
  162. Dim strMessage As String

  163. '-------------------------------------------------------------------------------


  164. Public Function displayMessage(mess As String) As Long
  165. strMessage = mess
  166. Const CLASSNAME = "我的信息提示~"
  167. Const TITLE = "透明提示框!"
  168. Dim hwnd As Long
  169. Dim wc As WNDCLASSEX
  170. Dim message As MSG

  171. wc.cbSize = Len(wc)
  172. wc.style = CS_HREDRAW Or CS_VREDRAW
  173. wc.lpfnWndProc = GetFuncPtr(AddressOf WindowProc)
  174. wc.cbClsExtra = 0&
  175. wc.cbWndExtra = 0&
  176. wc.hInstance = Application.hWndAccessApp
  177. wc.hIcon = LoadIcon(Application.hWndAccessApp, IDI_APPLICATION)
  178. wc.hCursor = LoadCursor(Application.hWndAccessApp, IDC_ARROW)
  179. wc.hbrBackground = GetStockObject(WHITE_BRUSH)
  180. wc.lpszMenuName = 0&
  181. wc.lpszClassName = CLASSNAME
  182. wc.hIconSm = LoadIcon(Application.hWndAccessApp, IDI_APPLICATION)

  183. RegisterClassEx wc

  184. hwnd = CreateWindowEx(WS_EX_PALETTEWINDOW, _
  185. CLASSNAME, _
  186. TITLE, _
  187. WS_OVERLAPPEDWINDOW, _
  188. 300, _
  189. 100, _
  190. 200, _
  191. 300, _
  192. 0&, _
  193. 0&, _
  194. Application.hWndAccessApp, _
  195. 0&)


  196. ShowWindow hwnd, SW_SHOWNORMAL
  197. UpdateWindow hwnd
  198. SetFocus hwnd


  199. Do While 0 <> GetMessage(message, 0&, 0&, 0&)
  200. TranslateMessage message
  201. DispatchMessage message
  202. Loop

  203. displayMessage = message.wParam
  204. End Function

  205. '--------------------------------------------------------------------------------
  206. Public Function WindowProc(ByVal hwnd As Long, _
  207.                            ByVal message As Long, _
  208.                            ByVal wParam As Long, _
  209.                            ByVal lParam As Long) As Long

  210. Dim ps As PAINTSTRUCT
  211. Dim rc As RECT
  212. Dim hdc As Long

  213. Select Case message

  214. Case WM_PAINT
  215. hdc = BeginPaint(hwnd, ps)
  216. Call GetClientRect(hwnd, rc)

  217. Call DrawText(hdc, strMessage, Len(strMessage), rc, DT_SINGLELINE Or _
  218.                DT_CENTER Or DT_VCENTER)
  219. Call EndPaint(hwnd, ps)

  220. Dim Ret As Long
  221. Ret = GetWindowLong(hwnd, GWL_EXSTYLE)
  222. Ret = Ret Or WS_EX_LAYERED
  223. SetWindowLong hwnd, GWL_EXSTYLE, Ret

  224. SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA

  225. Exit Function

  226. Case WM_KEYDOWN
  227. Call PostMessage(hwnd, WM_CLOSE, 0, 0)
  228. Exit Function

  229. Case WM_DESTROY
  230. PostQuitMessage 0&
  231. Exit Function

  232. Case Else

  233. WindowProc = DefWindowProc(hwnd, message, wParam, lParam)

  234. End Select


  235. End Function

  236. '--------------------------------------------------------------------------------
  237. Function GetFuncPtr(ByVal lngFnPtr As Long) As Long
  238. GetFuncPtr = lngFnPtr
  239. End Function


复制代码

评分

参与人数 2经验 +18 收起 理由
Henry D. Sy + 10 精品文章
andymark + 8 精品文章

查看全部评分

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏1 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2009-3-11 14:49:05 | 只看该作者
使用方法:

游客,如果您要查看本帖隐藏内容请回复
3#
发表于 2009-3-11 17:29:12 | 只看该作者
学习学习
4#
发表于 2009-3-11 19:35:25 | 只看该作者
谢谢分享
5#
发表于 2009-3-11 20:10:24 | 只看该作者
2# 5988143

学习
6#
发表于 2009-3-11 20:41:48 | 只看该作者
7#
发表于 2009-3-11 20:59:39 | 只看该作者
谢谢分享.
学习.
8#
发表于 2009-3-11 21:11:38 | 只看该作者
学习学习
9#
发表于 2009-3-12 00:04:59 | 只看该作者
“Public Const
……”
这段代码怎么都是红字?
10#
发表于 2009-3-12 00:14:23 | 只看该作者
谢谢知道了,要放在模块中。
谢谢分享。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-26 02:53 , Processed in 0.101008 second(s), 38 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表