サンプルコード007
ピグ自動きたよ20130226版
※コードは開発当時の物で、現在は機能いたしません。
アメーバピグの「きたよ」を自動で行います。
2013/02/26に仕様となった「お外」と「お部屋」をきたよします。
(その後のアメーバピグ側の仕様変更により途中で処理が進まなくなる問題があります)
(2013/05/21のアメーバピグ仕様変更により使用できなくなっています)
'CYTOLOGY2 ピグ自動きたよ お部屋とお外 20130226
'---------------------------------------------------------------
'Copyright(C) 2013 ao-system エーオーシステム
'licensed under the LGPL
'ライセンスはLGPLに準じたものになります。詳しくは下記サイトを参照下さい。
'https://ao-system.net/cytology2/
'LGPLに準じ、この著作権表示は消去できません。
'---------------------------------------------------------------
'
'任意位置の「きたよ帳」「グッピグ帳」「ピグとも一覧」を順に処理
'
'使い方:
'ピグで、きたよ帳、グッピグ帳、ピグとも一覧を全部またはいくつかを重ならない様に配置します。
'実行ボタンで開始します。
'
'注意事項:
'実行後はきたよ帳、グッピグ帳、ピグとも一覧は動かさない様にします。
'左上の、ベルは位置は見えるようにしておきます。
'左下の、チャット入力欄は見えるようにしておきます。
'右下の、お外・お部屋1,2,3,4の切り替えは見えるようにしておきます。
'
'備考:
'設定によりベル時に喋らせることが出来ます。
'一度訪問した部屋へは2回訪問しません。この記録は設定からリセットできます。
'
'---------------------------------------------------------------

Imports System.Drawing
Imports System.Windows.Forms

