Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Rainbow

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Rainbow

    Hope you like it.

    Regards,

    Erik
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    #INCLUDE "win32api.inc"
    GLOBAL Res&
    '
    FUNCTION RainbowColor(BYVAL i AS LONG) AS LONG
        LOCAL Red&,Green&,Blue&
        SELECT CASE i& 'i& can vary between 0 and 359 (full circle)
            CASE 0 TO 59
                Red&=(i& MOD 60)*4.25       ' increasing red
                Green&=255                  ' maximum green
                Blue&=0                     ' no blue
            CASE 60 TO 119
                Red&=255                    ' maximum red
                Green&=255-(i& MOD 60)*4.25 ' decreasing green
                Blue&=0                     ' no blue
            CASE 120 TO 179
                Red&=255                    ' maximum red
                Green&=0                    ' no green
                Blue&=(i& MOD 60)*4.25      ' increasing blue
            CASE 180 TO 239
                Red&=255-(i& MOD 60)*4.25   ' decreasing red
                Green&=0                    ' no green
                Blue&= 255                  ' maximum blue
            CASE 240 TO 299
                Red&=0                      ' no red
                Green&=(i& MOD 60)*4.25     ' increasing green
                Blue& = 255                 ' maximum blue
            CASE 300 TO 359
                Red&=0                      ' no red
                Green&=255                  ' maximum green
                Blue&=255-(i& MOD 60)*4.25  ' decreasing blue
            CASE ELSE
        END SELECT
        FUNCTION = RGB(Red,Green,Blue)
    END FUNCTION
    '
    CALLBACK FUNCTION DialCallBack
        STATIC hDC&,Rc AS RECT,i&,hPen&
        STATIC Ps AS PAINTSTRUCT
        SELECT CASE CBMSG
            CASE %WM_PAINT
                GetClientRect CBHNDL,Rc
                hDC = BeginPaint(CBHNDL, Ps)
                FOR i=0 TO 359
                    hPen = CreatePen(%PS_SOLID,1,RainbowColor((i+165) MOD 360))
                    SelectObject hDC, hPen
                    Arc hDC,-rc.nRight*.42,359-i,2.5*rc.nRight,2.8*rc.nBottom+359-i,rc.nRight,359-i,-rc.nRight*0.5,359-i
                    DeleteObject hPen
                NEXT
                EndPaint CBHNDL, Ps
        END SELECT
    END FUNCTION
    '
    FUNCTION PBMAIN
        LOCAL hForm&,rc AS RECT
        SystemParametersInfo %SPI_GETWORKAREA,BYVAL 0, BYVAL VARPTR(rc),BYVAL 0
        DIALOG NEW 0, "Rainbow",,,0,0,%DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN,0 TO hForm&
        MoveWindow hForm&,rc.nLeft,rc.nTop,rc.nRight-rc.nLeft,rc.nBottom-rc.nTop,%TRUE
       ' DIALOG SET COLOR hForm&,0,RGB(130,130,150)
        DIALOG SHOW MODAL hForm&,CALL DialCallBack TO Res&
    END FUNCTION


    ------------------
Working...
X