四个 VB 问题~

BillyG

1.) 怎样 convert 以下的 code(script) 去 VB

IfColor 536 552 4a82ad 0
...
Else
...
EndIf

MoveTo 370 545 <---- 鼠标移动

其中 “536 552” 是银幕/视窗的座标, 色码我有了。

鼠标移动要怎样换？

2.) 上面问题提到的视窗， 在VB里要怎样才能control它？因为要重复检查颜色

3.) 以下的code要怎样换掉"picture1"?

TempColour = GetPixel(Picture1.hDC, X, Y)

要用什麼syntax才能抓 window/screen 的颜色？
(pincture1 要换成 window/screen)

4.) 在VB里，要怎样设定 热键(hotkey)?用那些syntax?
(按热键开始，再按另一个热键停止)

希望能给个 example .

vampcheah

看起来你很象在写外挂 曾经看过类似的问题。。。

BillyG

是咯，在写外挂。
目前用quickmacro写的脚本，再convert了去scriptexpert用。
但以上两种要改变量的话很麻烦，所以想用VB做个简单易用的GUI。
GUI有了。。就差那几行code便能完成。

有人能帮忙吗？

vampcheah

你所谓的那几行，其实是很多。。。 你要会用VB 的 API。 用GOOGLE 吧。 我想噢，应该没什么人会帮你的。
不要当我会噢，我也是不懂的。我这种人叫做"SAMPAN 充 大炮"。

BillyG

可能我问的方法不对，换个问法。
Script <IfColor 536 552 4a82ad 0> 在VB里相同功能的syntax是什麼?

VB API 的 <TempColour = GetPixel(Picture1.hDC, X, Y)> 中的picture1是指一个form里的<picture object>，如果我要的不是一个form里的<picture object> 而是另一个 <window>，那 <picture1.hDC> 该换成什麼syntax?

就两个问题，其他有search到一些信息，就这两个part的syntax找不到。

meemee

你可以试试找findwindow，getdc，setcursorpos，getcursorpos的api资料。。。

getdc可以用来找出一个window的device context。getdc得到的就是hDC，应该可以直接代替picture1.hdc

在用getdc之前。。。必须找出，window的handle。。。这个需要用findwindow来找出来。。。
getcursorpos，setcursorpos，顾名思义就是用来找出cursor的位置和设定它的位置。。。

BillyG

meemee:
谢谢你，你给 syntax 让我找到我要的东西。

不过，现在面对一个 回圈 难题，

在我按 hotkey 启动我的 program 后不能用 hotkey 把它停下来。
我的 program 是一个不停重复的 回圈(loop)。我发觉当我的 program 进入回圈后 hotkey 变得没反应。这是否跟"active"有关(lopping一直active着)？该如何解决？以下付上 semple code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF10 Then
        MsgBox "testmsg 1"
        MsgBox "testmsg 2"
        Call id1 'calling sub
    ElseIf KeyCode = vbKeyEscape Then
        End
    End If
    MsgBox "exit jor loop 2"
End Sub
Sub id1()
loop1:
    If KeyCode = vbKeyF12 Then
        Exit Sub
    End If
    GoTo loop1 'looping back to loop1
    MsgBox "exit jor loop 1"
End Sub

meemee

你这样的作法会进入“死环节”，所以program根本不会给response。用doevents的指令就可以解决了。

doevents的指令会把控制权交还给os，然后再回到你的程序。
不过，我不建议这种做法，比较好的做法是用Timer来解决。错误的利用doevents会导致非常奇怪的问题。

还有这里有小小错误，应该declare一个global的variable或把Keycode pass进你的sub因为你的Keycode已经out of scope。

Dim MyKeyCode As Integer

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    MyKeyCode = KeyCode
    If KeyCode = vbKeyF10 Then
        MsgBox "testmsg 1"
        MsgBox "testmsg 1"
        MsgBox "testmsg 2"
        MsgBox "testmsg 1"
        Call id1 'calling sub
    ElseIf KeyCode = vbKeyEscape Then
        End
    End If
    MsgBox "exit jor loop 2"
