home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD91348192000.psc / UIMod.bas < prev   
Encoding:
BASIC Source File  |  2000-08-03  |  7.3 KB  |  195 lines
  1. Attribute VB_Name = "UIMod"
  2. Declare Function GetForegroundWindow Lib "user32" () As Long
  3. Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  4. Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  5. Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  6. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  7. Private Const LWA_COLORKEY = &H1
  8. Private Const LWA_ALPHA = &H2
  9. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  10. Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  11. 'Declare Function CreateWindowEx Lib "user32" (DWORD As dwExStyle, LPCTSTR As lPClassName, LPCTSTR As lpWindowName, _
  12. 'DWORD As dwStyle, Inte As x, Inte As y, Inte As nWidth, Inte As nHeight, Hwnd As hWndParent, hMenu As hMenu, _
  13. 'HINSTACE As hInstance, LPVOID As lpParam)
  14. 'Define CreateWindowA(lPClassName, lpWindowName, dwStyle, x, y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam)
  15. 'Public WithEvents menuPG As cPopupMenu
  16. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  17. Declare Function GetActiveWindow Lib "user32" () As Long
  18. Public Declare Function DrawCaption Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As RECT, ByVal un As Long) As Long
  19.  
  20. Public Type RECT
  21.         Left As Long
  22.         Top As Long
  23.         Right As Long
  24.         Bottom As Long
  25. End Type
  26.  
  27. Public Const DC_ACTIVE = &H1
  28. Public Const DC_SMALLCAP = &H2
  29. Public Const DC_ICON = &H4
  30. Public Const DC_TEXT = &H8
  31. Public Const DC_INBUTTON = &H10
  32. Public Const DC_GRADIENT = &H20
  33. Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  34. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  35. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
  36. Declare Function ReleaseCapture Lib "user32" () As Long
  37. Declare Function RegainCapture Lib "user32" () As Long
  38. Declare Function Capture Lib "user32" () As Long
  39. Public Const WM_NCLBUTTONDOWN = &HA1
  40. Public Const HTCAPTION = 2
  41.  
  42.  
  43.  
  44.  
  45. Public Const GWL_EXSTYLE = (-20)
  46. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  47.  
  48. Public Const WS_EX_LAYERED = &H80000
  49.  
  50.  
  51.  
  52.  
  53. Public Type OLECOLOR
  54.     RedOrSys As Byte
  55.     Green As Byte
  56.     Blue As Byte
  57.     Type As Byte
  58. End Type
  59.  
  60. Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  61. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  62.  
  63. Public Const DT_CENTER = &H1
  64. Public Const DT_WORDBREAK = &H10
  65. Public Const DT_CENTERCENTER = &H65
  66. Public Const DT_BOTTOM = &H8
  67. Public Const DT_CALCRECT = &H400
  68. Public Const DT_LEFT = &H0
  69. Public Const DT_NOCLIP = &H100
  70. Public Const DT_NOPREFIX = &H800
  71. Public Const DT_RIGHT = &H2
  72. Public Const DT_SINGLELINE = &H20
  73. Public Const DT_VCENTER = &H4
  74.  
  75. Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  76. Public Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long
  77. Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  78.  
  79.  
  80.  
  81. Public Const BDR_RAISEDOUTER = &H1
  82. Public Const BDR_SUNKENOUTER = &H2
  83. Public Const BDR_RAISEDINNER = &H4
  84. Public Const BDR_SUNKENINNER = &H8
  85.  
  86. Public Const BDR_OUTER = &H3
  87. Public Const BDR_INNER = &HC
  88. Public Const BDR_RAISED = &H5
  89. Public Const BDR_SUNKEN = &HA
  90.  
  91. Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  92. Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  93. Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  94. Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  95. Public Const EDGE_RAISED2 = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  96.  
  97. Public Const BF_LEFT = &H1
  98. Public Const BF_TOP = &H2
  99. Public Const BF_RIGHT = &H4
  100. Public Const BF_BOTTOM = &H8
  101.  
  102. Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
  103. Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
  104. Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
  105. Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
  106. Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  107.  
  108. Public Const BF_DIAGONAL = &H10
  109.  
  110.  
  111. Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP _
  112.         Or BF_RIGHT)
  113. Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP _
  114.         Or BF_LEFT)
  115. Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM _
  116.         Or BF_LEFT)
  117. Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM _
  118.         Or BF_RIGHT)
  119. Public Enum EDEDBorderParts
  120.     BF_MIDDLE = &H800
  121.     BF_SOFT = &H1000
  122.     BF_ADJUST = &H2000
  123.     BF_FLAT = &H4000
  124.     BF_MONO = &H8000
  125.     BF_ALL = BF_RECT Or BF_MIDDLE Or BF_SOFT Or BF_ADJUST Or BF_FLAT Or BF_MONO
  126. End Enum
  127. Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
  128.  
  129.  
  130.  
  131. Public Sub MakeWindowLayered(hwnd As Long)
  132.     Dim ExStyles As Long
  133.     ExStyles = GetWindowLong(hwnd, GWL_EXSTYLE)
  134.     ExStyles = ExStyles Or WS_EX_LAYERED
  135.     SetWindowLong hwnd, GWL_EXSTYLE, ExStyles
  136. End Sub
  137.  
  138. Public Sub SetColorKey(hwnd As Long, ByVal Color As Long)
  139.     Color = WinColor(Color)
  140.     SetLayeredWindowAttributes hwnd, Color, 0, LWA_COLORKEY
  141. End Sub
  142.  
  143. Public Function WinColor(VBColor As Long) As Long
  144.     Dim SysClr As OLECOLOR
  145.     CopyMemory SysClr, VBColor, Len(SysClr)
  146.     If SysClr.Type = &H80 Then
  147.         WinColor = GetSysColor(SysClr.RedOrSys)
  148.     Else
  149.         WinColor = VBColor
  150.     End If
  151. End Function
  152. Public Sub SetOpacity(hwnd As Long, Opacity As Byte)
  153.     SetLayeredWindowAttributes hwnd, 0, Opacity, LWA_ALPHA
  154. End Sub
  155.  
  156.  
  157. Sub CapPaint(Control, current As Form)
  158. Dim rt As RECT
  159.    Dim rtn As Long
  160. With rt
  161.       .Left = 0
  162.       .Top = 0
  163.       .Right = Control.ScaleX(Control.ScaleWidth, Control.ScaleMode, vbPixels)
  164.       .Bottom = 25
  165.    End With
  166. rtn = DrawCaption(current.hwnd, Control.hdc, rt, DC_ACTIVE Or DC_ICON Or DC_TEXT Or DC_GRADIENT)
  167. Control.Refresh
  168. End Sub
  169. Sub CapPaintINA(Control, current As Form)
  170. Dim rt As RECT
  171. Dim rtn As Long
  172. With rt
  173.       .Left = 0
  174.       .Top = 0
  175.       .Right = Control.ScaleX(Control.ScaleWidth, Control.ScaleMode, vbPixels)
  176.       .Bottom = 25
  177. End With
  178. rtn = DrawCaption(current.hwnd, Control.hdc, rt, DC_ICON Or DC_TEXT Or DC_GRADIENT)
  179. Control.Refresh
  180. End Sub
  181. Public Sub MoveForm(Frm)
  182. ReleaseCapture
  183. x = SendMessage(Frm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  184. End Sub
  185. Public Sub MoveFormC(Frm)
  186. ReleaseCapture
  187. x = SendMessage(Frm, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  188. End Sub
  189. Function GetHDC(ByVal hwnd As Long)
  190. GetHDC = GetDC(hwnd)
  191. End Function
  192.  
  193.  
  194.  
  195.