Public Class AddIn

    Private Const APPNAME As String = "自動きたよ"
    Private Const TALK As String = "きたよです"
    Private Const bellPointX = 45
    Private Const bellPointY = 163
    Private std As Std
    Private stdf As StdFunc
    Private chw As ClientHwnd
    Private ddItemCheckTalk As CheckBox
    Private ddLabelNow As ToolStripLabel
    Private ddItemProcessReset As ToolStripButton
    Private bd As bookData
    Private bellClickCount As Integer = 0

    Public Sub New()
        std = New Std
        stdf = New StdFunc
        chw = New ClientHwnd
        bd = New bookData
    End Sub

    Public Sub AddIn_Load()
        ddButtonInitial01()
        ddButtonInitial02()
        RemoveHandler ddItemProcessReset.Click, AddressOf ProcessReset
        AddHandler ddItemProcessReset.Click, AddressOf ProcessReset
    End Sub

    Public Sub AddIn_Start()
        Dim markKitayo As Integer(,) = New Integer(,) { _
           {&HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8} _
         , {&H181818, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8} _
         , {&H181818, &H181818, &H6890, &HA7E8, &HA7E8, &HA7E8, &HA7E8, &HA7E8} _
         , {&H181818, &H181818, &H8DC3, &H6890, &H6890, &H6890, &H0, &H0} _
         , {&H181818, &H181818, &H8DC3, &H181818, &H0, &H8DC3, &H0, &H0} _
        }
        Dim markGuppigg As Integer(,) = New Integer(,) { _
           {&H32CCFF, &H32CCFF, &H32CCFF, &H32CCFF, &H32CCFF, &H32CCFF, &H32CCFF, &H676666} _
         , {&H32CCFF, &H32CCFF, &H32CCFF, &H32CCFF, &H323232, &H32CCFF, &H323232, &H676666} _
         , {&H32CCFF, &H32CCFF, &H323232, &H32CCFF, &H32CCFF, &H32CCFF, &H32CCFF, &H676666} _
         , {&H32CCFF, &H323232, &H323232, &H323232, &H32CCFF, &H32CCFF, &H32CCFF, &H676666} _
         , {&H32CCFF, &H323232, &H32CCFF, &H323232, &H32CCFF, &H32CCFF, &H32CCFF, &H676666} _
        }
        Dim markPiggtomo As Integer(,) = New Integer(,) { _
           {&HB4DEFF, &HB4DEFF, &HB4DEFF, &HB4DEFF, &HB4DEFF, &HB4DEFF, &HB4DEFF, &HB4DEFF} _
         , {&HB4DEFF, &HAAD1F0, &H95B6D2, &HB4DEFF, &HB4DEFF, &H819DB3, &H7690A4, &HB4DEFF} _
         , {&HB4DEFF, &HAAD1F0, &H95B6D2, &HADCFF9, &HB0D6FC, &HABCCF8, &HB4DEFF, &H7892A7} _
         , {&HA8CFEE, &HB4DEFF, &HB4DEFF, &HA8C4F5, &HA4BCF2, &HADD0FA, &H8CABC4, &H212325} _
         , {&HB0D0F, &H4E616F, &H919AC0, &H9EB1DA, &H90ABC9, &H4E5F6E, &H3B4854, &H181818} _
        }
        Dim markGoHome As Integer(,) = New Integer(,) { _
           {&HCC, &HCC, &HCC, &HCC, &HCC, &HCC, &HCC, &HCC} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF} _
         , {&HCC9933, &HCC9933, &HCC9933, &HFFFFFF, &HCC9933, &HCC9933, &HCC9933, &HFFFFFF} _
         , {&HCC9933, &HCC9933, &HCC9933, &HFFFFFF, &HCC9933, &HCC9933, &HCC9933, &HFFFFFF} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF} _
         , {&HCC9933, &HCC9933, &HCC9933, &HFFFFFF, &HCC9933, &HCC9933, &HCC9933, &HFFFFFF} _
         , {&HCC9933, &HCC9933, &HCC9933, &HFFFFFF, &HCC9933, &HCC9933, &HCC9933, &HFFFFFF} _
        }
        chw.HwndBrowser(0, 0)
        setFocus()
        Dim markLocation As Point
        If std.StopFlag = False Then
            ddLabelNow.Text = "きたよ帳を探しています"
            markLocation = chw.ImageSearchClient(markKitayo)
            If markLocation.X <> -1 Then
                ddLabelNow.Text = "きたよ帳が見つかりました"
                bd.refX = markLocation.X + 204
                bd.refY = markLocation.Y + 16
                bd.scrollBarX = 25
                bd.scrollBarY = 292
                bd.nameOffset = 0
                kitayo()
            End If
        End If
        If std.StopFlag = False Then
            ddLabelNow.Text = "グッピグ帳を探しています"
            markLocation = chw.ImageSearchClient(markGuppigg)
            If markLocation.X <> -1 Then
                ddLabelNow.Text = "グッピグ帳が見つかりました"
                bd.refX = markLocation.X + 197
                bd.refY = markLocation.Y + 25
                bd.scrollBarX = 25
                bd.scrollBarY = 292
                bd.nameOffset = 0
                kitayo()
            End If
        End If
        If std.StopFlag = False Then
            ddLabelNow.Text = "ピグとも一覧を探しています"
            markLocation = chw.ImageSearchClient(markPiggtomo)
            If markLocation.X <> -1 Then
                ddLabelNow.Text = "ピグとも一覧が見つかりました"
                bd.refX = markLocation.X + 202
                bd.refY = markLocation.Y + 42
                bd.scrollBarX = 24
                bd.scrollBarY = 286
                bd.nameOffset = -20
                kitayo()
            End If
        End If
        If std.StopFlag = False Then
            ddLabelNow.Text = "自分の部屋へを探しています"
            markLocation = chw.ImageSearchClient(markGoHome)
            If markLocation.X <> -1 Then
                ddLabelNow.Text = "自分の部屋へが見つかりました"
                chw.mLClickClient(markLocation.X, markLocation.Y)   '自分の部屋への位置で
            End If
        End If
        loadWait()
        ddLabelNow.Text = "終了しました: " & bellClickCount.ToString & " ベル"
        stdf.WaitMilliSec(3000)
        Dim fnt As System.Drawing.Font = New Font("Arial", 60, FontStyle.Bold)
        Dim pnt As System.Drawing.Point = New Point(CInt(chw.RightClient / 2) - 200, CInt(chw.BottomClient / 2) - 30)
        chw.DrawStringClient("Bells Hit:" & bellClickCount.ToString, fnt, Brushes.Blue, pnt)
        std.ExitAddIn()
    End Sub

    Private Sub setFocus()
        chw.mLClick(chw.Left + 56, chw.Bottom - 56)
    End Sub
    Public Sub kitayo()
        Do While True
            oshiraseExit()
            For y As Integer = bd.refY - bd.nameOffset To bd.refY + 297 Step 1 '走査
                kitayo2(bd.refX, y)
                If std.StopFlag = True Then Exit Do '停止ボタンで終了
            Next
            oshiraseExit()
            stdf.WaitMilliSec(500)   '0.5秒待つ
            If chw.GetColorClient(bd.refX + bd.scrollBarX, bd.refY + bd.scrollBarY) = &H999999 Then '全て終了だったら
                Exit Do
            End If
            chw.mLClickClient(bd.refX + bd.scrollBarX, bd.refY + bd.scrollBarY + 9) '下スクロールボタン位置で
            stdf.WaitMilliSec(500)   '0.5秒待つ
        Loop
    End Sub
    Private Sub kitayo2(ByVal x As Integer, ByVal y As Integer)
        If chw.GetColorClient(x, y - 1) = &H656565 AndAlso chw.GetColorClient(x, y) = &HCC Then '赤屋根を見付けたら
            If checkName(x, y) = True Then
                ddLabelNow.Text = "スキップ"
                Exit Sub
            End If
            ddLabelNow.Text = "部屋を訪問中"
            chw.mLClickClient(x, y)     '屋根の位置で
            loadWait()
            alertExit()
            bellClick()
            Dim soto As Integer = chw.GetColorClient(chw.RightClient - 171, chw.BottomClient - 107)
            'Dim uchi As Integer = chw.GetColorClient(chw.RightClient - 150, chw.BottomClient - 107)
            If soto = &HFFF642 Then
                chw.mLClickClient(chw.RightClient - 150, chw.BottomClient - 107)
                loadWait()
                alertExit()
                bellClick()
            ElseIf soto = &HB2A800 Then
                chw.mLClickClient(chw.RightClient - 171, chw.BottomClient - 107)
                loadWait()
                alertExit()
                bellClick()
            Else
                '庭が造られていないから何もしない
            End If
        End If
    End Sub

    Private Sub ProcessReset(ByVal sender As Object, ByVal e As System.EventArgs)
        checkName(-1, -1)
    End Sub
    Private Function checkName(ByVal x As Integer, ByVal y As Integer) As Boolean
        Const imgSize As Integer = 120 * 9 - 1
        Static Dim nameAry(imgSize, 100) As Integer
        Static Dim pointer As Integer = -1

        '特別な処理:記憶した名前をクリア
        If x = -1 AndAlso y = -1 Then
            ReDim nameAry(imgSize, 100)
            pointer = -1
            Return True
        End If

        chw.FillRectangleClient(Brushes.Red, 2, 0, chw.RightClient, 23)
        '現在の名前を取得
        Dim currentName(imgSize) As Integer
        Dim c1 As Integer = 0
        For h As Integer = 0 To 8 Step 1
            For w As Integer = 0 To 119 Step 1
                Dim col = chw.GetColorClient(x - 195 + w, y + h + bd.nameOffset)
                currentName(c1) = col
                c1 += 1
                Dim pe As System.Drawing.Pen = New Pen(Color.FromArgb(col Or &HFF000000))
                chw.DrawLineClient(pe, 7 + w, 7 + h, 7 + w + 1, 7 + h)
                pe.Dispose()
            Next
        Next
        '名前を順に比較
        For i As Integer = 0 To pointer Step 1
            For c1 = 0 To imgSize Step 1
                If nameAry(c1, i) <> currentName(c1) Then
                    Exit For
                End If
            Next
            If c1 > imgSize Then
                Return True '同じ名前発見
            End If
        Next
        '同じ名前が無い場合
        If nameAry.GetLength(1) >= pointer Then
            ReDim Preserve nameAry(imgSize, pointer + 100)
        End If
        pointer += 1
        For c1 = 0 To imgSize Step 1
            nameAry(c1, pointer) = currentName(c1)
        Next
        Return False
    End Function

    Private Function loadWait() As Boolean
        stdf.WaitMilliSec(1000)  '1秒待つ
        Dim count As Integer
        For count = 0 To 20 Step 1      'ロード中は待つ(タイムアウト20sec)
            If chw.GetColorClient(chw.LeftClient, chw.TopClient) = &HFFFFFF Then
                ddLabelNow.Text = "部屋を訪問しました"
                Return True
            End If
            stdf.WaitMilliSec(1000)  '1秒待つ
            If std.StopFlag Then Exit For '停止ボタンで終了
        Next
        ddLabelNow.Text = "タイムアウトしました"
        std.StopFlag = True
        Return False
    End Function

    Private Function alertExit() As Boolean
        Dim markTojiruWindow As Integer(,) = New Integer(,) { _
           {&H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF, &H9D7DFF} _
         , {&H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF, &H6532FF} _
        }
        stdf.WaitMilliSec(1000)
        Dim p As Point = chw.ImageSearchClient(markTojiruWindow)
        If p.X <> -1 Then
            chw.mLClickClient(p)
            stdf.WaitMilliSec(500)
            Return True
        End If
        Return False
    End Function

    Private Function oshiraseExit() As Boolean
        Dim markOshirase As Integer(,) = New Integer(,) { _
           {&HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF} _
         , {&HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298} _
         , {&HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298} _
         , {&HFE3499, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3499} _
         , {&HFE51A7, &HFE399B, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE3298, &HFE399B, &HFE51A7} _
         , {&HFE59AB, &HFE56A9, &HFE43A0, &HFE3499, &HFE3298, &HFE3298, &HFE3499, &HFE43A0, &HFE56A9, &HFE59AB} _
         , {&HB5437B, &HFE59AB, &HFE59AB, &HFE59AB, &HFE59AB, &HFE59AB, &HFE59AB, &HFE59AB, &HFE59AB, &HB5447C} _
         , {&H30303, &H5F2140, &HB5437B, &HFE59AB, &HFE59AB, &HFE59AB, &HFE59AB, &HB5447C, &H6E304F, &H181818} _
         , {&H0, &H0, &H0, &H0, &H0, &H181818, &H181818, &H181818, &H181818, &H181818} _
         , {&H0, &H0, &H0, &H0, &H181818, &H181818, &H181818, &H181818, &H181818, &H181818} _
         , {&H0, &H0, &H0, &H171717, &H171717, &H171717, &H171717, &H171717, &H171717, &H171717} _
         , {&H3F3F3F, &H5F5F5F, &H8A8A8A, &H8A8A8A, &H898989, &H898989, &H4F4F4F, &H404040, &H161616, &H0} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HBFBFBF} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HD9D9D9} _
         , {&HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HFFFFFF, &HE5E5E5, &H3F3F3F} _
        }
        stdf.WaitMilliSec(300)
        Dim p As Point = chw.ImageSearchClient(markOshirase)
        If p.X <> -1 Then
            chw.mLClickClient(p.X + 27, p.Y)
            stdf.WaitMilliSec(500)
            Return True
        End If
        Return False
    End Function

    Private Sub bellClick()
        Dim bellColor As Integer = chw.GetColorClient(chw.LeftClient + bellPointX, chw.TopClient + bellPointY)
        If bellColor = &H19D3AF OrElse bellColor = &H999FF Then 'ベルボタンが緑または橙だったら
            ddLabelNow.Text = "ベルを鳴らします"
            chw.mLClickClient(chw.LeftClient + bellPointX, chw.TopClient + bellPointY) 'ベルの位置で
            stdf.WaitMilliSec(1500)  '1.5秒待つ
            If ddItemCheckTalk.Checked Then
                chw.PostText(TALK & " " & System.DateTime.Now.ToString())
                chw.PostKey(std.VK_RETURN)
                chw.PostKey(std.VK_F2)
                stdf.WaitMilliSec(1500)  '1.5秒待つ
            End If
            bellClickCount += 1
        End If
        stdf.WaitMilliSec(500)   '0.5秒待つ
    End Sub

    Private Sub ddButtonInitial01()
        Dim ddButton As ToolStripDropDownButton = New ToolStripDropDownButton("設定")
        Dim dd As ToolStripDropDownMenu = New ToolStripDropDownMenu()
        ddButton.DropDown = dd

        Dim ddItemSeparator As ToolStripSeparator
        ddItemSeparator = New ToolStripSeparator()
        ddItemSeparator.AutoSize = True
        dd.Items.Add(ddItemSeparator)

        ddItemCheckTalk = New CheckBox
        ddItemCheckTalk.Text = "訪問時にしゃべる"
        ddItemCheckTalk.BackColor = Color.Transparent
        Dim cHost As ToolStripControlHost = New ToolStripControlHost(ddItemCheckTalk)
        dd.Items.Add(cHost)

        ddItemProcessReset = New ToolStripButton("訪問先名の記録リセット")
        dd.Items.Add(ddItemProcessReset)

        'Dim ddItemLabelBlank As ToolStripLabel = New ToolStripLabel(" ")
        'dd.Items.Add(ddItemLabelBlank)
        Dim ddItemSeparator2 As ToolStripSeparator
        ddItemSeparator2 = New ToolStripSeparator()
        ddItemSeparator2.AutoSize = True
        dd.Items.Add(ddItemSeparator2)

        std.AddInMenuAddOnce(ddButton)
    End Sub
    Private Sub ddButtonInitial02()
        ddLabelNow = New ToolStripLabel("きたよ帳,グッピグ帳,ピグとも一覧を開いて実行します")
        std.AddInMenuAddOnce(ddLabelNow)
    End Sub

End Class

Public Class bookData
    Private e_refX As Integer
    Private e_refY As Integer
    Private e_scrollBarX As Integer
    Private e_scrollBarY As Integer
    Private e_nameOffset As Integer

    Public Property refX() As Integer
        Get
            Return e_refX
        End Get
        Set(value As Integer)
            e_refX = value
        End Set
    End Property
    Public Property refY() As Integer
        Get
            Return e_refY
        End Get
        Set(value As Integer)
            e_refY = value
        End Set
    End Property
    Public Property scrollBarX() As Integer
        Get
            Return e_scrollBarX
        End Get
        Set(value As Integer)
            e_scrollBarX = value
        End Set
    End Property
    Public Property scrollBarY() As Integer
        Get
            Return e_scrollBarY
        End Get
        Set(value As Integer)
            e_scrollBarY = value
        End Set
    End Property
    Public Property nameOffset() As Integer
        Get
            Return e_nameOffset
        End Get
        Set(value As Integer)
            e_nameOffset = value
        End Set
    End Property

End Class