'================================================================
'= 表示できる色に最も近いカラー値を取得(�U)
'=    (GetNearestColor2.bas)
'================================================================
#include "Windows.bi"

' 指定された座標のピクセルのRGB値を取得
Declare Function Api_GetPixel& Lib "gdi32" Alias "GetPixel" (ByVal hDC&, ByVal X&, ByVal Y&)

' 指定のカラー値に対して、デバイスが表示できる色に最も近いカラー値を取得
Declare Function Api_GetNearestColor& Lib "gdi32" Alias "GetNearestColor" (ByVal hDC&, ByVal crColor&)

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

Var Shared MainForm As Object
Var Shared Text(3) As Object
Var Shared Picture(1) As Object
Var SHared Button1 As Object
Var Shared Bitmap As Object
BitmapObject Bitmap

MainForm.Attach GethWnd
For i = 0 To 3
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
    If i < 2 Then
        Text(i).SetFontSize 14
        Picture(i).Attach GetDlgItem("Picture" & Trim$(Str$(i + 1)))
    Else
        Text(i).SetFontSize 12
    End If
Next i
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared hDC As Long

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Bitmap.LoadFile "flower.bmp"
    Picture(0).DrawBitmap Bitmap , 0, 0
    Bitmap.DeleteObject

    'Picture1のデバイスコンテキストを取得
    hDC = Api_GetDC(Picture(0).GethWnd)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var DotCol As String
    Var lColor As Long
    Var rgbR As Integer
    Var rgbG As Integer
    Var rgbB As Integer
    Var nDC As Long
    Var x As Integer
    Var y As Integer
    Var Ret As Long

    Picture(1).Cls

    'デバイスコンテキストを作成
    nDC = Api_CreateCompatibleDC(hDC)

    For x = 0 To Picture(0).GetWidth - 1
        For y = 0 To Picture(0).GetHeight - 1
            'マウス指定位置のRGB値を取得
            lColor = Api_GetPixel(hDC, x, y)

            rgbR = lColor And &HFF
            rgbG = (lColor And &HFF00) / 256
            rgbB = (lColor And &HFF0000) / 65536

            If Api_GetNearestColor(nDC, RGB(rgbR, rgbG, rgbB)) = &HFFFFFF Then
                Picture(1).Pset(x, y), 15
            Else
                Picture(1).Pset(x, y), 0
            End If
        Next y
    Next x

    '解放
    Ret = Api_DeleteDC(nDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture1_MouseMove edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Sub Picture1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Var DotCol As String
    Var lColor As Long
    Var rgbR As Integer
    Var rgbG As Integer
    Var rgbB As Integer
    Var nDC As Long
    Var Ret As Long

    'デバイスコンテキストを作成
    nDC = Api_CreateCompatibleDC(hDC)

    'マウス指定位置のRGB値を取得
    lColor = Api_GetPixel(hDC, X, Y)

    'Picture1指定座標と同位置に赤のドットで描画
    Picture(1).Pset(X, Y), 5

    rgbR = lColor And &HFF
    rgbG = (lColor And &HFF00) / 256
    rgbB = (lColor And &HFF0000) / 65536

    'RGBを表示
    DotCol = "(" & Format$(rgbR, "###") & "," & Format$(rgbG, "###") & "," & Format$(rgbB, "###") & ")"
    Text(0).SetWindowText DotCol

    '最も近いカラー値を取得
    Text(1).SetWindowText "&&H" & Hex$(Api_GetNearestColor(nDC, RGB(rgbR, rgbG, rgbB)))

    '解放
    Ret = Api_DeleteDC(nDC)
End Sub

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

    Ret = Api_ReleaseDC(Picture(0).GethWnd, hDC)
End Sub

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