色について (ID:119709)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

pictureの中身が変わらなければ、事前に赤い部分の座標を配列に入れて
おくと便利かもしれません。
あと、多重ループの時、判断はループの一番奥ですべてやるんじゃなくて
途中で出来るものは、そこでやったほうが余計なループを回らなくて済み
ますよ。

本当はサンプルを書くと勉強にならないんだけど、まぁいいか(^^;
手書きなのでスペルミスとかあるかも・・・

Private Pic1X() As Long
Private Pic1Y() As Long
Private Pic2X() As Long
Private Pic2Y() As Long

Private Sub Command1_Click()
   Dim n As Long
   Dim x As Long
   Dim y As Long

n = 0
   For x = 0 To 100
      For y = 0 To 80
         If Picture1.Point(x, y) = vbRed Then
            ReDim Preserve Pic1X(n)
            ReDim Preserve Pic1Y(n)
            Pic1X(n) = x
            Pic1Y(n) = y
            n = n + 1
         End If
      Next y
   Next x

n = 0
   For x = 20 To 32
      For y = 20 To 32
         If Picture2.Point(x, y) = vbRed Then
            ReDim PreServe Pic2X(n)
            ReDim PreServe Pic2Y(n)
            Pic2X(n) = x
            Pic2Y(n) = y
            n = n + 1
         End If
      Next y
   Next x

Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  Dim x1 As Long
  Dim y1 As Long
  Dim x2 As Long
  Dim y2 As Long
  Dim Pic1Left As Long
  Dim Pic1Top As Long
  Dim Pic2Left As Long
  Dim Pic2Top As Long

Pic1Left = Picture1.Left
  Pic1Top = Picture1.Top
  Pic2Left = Picture2.Left
  Pic2Top = Picture2.Top

For x1 = LBound(Pic1X) to UBound(Pic1X)
    For x2 = LBound(Pic2X) to UBound(Pic2X)
      'まずX座標が同じかチェック
      If Pic1X(x1) + Pic1Left = Pic2X(x2) + Pic2Left Then
        For y1 = LBound(Pic1Y) to UBound(Pic1Y)
          For y2 = LBound(Pic2Y) to UBound(Pic2Y)
            '次にY座標も同じかチェック
            If Pic1Y(y1) + Pic1Top = Pic2Y(y2) + Pic2Top Then
              MsgBox "あたり"
              '１つでもあたったら残りのループ処理は不要
              Exit Sub
            End If
          Next y2
        Next y1
      End If
    Next x2
  Next x1
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る