form1.frm

中游斗地主(老版)记牌器,分辨率800*600下编写

      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