'================================================================
'= グラデーションで塗りつぶす
'=    (GradientFill.bas)
'================================================================
#include "Windows.bi"

#define GRADIENT_FILL_RECT_H &H0        '水平方向にグラデーション
#define GRADIENT_FILL_RECT_V &H1        '垂直方向にグラデーション
#define GRADIENT_FILL_TRIANGLE &H2      '三角形グラデーション
#define vbRed &H0000FF                  '赤のカラーコード
#define vbBlack &H000000                '黒のカラーコード

Type TRIVERTEX
    x     As Long
    Y     As Long
    Red   As Integer
    Green As Integer
    Blue  As Integer
    Alpha As Integer
End Type

Type GRADIENT_RECT
    UpperLeft  As Long
    LowerRight As Long
End Type
   
' 矩形、または三角形の内部をグラデーションで塗りつぶす
Declare Function Api_GradientFill& Lib "msimg32" Alias "GradientFill" (ByVal hDC&, pVertex As Any, ByVal dwNumVertex&, pMesh As Any, ByVal dwNumMesh&, ByVal dwMode&)

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared GraFillDirection As Long
Var Shared hDC As long

Var Shared Button1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub mainForm_Start()

    hDC = Api_GetDC(GethWnd)
End Sub

'================================================================
'=
'================================================================
Declare Function LongToShort(Unsigned As Long) As Integer
Function LongToShort(Unsigned As Long) As Integer
    If Unsigned < 32768 Then
       LongToShort = CInt(Unsigned)
    Else
       LongToShort = CInt(Unsigned - &H10000)
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub DrawGradientFill(ByVal Col1 As Long, ByVal Col2 As Long)
Sub DrawGradientFill(ByVal Col1 As Long, ByVal Col2 As Long)
    Var vert(1) As TRIVERTEX
    Var grc As GRADIENT_RECT
  
   '左上
    vert(0).x = 0
    vert(0).y = 0
    vert(0).Red = LongToShort((Col1 And &HFF) * 256)
    vert(0).Green = LongToShort(((Col1 And &HFF00) \ &H100) * 256)
    vert(0).Blue = LongToShort(((Col1 And &HFF0000) \ &H10000) * 256)
    vert(0).Alpha = 0
   
   '右下
    vert(1).x = GetWidth
    vert(1).y = GetHeight
    vert(1).Red = LongToShort((Col2 And &HFF) * 256)
    vert(1).Green = LongToShort(((Col2 And &HFF00) \ &H100) * 256)
    vert(1).Blue = LongToShort(((Col2 And &HFF0000) \ &H10000) * 256)
    vert(1).Alpha = 0

    grc.LowerRight = 0
    grc.UpperLeft = 1
   
    Cls

    Ret = Api_GradientFill(hDC, vert(0), 2, grc, 1, Abs(GraFillDirection))
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Ret As Long

   '切替
    GraFillDirection = Not GraFillDirection
    DrawGradientFill vbRed, vbBlack
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Resize edecl ()
Sub MainForm_Resize()
    Var Ret As Long

    DrawGradientFill vbRed, vbBlack 
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_ReleaseDC(gethWnd, hDC)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End