X hit-test examination

Option Explicit

Private Declare Function WindowFromAccessibleObject Lib "OLEACC" (ByVal IAcessible As Object, ByRef hwnd As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SetPixel Lib "GDI32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Const COLOR_UP& = vbRed
Const COLOR_RIGHT& = vbGreen
Const COLOR_LEFT& = vbBlue
Const COLOR_DOWN& = vbYellow

Public Property Get hwnd() As Long
    WindowFromAccessibleObject Me, hwnd ' VBAの場合、hwndプロパティーが無いので…
End Property

Private Sub UserForm_Click()
    Dim LoopCount As Integer
    Dim fxN As Single
    Dim fyN As Single
    Dim Color As Long
    Dim dc As Long

    Let LoopCount = 32767
    Let dc = GetDC(Me.hwnd)
    Do
        Let fxN = (Rnd - 0.5) * 2
        Let fyN = (Rnd - 0.5) * 2

        If fxN >= 0 Then
            If fyN >= 0 Then
                If fxN > fyN Then
                    Let Color = COLOR_RIGHT
                Else
                    Let Color = COLOR_DOWN
                End If
            Else
                If fxN > -fyN Then
                    Let Color = COLOR_RIGHT
                Else
                    Let Color = COLOR_UP
                End If
            End If
        Else
            If fyN >= 0 Then
                If -fxN > fyN Then
                    Let Color = COLOR_LEFT
                Else
                    Let Color = COLOR_DOWN
                End If
            Else
                If -fxN > -fyN Then
                    Let Color = COLOR_LEFT
                Else
                    Let Color = COLOR_UP
                End If
            End If
        End If
        SetPixel dc, 64 + (0.5 + fxN) * 128, 64 + (0.5 + fyN) * 128, Color
        Let LoopCount = LoopCount - 1
        DoEvents
    Loop While LoopCount >= 0
    ReleaseDC Me.hwnd, dc
End Sub

Private Sub UserForm_Initialize()
    Let Me.Width = 256
    Let Me.Height = 256
End Sub