VBA_UI_base.frm 2.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374
  1. #If VBA7 Then
  2. Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
  3. Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
  4. Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  5. Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  6. Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  7. #Else
  8. Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long
  9. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
  10. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  11. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  12. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  13. #End If
  14. Private Const GWL_STYLE As Long = (-16)
  15. Private Const GWL_EXSTYLE = (-20)
  16. Private Const WS_CAPTION As Long = &HC00000
  17. Private Const WS_EX_DLGMODALFRAME = &H1&
  18. Private Const SM_CXSCREEN = 0
  19. Private Const SM_CYSCREEN = 1
  20. Option Explicit
  21. Dim mX As Long, mY As Long
  22. Private Sub UserForm_Initialize()
  23. Dim IStyle As Long
  24. Dim Hwnd As Long
  25. Hwnd = FindWindow("ThunderDFrame", Me.Caption)
  26. IStyle = GetWindowLong(Hwnd, GWL_STYLE)
  27. IStyle = IStyle And Not WS_CAPTION
  28. SetWindowLong Hwnd, GWL_STYLE, IStyle
  29. DrawMenuBar Hwnd
  30. IStyle = GetWindowLong(Hwnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
  31. SetWindowLong Hwnd, GWL_EXSTYLE, IStyle
  32. With Me
  33. .StartUpPosition = 0
  34. .Left = 500
  35. .Top = 200
  36. .Height = 312
  37. .Width = 36
  38. End With
  39. End Sub
  40. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  41. If Button Then
  42. mX = X
  43. mY = Y
  44. End If
  45. End Sub
  46. Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  47. If Button Then
  48. Me.Left = Me.Left - mx + x
  49. Me.Top = Me.Top - my + y
  50. End If
  51. End Sub
  52. Private Sub UserForm_Click()
  53. '// 屏幕分辨率
  54. Dim X As Long, Y As Long
  55. X = GetSystemMetrics(SM_CXSCREEN)
  56. Y = GetSystemMetrics(SM_CYSCREEN)
  57. ' MsgBox "您的屏幕分辨率为:" & x & "*" & y
  58. With Me
  59. .Height = 30
  60. .Top = .Top + 10
  61. End With
  62. ' MsgBox "窗口定位点: 左" & Me.Left & " 上 " & Me.Top & vbNewLine & "您的屏幕分辨率为:" & X & "*" & Y
  63. End Sub