As allways, this code was started in the 'Coding Questions' area
, but now maybe somebody will find a good use for it. Nothing fancy or hard, just a small effect... If some bright minds can improve this, it would be really cool. Source and demo are here:I hope you like it
Code: Select all
;-
;- Gradient Fill Example, For PureBasic 4.0.
;-
EnableExplicit
;-
;- Initialising Win32 API (Msimg32.dll)
;-
Macro NotDef(x, y)
Defined(x, y) = #False
EndMacro
CompilerIf NotDef(GRADIENT_RECT, #PB_Structure) ;{
Structure GRADIENT_RECT
UpperLeft.l
LowerRight.l
EndStructure
CompilerEndIf ;}
CompilerIf NotDef(GRADIENT_TRIANGLE, #PB_Structure) ;{
Structure GRADIENT_TRIANGLE
Vertex1.l
Vertex2.l
Vertex3.l
EndStructure
CompilerEndIf ;}
Enumeration ; #GRADIENT_FILL_
#GRADIENT_FILL_RECT_H
#GRADIENT_FILL_RECT_V
#GRADIENT_FILL_TRIANGLE
EndEnumeration
Import "msimg32.lib"
GradientFill(*hDC, *pVertex, numVertex.l, *pMesh, numMesh.l, flags.l)
EndImport
;-
;- Defining Rectangle
;-
Global Dim vRectangle.TRIVERTEX(1)
Global Dim gRectangle.GRADIENT_RECT(0)
With vRectangle(0) ;{
\x = 10
\y = 10
\Red = $0000
\Green = $0000
\Blue = $A000
\Alpha = $0000
EndWith ;}
With vRectangle(1) ;{
\x = 630
\y = 470
\Red = $0000
\Green = $0000
\Blue = $0000
\Alpha = $0000
EndWith ;}
With gRectangle(0) ;{
\UpperLeft = 0
\LowerRight = 1
EndWith ;}
;-
;- Defining Triangle
;-
Global Dim vTriangle.TRIVERTEX(2)
Global Dim gTriangle.GRADIENT_TRIANGLE(0)
With vTriangle(0) ;{
\x = 50
\y = 50
\Red = $FF00
\Green = $0000
\Blue = $0000
\Alpha = $0000
EndWith ;}
With vTriangle(1) ;{
\x = 350
\y = 75
\Red = $0000
\Green = $FF00
\Blue = $0000
\Alpha = $0000
EndWith ;}
With vTriangle(2) ;{
\x = 200
\y = 400
\Red = $0000
\Green = $0000
\Blue = $FF00
\Alpha = $0000
EndWith ;}
With gTriangle(0) ;{
\Vertex1 = 0
\Vertex2 = 1
\Vertex3 = 2
EndWith ;}
;-
;- Drawing Rectangle & Triangle
;-
Procedure myCallback(window, message, wParam, lParam)
Protected result.l, dc.l, ps.PAINTSTRUCT
result = #PB_ProcessPureBasicEvents
Select message
Case #WM_PAINT, #WM_NCPAINT
dc = BeginPaint_(window, @ps)
If dc
GradientFill(dc, @vRectangle(), 2, @gRectangle(), 1, #GRADIENT_FILL_RECT_V)
GradientFill(dc, @vTriangle(), 3, @gTriangle(), 1, #GRADIENT_FILL_TRIANGLE)
EndPaint_(window, @ps)
EndIf
EndSelect
ProcedureReturn result
EndProcedure
If OpenWindow(0,100,100,640,480,"")
SetWindowColor(0, #Black)
SetWindowCallback(@myCallback(), 0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow: Break
EndSelect
ForEver
EndIf
.
