ab.com コミュニティ https://www.activebasic.com/forum/ |
|
[AB開発日記] グラデーション生成モジュール https://www.activebasic.com/forum/viewtopic.php?t=1189 |
ページ 1 / 1 |
作成者: | イグトランス [ 2006年6月30日(金) 23:05 ] |
記事の件名: | [AB開発日記] グラデーション生成モジュール |
AB開発日記 2006-06-30 ここに書かれているCreateGradationBitmap関数をABへ移植しました。 グラデーションした色を求める部分で整数型へのキャストのあたりがおそらく間違っていると思われる(※)ので,そこだけは変更してあります。 ※(int)(double)LOBYTE(LOWORD(color1))略,ではなく(int)((double)LOBYTE(LOWORD(color1))略), だと思います。 [ここをクリックすると内容が表示されます]
コード: 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 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |