Gradient Fill Between Two Colors

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As Dword
Global qFreq, qStart, qStop As Quad
 
Enum Equates Singular
   IDC_GraphicA = 500
   IDC_GraphicB
End Enum
 
Global hDlg,hBMP As Dword, ColorLeft, ColorRight, ColorArray(), MaxColors As Long
 
Function PBMain() As Long
   MaxColors = 101   '101 allows 0 to 100 as array elements
   Dialog New Pixels, 0, "Gradient Colors",300,300,270,MaxColors+40, %WS_OverlappedWindow To hDlg
   Control Add Graphic, hDlg, %IDC_GraphicA, "", 20,20,101,MaxColors
   Control Add Graphic, hDlg, %IDC_GraphicB, "", 150,20,101,MaxColors
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local temp$
   Select Case Cb.Msg
      Case %WM_InitDialog
         QueryPerformanceFrequency qFreq
         ReDim ColorArray(MaxColors-1)
 
         ColorLeft  = %rgb_Yellow
         ColorRight = %rgb_Blue
 
         QueryPerformanceCounter   qStart
         CreateGradientColors_GradientFill ColorArray(), ColorLeft, ColorRight, MaxColors
         ApplyColorsToGraphicControl %IDC_GraphicA
         QueryPerformanceCounter   qStop
         temp$ = "GradientFill: " + Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
 
         QueryPerformanceCounter   qStart
         CreateGradientColors_Custom ColorArray(), ColorLeft, ColorRight, MaxColors
         ApplyColorsToGraphicControl %IDC_GraphicB
         QueryPerformanceCounter   qStop
         temp$ += $CrLf + "Custom Function: " + Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
 
         ? temp$
 
   End Select
End Function
 
Sub ApplyColorsToGraphicControl(cID As Long)
   Local x,y,w,h As Long
   Graphic Attach hDlg, cID, ReDraw
   Graphic Get Client To w,h
   For x = 0 To w-1
      For y = 0 To h-1
         Graphic Set Pixel (x,y), ColorArray(y)
      Next y
   Next x
   Graphic ReDraw
End Sub
 
Sub CreateGradientColors_GradientFill (ColorArray() As Long, clrLeft As Long, clrRight As Long, MaxColors As Long)
   Local hBMP_Gradient,hDC_Gradient As Dword, gRect As Gradient_Rect, i,w,h As Long
   Dim V(1) As TriVertex
   h = 1 : w = MaxColors
   Graphic Bitmap New w,h To hBMP_Gradient
   Graphic Attach hBMP_Gradient,0
   Graphic Get DC To hDC_Gradient
   V(0).x      = 0
   V(0).y      = 0
   V(0).Red    = Mak(Word,0,GetRValue(clrLeft))
   V(0).Green  = Mak(Word,0,GetGValue(clrLeft))
   V(0).Blue   = Mak(Word,0,GetBValue(clrLeft))
   V(1).x      = w
   V(1).y      = h
   V(1).Red    = Mak(Word,0,GetRValue(clrRight))
   V(1).Green  = Mak(Word,0,GetGValue(clrRight))
   V(1).Blue   = Mak(Word,0,GetBValue(clrRight))
   gRect.UpperLeft = 0
   gRect.LowerRight = 1
   GradientFill hDC_Gradient, V(0), 2, gRect, 1, %Gradient_Fill_Rect_H
   For i = 0 To MaxColors : Graphic Get Pixel (i,0) To ColorArray(i) : Next i
   Graphic Bitmap End
End Sub
 
Sub CreateGradientColors_Custom(ColorArray() As Long, ClrLeft As Long, ClrRight As Long, MaxColors As Long)
   Local i,R1,G1,B1,R2,G2,B2 As Long, s As Single
   For i = 0 To MaxColors
      R1 = ClrLeft Mod 256              'or R1 = GetRValue(ClrLeft)
      G1 = (ClrLeft\256) Mod 256        'or G1 = GetGValue(ClrLeft)
      B1 = (ClrLeft\256\256) Mod 256    'or B1 = GetBValue(ClrLeft)
      R2 = ClrRight Mod 256             'or R2 = GetRValue(ClrRight)
      G2 = (ClrRight\256) Mod 256       'or G2 = GetGValue(ClrRight)
      B2 = (ClrRight\256\256) Mod 256   'or B2 = GetBValue(ClrRight)
      s = i/MaxColors
      ColorArray(i) = RGB( (R1 + (R2-R1)*s), (G1 + (G2-G1)*s), (B1 + (B2-B1)*s) )
   Next i
End Sub
 
 

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm