game.frm

本人收藏的用VB编写的游戏程序,希望对大家有帮助,

  If total_count >= 9 Then '和局收场
    Label2.ForeColor = vbBlue
    Label2.Caption = "和局！"
    Command1.Enabled = True
  End If
  total_count = total_count + 1
  
End Sub

Sub compu_select()
  Dim anyone As Byte, temp As Integer
  
   For i = 0 To 8
     If Picture1(i).Tag = 0 Then sel = i
   Next
   If total_count <= 2 Then
     If Picture1(4).Tag = 0 Then
       sel = 4
     Else
       anyone = 2 * Int(Rnd * 4) '在0，2，4，6间产生一数值
       If anyone = 4 Then anyone = 8
       sel = anyone
     End If
   End If
   
   temp = who_num Mod 2
   If temp = 0 Then temp = -1 '找出我方的Tag属性值
   
   If total_count > 2 Then
     For i = 0 To 8
       If i = 4 Then GoTo a0
       If Picture1(i).Tag = 0 Then
         If Picture1(8 - i).Tag <> 0 And Picture1(8 - i).Tag = Picture1(4).Tag Then
             sel = i
             If Picture1(8 - i) = temp Then Exit For
         End If
         Select Case i
          Case 0
              If Picture1(1).Tag <> 0 And Picture1(1).Tag = Picture1(2).Tag Then
                sel = 0
                If Picture1(1) = temp Then Exit For
              End If
              If Picture1(3).Tag <> 0 And Picture1(3).Tag = Picture1(6).Tag Then
                sel = 0
                If Picture1(3) = temp Then Exit For
              End If
          Case 1
              If Picture1(0).Tag <> 0 And Picture1(0).Tag = Picture1(2).Tag Then
                  sel = 1
                  If Picture1(0) = temp Then Exit For
              End If
          Case 2
              If Picture1(0).Tag <> 0 And Picture1(0).Tag = Picture1(1).Tag Then
                  sel = 2
                  If Picture1(0) = temp Then Exit For
              End If
              If Picture1(6).Tag <> 0 And Picture1(6).Tag = Picture1(8).Tag Then
                  sel = 2
                  If Picture1(6).Tag = temp Then Exit For
              End If
          Case 3
              If Picture1(0).Tag <> 0 And Picture1(0).Tag = Picture1(6).Tag Then
                  sel = 3
                  If Picture1(0) = temp Then Exit For
              End If
          Case 5
              If Picture1(2).Tag <> 0 And Picture1(2).Tag = Picture1(8).Tag Then
                  sel = 5
                  If Picture1(2) = temp Then Exit For
              End If
          Case 6
              If Picture1(0).Tag <> 0 And Picture1(0).Tag = Picture1(3).Tag Then
                   sel = 6
                   If Picture1(0) = temp Then Exit For
              End If
              If Picture1(7).Tag <> 0 And Picture1(7).Tag = Picture1(8).Tag Then
                   sel = 6
                   If Picture1(7) = temp Then Exit For
              End If
          Case 7
              If Picture1(6).Tag <> 0 And Picture1(6).Tag = Picture1(8).Tag Then
                  sel = 7
                  If Picture1(6) = temp Then Exit For
              End If
          Case 8
              If Picture1(6).Tag <> 0 And Picture1(6).Tag = Picture1(7).Tag Then
                  sel = 8
                  If Picture1(6) = temp Then Exit For
              End If
              If Picture1(2).Tag <> 0 And Picture1(2).Tag = Picture1(5).Tag Then
                  sel = 8
                  If Picture1(2) = temp Then Exit For
              End If
         End Select
      End If
a0:
    Next
    End If
    draw_ox (sel)
    allow_select = True
          
End Sub

Sub check_win()
   
   If Picture1(0).Tag <> 0 Then
       If Picture1(0).Tag = Picture1(1).Tag And Picture1(1).Tag = Picture1(2).Tag Then show_win 0, 1, 2
       If Picture1(0).Tag = Picture1(3).Tag And Picture1(3).Tag = Picture1(6).Tag Then show_win 0, 3, 6
       If Picture1(0).Tag = Picture1(4).Tag And Picture1(4).Tag = Picture1(8).Tag Then show_win 0, 4, 8
   End If
   If Picture1(4).Tag <> 0 Then
       If Picture1(1).Tag = Picture1(4).Tag And Picture1(4).Tag = Picture1(7).Tag Then show_win 1, 4, 7
       If Picture1(2).Tag = Picture1(4).Tag And Picture1(4).Tag = Picture1(6).Tag Then show_win 2, 4, 6
       If Picture1(3).Tag = Picture1(4).Tag And Picture1(4).Tag = Picture1(5).Tag Then show_win 3, 4, 5
   End If
   If Picture1(8).Tag <> 0 Then
       If Picture1(2).Tag = Picture1(5).Tag And Picture1(5).Tag = Picture1(8).Tag Then show_win 2, 5, 8
       If Picture1(6).Tag = Picture1(7).Tag And Picture1(7).Tag = Picture1(8).Tag Then show_win 6, 7, 8
   End If
   If someone_win Then
     For i = 0 To 8
        Picture1(i).Tag = 1
     Next
     Command1.Enabled = True
   End If
   
