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

Gradients at any angle

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

  • PBWin Gradients at any angle

    More exercises about gradients, now controlled by a rotary knob.
    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    '  AnyAngle.bas                            Jordi Vallès        version 1a       04/05/2010
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '    Gradient in any direction selectable using a rotary knob.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  - Compiled and tested with PowerBASIC for Windows 9.04 on a PC HP Pavilion with
    '    Windows Vista Home Premium SP2.
    '  - Code posted here is released to Public Domain. Use at your own risk.
    '  - Some ideas, comments and code portions are borrowed from people of PB community.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    #Compile Exe
    #Dim All
    #Include "Win32Api.inc"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    %ID_BOARD   = 1111
    %ID_ANGLE   = 1112
    %ID_DIAL    = 1113
    %ID_EXIT    = 1115
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Type JCONTROL
       hArea    As Dword       'graphic handler
       hDial    As Dword       'dial bmp handler
       hKnob    As Dword       'knob bmp handler
       idc      As Long        'control identifier
       hwide    As Long        'half dial size
       hhigh    As Long        ' "    "    "
       radius   As Long        'from dial center to knob center
       knobX    As Long        'knob current center position
       knobY    As Long        '  "     "       "      "
       angle    As Single      'gradient angle
    End Type
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Macro Pi    = 3.141592653589793##   'some comment?
    Macro ToRad = 0.017453292519943##   'pi/180
    Macro ToDeg = 57.29577951308232##   '180/pi
    Macro P2Pdistance(X1,Y1,X2,Y2) = Sqr((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2))
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Global jD As JCONTROL
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function PBMain() As Long
       Local hDlg As Dword
       Local fW, fH As Long
    
       Dialog Font Default "Arial", 9, 0, 0
       Dialog New Pixels, 0, "Any angle gradient - 1a", , , 494, 314, %WS_CAPTION Or %WS_SYSMENU, 0 To hDlg
       Control Add Graphic,  hDlg, %ID_BOARD, "", 5, 5, 404, 304, %WS_BORDER Or %SS_NOTIFY
       Graphic Attach        hDlg, %ID_BOARD, ReDraw
       Control Get Client    hDlg, %ID_BOARD To fW, fH       'get client size
       Graphic Scale (0, 0) - (fW, fH)                       'scale to pixel coordinate system
    
       Control Add Button,   hDlg, %ID_EXIT,  "Quit",        416, 287, 74, 22
       Control Add Label,    hDlg, %ID_ANGLE, " 0º",         432,  56, 40, 18, %SS_CENTER, %WS_EX_STATICEDGE
       CreateDial            hDlg, %ID_DIAL,                 414,  80, 76, 76
    
       Dialog Show Modal hDlg Call DialogProc
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    CallBack Function DialogProc() As Long
       Static hDC As Dword
       Static wide, high As Long
    
       Select Case As Long Cb.Msg
          Case %WM_INITDIALOG
             Graphic Get DC To hDC
             Control Get Client Cb.Hndl, %ID_BOARD To wide, high
             DrawDial Cb.Hndl
             DrawGradient hDC, 0, 0, wide, high, RGB(128, 0, 0), RGB(255, 255, 0), jD.angle
    
          Case %WM_SETCURSOR
             If Cb.wParam = jD.hArea Then
                If GetAsyncKeyState(%VK_LBUTTON) <> 0 Then
                   ControlKnob Cb.Hndl
                   DrawGradient hDC, 0, 0, wide, high, RGB(128, 0, 0), RGB(255, 255, 0), jD.angle
                   Graphic Redraw
                   Function = 0
                End If
             End If
    
          Case %WM_COMMAND
             Select Case Cb.Ctl
                Case %ID_EXIT, %IDCANCEL
                   If Cb.CtlMsg = %BN_CLICKED Then Dialog End Cb.Hndl
                End Select
       End Select
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function CreateDial(ByVal hWnd As Dword, ByVal idc As Long, ByVal posx As Long, _
                        ByVal posy As Long,  ByVal wide As Long, ByVal high As Long) As Dword
       Local rll, rhh, bkcolr As Long
    
       bkcolr = GetSysColor(%COLOR_MENUBAR)
    
       '--- create dial bmp ---
       Graphic Bitmap New wide, high To jD.hDial
       Graphic Attach jD.hDial, 0
       Graphic Box     (0, 0) - (wide, high), , bkcolr, -1
       Graphic Line    (0, high/2) - (wide, high/2), %WHITE
       Graphic Line    (wide/2, 0) - (wide/2, high), %WHITE
       Graphic Ellipse (0, 0) - (wide, high), %GRAY, -2, 0
    
       '--- create knob bmp ---
       Graphic Bitmap New 14, 14 To jD.hKnob
       Graphic Attach jD.hKnob, 0
       Graphic Box     (0, 0) - (14, 14), , bkcolr, -1
       Graphic Ellipse (0, 0) - (14, 14), %GRAY, %LTGRAY
    
       '--- create graphic area for dial control ---
       Control Add Graphic, hWnd, idc, "", posx, posy, wide, high, %SS_NOTIFY
       Control Get Client   hWnd, idc To rll, rhh         'get client size
       Graphic Attach hWnd, idc, ReDraw                   'ATTACH new graphic area to trackbar
       Graphic Scale (0, 0) - (rll, rhh)                  'scale to pixel coordinate
       Control Handle hWnd, idc To jD.hArea               'save handler
    
       '--- save parameters to be used after ----
       jD.hwide  = wide/2                                 'save parameters
       jD.hhigh  = high/2                                 '  "      "
       jD.idc    = idc                                    '  "      "
       jD.radius = (wide/2)-12                            '  "      "
       jD.knobX  = wide/2                                 'initial knob position, at 0º
       jD.knobY  = 12                                     '   "      "     "
       jD.angle  = 0                                      'dawn at 0º
       Graphic Attach hWnd, %ID_BOARD, Redraw             'ATTACH, return control to main graphic
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub DrawDial(ByVal hWnd As Dword)
       Graphic Attach jD.hArea, jD.idc, ReDraw            'get graphic control, ATTACH
       Graphic Copy jD.hDial, 0                           'draw dial
       Graphic Copy jD.hKnob, 0 To (jD.knobX-7, jD.knobY-7) 'draw knob
       Graphic Redraw
       Graphic Attach hWnd, %ID_BOARD, Redraw             'ATTACH, return control to main graphic
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub ControlKnob(Byval hWnd As Dword)
       Local sAngle, rPt As Single
       Local xx, yy As Long
       Local pt As POINTAPI
    
       GetCursorPos pt
       ScreenToClient jD.hArea, pt
       If P2PDistance(pt.x, pt.y, jD.knobX, jD.knobY) > 12.0 Then Exit Sub
    
       xx = pt.x - jD.hwide
       yy = pt.y - jD.hhigh
       rPt = Sqr((xx * xx) + (yy * yy))
       jD.knobX = xx * jD.radius / rPt + jD.hwide
       jD.knobY = yy * jD.radius / rPt + jD.hhigh
       '--- angle in degrees
       sAngle = (Atn(yy / xx)) * ToDeg
       '--- make centre zero with index at top
       jd.angle = Iif(xx > 0, 90 + sAngle, 270 + sAngle)
       '--- correct 0 and 180 points
       If jD.angle = 360 Then
          jD.angle = 180
       ElseIf jD.angle = 180 Then
          jD.angle = 0
       End If
       '--- draw it and show angle
       DrawDial hWnd
       Control Set Text hWnd, %ID_ANGLE, Format$(jD.angle, "###\º")
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub DrawGradient(ByVal hDC As Long, ByVal xx As Long, ByVal yy As Long, _
                     ByVal Wide As Long, ByVal High As Long, _
                     ByVal Colour1 As Long, ByVal Colour2 As Long, _
                     ByVal Angle As Single)
       Register i As Long, j As Long
       Local Colour, R1, G1, B1, R2, G2, B2, dR, dG, dB As Long
       Local iIn, jIn, iEnd, jEnd, ScanW, Offset As Long
       Local gr, uSin, uCos, Quadr As Long
       Local AngleDiag, AngleComp As Single
       Local lBits(), lGrad() As Long
       Local bmph As BITMAPINFO
    
       '--- normalize to 0º 360º
       Angle = Angle Mod 360
       If (Angle < 0) Then Angle = 360 + Angle
       '--- get quadrant (0 - 3)
       Quadr = Angle \ 90
       '--- normalize to 0º 90º
       Angle = Angle Mod 90
       '--- calculate gradient length ('distance')
       If (Quadr Mod 2 = 0) Then
          AngleDiag = Atn(Wide / High) * ToDeg
       Else
          AngleDiag = Atn(High / Wide) * ToDeg
       End If
       AngleComp = (90 - Abs(Angle - AngleDiag)) * ToRad
       Angle = Angle * ToRad
       gr = Sqr(Wide * Wide + High * High) * Sin(AngleComp)
       '--- decompose colors
       If (Quadr > 1) Then
          Colour  = Colour1
          Colour1 = Colour2
          Colour2 = Colour
       End If
       R1 = (Colour1 And &h0000FF&)
       G1 = (Colour1 And &h00FF00&) \ 256
       B1 = (Colour1 And &hFF0000&) \ 65536
       R2 = (Colour2 And &h0000FF&)
       G2 = (Colour2 And &h00FF00&) \ 256
       B2 = (Colour2 And &hFF0000&) \ 65536
       '--- get color distances
       dR = R2 - R1
       dG = G2 - G1
       dB = B2 - B1
       '--- size gradient-colors array
       ReDim lGrad(0 To gr - 1)
       '--- calculate gradient-colors
       iEnd = gr - 1
       For i = 0 To iEnd
          lGrad(i) = B1 + (dB * i) \ iEnd + 256 * (G1 + (dG * i) \ iEnd) + 65536 * (R1 + (dR * i) \ iEnd)
       Next i
       '--- size DIB array
       ReDim lBits(Wide * High - 1) As Long
       '--- render gradient DIB
       iEnd = Wide - 1
       jEnd = High - 1
       Select Case Quadr
          Case 0, 2
             uSin   = Sin(Angle) * 1000
             uCos   = Cos(Angle) * 1000
             Offset = 0
             ScanW  = Wide
          Case 1, 3
             uSin   = Sin(90 * ToRad - Angle) * 1000
             uCos   = Cos(90 * ToRad - Angle) * 1000
             Offset = jEnd * Wide
             ScanW  = -Wide
       End Select
       jIn = 0  :  iIn = 0
       For j = 0 To jEnd
          iIn = jIn
          For i = 0 To iEnd
             lBits(i + Offset) = lGrad(iIn \ 1000)
             iIn = iIn + uSin
          Next i
          jIn = jIn + uCos
          Offset = Offset + ScanW
       Next j
       '--- define DIB header
       bmph.bmiHeader.biSize     = 40
       bmph.bmiHeader.biPlanes   = 1
       bmph.bmiHeader.biBitCount = 32
       bmph.bmiHeader.biWidth    = Wide
       bmph.bmiHeader.biHeight   = High
       '--- draw it
       StretchDIBits hDC, xx, yy, Wide, High, 0, 0, Wide, High, ByVal VarPtr(lBits(0)), bmph, %DIB_RGB_COLORS, %SRCCOPY
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    'eof
    '
    This zip file contains source and executable
    Attached Files
    Last edited by Jordi Vallès; 7 May 2010, 03:09 AM. Reason: %COLOR_MENU changed to %COLOR_MENUBAR

  • #2
    Great code as usual, just the source file in the attachement seems to contain odd character for "°", maybe some Unicode trouble?
    It occurs here, when viewed on Czech XPs.
    Attaching "fixed" version with little modification for more tolerant knob (no need to carefully drag the circle on knob).
    Attached Files
    petrschreiber@gmail.com

    Comment


    • #3
      New version (1b) with corrections and additions:
      - Solve a problem with some local language.
      - Now tested on XP too, a color changed.
      - Optional precision knob control.
      Thanks Petr to report problem and suggestion.
      Attached Files

      Comment


      • #4
        New version (1e) with some improvements and additions:
        - Gradient on rectangles and ellises.
        - Four different views of same gradient.
        - Better knob, visually improved.
        - Fixed gradient themes.
        - Start and end gradient colors can be selected by user.
        - A readability check is possible now.
        Attached Files

        Comment


        • #5
          In source code of AnyAngle.bas file I found an small error that is visible in ellipses on XP only.
          Line 497, inside DrawGradient procedure is
          Code:
             @TmpPtr = jB.bkColor           'corners of bounding rectangle
          and must be
          Code:
             @TmpPtr = BGR(jB.bkColor)      'corners of bounding rectangle
          Jordi
          Last edited by Jordi Vallès; 20 May 2010, 05:09 PM.

          Comment


          • #6
            Modified by Jim Fritts on 05-AUG-2018
            Now works with Jose's includes and PBWIN 10.4


            Code:
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            '  AnyAngle.bas                            Jordi Vallès        version 1e       17/05/2010
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            '  Gradient in any direction selectable using a rotary knob. On rectangles and ellipses.
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            '  - Compiled and tested with PowerBASIC for Windows 9.04 on a PC HP Pavilion with
            '    Windows Vista Home Premium SP2.
            '  - Code posted here is released to Public Domain. Use at your own risk.
            '  - Some ideas, comments and code portions are borrowed from people of PB community.
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            ' 05/05/2010 - First version.
            ' 08/05/2010 - Solve problem with some local languages.
            '            - Now tested on XP too, a color changed.
            '            - Optional precision knob control.
            ' 11/05/2010 - Better knob, visually improved.
            '            - Color theme can be choosen.
            '            - Different gradient views added.
            '            - Start and end gradient colors can be selected by user.
            ' 17/05/2010 - A readability text check is possible now.
            '            - Added ellipses as figures with gradient.
            '            - Code optimized in size and speed.
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            ' SED_PBWIN
            
            'Original Post
            'https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/44591-gradients-at-any-angle?p=526001#post526001
            
            'Modified by Jim Fritts on 05-AUG-2018
            'Corrected variable conflicts
            'Now works with Jose's includes and PBWIN 10.4
            'Very Cool Jordi
            'Thank you
            
            #COMPILE EXE
            #DIM ALL
            
            %USEMACROS = 1
            #INCLUDE ONCE "Win32Api.inc"
            #INCLUDE ONCE "ComDlg32.inc"
            
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            %ID_BOARD1  = 1101
            %ID_BOARD2  = 1102
            %ID_BOARD3  = 1103
            %ID_BOARD4  = 1104
            
            %ID_ANGLE   = 1111
            %ID_DIAL    = 1112
            %ID_EXACT   = 1113
            %ID_CHECK   = 1114
            
            %ID_FRM3    = 1121         'frame 3
            %ID_BOXES   = 1122
            %ID_ELLIP   = 1123
            
            %ID_FRM2    = 1131         'frame 2
            %ID_START   = 1132
            %ID_END     = 1133
            %ID_TXT1    = 1134
            %ID_TXT2    = 1135
            
            %ID_FRM1    = 1151         'frame 1
            %ID_THM1    = 1152
            %ID_THM2    = 1153
            %ID_THM3    = 1154
            %ID_THM4    = 1155
            %ID_THM5    = 1156
            
            %QBLACK1    = &h000001???  'quasi black in RGB, used per ellipse mask
            %QBLACK2    = &h010000???  'quasi black in BGR, used to check QBLACK1 on DIB
            
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            TYPE JKNOB
               hArea    AS DWORD       'graphic handler
               hDial    AS DWORD       'dial bmp handler
               idc      AS LONG        'control identifier
               hwide    AS LONG        'half dial size
               hhigh    AS LONG        ' "    "    "
               radius   AS LONG        'from dial center to knob center
               knobX    AS LONG        'knob current center position
               knobY    AS LONG        '  "     "       "      "
               angle    AS SINGLE      'gradient angle
               precise  AS LONG        'precise knob control
            END TYPE
            
            TYPE JFIGURES
               wideX     AS LONG
               highY     AS LONG
            END TYPE
            
            TYPE JBOARD
               isEllip  AS LONG
               testTxt  AS LONG
               bkColor  AS LONG
               hFontS   AS DWORD
               hFontN   AS DWORD
               clr(1 TO 4) AS LONG
               fig(1 TO 4) AS JFIGURES
            END TYPE
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            MACRO PPiX    = 3.141592653589793##   'some comment?
            MACRO TwoPi = 6.283185307179586##   'pi*2
            MACRO ToRad = 0.017453292519943##   'pi/180
            MACRO ToDeg = 57.29577951308232##   '180/pi
            MACRO P2Pdistance(X1,Y1,X2,Y2) = SQR((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2))
            MACRO Angle2Radiant(sangle) = TwoPi * (1-sangle/360)
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            GLOBAL jK AS JKNOB
            GLOBAL jB AS JBOARD
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            FUNCTION PBMAIN() AS LONG
               LOCAL hDlg AS DWORD
               LOCAL fW, fH AS LONG
            
               FONT NEW "Symbol", 10, 0, 0, 0, 0 TO jB.hFontS
               FONT NEW "Arial",  10, 0, 0, 0, 0 TO jB.hFontN
            
               DIALOG FONT DEFAULT "Arial", 9, 0, 0
               DIALOG NEW PIXELS, 0, "Any angle gradient - 1e", , , 564, 364, %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg
            
               CONTROL ADD GRAPHIC,  hDlg, %ID_BOARD1, "", 5, 5, 404, 304, %SS_NOTIFY
               GRAPHIC ATTACH        hDlg, %ID_BOARD1, REDRAW
               CONTROL GET CLIENT    hDlg, %ID_BOARD1 TO fW, fH         'get client size
               GRAPHIC SCALE (0, 0) - (fW, fH)                          'scale to pixel coordinate system
               jB.fig(1).wideX = fW  :  jB.fig(1).highY = fH
            
               CONTROL ADD GRAPHIC,  hDlg, %ID_BOARD2, "", 5, 314, 404, 44, %SS_NOTIFY
               GRAPHIC ATTACH        hDlg, %ID_BOARD2, REDRAW
               CONTROL GET CLIENT    hDlg, %ID_BOARD2 TO fW, fH         'get client size
               GRAPHIC SCALE (0, 0) - (fW, fH)                          'scale to pixel coordinate system
               jB.fig(2).wideX = fW  :  jB.fig(2).highY = fH
            
               CONTROL ADD GRAPHIC,  hDlg, %ID_BOARD3, "", 414, 5, 44, 304, %SS_NOTIFY
               GRAPHIC ATTACH        hDlg, %ID_BOARD3, REDRAW
               CONTROL GET CLIENT    hDlg, %ID_BOARD3 TO fW, fH         'get client size
               GRAPHIC SCALE (0, 0) - (fW, fH)                          'scale to pixel coordinate system
               jB.fig(3).wideX = fW  :  jB.fig(3).highY = fH
            
               CONTROL ADD GRAPHIC,  hDlg, %ID_BOARD4, "", 414,314, 44, 44, %SS_NOTIFY
               GRAPHIC ATTACH        hDlg, %ID_BOARD4, REDRAW
               CONTROL GET CLIENT    hDlg, %ID_BOARD4 TO fW, fH         'get client size
               GRAPHIC SCALE (0, 0) - (fW, fH)                          'scale to pixel coordinate system
               jB.fig(4).wideX = fW  :  jB.fig(4).highY = fH
            
               CONTROL ADD LABEL,    hDlg, %ID_ANGLE, " 0°",            494,   6, 40, 18, %SS_CENTER, %WS_EX_STATICEDGE
               CONTROL SET FONT      hDlg, %ID_ANGLE, jB.hFontS
               CONTROL ADD CHECKBOX, hDlg, %ID_EXACT, "precise knob",   470, 100, 96, 18
               CONTROL ADD CHECKBOX, hDlg, %ID_CHECK, "readability",    470, 344, 96, 18
            
               CONTROL ADD FRAME,    hDlg, %ID_FRM1,  " color theme ",  466, 122, 92, 92
               CONTROL ADD OPTION,   hDlg, %ID_THM1,  "Fire",           478, 140, 60, 14, %WS_GROUP
               CONTROL ADD OPTION,   hDlg, %ID_THM2,  "Leaves",         478, 154, 60, 14
               CONTROL ADD OPTION,   hDlg, %ID_THM3,  "Sky",            478, 168, 60, 14
               CONTROL ADD OPTION,   hDlg, %ID_THM4,  "Fog",            478, 182, 60, 14
               CONTROL ADD OPTION,   hDlg, %ID_THM5,  "Selection",      478, 196, 70, 14
               CONTROL SET OPTION    hDlg, %ID_THM1, %ID_THM1, %ID_THM5
            
               CONTROL ADD FRAME,    hDlg, %ID_FRM2,  " user colors ",  466, 220, 92, 62
               CONTROL ADD BUTTON,   hDlg, %ID_START, "",               476, 238, 22, 16, %BS_OWNERDRAW
               CONTROL ADD BUTTON,   hDlg, %ID_END,   "",               476, 258, 22, 16, %BS_OWNERDRAW
               CONTROL ADD LABEL,    hDlg, %ID_TXT1,  "Start",          506, 240, 40, 14
               CONTROL ADD LABEL,    hDlg, %ID_TXT2,  "End",            506, 262, 40, 14
            
               CONTROL ADD FRAME,    hDlg, %ID_FRM3,  " figures ",      466, 288, 92, 50
               CONTROL ADD OPTION,   hDlg, %ID_BOXES, "Boxes",          478, 306, 70, 14, %WS_GROUP
               CONTROL ADD OPTION,   hDlg, %ID_ELLIP, "Ellipses",       478, 320, 70, 14
               CONTROL SET OPTION    hDlg, %ID_BOXES, %ID_BOXES, %ID_ELLIP
            
               jB.bkColor = GetSysColor(%COLOR_MENUBAR)                 'tested on Vista and XP
               CreateDial            hDlg, %ID_DIAL,                    480,  30, 66, 66
            
               DIALOG SHOW MODAL hDlg CALL DialogProc
               FONT END jB.hFontS
               FONT END jB.hFontN
            END FUNCTION
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            CALLBACK FUNCTION DialogProc() AS LONG
               LOCAL lpdis  AS DRAWITEMSTRUCT PTR
               LOCAL ColorSpec AS CHOOSECOLORAPI
               LOCAL hBrush AS DWORD
               LOCAL lCounter, lResult AS LONG
               DIM lCustomColor(15) AS LONG
            
               SELECT CASE AS LONG CB.MSG
            
                  CASE %WM_INITDIALOG
                     ControlSelection CB.HNDL, %FALSE
                     GRAPHIC ATTACH CB.HNDL, %ID_BOARD1, REDRAW         'set control to main board
                     'set default colors
                     jB.clr(1) = RGB(128, 0, 0)  :  jB.clr(2) = RGB(255, 255, 0)  'fire
                     jB.clr(3) = %BLACK          :  jB.clr(4) = %WHITE            'boring
                     DrawDial CB.HNDL
                     DrawAll CB.HNDL
            
                  CASE %WM_SETCURSOR
                     IF CB.WPARAM = jK.hArea THEN
                        IF GetAsyncKeyState(%VK_LBUTTON) <> 0 THEN
                           ControlKnob CB.HNDL
                           DrawAll CB.HNDL
                           FUNCTION = %FALSE
                        END IF
                     END IF
            
                  CASE %WM_DRAWITEM                                     'buttons for start & end user colors
                     SELECT CASE CB.CTL
                        CASE %ID_START, %ID_END
                           lpdis = CB.LPARAM
                           hBrush = CreateSolidBrush(IIF(CB.CTL = %ID_START, jB.clr(3), jB.clr(4)))
                           FillRect @lpdis.hDc, @lpdis.rcItem, hBrush
                           DrawEdge @lpdis.hDC, @lpdis.rcItem, %BDR_RAISEDOUTER, %BF_RECT
                           DeleteObject hBrush
                           FUNCTION = %FALSE
                     END SELECT
            
                  CASE %WM_COMMAND
                     SELECT CASE CB.CTL
                        CASE %ID_EXACT
                           CONTROL GET CHECK CB.HNDL, %ID_EXACT TO jK.precise
            
                        CASE %ID_CHECK
                           CONTROL GET CHECK CB.HNDL, %ID_CHECK TO jB.testTxt
                           DrawAll CB.HNDL
            
                        CASE %ID_BOXES TO %ID_ELLIP
                           jB.IsEllip = CB.CTL - 1122
                           DrawAll CB.HNDL
            
                        CASE %ID_THM1 TO %ID_THM5
                           ControlSelection CB.HNDL, %FALSE
                           SELECT CASE CB.CTL
                              CASE %ID_THM1                       'fire
                                 jB.clr(1) = RGB(180, 080, 000)  :  jB.clr(2) = RGB(255, 255, 000)
                              CASE %ID_THM2                       'leaves
                                 jB.clr(1) = RGB(020, 100, 080)  :  jB.clr(2) = RGB(220, 250, 090)
                              CASE %ID_THM3                       'sky
                                 jB.clr(1) = RGB(050, 150, 200)  :  jB.clr(2) = RGB(233, 244, 255)
                              CASE %ID_THM4                       'fog
                                 jB.clr(1) = RGB(160, 160, 160)  :  jB.clr(2) = RGB(255, 255, 255)
                              CASE %ID_THM5                       'user selection
                                 ControlSelection CB.HNDL, %TRUE
                                 jB.clr(1) = jB.clr(3)  :  jB.clr(2) = jB.clr(4)
                           END SELECT
                           DrawAll CB.HNDL
            
                        CASE %ID_START, %ID_END
                           ColorSpec.lStructSize  = LEN(ColorSpec)
                           ColorSpec.hwndOwner    = CB.HNDL
                           ColorSpec.RgbResult    = RGB(193,172,053) 'set the default color
                           ColorSpec.lpCustColors = VARPTR(lCustomColor(0))
                           ColorSpec.Flags        = %CC_RGBINIT ' Or %CC_FULLOPEN
                           FOR lCounter = 0 TO 15                 'create a nice selection of colors for the custom colors
                              lCustomColor(lCounter) = RND(0,16777215)
                           NEXT                                   'could also load custom colors from a file, or hard-code them
                           lResult = ChooseColor(ColorSpec)       'call standard color function kindly provided by MS
                           IF lResult <> 0 THEN                   'if not cancelled then ...
                              IF CB.CTL = %ID_START THEN
                                 jB.clr(3) = ColorSpec.RgbResult
                                 CONTROL REDRAW CB.HNDL, %ID_START
                                 jB.clr(1) = jB.clr(3)
                              ELSE
                                 jB.clr(4) = ColorSpec.RgbResult
                                 CONTROL REDRAW CB.HNDL, %ID_END
                                 jB.clr(2) = jB.clr(4)
                              END IF
                           END IF
                           DrawAll CB.HNDL
            
                        CASE %IDCANCEL
                           IF CB.CTLMSG = %BN_CLICKED THEN DIALOG END CB.HNDL
                     END SELECT
                     GetAsyncKeyState %VK_LBUTTON                 'clear pending clicks
            
               END SELECT
            END FUNCTION
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB DrawAll(BYVAL hWnd AS DWORD)
               GRAPHIC ATTACH hWnd, %ID_BOARD4, REDRAW
               IF jB.isEllip THEN
                  GRAPHIC BOX     (0, 0) - (jB.fig(4).wideX, jB.fig(4).highY), , jB.bkColor, -1
                  GRAPHIC ELLIPSE (0, 0) - (jB.fig(4).wideX, jB.fig(4).highY), jB.bkColor, %QBLACK1
               END IF
               DrawGradient jB.fig(4).wideX, jB.fig(4).highY, jB.clr(1), jB.clr(2), jK.angle
            
               GRAPHIC ATTACH hWnd, %ID_BOARD3, REDRAW
               IF jB.isEllip THEN
                  GRAPHIC BOX     (0, 0) - (jB.fig(3).wideX, jB.fig(3).highY), , jB.bkColor, -1
                  GRAPHIC ELLIPSE (0, 0) - (jB.fig(3).wideX, jB.fig(3).highY), jB.bkColor, %QBLACK1
               END IF
               DrawGradient jB.fig(3).wideX, jB.fig(3).highY, jB.clr(1), jB.clr(2), jK.angle
            
               GRAPHIC ATTACH hWnd, %ID_BOARD2, REDRAW
               IF jB.isEllip THEN
                  GRAPHIC BOX     (0, 0) - (jB.fig(2).wideX, jB.fig(2).highY), , jB.bkColor, -1
                  GRAPHIC ELLIPSE (0, 0) - (jB.fig(2).wideX, jB.fig(2).highY), jB.bkColor, %QBLACK1
               END IF
               DrawGradient jB.fig(2).wideX, jB.fig(2).highY, jB.clr(1), jB.clr(2), jK.angle
            
               GRAPHIC ATTACH hWnd, %ID_BOARD1, REDRAW
               IF jB.isEllip THEN
                  GRAPHIC BOX     (0, 0) - (jB.fig(1).wideX, jB.fig(1).highY), , jB.bkColor, -1
                  GRAPHIC ELLIPSE (0, 0) - (jB.fig(1).wideX, jB.fig(1).highY), jB.bkColor, %QBLACK1
               END IF
               DrawGradient jB.fig(1).wideX, jB.fig(1).highY, jB.clr(1), jB.clr(2), jK.angle, jB.testTxt
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB ControlSelection(BYVAL hWnd AS DWORD, BYVAL activate AS LONG)
               IF activate THEN
                  CONTROL ENABLE hWnd, %ID_START
                  CONTROL ENABLE hWnd, %ID_END
                  CONTROL ENABLE hWnd, %ID_FRM2
                  CONTROL ENABLE hWnd, %ID_TXT1
                  CONTROL ENABLE hWnd, %ID_TXT2
               ELSE
                  CONTROL DISABLE hWnd, %ID_START
                  CONTROL DISABLE hWnd, %ID_END
                  CONTROL DISABLE hWnd, %ID_FRM2
                  CONTROL DISABLE hWnd, %ID_TXT1
                  CONTROL DISABLE hWnd, %ID_TXT2
               END IF
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            FUNCTION CreateDial(BYVAL hWnd AS DWORD, BYVAL idc AS LONG, BYVAL posx AS LONG, _
                                BYVAL posy AS LONG,  BYVAL Mywide AS LONG, BYVAL Myhigh AS LONG) AS DWORD
               LOCAL j, rangle, flange, rll, rhh AS LONG
            
               '--- create dial bmp --- adapted from R.Bervini code
               GRAPHIC BITMAP NEW Mywide, Myhigh TO jK.hDial
               GRAPHIC ATTACH jK.hDial, 0
               GRAPHIC BOX     (0, 0) - (Mywide, Myhigh), , jB.bkColor, -1
               rangle = 310
               flange = 0
               FOR j = 180 TO 1 STEP -1
                  DrawReflex Mywide, Myhigh, 0+rangle, j, flange
                  DrawReflex Mywide, Myhigh, 180+rangle, j, flange
               NEXT
               GRAPHIC ELLIPSE (0, 0) - (Mywide, Myhigh), %BLACK
               rangle = 302
               flange = 6
               FOR j = 180 TO 1 STEP -1
                  DrawReflex Mywide, Myhigh, 0+rangle, j, flange
                  DrawReflex Mywide, Myhigh, 180+rangle, j, flange
               NEXT
               GRAPHIC ELLIPSE (flange, flange) - (Mywide-flange, Myhigh-flange), %BLACK
            
               '--- create graphic area for dial control ---
               CONTROL ADD GRAPHIC, hWnd, idc, "", posx, posy, Mywide, Myhigh, %SS_NOTIFY
               CONTROL GET CLIENT   hWnd, idc TO rll, rhh         'get client size
               GRAPHIC ATTACH hWnd, idc, REDRAW                   'ATTACH new graphic area to trackbar
               GRAPHIC SCALE (0, 0) - (rll, rhh)                  'scale to pixel coordinate
               CONTROL HANDLE hWnd, idc TO jK.hArea               'save handler
            
               '--- save parameters to be used after ----
               jK.hwide  = Mywide/2                                 'save parameters
               jK.hhigh  = Myhigh/2                                 '  "      "
               jK.idc    = idc                                    '  "      "
               jK.radius = (Mywide/2)-13                            '  "      "
               jK.knobX  = Mywide/2                                 'initial knob position, at 0º
               jK.knobY  = 13                                     '   "      "     "
               jK.angle  = 0                                      'dawn on 0º at init
            END FUNCTION
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB DrawReflex(BYVAL la AS LONG, BYVAL al AS LONG, BYVAL init0 AS LONG, BYVAL init1 AS LONG, BYVAL entry AS LONG)
               LOCAL arcStart, arcEnd AS SINGLE
               LOCAL colour AS LONG
            
               colour   = RGB(255-init1, 255-init1, 255-init1)
               arcStart = init0+init1/2-90
               arcEnd   = init0-init1/2-90
               GRAPHIC PIE (entry, entry) - (la-entry, al-entry), Angle2Radiant(arcStart), Angle2Radiant(arcEnd), colour, colour
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB DrawDial(BYVAL hWnd AS DWORD)
               GRAPHIC ATTACH jK.hArea, jK.idc, REDRAW            'get graphic control, ATTACH
               GRAPHIC COPY jK.hDial, 0                           'draw dial
               GRAPHIC ELLIPSE (jK.knobX-5, jK.knobY-5) - (jK.knobX+5, jK.knobY+5), %BLACK, %LTGRAY  'draw knob
               GRAPHIC REDRAW                                     'needed before return to main graphic
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB ControlKnob(BYVAL hWnd AS DWORD)
               LOCAL sAngle, rPt AS SINGLE
               LOCAL xx, yy AS LONG
               LOCAL pt AS POINTAPI
            
               GetCursorPos pt
               ScreenToClient jK.hArea, pt
            
               IF jK.precise THEN
                  IF P2PDistance(pt.x, pt.y, jK.knobX, jK.knobY) > 10.0 THEN EXIT SUB
               END IF
            
               xx = pt.x - jK.hwide
               yy = pt.y - jK.hhigh
               rPt = SQR((xx * xx) + (yy * yy))
               jK.knobX = xx * jK.radius / rPt + jK.hwide
               jK.knobY = yy * jK.radius / rPt + jK.hhigh
               '--- angle in degrees
               sAngle = (ATN(yy / xx)) * ToDeg
               '--- make centre zero with index at top
               jK.angle = IIF(xx > 0, 90 + sAngle, 270 + sAngle)
               '--- correct 0 and 180 points
               IF jK.angle = 360 THEN
                  jK.angle = 180
               ELSEIF jK.angle = 180 THEN
                  jK.angle = 0
               END IF
               '--- draw it and show angle
               DrawDial hWnd
               CONTROL SET TEXT hWnd, %ID_ANGLE, FORMAT$(jK.angle, "###\°")
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB DrawGradient(BYVAL Mywide AS LONG, BYVAL Myhigh AS LONG, _
                             BYVAL colour1 AS LONG, BYVAL colour2 AS LONG, _
                             BYVAL Angle AS SINGLE, OPT BYVAL PutText AS LONG)
               REGISTER i AS LONG, j AS LONG
               STATIC TXT AS STRING
               STATIC FirstTime AS LONG
               LOCAL Colour, R1, G1, B1, R2, G2, B2, dR, dG, dBk AS LONG
               LOCAL iIn, jIn, iEnd, jEnd, ScanW, Offset AS LONG
               LOCAL gr, uSin, uCos, Quadr, lGrad() AS LONG
               LOCAL AngleDist, AngleComp AS SINGLE
               LOCAL StringTemp AS STRING
               LOCAL StringOffset, TmpPtr AS LONG PTR
            
               IF NOT FirstTime AND PutText THEN         'first time only is for BOARD1
                  INCR firstTime
                  TXT = "the quick brown fox jumps over the lazy dog"
                  GRAPHIC SET FONT jB.hFontN
               END IF
            
               '--- set current board contents as DIB in a dynamic string
               GRAPHIC GET BITS TO StringTemp
               StringOffset = STRPTR(StringTemp) + 8
            
               '--- normalize angle (0º to 360º)
               'invert value needed if DIB string is used ???
               'not needed if StretchDIBits API is used   ???
               Angle = (Angle MOD 360) * -1
               IF (Angle < 0) THEN Angle = 360 + Angle
               '--- get quadrant (0 - 3)
               Quadr = Angle \ 90
               '--- normalize to 0º 90º
               Angle = Angle MOD 90
               '--- calculate gradient length ('distance')
               IF (Quadr MOD 2 = 0) THEN
                  AngleDist = ATN(Mywide / Myhigh) * ToDeg
               ELSE
                  AngleDist = ATN(Myhigh / Mywide) * ToDeg
               END IF
               AngleComp = (90 - ABS(Angle - AngleDist)) * ToRad
               Angle = Angle * ToRad
               gr = SQR(Mywide * Mywide + Myhigh * Myhigh) * SIN(AngleComp)
               '--- decompose colors
               IF (Quadr > 1) THEN
                  Colour  = colour1
                  colour1 = colour2
                  colour2 = Colour
               END IF
               R1 = (colour1 AND &h0000FF&)
               G1 = (colour1 AND &h00FF00&) \ 256
               B1 = (colour1 AND &hFF0000&) \ 65536
               R2 = (colour2 AND &h0000FF&)
               G2 = (colour2 AND &h00FF00&) \ 256
               B2 = (colour2 AND &hFF0000&) \ 65536
               '--- get color distances
               dR = R2 - R1
               dG = G2 - G1
               dBk = B2 - B1
               '--- size gradient-colors array
               REDIM lGrad(0 TO gr - 1)
               '--- calculate gradient-colors
               iEnd = gr - 1
               FOR i = 0 TO iEnd
                  lGrad(i) = B1 + (dBk * i) \ iEnd + 256 * (G1 + (dG * i) \ iEnd) + 65536 * (R1 + (dR * i) \ iEnd)
               NEXT i
               '--- render gradient DIB
               iEnd = Mywide - 1  :  jEnd = Myhigh - 1
               SELECT CASE Quadr
                  CASE 0, 2
                     uSin   = SIN(Angle) * 1000
                     uCos   = COS(Angle) * 1000
                     Offset = 0
                     ScanW  = Mywide
                  CASE 1, 3
                     uSin   = SIN(90 * ToRad - Angle) * 1000
                     uCos   = COS(90 * ToRad - Angle) * 1000
                     Offset = jEnd * Mywide
                     ScanW  = -Mywide
               END SELECT
               jIn = 0  :  iIn = 0
            
               '---fill DIB array with colors
               FOR j = 0 TO jEnd
                  iIn = jIn
                  FOR i = 0 TO iEnd
                     TmpPtr = StringOffset + (i + Offset) * 4
                     IF jB.isEllip AND (@TmpPtr <> %QBLACK2) THEN 'if ellipse mode then test the ellipse mask
                        @TmpPtr = jB.bkColor                      'corners of bounding rectangle
                     ELSE
                        @TmpPtr = lGrad(iIn \ 1000)               'rectangle or ellipse interior part
                     END IF
                     iIn = iIn + uSin
                  NEXT i
                  jIn = jIn + uCos
                  Offset = Offset + ScanW
               NEXT j
            
               '--- replace the copy of bitmap that was retrieved as a DIB
               GRAPHIC SET BITS StringTemp                        'write new bitmap to the screen
            
               '--- check text readability, if marked
               IF PutText THEN
                  DrawTxt %BLACK,   6,  10, 10,  30, TXT
                  DrawTxt %RED,    14,  50, 18,  70, TXT
                  DrawTxt %WHITE,  22,  90, 26, 110, TXT
                  DrawTxt %BLUE,   30, 130, 34, 150, TXT
                  DrawTxt %GREEN,  38, 170, 42, 190, TXT
                  DrawTxt %YELLOW, 46, 210, 50, 230, TXT
                  DrawTxt %MAGENTA,54, 250, 58, 270, TXT
               END IF
               '--- and finally the winner is.....
               GRAPHIC REDRAW
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            SUB DrawTxt(BYVAL colour AS LONG, BYVAL px1 AS LONG, BYVAL py1 AS LONG, _
                        BYVAL px2 AS LONG, BYVAL py2 AS LONG, BYVAL txt AS STRING)
               GRAPHIC COLOR colour, -2
               GRAPHIC SET POS (px1, py1)  :  GRAPHIC PRINT TXT
               GRAPHIC SET POS (px2, py2)  :  GRAPHIC PRINT UCASE$(TXT)
            END SUB
            
            '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
            'eof

            Comment

            Working...
            X