SHARE
TWEET

X hit-test examination

EnderAlice May 18th, 2013 56 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.  
  3. Private Declare Function WindowFromAccessibleObject Lib "OLEACC" (ByVal IAcessible As Object, ByRef hwnd As Long) As Long
  4. Private Declare Function GetDC Lib "USER32" (ByVal hwnd As Long) As Long
  5. Private Declare Function ReleaseDC Lib "USER32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  6. Private Declare Function SetPixel Lib "GDI32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  7.  
  8. Const COLOR_UP& = vbRed
  9. Const COLOR_RIGHT& = vbGreen
  10. Const COLOR_LEFT& = vbBlue
  11. Const COLOR_DOWN& = vbYellow
  12.  
  13. Public Property Get hwnd() As Long
  14.     WindowFromAccessibleObject Me, hwnd ' VBAの場合、hwndプロパティーが無いので…
  15. End Property
  16.  
  17. Private Sub UserForm_Click()
  18.     Dim LoopCount As Integer
  19.     Dim fxN As Single
  20.     Dim fyN As Single
  21.     Dim Color As Long
  22.     Dim dc As Long
  23.  
  24.     Let LoopCount = 32767
  25.     Let dc = GetDC(Me.hwnd)
  26.     Do
  27.         Let fxN = (Rnd - 0.5) * 2
  28.         Let fyN = (Rnd - 0.5) * 2
  29.  
  30.         If fxN >= 0 Then
  31.             If fyN >= 0 Then
  32.                 If fxN > fyN Then
  33.                     Let Color = COLOR_RIGHT
  34.                 Else
  35.                     Let Color = COLOR_DOWN
  36.                 End If
  37.             Else
  38.                 If fxN > -fyN Then
  39.                     Let Color = COLOR_RIGHT
  40.                 Else
  41.                     Let Color = COLOR_UP
  42.                 End If
  43.             End If
  44.         Else
  45.             If fyN >= 0 Then
  46.                 If -fxN > fyN Then
  47.                     Let Color = COLOR_LEFT
  48.                 Else
  49.                     Let Color = COLOR_DOWN
  50.                 End If
  51.             Else
  52.                 If -fxN > -fyN Then
  53.                     Let Color = COLOR_LEFT
  54.                 Else
  55.                     Let Color = COLOR_UP
  56.                 End If
  57.             End If
  58.         End If
  59.         SetPixel dc, 64 + (0.5 + fxN) * 128, 64 + (0.5 + fyN) * 128, Color
  60.         Let LoopCount = LoopCount - 1
  61.         DoEvents
  62.     Loop While LoopCount >= 0
  63.     ReleaseDC Me.hwnd, dc
  64. End Sub
  65.  
  66. Private Sub UserForm_Initialize()
  67.     Let Me.Width = 256
  68.     Let Me.Height = 256
  69. End Sub
RAW Paste Data
Top