End Sub
Sub id1()
loop1:
    If MyKeyCode = vbKeyF12 Then
        'Exit Sub
        GoTo MyExit:
    End If
    DoEvents
    GoTo loop1 'looping back to loop1
Exit Sub
MyExit:
    MsgBox "exit jor loop 1"
End Sub

BillyG

谢谢 meemee,

doevents 正是我要的。
对是漏了一的variable declaration,原本loop是打算放进Form_KeyDown,后来改了漏了加。


再一个问题。。
以下这段code为什麼不会跑呢？如果是放进cmd_click()，按下cmd却会跑。
为什么form_load不会跑？
还有 “test_hwnd = FindWindow(ByVal 0&, "MyWindowTitle" )” 和declaration 的 argument 有误吗？

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As String) As Long
Private Sub Form_Load()
    Dim test_hwnd As Long

    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, "MyWindowTitle" )
    Picture1.Cls
    Picture1.Print "hWnd = " & test_hwnd
End Sub

meemee

没有问题啊。。。

test_hwnd = FindWindow(ByVal 0&, "MyWindowTitle")
这是非常正确的syntax。。。如果，你怕错的话可以改用
test_hwnd = FindWindow(ByVal 0&, ByVal "MyWindowTitle")

Picture1里没有东西因为，Form_load的时候那个Form并没有被显示出来，所以即使你print东西在它的上面，也是不会有东西出来。

你可以改用Form_Activate()，试试看。

[ 本帖最后由 meemee 于 18-5-2006 07:57 AM 编辑 ]

BillyG

明白了，我search了一下Form_Activate() 找到了一下的syntax和次序：
Initialize
Load
Resize
Activate
GotFocus
Paint

请问 GetDC 和 GetWindowDC 有什么分别？DC 是从那里开始到那里结束(window范围)?
我下面的coding似乎有错。。。抓不到颜色。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As String) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetWindowDC 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 SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long


Private Sub cmdFindWindow_Click()
    Dim test_hwnd As Long
    Dim test_dc As Long
    Dim i As Long, j As Long
    Dim colours As Long

    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = True
    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal "untitled - Paint")
    test_dc = GetDC(test_hwnd)'hDC 是这样抓的对吗？
    Picture1.Cls
    Picture1.Print test_hwnd
    Picture1.Print test_dc

    colours = GetPixel(test_dc, 400, 300)
    Picture1.Print colours '为什么print出来会= “-1”而不是hex code?
   
    For i = 0 To 500
        ' for each pixel across
        For j = 0 To 500
            ' for each pixel down
            ' (i, j) = out i pixels, down j pixels
            SetPixelV Picture2.hDC, i, j, GetPixel(test_dc, i, j)' 为什么总是黑色?
        Next
        Picture2.Refresh
    Next

End Sub

[ 本帖最后由 BillyG 于 18-5-2006 10:52 PM 编辑 ]

BillyG

哈哈 被我左试右试，给试出来了能抓色了。

“-1” 是因为抓不到
抓不到所以黑色
因为 window minimize 了 和 no focus 所以抓不到。

GetWindowDC 是包括 window 边框，GetDC 是不包括边框。

新问题：(键盘/鼠标模拟)
按 mouse 左键 或 右键 该用什么syntax?
打字(typing) 除了“KeyDown xx KeyUp xx” 还有别的方法吗？

能在背景(被盖住)之下抓色吗？

[ 本帖最后由 BillyG 于 20-5-2006 06:19 AM 编辑 ]

meemee

Initialize
Load
Resize
Activate
GotFocus
Paint

对呀。。。它的次序应该是这样。。。我只记得三个的次序。。。Initialize，Load，Activate。

原帖由 BillyG 于 20-5-2006 06:16 AM 发表
哈哈 被我左试右试，给试出来了能抓色了。

“-1” 是因为抓不到
抓不到所以黑色
因为 window minimize 了 和 no focus 所以抓不到。

GetWindowDC 是包括 window 边框，GetDC 是不包括边框。