End Sub

Sub show_win(a, b, c)
   
    line1 = a
    line2 = b
    line3 = c
    Timer2.Enabled = True
    someone_win = True
    
    If who_num Mod 2 = 0 Then '玩者先
      If total_count Mod 2 <> 0 Then Label2.Caption = "您赢了!"
      If total_count Mod 2 = 0 Then Label2.Caption = "您输了!"
    Else '计算机先
      If total_count Mod 2 = 0 Then Label2.Caption = "您赢了!"
      If total_count Mod 2 <> 0 Then Label2.Caption = "您输了!"
    End If
    
End Sub

Private Sub Command1_Click()
    For i = 0 To 8
       Picture1(i).Tag = 0
       Picture1(i).Cls
       Picture1(i).Visible = True
    Next
    Label2.Caption = "胜负"
    Timer2.Enabled = False
    total_count = 1
    someone_win = False
    
    Command1.Enabled = False
    '决定先玩者
    who_num = 5 + Int(Rnd * 5)
    num = 0
    Game.Tag = 1
    'Timer1.Enabled = True
    '设置先后
    If who_num Mod 2 <> 0 Then
       allow_select = False
    Else
       allow_select = True
    End If
    
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
   
 If App.PrevInstance Then '判断是否有同一个程序实例已运行
     End
 End If
    
  ' 建立椭圆窗体
    wid = ScaleX(Width, vbTwips, vbPixels)
    hgt = ScaleY(Height, vbTwips, vbPixels)
    rgn = CreateEllipticRgn(0, 0, wid, hgt)
    ' 限定窗体形状
    SetWindowRgn hwnd, rgn, True
    '建立椭圆按钮
    rgn = CreateEllipticRgn(0, 0, Command1.Width / Screen.TwipsPerPixelX, Command1.Height / Screen.TwipsPerPixelY)
    SetWindowRgn Command1.hwnd, rgn, True
    rgn = CreateEllipticRgn(0, 0, Command2.Width / Screen.TwipsPerPixelX, Command2.Height / Screen.TwipsPerPixelY)
    SetWindowRgn Command2.hwnd, rgn, True
    
    '实现无标题窗体拖动
    PROROC = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
    
    Randomize
    allow_select = False
    For i = 0 To 8
       Picture1(i).Tag = 1
    Next
    Game.Tag = 0
    AniIcon = 0
    PerAniIcon = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Dim rv As Long
 
 '退出程序时的处理工作
   rv = SetWindowLong(hwnd, GWL_WNDPROC, PROROC) '恢复标题栏拖动
End Sub

Private Sub Picture1_Click(Index As Integer)
    
    If Picture1(Index).Tag <> 0 Or Not allow_select Then Exit Sub
    allow_select = Not allow_select '不允许重复选定
      '输入图形
    draw_ox Index
      '轮到计算机选定
    If Not someone_win And total_count <= 9 Then compu_select
      
End Sub

Private Sub Timer1_Timer()
   
'  If PerAniIcon Mod 10 = 0 Then
'    Game.Icon = Image1(AniIcon).Picture '显示动态图标
'    AniIcon = AniIcon + 1
'    If AniIcon = 3 Then AniIcon = 0
'  End If
'  PerAniIcon = PerAniIcon + 1
  
   If Game.Tag = 1 Then
    num = num + 1
    If num Mod 2 = 0 Then '偶数
      Label1.Caption = "您先!"
    Else  '奇数
      Label1.Caption = "计算机先!"
    End If
    If num >= who_num Then
      If who_num Mod 2 <> 0 Then compu_select
      Game.Tag = 0
      'Timer1.Enabled = False '停止条件
    End If
   End If
   
End Sub

Private Sub Timer2_Timer()
    
    '闪烁连成一线的部分
    Picture1(line1).Visible = Not Picture1(line1).Visible
    Picture1(line2).Visible = Not Picture1(line2).Visible
    Picture1(line3).Visible = Not Picture1(line3).Visible
    
End Sub