XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
OGL: Farbwerte kovertieren (RGB <-> OGL)
----- ogl-rgb-color.inc  ---------------------------------------------------------------------------------
Hallo Profanis,
diese Include-Datei erleichtert den Umgang mit RGB- und ogl-Farben.
Enthalten sind
vier Funktionen zum Umrechnen zwischen RGB- und ogl-Farben,
eine Funktion, die den Farbauswahldialog von Windows bequem nutzbar macht und
eine Funktion, die ohne Verwendung von @Get(TrueColor) ermittelt, ob aktuell
der Truecolor-Farbmodus aktiv ist.
Mit der letzten Funktion können die Umrechnungen auch bei Profan-Versionen
ohne @Get(TrueColor) genutzt werden (die erforderlichen Änderungen sind
schon im Quellcode eingebaut, aber auskommentiert).
@RGBtoOGL_rot(f&)      f& ist der auszuwertende RGB-Farbwert
Rückgabewert ist der Rotanteil  im ogl-Wertebereich 0-1
@RGBtoOGL_gelb(f&)     f& ist der auszuwertende RGB-Farbwert
Rückgabewert ist der Gelbanteil im ogl-Wertebereich 0-1
@RGBtoOGL_grün(f&)     f& ist der auszuwertende RGB-Farbwert
Rückgabewert ist der Grünanteil im ogl-Wertebereich 0-1
@OGLtoRGB(r!, g!, b!)  r!, g! und b! sind die ogl-Farbwerte (jeweils im Bereich 0-1)
Rückgabewert ist der entsprechende RGB-Farbwert (der
aktuelle TrueColor-Zustand wird automatisch berücksichtigt)
@Farbewählen(f&)       f& ist die Vorgabefarbe
Rückgabewert ist der RGB-Wert der gewählten Farbe
@IsTrueColor()         kein Parameter
Die Funktion verhält sich wie @Get(TrueColor), arbeitet aber
anders, so dass sie auch bei früheren PRofan-Versionen genutzt werden kann.
Rückgabewert ist 1 (=TRUE) bei gesetztem TrueColor-Modus und
0 (=FALSE) bei nicht gesetztem TrueColor-Modus
--------------------------------------------------------------------------------------------------

