home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD90398172000.psc / Module1.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-17  |  1.8 KB  |  55 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. ' position/size functions
  5. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  6. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  7.  
  8. ' drawing functions
  9. Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  10. Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  11. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  12. Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  13. Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  14.  
  15. Public Const PS_SOLID = 0
  16.  
  17. Public Type POINTAPI
  18.         x As Long
  19.         y As Long
  20. End Type
  21.  
  22. Public Type RECT
  23.         Left As Long
  24.         Top As Long
  25.         Right As Long
  26.         Bottom As Long
  27. End Type
  28.  
  29. Public Sub DrawRectangle(TheDC As Long, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, TheColor As Long)
  30.     ' This sub draws the select box rectangle
  31.     ' (the box that shows an item is highlighted)
  32.     Dim NewPen As Long, OldPen As Long
  33.     Dim NewBrush As Long, OldBrush As Long
  34.     
  35.     NewPen = CreatePen(PS_SOLID, 1, TheColor)
  36.     NewBrush = CreateSolidBrush(TheColor)
  37.     OldPen = SelectObject(TheDC, NewPen)
  38.     OldBrush = SelectObject(TheDC, NewBrush)
  39.     
  40.     Call Rectangle(TheDC, X1, Y1, X2, Y2)
  41.     
  42.     Call SelectObject(TheDC, OldPen)
  43.     Call SelectObject(TheDC, OldBrush)
  44.     Call DeleteObject(NewPen)
  45.     Call DeleteObject(NewBrush)
  46. End Sub
  47.  
  48. Public Sub Timeout(Dur As Double)
  49.     Dim TimeNow As Double
  50.     TimeNow = Timer
  51.     Do While Timer < (TimeNow + Dur)
  52.         DoEvents
  53.     Loop
  54. End Sub
  55.