Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Web Color Calculations 2

Status
Not open for further replies.

mdodge2000

Technical User
Mar 7, 2002
2
0
0
US
I have a bunch of cookie cutter type website where I specify most of the look and feel parameters in a database. One of the parameters is button color.

What I would like to do is specify one color, the background color, for the button and have the left and top border color values be calculated as a certain percentage lighter than the background color and the right and bottom border color values be calculated as a certain percentage darker than the background color.

Has anyone ever written or seen any code that will perform these hex calculations?

Thanks in advance,

Mike
 
The function below takes 2 paramters... the first is the percent amount and the second is the 6 character hex string.

So suppose you have this nasty purple 8F36F1
To darken the color, you could decrease the hex number to 90% of current value like this: [tt]GetPercentHex(90, "8F36F1")[/tt] ... and you get 813159

To lighten the color, you could increase the hex number to 150% of current value like this: [tt]GetPercentHex(110, "8F36F1")[/tt] ... and you get D651FF

Code:
Function GetPercentHex(PercentNum, HexString)
  If Not IsNumeric(PercentNum) Then 
    GetPercentHex = "Parameter PercentNum must be numeric."
    Exit Function
  End if

  IF (PercentNum < 0) Then
    GetPercentHex = "Parameter PercentNum must not be negative."
    Exit Function
  End If

  If Len(HexString) <> 6 Then 
    GetPercentHex = "Parameter HexString must be 6 characters long."
    Exit Function
  End if

  'Check for bad characters
  sValid = "0123456789AaBbCcDdEeFf"
  for i = 1 to 6
    sChar = Mid(HexString, i, 1)
    If Not CBool(Instr(sValid, sChar)) Then 
      GetPercentHext = "Invalid character in Parameter HexString: " & sChar
      Exit Function
    end if
  next

  'Calculate percent for each color separately
  R = (PercentNum/100)*(CInt("&H" & Mid(HexString, 1 , 2)))
  G = (PercentNum/100)*(CInt("&H" & Mid(HexString, 3 , 2)))
  B = (PercentNum/100)*(CInt("&H" & Mid(HexString, 5 , 2)))

  'Max number for any color is 255
  IF (R > 255) Then R = 255
  IF (B > 255) Then B = 255
  IF (G > 255) Then G = 255

  'Change to two digit Hex w/leading zero if needed
  R = Right("0" & Hex(R), 2)
  G = Right("0" & Hex(G), 2)
  B = Right("0" & Hex(B), 2)

  'Return hex string
  GetPercentHex = R & G & B
End Function
 
Whoops, I meant to say:
To lighten the color, you could increase the hex number to 150% of current value like this: GetPercentHex([red]150[/red], "8F36F1") ... and you get D651FF
 

nice one Sheco.

A smile is worth a thousand kind words. So smile, it's easy! :)
 
Thanks y'all.

I was first trying to write out how to do it but I couldnt find the words to explain it. Then I thought I would just write the code instead and I realized it was a little more complicated than I first thought.

Looking at it now a few hours later I think that maybe it would be better returning some default color code instead of the descriptive error messages... maybe bright red or something.
 

you could always do err.raise.....


A smile is worth a thousand kind words. So smile, it's easy! :)
 
Thank you very much, Sheco. That is exactly what I was looking for. Definitely worth a star.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top