Proc Farbewählen

    Parameters Farbe&
    Def APIFarbwahl(1) !COMDLG32.DLL, ChooseColorA, #, %
    Declare Parameter#, Palette#
    Dim Parameter#,36
    Dim Palette#,  64
    Long Parameter#, 0 = 36           Länge dieser Strukturvariablen
    Word Parameter#, 4 = %HWnd        Handle des Hauptfensters
    Word Parameter#, 8 = %HInstance   Instance-Handle des Hauptfensters
    Long Parameter#,12 = Farbe&       Vorgabe- bzw. Rückgabefarbe
    Long Parameter#,16 = Palette#     Palette (wird hier nicht benutzt)
    Long Parameter#,20 = $00000003    Flags
    Long Parameter#,24 = 0
    Long Parameter#,28 = 0
    Long Parameter#,32 =
    APIFarbwahl(Parameter#)
    Farbe& = @Long(Parameter#, 12)
    Dispose Parameter#
    Dispose Palette#
    Return Farbe&

EndProc

--------------------------------------------------------------------------------------------------

Proc RGBtoOGL_rot

    Parameters RGB&
    Declare x%
    x% = @If(@Get(TrueColor) = 1; 255; 31)   Bei Bedarf auskommentieren und die folgende Zeile aktivieren
    x% = @If(IsTrueColor() = 1; 255; 31)   damit klappt es bei Profan-Versionen ohne @Get(TrueColor)
    Return @GetRValue(RGB&) / x%
    EndProc   RGBtoOGL_rot
    --------------------------------------------------------------------------------------------------

    Proc RGBtoOGL_grün

        Parameters RGB&
        Declare x%
        x% = @If(@Get(TrueColor) = 1; 255; 31)   Bei Bedarf auskommentieren und die folgende Zeile aktivieren
        x% = @If(IsTrueColor() = 1; 255; 31)   damit klappt es bei Profan-Versionen ohne @Get(TrueColor)
        Return @GetGValue(RGB&) / x%
        EndProc   RGBtoOGL_grün
        --------------------------------------------------------------------------------------------------

        Proc RGBtoOGL_blau

            Parameters RGB&
            Declare x%
            x% = @If(@Get(TrueColor) = 1; 255; 31)   Bei Bedarf auskommentieren und die folgende Zeile aktivieren
            x% = @If(IsTrueColor() = 1; 255; 31)   damit klappt es bei Profan-Versionen ohne @Get(TrueColor)
            Return @GetBValue(RGB&) / x%
            EndProc   RGBtoOGL_blau
            --------------------------------------------------------------------------------------------------

            Proc OGLtoRGB

                Parameters r!, g!, b!
                Declare f%
                f% = @If(@Get(TrueColor) = 1; 255; 31)   Bei Bedarf auskommentieren und die folgende Zeile aktivieren
                f% = @If(IsTrueColor() = 1; 255; 31)   damit klappt es bei Profan-Versionen ohne @Get(TrueColor)
                Return ((b! * f%) << 16) + ((g! * f%) << 8) + (r! * f%)
                EndProc   OGLtoRGB
                --------------------------------------------------------------------------------------------------

                Proc IsTrueColor

                    Return @If(@RGB(31,31,31)=@RGB(255,255,255), 0,1)

                EndProc

                --------------------------------------------------------------------------------------
                ##### Demo-Programm #######################################################
                Declare Farbe1&, Farbe2&
                Declare ende%
                WindowStyle $F0
                Window 0, 0 - %MaxX, %MaxY
                Cls
                Farbe1& = @RGB(255, 127, 63)
                Farbe2& = @RGB(0, 255, 255)
                Print RGB-Farbe   ; Farbe1&
                Print RGB-rot     ; @GetRValue(Farbe1&); @Tab(30); ogl-rot  ; @RGBtoOGL_rot(Farbe1&)
                Print RGB-grün    ; @GetGValue(Farbe1&); @Tab(30); ogl-grün ; @RGBtoOGL_grün(Farbe1&)
                Print RGB-blau    ; @GetBValue(Farbe1&); @Tab(30); ogl-blau ; @RGBtoOGL_blau(Farbe1&)
                Print RGB aus ogl ; @Format$(######, @OGLtoRGB(@RGBtoOGL_rot(Farbe1&), @RGBtoOGL_grün(Farbe1&), @RGBtoOGL_blau(Farbe1&)))
                Print
                Print IsTrueColor = ;  @IsTrueColor()
                Print
                Print  Auf der nächsten Seite gilt:
                Taste q1q für Farbe 1 ändern
                Taste q2q für Farbe 2 ändern
                ESC für Ende
                Print
                Print Weiter nach Tastendruck
                WaitKey
                --------------------------------------------------------------------------------------------------
                und jetzt wirds oglich
                Declare dreh!, font&

                Proc DrawGLScene

                    oGL(Clear)
                    oGL(Origin, -1.5, 0, -7)
                    oGL(Color, @RGBtoOGL_rot(Farbe1&), @RGBtoOGL_grün(Farbe1&), @RGBtoOGL_blau(Farbe1&), 0.5)
                    oGL(Rotate, 0, dreh!, 0)
                    oGL(Pyramid, 2, 2, 2)
                    oGL(Origin, 1.5, 0, -7)
                    oGL(Color, @RGBtoOGL_rot(Farbe2&), @RGBtoOGL_grün(Farbe2&), @RGBtoOGL_blau(Farbe2&), 0.5)
                    oGL(Rotate, dreh!, 0, 0)
                    oGL(Cuboid, 2, 2, 2)
                    oGL(Show)
                    dreh! = dreh! + 1

                Endproc

                oGL(Init, %hWnd, 0, 0, 0, 1)
                oGL(PosMode, 1)
                oGL(BlendMode, 0)
                font& = oGL(BitmapFont, @Create(Font, Arial, 12, 0, 0, 0, 0))
                ende% = 0

                WhileNot ende%

                    If IsKey(27)                 Escape-Taste?

                        ende% = 1                  dann beenden

                    ElseIf IsKey(49)             = 1 ?

                        Farbe1& = Farbewählen(0)

                    ElseIf IsKey(50)             = 2 ?

                        Farbe2& = Farbewählen(0)

                    EndIf

                    DrawGLScene()

                EndWhile

                END