コード:
Const GetRValue(rgb) = (rgb And &hff)
Const GetGValue(rgb) = ((rgb >> 8) And &hff)
Const GetBValue(rgb) = ((rgb >> 16) And &hff)
TypeDef COLORREF = DWord
TypeDef UINT = DWord
Declare Function CreateDIBSection Lib "gdi32.dll" (
/*[in]*/ ByVal hdc As HDC,
/*[in]*/ ByRef bmi As BITMAPINFO,
/*[in]*/ ByVal iUsage As UINT,
/*[out]*/ ByVal pv As *VoidPtr,
/*[in]*/ ByVal hSection As HANDLE,
/*[in]*/ ByVal dwOffset As DWord
) As HBITMAP
Const GetGradationColor(c1, c2, y, h) = c2 + ((c1 - c2) * y As Double / h) As Long
Function CreateGradationBitmap(
/*[in]*/ ByRef size As SIZE,
/*[in]*/ ByVal color1 As COLORREF,
/*[in]*/ ByVal color2 As COLORREF) As HBITMAP
' グラデーションビットマップを生成
Dim BitmapInfo As BITMAPINFO
'memset(&BitmapInfo.bmiHeader,0,sizeof(BITMAPINFOHEADER));
With BitmapInfo.bmiHeader
.biSize = SizeOf (BITMAPINFOHEADER)
.biWidth = size.cx
.biHeight = size.cy
.biPlanes = 1
.biBitCount = 24
End With
Dim hdc As HDC
hdc = GetDC(GetDesktopWindow())
Dim hBitmap As HBITMAP
Dim pByte As BytePtr
hBitmap = CreateDIBSection(hdc, BitmapInfo, DIB_RGB_COLORS, VarPtr(pByte) As *VoidPtr, 0, 0)
Dim i As Long, i2 As Long, x As Long, y As Long
i = BitmapInfo.bmiHeader.biWidth * 3
If i Mod SizeOf (Long) <> 0 Then i += SizeOf (Long) - (i Mod SizeOf (Long))
Dim height As Double
height = BitmapInfo.bmiHeader.biHeight
For y = 0 To BitmapInfo.bmiHeader.biHeight - 1
Dim r As Byte, g As Byte, b As Byte
r = GetGradationColor(GetRValue(color1), GetRValue(color2), y, height) '赤要素
g = GetGradationColor(GetGValue(color1), GetGValue(color2), y, height) '緑要素
b = GetGradationColor(GetBValue(color1), GetBValue(color2), y, height) '青要素
For x = 0 To BitmapInfo.bmiHeader.biWidth - 1
i2 = y * i + x * 3
pByte[i2+2] = r
pByte[i2+1] = g
pByte[i2+0] = b
Next
Next
DeleteDC(hdc)
CreateGradationBitmap = hBitmap
End Function