新问题：( ...

对了，就是这样。。。
GetWindowDC是有title bar (最上面蓝色那行)，menu bar (菜单)，scroll bar。。。

捉不到颜色就是你说的。。。

嗯。。。好像漏了。。。ReleaseDC

能在背景(被盖住)之下抓色吗？
好像不能。。。不过，我有一个提议，就是捉整个银幕(用test_dc = GetDC(0))，然后再用GetWindowRect和GetClientRect的找出你要的windows位置。。。

[size=-1]

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As String) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetWindowDC 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 SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Sub cmdFindWindow_Click()
    Dim test_hwnd As Long
    Dim test_dc As Long
    Dim i As Long, j As Long
    Dim colours As Long

    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = True
    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal "untitled - Paint")
    'test_hwnd = FindWindowEx(test_hwnd, ByVal 0&, ByVal "AfxFrameOrView42", ByVal "")
    test_hwnd = FindWindowEx(test_hwnd, ByVal 0&, ByVal "AfxFrameOrView42u", ByVal "")
    test_hwnd = FindWindowEx(test_hwnd, ByVal 0&, ByVal "Afx:1000000:8", ByVal "")
   
    test_dc = GetDC(test_hwnd)
    Picture1.Cls
    Picture1.Print test_hwnd
    Picture1.Print test_dc

    colours = GetPixel(test_dc, 400, 300)
    Picture1.Print colours
   
    For i = 0 To 500
        ' for each pixel across
        For j = 0 To 500
            ' for each pixel down
            ' (i, j) = out i pixels, down j pixels
            SetPixelV Picture2.hdc, i, j, GetPixel(test_dc, i, j)
        Next
        Picture2.Refresh
    Next
   
    If test_dc <> 0 Then
        If ReleaseDC(test_hwnd, test_dc) <> 0 Then _
        MsgBox "Successfull release DC"
    End If

End Sub

红色和青色那行不能同时使用。。。win98就用红色的。。。winXP就用青色那行。。。



这是我做的。。。有一部分的地方是白色。。。因为它被vb盖着了。。。
FindWindowEx是用来找child window。那个"Afx:1000000:8"是"AfxFrameOrView42"的子视窗，"AfxFrameOrView42"又是"untitled - Paint"的子视窗。。。

[ 本帖最后由 meemee 于 20-5-2006 10:06 AM 编辑 ]

meemee

新问题：(键盘/鼠标模拟)
按 mouse 左键 或 右键 该用什么syntax?
打字(typing) 除了“KeyDown xx KeyUp xx” 还有别的方法吗？

用mousedown或mouseup。。。click应该是给“左键单击”用。

mousedown和mouseup有一个button的parameter(argument)。。。
If Button = vbRightButton Then就是给右键。
If Button = vbLeftButton Then就是给左键。

还有一个是keypressed不过，用途不多。。。

还有，你可以试试。。。GetKeyboardState，GetKeyState。。。

BillyG

哇 很详细~
谢谢meemee.

FindWindowEx 和 GetWindowRect 和 GetClientRect
之前 shearching 时有看到，我再去研究研究。

BillyG

有问题，

前面我成功抓到颜色了。

现在我如何才能在我 FindWindow 找到的 window 里进行一系列鼠标和键盘动作呢？
我用 VB 写出来的 program 如何才能在背景(被覆盖下)运行呢？
假如我所找到的 window 因为要抓色所以必须 on focus 或 on top 或 foreground,那我的 VB(form) 便得被覆盖。

前面，我用了以下两个 sub 来达到鼠标和延缓动作，可当我运行是却没动静。请问有错吗？

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)

Private Const MOUSEEVENTF_LEFTDOWN = &H2      ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4        ' left button up

Public Sub MouseClick(x As Long, y As Long)
    Delay move_speed
    SetCursorPos x, y
    Delay click_speed
    mouse_event MOUSEEVENTF_LEFTDOWN, x, y, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, x, y, 0, 0
End Sub

Sub Delay(pdblSeconds As Integer)
' delay for x secodns
' this sub used very little CPU resouces
    Const OneSecond As Double = 1# / (1440# * 60#)
    Dim dblWaitUntil As Date
    dblWaitUntil = Now + OneSecond * pdblSeconds
    Do Until Now > dblWaitUntil
        DoEvents ' Allow windows message to be processed
    Loop
End Sub

如何写，VB 才知道我要在 findwindow 找到的 window 上面进行鼠标动作？
如何才能让 VB 在背景工作呢？

