?? form1.frm
字號:
Left = 450
Picture = "Form1.frx":62FA
Top = 4680
Width = 165
End
Begin VB.Image Image1
Height = 165
Index = 12
Left = 450
Picture = "Form1.frx":64C8
Top = 4440
Width = 165
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "4"
Height = 180
Index = 3
Left = 450
TabIndex = 4
Top = 4200
Width = 180
End
Begin VB.Image Image1
Height = 180
Index = 11
Left = 300
Picture = "Form1.frx":6696
Top = 5160
Width = 180
End
Begin VB.Image Image1
Height = 180
Index = 10
Left = 300
Picture = "Form1.frx":6888
Top = 4920
Width = 180
End
Begin VB.Image Image1
Height = 165
Index = 9
Left = 300
Picture = "Form1.frx":6A7A
Top = 4680
Width = 165
End
Begin VB.Image Image1
Height = 165
Index = 8
Left = 300
Picture = "Form1.frx":6C48
Top = 4440
Width = 165
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "3"
Height = 180
Index = 2
Left = 300
TabIndex = 3
Top = 4200
Width = 180
End
Begin VB.Image Image1
Height = 180
Index = 7
Left = 150
Picture = "Form1.frx":6E16
Top = 5160
Width = 180
End
Begin VB.Image Image1
Height = 180
Index = 6
Left = 150
Picture = "Form1.frx":7008
Top = 4920
Width = 180
End
Begin VB.Image Image1
Height = 165
Index = 5
Left = 150
Picture = "Form1.frx":71FA
Top = 4680
Width = 165
End
Begin VB.Image Image1
Height = 165
Index = 4
Left = 150
Picture = "Form1.frx":73C8
Top = 4440
Width = 165
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "2"
Height = 180
Index = 1
Left = 150
TabIndex = 2
Top = 4200
Width = 180
End
Begin VB.Image Image1
Height = 180
Index = 3
Left = 0
Picture = "Form1.frx":7596
Top = 5160
Width = 180
End
Begin VB.Image Image1
Height = 180
Index = 2
Left = 0
Picture = "Form1.frx":7788
Top = 4920
Width = 180
End
Begin VB.Image Image1
Height = 165
Index = 1
Left = 0
Picture = "Form1.frx":797A
Top = 4680
Width = 165
End
Begin VB.Image Image1
Height = 165
Index = 0
Left = 0
Picture = "Form1.frx":7B48
Top = 4440
Width = 165
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "A"
Height = 180
Index = 0
Left = 0
TabIndex = 1
Top = 4200
Width = 180
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 4095
Left = 0
TabIndex = 0
Top = 0
Width = 2775
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) 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 Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Const PPlayerx = 136
Const NPlayerx = 414
Const PPlayery = 174
Const NPlayery = 174
Const Myx1 = 266
Const Myx2 = 275
Const Myy = 268
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim g_Rect As RECT
Dim Fstar As Boolean
Dim CardName
Dim CardNumber(14) As Integer
Dim TzM(53, 13) As Long '紙牌特征碼存放
Dim Yichu(2, 19) As Integer '三家出牌存放
Dim strYichu(2, 19) As String '三家全部出牌存放
Dim P(2) As Integer '三家出牌手數
Dim C(2) As Integer '三家出牌張數
Private Sub Form_Load()
Dim i, j As Integer
Me.Left = Screen.Width - Me.Width
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
LoadTeZhengMa
Restart
Fstar = True
End Sub
Private Sub Label1_Click()
End
End Sub
Private Sub Timer1_Timer()
Dim i, j, k, l As Long
Dim PPixel As Long
Dim myMouse As POINTAPI
Dim hdcscreen, r As Long
hdcscreen = GetDC(0)
r = FindWindow("LandLord.Class", "斗地主")
If r = 0 Then
If Me.Visible = False Then Me.Visible = True
Else
GetWindowRect r, g_Rect
l = GetPixel(hdcscreen, g_Rect.Left + 200, g_Rect.Top + 186)
ReleaseDC r, hdcscreen
If l = 65535 Then
If Fstar = True Then Restart
Else
Fstar = True
ScanPlayer
GetCursorPos myMouse
If myMouse.X >= g_Rect.Left + 30 And myMouse.X <= g_Rect.Left + 60 And myMouse.Y >= g_Rect.Top + 180 And myMouse.Y <= g_Rect.Top + 210 Then
PlayShow (0)
ElseIf myMouse.X >= g_Rect.Left + 245 And myMouse.X <= g_Rect.Left + 275 And myMouse.Y >= g_Rect.Top + 530 And myMouse.Y <= g_Rect.Top + 560 Then
PlayShow (1)
ElseIf myMouse.X >= g_Rect.Left + 550 And myMouse.X <= g_Rect.Left + 580 And myMouse.Y >= g_Rect.Top + 180 And myMouse.Y <= g_Rect.Top + 210 Then
PlayShow (2)
Else
If Me.Visible = True Then Me.Visible = False
End If
End If
End If
End Sub
Private Sub PlayShow(N As Integer)
Dim tmp As Variant
Dim i, j As Integer
Dim Str1 As String
tmp = Array("上家", "自家", "下家")
Str1 = tmp(N) & "出牌" & P(N) & "手,共" & C(N) & "張" & vbCrLf
For i = 0 To P(N)
Str1 = Str1 & strYichu(N, i) & vbCrLf
Next
Label1.Caption = Str1
If Me.Visible = False Then Me.Visible = True
End Sub
Private Sub LoadTeZhengMa()
Dim t As Integer
On Error GoTo errline
CardName = Array("A", "2", "3", "4", "5", "6", "7", "8", "9", "10", "J", "Q", "K", "小", "大")
Open App.Path & "\圖標特征.txt" For Input As #1
While Not EOF(1)
Input #1, TzM(t, 0), TzM(t, 1), TzM(t, 2), TzM(t, 3), TzM(t, 4), TzM(t, 5) _
, TzM(t, 6), TzM(t, 7), TzM(t, 8), TzM(t, 9), TzM(t, 10), TzM(t, 11) _
, TzM(t, 12), TzM(t, 13)
t = t + 1
Wend
Close #1
errline:
If Err.Number = 53 Then
MsgBox "圖標物征文件丟失！程序退出"
End
End If
End Sub
Private Function Chioce(tmp As Variant) As Integer
Dim i, j, k, l As Long
k = 0
For i = 0 To 53
For j = 1 To 13
If Abs(tmp(j - 1) - TzM(i, j)) < 100 Then k = k + 1
Next
If k >= 12 Then
Chioce = TzM(i, 0)
Exit For
End If
k = 0
Next
End Function
Private Function ScanScreen(ByVal X As Long, ByVal Y As Long) As Long
Dim i, j, k, l As Long
Dim scPixel(12) As Long
Dim g_hwd As Long
Dim hdcscreen As Long
g_hwd = FindWindow("LandLord.Class", "斗地主")
hdcscreen = GetDC(0)
X = g_Rect.Left + X
Y = g_Rect.Top + Y
For i = 0 To 12
scPixel(i) = GetPixel(hdcscreen, X + i, Y + 10)
Next
ScanScreen = Chioce(scPixel)
ReleaseDC g_hwd, hdcscreen
End Function
Private Function Change(N As Long) As Integer
If N > 52 Then
Change = N - 52 + 12
Else
Change = (N - 1) \ 4
End If
End Function
Private Sub Restart()
Dim i, j As Integer
Fstar = False
For i = 0 To 12
CardNumber(i) = 4
Next
CardNumber(13) = 1
CardNumber(14) = 1
For i = 0 To 2
For j = 0 To 19
Yichu(i, j) = 0
strYichu(i, j) = ""
Next
Next
For i = 0 To 2
C(i) = 0
P(i) = 0
Next
For i = 0 To 53
Image1(i).Visible = True
Next
End Sub
Private Sub ScanPlayer()
Dim k, l As Long
Static tmp As Integer
Dim PPixel As Long
'掃描上家
PPixel = ScanScreen(PPlayerx, PPlayery)
If PPixel <> Yichu(0, 0) And PPixel <> 0 Then
While PPixel <> 0
l = Change(PPixel)
If Image1(PPixel - 1).Visible = False Then
Image1(PPixel - 1 + 2).Visible = False
Else
Image1(PPixel - 1).Visible = False
End If
CardNumber(l) = CardNumber(l) - 1
Yichu(0, k) = PPixel
strYichu(0, P(0)) = strYichu(0, P(0)) & " " & CardName(l)
C(0) = C(0) + 1
k = k + 1
PPixel = ScanScreen(PPlayerx + k * 18, PPlayery)
Wend
P(0) = P(0) + 1
End If
'掃描自家
k = 0
PPixel = ScanScreen(Myx1, Myy)
If PPixel <> Yichu(1, tmp) And PPixel <> 0 Then
tmp = 0
Do
tmp = tmp + 1
PPixel = ScanScreen(Myx1 + tmp * 18, Myy)
Loop Until PPixel = 0
tmp = tmp - 1
PPixel = ScanScreen(Myx1 + (tmp) * 18, Myy)
While PPixel <> 0
l = Change(PPixel)
If Image1(PPixel - 1).Visible = False Then
Image1(PPixel - 1 + 2).Visible = False
Else
Image1(PPixel - 1).Visible = False
End If
CardNumber(l) = CardNumber(l) - 1
Yichu(1, k) = PPixel
strYichu(1, P(1)) = strYichu(1, P(1)) & " " & CardName(l)
C(1) = C(1) + 1
k = k + 1
PPixel = ScanScreen(Myx1 + (tmp) * 18 - k * 18, Myy)
Wend
P(1) = P(1) + 1
End If
k = 0
PPixel = ScanScreen(Myx2, Myy)
If PPixel <> Yichu(1, tmp) And PPixel <> 0 Then
tmp = 0
Do
tmp = tmp + 1
PPixel = ScanScreen(Myx2 + tmp * 18, Myy)
Loop Until PPixel = 0
tmp = tmp - 1
PPixel = ScanScreen(Myx2 + (tmp) * 18, Myy)
While PPixel <> 0
l = Change(PPixel)
If Image1(PPixel - 1).Visible = False Then
Image1(PPixel - 1 + 2).Visible = False
Else
Image1(PPixel - 1).Visible = False
End If
CardNumber(l) = CardNumber(l) - 1
Yichu(1, k) = PPixel
strYichu(1, P(1)) = strYichu(1, P(1)) & " " & CardName(l)
C(1) = C(1) + 1
k = k + 1
PPixel = ScanScreen(Myx2 + (tmp) * 18 - k * 18, Myy)
Wend
P(1) = P(1) + 1
End If
'掃描下家
k = 0
PPixel = ScanScreen(NPlayerx, NPlayery)
If PPixel <> Yichu(2, 0) And PPixel <> 0 Then
While PPixel <> 0
l = Change(PPixel)
If Image1(PPixel - 1).Visible = False Then
Image1(PPixel - 1 + 2).Visible = False
Else
Image1(PPixel - 1).Visible = False
End If
CardNumber(l) = CardNumber(l) - 1
Yichu(2, k) = PPixel
strYichu(2, P(2)) = strYichu(2, P(2)) & " " & CardName(l)
C(2) = C(2) + 1
k = k + 1
PPixel = ScanScreen(NPlayerx - k * 18, NPlayery)
Wend
P(2) = P(2) + 1
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -