Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen Download
Dateidownload

ColorDefinition.bi

Uploader:MitgliedMuttonhead
Datum/Zeit:15.02.2014 20:58:09

'basierend auf Eternal Pains Code:
'http://www.freebasic-portal.de/code-beispiele/grafik-und-fonts/hsv-rgb-162.html
'siehe auch:
'http://de.wikipedia.org/wiki/HSV-Farbraum

type ColorDefinition
  private:
  RGBValue      as uinteger
  Red           as ubyte
  Green         as ubyte
  Blue          as ubyte

  Hue           as single
  Saturation    as single
  Value         as single

  public:
  declare constructor

  declare sub AllToZero

  declare sub SetRGB (rgbv as uinteger)
  declare sub SetRed (r as ubyte)
  declare sub SetGreen (g as ubyte)
  declare sub SetBlue (b as ubyte)

  declare sub SetHSV (h as single, s as single, v as single)
  declare sub SetHue (h as single)
  declare sub SetSaturation (s as single)
  declare sub SetValue (v as single)

  declare function GetRGB as uinteger
  declare function GetRed as ubyte
  declare function GetGreen as ubyte
  declare function GetBlue as ubyte

  declare function GetHue as single
  declare function GetSaturation as single
  declare function GetValue as single

  private:
  declare sub CalcHSV
  declare sub CalcRGB
end type



constructor ColorDefinition
  AllToZero
end constructor



sub ColorDefinition.AllToZero
  RGBValue=0
  Red=0
  Green=0
  Blue=0
  Hue=0
  Saturation=0
  Value=0
end sub



sub ColorDefinition.SetRGB (rgbv as uinteger)
  RGBValue=rgbv
  Red   =((RGBValue shr 16) and &HFF)
  Green =((RGBValue shr 8) and &HFF )
  Blue  =(RGBValue and &HFF         )
  CalcHSV
end sub



sub ColorDefinition.SetRed (r as ubyte)
  Red=r
  RGBValue=(cuint(Red) shl 16) or (cuint(Green) shl 8) or cuint(Blue)
  CalcHSV
end sub



sub ColorDefinition.SetGreen (g as ubyte)
  Green=g
  RGBValue=(cuint(Red) shl 16) or (cuint(Green) shl 8) or cuint(Blue)
  CalcHSV
end sub



sub ColorDefinition.SetBlue (b as ubyte)
  Blue=b
  RGBValue=(cuint(Red) shl 16) or (cuint(Green) shl 8) or cuint(Blue)
  CalcHSV
end sub



sub ColorDefinition.SetHSV (h as single, s as single, v as single)
  Hue=h
  Saturation=s
  Value=v
  if Hue>=360 then Hue=0
  if Hue<=0 then Hue=0
  if Saturation>100 then Saturation=100
  if Saturation<0 then Saturation=0
  if Value>100 then Value=100
  if Value<0 then Value=0
  CalcRGB
end sub



sub ColorDefinition.SetHue (h as single)
  Hue=h
  if Hue>=360 then Hue=0
  if Hue<=0 then Hue=0
  CalcRGB
end sub



sub ColorDefinition.SetSaturation (s as single)
  Saturation=s
  if Saturation>100 then Saturation=100
  if Saturation<0 then Saturation=0
  CalcRGB
end sub



sub ColorDefinition.SetValue (v as single)
  Value=v
  if Value>100 then Value=100
  if Value<0 then Value=0
  CalcRGB
end sub



function ColorDefinition.GetRGB as uinteger
  function=RGBValue
end function



function ColorDefinition.GetREd as ubyte
  function=Red
end function



function ColorDefinition.GetGreen as ubyte
  function=Green
end function



function ColorDefinition.GetBlue as ubyte
  function=Blue
end function



function ColorDefinition.GetHue as single
  function=Hue
end function



function ColorDefinition.GetSaturation as single
  function=Saturation
end function



function ColorDefinition.GetValue as single
  function=Value
end function



sub ColorDefinition.CalcHSV
  dim as ubyte RGB_Max,RGB_Min,RGB_Range

  'Maximal- und Minimalwerte ermitteln
  RGB_Max=0
  RGB_Min=255
  if Red<RGB_Min then RGB_Min=Red
  if Green<RGB_Min then RGB_Min=Green
  if Blue<RGB_Min then RGB_Min=Blue

  if Red>RGB_Max then RGB_Max=Red
  if Green>RGB_Max then RGB_Max=Green
  if Blue>RGB_Max then RGB_Max=Blue

  RGB_Range=RGB_Max-RGB_Min

  'Grundfarbe in Grad ermitteln
  if RGB_Range then'keine Grauwerte
    select case RGB_Max
      case Red                                 'Maximalwert:rot
        Hue=60 * (0 + (Green-Blue) / RGB_Range)
      case Green                                 'Maximalwert:grün
        Hue=60 * (2 + (Blue-Red) / RGB_Range)
      case Blue                                 'Maximalwert:blau
        Hue=60 * (4 + (Red-Green) / RGB_Range)
    end select
    if Hue<0 then Hue +=360

  else'Grauwerte
    Hue=0
  end if

  if RGB_Max then Saturation=100 * RGB_range/RGB_Max else Saturation=0

  Value=100 *RGB_Max/255
end sub



sub ColorDefinition.calcRGB
  dim as integer Huecase
  'Grundfarbe ermitteln
  Huecase=int(Hue/60)+1
  select case Huecase
    case 1                        'grün steigend
      Red=255
      Green=255 * Hue/60
      Blue=0
    case 2                        'rot fallend
      Red=255 - (255 * (Hue-60) / 60)
      Green=255
      Blue=0
    case 3                        'blau steigend
      Red=0
      Green=255
      Blue=255 * (Hue-120)/60
    case 4                        'grün fallend
      Red=0
      Green=255 - (255 * (Hue-180)/60)
      Blue=255
    case 5                        'rot steigend
      Red=255 * (Hue-240)/60
      Green=0
      Blue=255
    case 6                        'blau fallend
      Red=255
      Green=0
      Blue=255 - (255 * (Hue-300)/60)
  end select
  '        s Sättigung      und    v Helligkeit berechnen
  Red=(255 - (255-Red)*Saturation/100)    * Value/100
  Green=(255 - (255-Green)*Saturation/100)    * Value/100
  Blue=(255 - (255-Blue)*Saturation/100)    * Value/100
  RGBValue=(cuint(Red) shl 16) or (cuint(Green) shl 8) or cuint(Blue)
end sub