home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / RedHat_Win185020282005.psc / Colors.bas < prev    next >
BASIC Source File  |  2005-02-05  |  3KB  |  82 lines
  1. Attribute VB_Name = "ModColors"
  2. Private Type RECT
  3.     Left As Long
  4.     Top As Long
  5.     Right As Long
  6.     Bottom As Long
  7. End Type
  8. Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long
  9. Private Declare Function InvertRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
  10. Private 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
  11.  
  12. Public Sub GetRGB(R As Integer, G As Integer, b As Integer, ByVal Color As Long)
  13.     Dim TempValue As Long
  14.     
  15.     'First translate the color from a long v
  16.     '     alue to a short value
  17.     TranslateColor Color, 0, TempValue
  18.     
  19.     'Calculate the red, green, and blue valu
  20.     '     es from the short value
  21.     R = TempValue And &HFF&
  22.     G = (TempValue And &HFF00&) / 2 ^ 8
  23.     b = (TempValue And &HFF0000) / 2 ^ 16
  24. End Sub
  25.  
  26. Public Function MakeGrey(ByVal Col As ColorConstants) As ColorConstants
  27.     Dim R As Integer, G As Integer, b As Integer
  28.     GetRGB R, G, b, Col 'EXTRACT COLOUR VARIABLES
  29.     Dim X As Integer
  30.     X = (R + G + b) / 3 'GET AVERAGE VALUE OF Each
  31.     MakeGrey = RGB(X, X, X) 'Make the GREY colour
  32. End Function
  33.  
  34.  
  35. Public Function MakeBW(ByVal Col As ColorConstants) As ColorConstants
  36.     Dim R As Integer, G As Integer, b As Integer
  37.     GetRGB R, G, b, Col 'EXTRACT COLOUR VARIABLES
  38.     Dim X As Integer
  39.     X = (R + G + b) / 3 'GET AVERAGE VALUE OF Each
  40.  
  41.  
  42.     If X < (255 / 2) Then X = 0 Else X = 255 'IF AVERAGE IS LESS THAN HALF OF MAX THEN
  43.         'MAKE BLACK, ELSE MAKE WHITE
  44.         MakeBW = RGB(X, X, X)
  45.     End Function
  46.  
  47. Public Function AdjustBrightness(ByVal Color As Long, ByVal Amount As Single) As Long
  48.     On Error Resume Next
  49.     
  50.     Dim R(1) As Integer, G(1) As Integer, b(1) As Integer
  51.     
  52.     'get red, green, and blue values
  53.     GetRGB R(0), G(0), b(0), Color
  54.     
  55.     'add/subtract the amount to/from the ori
  56.     '     ginal RGB values
  57.     R(1) = SetBound(R(0) + Amount, 0, 255)
  58.     G(1) = SetBound(G(0) + Amount, 0, 255)
  59.     b(1) = SetBound(b(0) + Amount, 0, 255)
  60.     
  61.     'convert RGB back to Long value
  62.     AdjustBrightness = RGB(R(1), G(1), b(1))
  63. End Function
  64.  
  65. Private Function SetBound(ByVal Num As Single, ByVal MinNum As Single, ByVal MaxNum As Single) As Single
  66.     If Num < MinNum Then
  67.         SetBound = MinNum
  68.     ElseIf Num > MaxNum Then
  69.         SetBound = MaxNum
  70.     Else
  71.         SetBound = Num
  72.     End If
  73. End Function
  74.  
  75. Public Function InvertColor(ByVal hdc As Long, ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single)
  76.     Dim hRect As RECT
  77.     SetRect hRect, X1, Y1, X2, Y2
  78.     InvertRect hdc, hRect
  79. End Function
  80.  
  81.  
  82.