meemee

huh。。。越来越高难度了。。。

首先，我有几个疑问。

1，
你是要模拟还是要侦查出一系列的keyboard和mouse动作？？

2，
你要在背景运行什么？？其实，如果你有放infinite loop的话。。。即使在背景，它还是一样的操作。。。我对这个问题不了解，还是你有example。

3，
前面，我用了以下两个 sub 来达到鼠标和延缓动作，可当我运行是却没动静。请问有错吗？
这一行。。。你是要减低鼠标的移动述度，还是把模拟鼠标的述度减低？？

BillyG

hehe

答：

1，我是要模拟一系列鼠标和键盘动作（程式运行后mouse和键盘会自动在指定的window 里/上面 工作）。
因为我要摹拟的动作是重复性动作所以会有回圈（infinite loop）而我只在想停止程式时才通过 hotkey 来 brake infinite loop 从而跳出 loop.

2，是啊，infinite loop 会继续运行，尽管被覆盖了，可是如果被覆盖了，hotkey（form_keydown）便抓不到 hotkey 了，所以我猜想 hotkey 是只有在 form on focus 是才会 function。
换个说法，假如我开了 "untitled - paint" 再运行我的程式，然后再回到 "untitled - paint"（程式window被覆盖了） 这时我按 hotkey 的话我的程式是不会运行的。
我做了测试（程式覆盖"untitle - pain"/ 程式在最上面--on top），由于程式window on top 所以我按 hotkey 会跑，可是当程式执行第一个 mouse-click 后，"untitle - paint" 便成 on top (on focus) 而程式 window 变成被覆盖， 之后就再也没有鼠标/键盘动作了。

3，是要减低鼠标的移动述度。当鼠标要从 A点 移到 B点 时在从 A 移动到 B 中间要相隔个几秒。
我测试到为何会没动静了。。是 秒 和 毫秒 的问题， 因为我放 "Delay 2000" <-- 33.33分钟。。

meemee

1，
如果是keyboard，vb的SendKeys就可以了。。。
如果是mouse，你找到的mouse_event就可以用了，不然的话你可以试试用SendInput。

2，
试试AttachThreadInput

以上，这两个syntax我还没有测试过。。。你先试试看，可能可以，可能不可以。。

3，
这个，你已经找到原因了，哪我就不答你了。

BillyG

meemee...

我 search 了 AttachThreadInput ， 但是不大明白 AttachThreadInput 的用法/用处。好像不是我要的东西。

改一下我的问题：(用英文)

2。 when i have my app load then follow by my form1, then my form1 is now "foreground" compare to my app. In this case when i press F10 to start my form1(loop action) then form1 catch the key_down event & fire the loop action.

now my problem is , i wish to to have my app in "foreground" & my form1 in "background" and i can still fire the loop function(inside the form1 code).

it seen here is that the form_KeyDown() funtion didnt work when the form1 is in background.(form1 not respone to my key-press when form1 is in background)

so how could i do inorder to made the form1 able to catch my key press while then from1 is in background?

OR how could i put my form1 to be run from/in the systemtray?

Private Sub Form_Load()
    Dim test_hwnd As Long
    Dim test_DC As Long
    Picture1.AutoRedraw = True

    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, "my-app")
    test_DC = GetWindowDC(test_hwnd)
    Picture1.Cls
    Picture1.Print "hWnd = " & test_hwnd
    Picture1.Print "hDC = " & test_DC
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    MyKeyCode = KeyCode
    If KeyCode = vbKeyF10 Then
        Call id1   '###calling sub <--- loop function
    ElseIf KeyCode = vbKeyEscape Then
        Call ReleaseDC(test_hwnd, test_DC)
        End
    End If
End Sub

Sub id1()  '###looping function
loop1:
    DoEvents
    If MyKeyCode = vbKeyF12 Then
        'Exit Sub
        Debug.Print "fress jor f12"
        GoTo MyExit:
    End If
    Picture1.Cls
    Picture1.Print " inside loop "
    GoTo loop1 'looping back to loop1
MyExit:
End Sub   '### id1

[ 本帖最后由 BillyG 于 30-5-2006 06:15 AM 编辑 ]