home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / create6r / frmchess.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-05  |  24.2 KB  |  727 lines
  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
  3. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  4. Object = "{5336AD54-C994-11D2-B7D6-444553540000}#11.0#0"; "HChessBoardP.ocx"
  5. Begin VB.Form frmChess 
  6.    AutoRedraw      =   -1  'True
  7.    BackColor       =   &H00FFFFFF&
  8.    BorderStyle     =   1  'Fixed Single
  9.    Caption         =   "Chess Board"
  10.    ClientHeight    =   7095
  11.    ClientLeft      =   45
  12.    ClientTop       =   375
  13.    ClientWidth     =   6930
  14.    Icon            =   "frmChess.frx":0000
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   473
  19.    ScaleMode       =   3  'Pixel
  20.    ScaleWidth      =   462
  21.    Begin VB.Timer Timer4 
  22.       Left            =   7440
  23.       Top             =   6360
  24.    End
  25.    Begin VB.Timer Timer3 
  26.       Left            =   7440
  27.       Top             =   5880
  28.    End
  29.    Begin VB.Timer Timer2 
  30.       Left            =   7440
  31.       Top             =   5400
  32.    End
  33.    Begin VB.Timer Timer1 
  34.       Left            =   7440
  35.       Top             =   4920
  36.    End
  37.    Begin MSWinsockLib.Winsock SockClient 
  38.       Left            =   7440
  39.       Top             =   4440
  40.       _ExtentX        =   741
  41.       _ExtentY        =   741
  42.    End
  43.    Begin PicClip.PictureClip PictureClip1 
  44.       Left            =   7440
  45.       Top             =   3960
  46.       _ExtentX        =   6985
  47.       _ExtentY        =   556
  48.       _Version        =   327680
  49.       Picture         =   "frmChess.frx":113A
  50.    End
  51.    Begin VB.PictureBox Picture1 
  52.       Appearance      =   0  'Flat
  53.       AutoSize        =   -1  'True
  54.       BackColor       =   &H80000005&
  55.       BorderStyle     =   0  'None
  56.       ForeColor       =   &H80000008&
  57.       Height          =   525
  58.       Left            =   315
  59.       Picture         =   "frmChess.frx":5284
  60.       ScaleHeight     =   525
  61.       ScaleWidth      =   6330
  62.       TabIndex        =   9
  63.       Top             =   480
  64.       Width           =   6330
  65.       Begin VB.Image Image1 
  66.          Height          =   255
  67.          Index           =   5
  68.          Left            =   5880
  69.          ToolTipText     =   "Help"
  70.          Top             =   120
  71.          Width           =   375
  72.       End
  73.       Begin VB.Image Image1 
  74.          Height          =   255
  75.          Index           =   4
  76.          Left            =   5160
  77.          ToolTipText     =   "Chat Window"
  78.          Top             =   120
  79.          Width           =   375
  80.       End
  81.       Begin VB.Image Image1 
  82.          Height          =   255
  83.          Index           =   3
  84.          Left            =   4680
  85.          ToolTipText     =   "Info Game Window"
  86.          Top             =   120
  87.          Width           =   375
  88.       End
  89.       Begin VB.Image Image1 
  90.          Height          =   255
  91.          Index           =   2
  92.          Left            =   3960
  93.          ToolTipText     =   "Music"
  94.          Top             =   120
  95.          Width           =   375
  96.       End
  97.       Begin VB.Image Image1 
  98.          Height          =   255
  99.          Index           =   1
  100.          Left            =   3480
  101.          ToolTipText     =   "No Sound"
  102.          Top             =   120
  103.          Width           =   375
  104.       End
  105.       Begin VB.Image Image1 
  106.          Height          =   255
  107.          Index           =   0
  108.          Left            =   120
  109.          ToolTipText     =   "New Game"
  110.          Top             =   120
  111.          Width           =   375
  112.       End
  113.    End
  114.    Begin HChessBoardP.HChessBoard HChessBoard1 
  115.       Height          =   6360
  116.       Left            =   300
  117.       TabIndex        =   11
  118.       Top             =   480
  119.       Width           =   6360
  120.       _ExtentX        =   11218
  121.       _ExtentY        =   11218
  122.       BoardPicture    =   "frmChess.frx":5FA4
  123.       PiecePicture    =   "frmChess.frx":6BF6
  124.       MouseIcon       =   "frmChess.frx":7848
  125.       DiffBoard_Y     =   11
  126.       DiffBoard_X     =   11
  127.       BoardWidth      =   424
  128.       BoardHeight     =   424
  129.    End
  130.    Begin VB.Label Label3 
  131.       BackStyle       =   0  'Transparent
  132.       Caption         =   "Guest Vs Opponent"
  133.       BeginProperty Font 
  134.          Name            =   "Lucida Sans"
  135.          Size            =   14.25
  136.          Charset         =   0
  137.          Weight          =   700
  138.          Underline       =   0   'False
  139.          Italic          =   -1  'True
  140.          Strikethrough   =   0   'False
  141.       EndProperty
  142.       ForeColor       =   &H80000002&
  143.       Height          =   330
  144.       Left            =   600
  145.       TabIndex        =   10
  146.       Top             =   75
  147.       Width           =   5295
  148.    End
  149.    Begin VB.Image Image2 
  150.       Height          =   330
  151.       Left            =   7560
  152.       Picture         =   "frmChess.frx":7B62
  153.       Top             =   3600
  154.       Width           =   300
  155.    End
  156.    Begin VB.Label Label2 
  157.       BackStyle       =   0  'Transparent
  158.       Caption         =   "1"
  159.       BeginProperty Font 
  160.          Name            =   "MS Sans Serif"
  161.          Size            =   8.25
  162.          Charset         =   0
  163.          Weight          =   700
  164.          Underline       =   0   'False
  165.          Italic          =   0   'False
  166.          Strikethrough   =   0   'False
  167.       EndProperty
  168.       Height          =   255
  169.       Index           =   7
  170.       Left            =   75
  171.       TabIndex        =   8
  172.       Top             =   6120
  173.       Width           =   135
  174.    End
  175.    Begin VB.Label Label2 
  176.       BackStyle       =   0  'Transparent
  177.       Caption         =   "2"
  178.       BeginProperty Font 
  179.          Name            =   "MS Sans Serif"
  180.          Size            =   8.25
  181.          Charset         =   0
  182.          Weight          =   700
  183.          Underline       =   0   'False
  184.          Italic          =   0   'False
  185.          Strikethrough   =   0   'False
  186.       EndProperty
  187.       Height          =   255
  188.       Index           =   6
  189.       Left            =   75
  190.       TabIndex        =   7
  191.       Top             =   5400
  192.       Width           =   135
  193.    End
  194.    Begin VB.Label Label2 
  195.       BackStyle       =   0  'Transparent
  196.       Caption         =   "3"
  197.       BeginProperty Font 
  198.          Name            =   "MS Sans Serif"
  199.          Size            =   8.25
  200.          Charset         =   0
  201.          Weight          =   700
  202.          Underline       =   0   'False
  203.          Italic          =   0   'False
  204.          Strikethrough   =   0   'False
  205.       EndProperty
  206.       Height          =   255
  207.       Index           =   5
  208.       Left            =   75
  209.       TabIndex        =   6
  210.       Top             =   4680
  211.       Width           =   135
  212.    End
  213.    Begin VB.Label Label2 
  214.       BackStyle       =   0  'Transparent
  215.       Caption         =   "4"
  216.       BeginProperty Font 
  217.          Name            =   "MS Sans Serif"
  218.          Size            =   8.25
  219.          Charset         =   0
  220.          Weight          =   700
  221.          Underline       =   0   'False
  222.          Italic          =   0   'False
  223.          Strikethrough   =   0   'False
  224.       EndProperty
  225.       Height          =   255
  226.       Index           =   4
  227.       Left            =   75
  228.       TabIndex        =   5
  229.       Top             =   3960
  230.       Width           =   135
  231.    End
  232.    Begin VB.Label Label2 
  233.       BackStyle       =   0  'Transparent
  234.       Caption         =   "5"
  235.       BeginProperty Font 
  236.          Name            =   "MS Sans Serif"
  237.          Size            =   8.25
  238.          Charset         =   0
  239.          Weight          =   700
  240.          Underline       =   0   'False
  241.          Italic          =   0   'False
  242.          Strikethrough   =   0   'False
  243.       EndProperty
  244.       Height          =   255
  245.       Index           =   3
  246.       Left            =   75
  247.       TabIndex        =   4
  248.       Top             =   3120
  249.       Width           =   135
  250.    End
  251.    Begin VB.Label Label2 
  252.       BackStyle       =   0  'Transparent
  253.       Caption         =   "6"
  254.       BeginProperty Font 
  255.          Name            =   "MS Sans Serif"
  256.          Size            =   8.25
  257.          Charset         =   0
  258.          Weight          =   700
  259.          Underline       =   0   'False
  260.          Italic          =   0   'False
  261.          Strikethrough   =   0   'False
  262.       EndProperty
  263.       Height          =   255
  264.       Index           =   2
  265.       Left            =   75
  266.       TabIndex        =   3
  267.       Top             =   2400
  268.       Width           =   135
  269.    End
  270.    Begin VB.Label Label2 
  271.       BackStyle       =   0  'Transparent
  272.       Caption         =   "7"
  273.       BeginProperty Font 
  274.          Name            =   "MS Sans Serif"
  275.          Size            =   8.25
  276.          Charset         =   0
  277.          Weight          =   700
  278.          Underline       =   0   'False
  279.          Italic          =   0   'False
  280.          Strikethrough   =   0   'False
  281.       EndProperty
  282.       Height          =   255
  283.       Index           =   1
  284.       Left            =   75
  285.       TabIndex        =   2
  286.       Top             =   1680
  287.       Width           =   135
  288.    End
  289.    Begin VB.Label Label2 
  290.       BackStyle       =   0  'Transparent
  291.       Caption         =   "8"
  292.       BeginProperty Font 
  293.          Name            =   "MS Sans Serif"
  294.          Size            =   8.25
  295.          Charset         =   0
  296.          Weight          =   700
  297.          Underline       =   0   'False
  298.          Italic          =   0   'False
  299.          Strikethrough   =   0   'False
  300.       EndProperty
  301.       Height          =   255
  302.       Index           =   0
  303.       Left            =   75
  304.       TabIndex        =   1
  305.       Top             =   960
  306.       Width           =   135
  307.    End
  308.    Begin VB.Label Label1 
  309.       BackStyle       =   0  'Transparent
  310.       Caption         =   "A            B          C          D          E          F          G           H"
  311.       BeginProperty Font 
  312.          Name            =   "MS Sans Serif"
  313.          Size            =   8.25
  314.          Charset         =   0
  315.          Weight          =   700
  316.          Underline       =   0   'False
  317.          Italic          =   0   'False
  318.          Strikethrough   =   0   'False
  319.       EndProperty
  320.       Height          =   255
  321.       Index           =   0
  322.       Left            =   720
  323.       TabIndex        =   0
  324.       Top             =   6855
  325.       Width           =   5775
  326.    End
  327. Attribute VB_Name = "frmChess"
  328. Attribute VB_GlobalNameSpace = False
  329. Attribute VB_Creatable = False
  330. Attribute VB_PredeclaredId = True
  331. Attribute VB_Exposed = False
  332. Dim HoldIndex
  333. Dim OPTSelected As Boolean
  334. Dim piecejouer As String
  335. Dim hr, min, sec As Integer
  336. Dim hrs, mins, secs As String
  337. Dim tempdebcoup
  338. Dim waitforplayer As Boolean
  339. Dim nbcoupmoi As Long
  340. Dim nbcoup As Long
  341. Dim montour As Boolean
  342. Dim entraitement As Boolean
  343. Dim sendok As Boolean
  344. Public Sub recommendeG()
  345. On Error Resume Next
  346. ChessBoard1.EraseBoard
  347. If PlayOffline Then
  348.    If Connected Then SockClient.SendData "#020code#findepart"
  349. Dim str1
  350.   If JoueurHote Then
  351.    str1 = "false"
  352.   Else
  353.    str1 = "true"
  354.   End If
  355. If Connected Then SockClient.SendData "#020code#recomgame" & str1
  356. End If
  357. 'initpartie
  358. End Sub
  359. Private Sub Form_Initialize()
  360. strArg = Command()
  361. If strArg <> "" Then CheckArg strArg
  362. End Sub
  363. Private Sub Form_Unload(Cancel As Integer)
  364. HChessBoard1.ClearGraphicBuffer
  365. Unload frmChat
  366. Unload frmInfoG
  367. End Sub
  368. Private Sub HChessBoard1_EventStatus()
  369. 'frmInfoG.Label1.Caption = HChessBoard1.StatusString
  370. End Sub
  371. Private Sub SockClient_ConnectionRequest(ByVal requestID As Long)
  372. On Error Resume Next
  373. Dim rep
  374. rep = MsgBox("You have a Visitor Request, Do You want to Accept ?", vbYesNoCancel, "Connection !")
  375. If rep = vbCancel Or rep = vbNo Then Exit Sub
  376. If SockClient.State <> sckClosed Then
  377.   SockClient.Close
  378. End If
  379.  SockClient.Accept requestID
  380.  SockClient.SendData "#020code#okconnect" & NickName
  381.  Timer3.Interval = 1000
  382.  DoEvents
  383. End Sub
  384. Private Sub SockClient_DataArrival(ByVal bytesTotal As Long)
  385. On Error Resume Next
  386. Dim strdata As String
  387. SockClient.GetData strdata
  388. If Mid(strdata, 1, 9) = "#010text#" Then
  389.   frmChat.List1.AddItem VisitorName & " Say >> " & Mid(strdata, 10, Len(strdata) - 9)
  390.   frmChat.List1.ListIndex = frmChat.List1.ListCount - 1
  391. Dim code1, code2
  392.  code1 = Mid(strdata, 1, 14)
  393.  code2 = Mid(strdata, 1, 18)
  394.  Select Case code1
  395.  Case "#010#code:move": joujeuadv strdata, "move"
  396.  Case "#010#code:rock": joujeuadv strdata, "rock"
  397.  Case "#010#code:quen": joujeuadv strdata, "quen"
  398.  Case "#010#code:ches": joujeuadv strdata, "ches"
  399. End Select
  400. Select Case code2
  401.  Case "#020code#wantnewga": WantaNewGame strdata
  402.  Case "#020code#kfornewga": Unload frmWaitting: nouvelleP strdata
  403.  Case "#020code#okconnect": okconnect strdata
  404.  Case "#020code#receiveok": nouvelleP strdata
  405.  Case "#020code#refunewga": RefuseNewGame
  406.  Case "#020code#quitegame": quitthegame
  407.  'Case "#020code#movepitou": joujeuadv strdata
  408.  End Select
  409. End If
  410. End Sub
  411. Private Sub quitthegame()
  412. MsgBox VisitorName & " Has left the game !"
  413. HChessBoard1.EraseBoard
  414. PartiEnCour = False
  415. End Sub
  416. Private Sub RefuseNewGame()
  417. MsgBox "Your Opponent has refused your proposal !"
  418. Unload frmWaitting
  419. End Sub
  420. Private Sub WantaNewGame(strdata)
  421. Dim rep, strtemp
  422. rep = MsgBox(VisitorName & " have a new proposal do you want to accept ?", vbYesNo, "New Game")
  423. If rep = vbYes Then
  424.  SockClient.SendData "#020code#kfornewga"
  425.  strtemp = Mid(strdata, 19, Len(strdata) - 18)
  426.  If strtemp = "No" Then
  427.   JoueurHote = True
  428.   HChessBoard1.Host = True
  429.  Else
  430.   JoueurHote = False
  431.   HChessBoard1.Host = False
  432.  End If
  433.   HChessBoard1.PlayOffline = False
  434.   PlayOffline = False
  435.   Connected = True
  436.   HChessBoard1.InitGame
  437.  SockClient.SendData "#020code#refunewga"
  438.  HChessBoard1.EraseBoard
  439. End If
  440. End Sub
  441. Private Sub nouvelleP(strdata)
  442. On Error Resume Next
  443. VisitorName = Mid(strdata, 19, Len(strdata) - 18)
  444. 'Label1.Caption = Label1.Caption & " " & Mid(strdata, 19, Len(strdata) - 18)
  445. Connected = True
  446. PartiEnCour = True
  447. Timer3.Interval = 1000
  448. 'List1.Clear
  449. 'If HChessBoard1.CanIPlay Then frmInfoG.Label1.Caption = "Your Turn" Else frmInfoG.Label1.Caption = "Your Turn"
  450. InitGame
  451. End Sub
  452. Private Sub okconnect(strdt)
  453. On Error Resume Next
  454. nouvelleP strdt
  455. SockClient.SendData "#020code#receiveok" & NickName
  456. DoEvents
  457. End Sub
  458. Private Sub findepartie(msg1)
  459. On Error Resume Next
  460. 'Timer5.Interval = 0
  461. 'Timer2.Interval = 0
  462. 'DoEvents
  463. 'Label2.Caption = "Start a New Game !"
  464. 'List2.Clear
  465. 'Command2.Caption = "New Game"
  466. 'ChessBoard1.EraseBoard
  467. 'PartiEnCour = False
  468. 'MsgBox msg1
  469. End Sub
  470. Private Sub joujeuadv(strdat, cod)
  471. On Error Resume Next
  472. Dim strtemp, code
  473. code = Mid(strdat, 1, 14)
  474. Dim p1, p2, p3, p4
  475. p1 = Val(InStr(1, strdat, "-", vbBinaryCompare))
  476. p2 = Val(InStr(p1 + 1, strdat, "-", vbBinaryCompare))
  477. p3 = Val(InStr(p2 + 1, strdat, "-", vbBinaryCompare))
  478. p4 = Val(InStr(p3 + 1, strdat, "-", vbBinaryCompare))
  479. Dim val1, val2, val3, val4
  480. val1 = Val(Mid(strdat, 15, p1 - 15)): val2 = Val(Mid(strdat, p1 + 1, p2 - 15)): val3 = Val(Mid(strdat, p2 + 1, p3 - 15)): val4 = Val(Mid(strdat, p3 + 1, Len(strdat) - 2 - (p2))) 'lit la position du move
  481. val1 = 7 - val1: val2 = 7 - val2: val3 = 7 - val3: val4 = 7 - val4
  482. strtemp = Str(val1) & Chr(val2 + 65) & " To " & Str(val3) & Chr(val4 + 65)
  483. 'List2.List(List2.ListCount - 1) = "I: " & (nbcoup - nbcoupmoi) & " - " & nomoposant & " -T- : " & hrs & ":" & mins & ":" & secs & " -M- : " & strtemp
  484. nbcoup = nbcoup + 1
  485. nbcoupmoi = nbcoupmoi + 1
  486. hrs = "": mins = "": secs = ""
  487. hr = 0: min = 0: sec = 0
  488. 'List2.AddItem "I: " & nbcoupmoi & " - " & NickName & " -T- : " & hrs & ":" & mins & ":" & secs
  489. 'List2.ListIndex = List2.ListCount - 1
  490. HChessBoard1.MoveThePlayer2Piece val1, val2, val3, val4, cod
  491. DoEvents
  492. waitforplayer = False
  493. End Sub
  494. Private Sub Timer2_Timer()
  495. On Error Resume Next
  496. If min = 59 Then min = 0: hr = hr + 1: hrs = trans(hr): mins = trans(min)
  497. If sec = 59 Then sec = 0: min = min + 1: mins = trans(min)
  498. sec = sec + 1
  499. secs = trans(sec)
  500. 'If Not waitforplayer Then
  501.  ' frmInfoG.List1.List(List2.ListCount - 1) = "I: " & nbcoupmoi & " - " & NickName & " -T- : " & hrs & ":" & mins & ":" & secs
  502. 'Else
  503. '  frmInfoG.List1.List(List2.ListCount - 1) = "I: " & (nbcoup - nbcoupmoi) & " - " & nomoposant & " -T- : " & hrs & ":" & mins & ":" & secs
  504. 'End If
  505. End Sub
  506. Private Sub Timer3_Timer()
  507. checkdisconnect
  508. End Sub
  509. Private Sub checkdisconnect()
  510. On Error Resume Next
  511. If SockClient.State <> 7 And Connected Then
  512.   SockClient.Close
  513.   MsgBox "You are Disconnected !"
  514.   PartiEnCour = False
  515.   Unload frmWaitting
  516.   Timer2.Interval = 0
  517.   Timer3.Interval = 0
  518.   Connected = False
  519.   HChessBoard1.EraseBoard
  520.   PartiEnCour = False
  521.   'frmInfoG.Label1.Caption = "Start a New Game !"
  522.   'frmInfoG.List1.Clear: List2.Clear
  523. End If
  524. End Sub
  525. Private Function trans(var1) As String
  526. On Error Resume Next
  527. If var1 = 0 Then
  528.  trans = "00"
  529. If var1 < 10 Then
  530.   trans = "0" & Trim(Str(var1))
  531.   trans = Trim(Str(var1))
  532. End If
  533. End If
  534. End Function
  535. Public Sub InitGame()
  536. On Error Resume Next
  537. hrs = "": mins = "": secs = ""
  538. hr = 0: min = 0: sec = 0
  539. nbcoup = 1:
  540. If PlayOffline Then
  541.   HChessBoard1.PlayOffline = True
  542.   HChessBoard1.Host = True
  543.   Command2.Caption = "New Game"
  544.   'frmInfoG.Label1.Caption = "Offline game !"
  545.   HChessBoard1.PlayOffline = False
  546.   If JoueurHote Then
  547.     nbcoupmoi = 1
  548.     waitforplayer = False
  549.     HChessBoard1.Host = True
  550.    ' frmInfoG.Label1.Caption = "Your Turn !"
  551.   Else
  552.     nbcoupmoi = 0
  553.     HChessBoard1.Host = False
  554.     waitforplayer = True
  555.     'frmInfoG.Label1.Caption = "Wait Your Turn !"
  556.   End If
  557.   Timer2.Interval = 1000
  558.  End If
  559. Label3.Caption = Label3.Caption & VisitorName
  560. HChessBoard1.Sound = True
  561. HChessBoard1.MoveString = ""
  562. HChessBoard1.CreateGraphicBuffer
  563. HChessBoard1.InitGame
  564. 'frmInfoG.List1.Clear
  565. PartiEnCour = True
  566. End Sub
  567. Private Sub Form_Load()
  568. 'On Error Resume Next
  569. Dim strArg As String
  570. OutSquare 0, 0, ScaleWidth - 1, ScaleHeight, Me
  571. InSquare HChessBoard1.Left, HChessBoard1.Top, HChessBoard1.Width - 1, HChessBoard1.Height, Me
  572. PaintPicture Image2.Picture, 15, 5
  573. PaintPicture Image2.Picture, ScaleWidth - 35, 5
  574. JoueurHote = True
  575. HostName = "Computer Name/IP"
  576. NickName = "Guest"
  577. VisitorName = "Opponent"
  578. SockClient.Protocol = sckTCPProtocol
  579. SockClient.RemoteHost = "pc2"
  580. SockClient.RemotePort = 1004
  581. SockClient.LocalPort = 1004
  582. HoldIndex = -1
  583. currentdirectory = CurDir("")
  584. PictureClip1.Cols = 12
  585. For i = 0 To 5
  586.  Image1(i).Picture = PictureClip1.GraphicCell(i)
  587.  Next i
  588. If fromServer Then currentdirectory = currentdirectory & "\VChess"
  589. 'frmChat.Show
  590. 'frmChat.Left = 500
  591. HChessBoard1.PickUpSoundFile = currentdirectory & "\Sounds\PickUp.wav"
  592. HChessBoard1.PutDownSoundFile = currentdirectory & "\Sounds\WoodThunk.wav"
  593. HChessBoard1.StartGameSoundFile = currentdirectory & "\Sounds\Opening.wav"
  594. HChessBoard1.ChessSoundFile = "c:\windows\Media\canyon.mid" 'currentdirectory & "\Sounds\Rockem.mid"
  595. HChessBoard1.MoveNotAllowedSoundFile = currentdirectory & "\Sounds\Orchestra.wav"
  596. Set HChessBoard1.PiecePicture = LoadPicture(currentdirectory & "\Images\PieceBR.bmp")
  597. Set HChessBoard1.BoardPicture = LoadPicture(currentdirectory & "\Images\BlueMarbBoard.bmp")
  598. 'HChessBoard1.PickUpSoundFile = "e:\Program Basic\HChessGameProj\Sounds\PickUp.wav"
  599. 'HChessBoard1.PutDownSoundFile = "e:\Program Basic\HChessGameProj\Sounds\WoodThunk.wav"
  600. 'HChessBoard1.StartGameSoundFile = "e:\Program Basic\HChessGameProj\Sounds\Opening.wav"
  601. 'HChessBoard1.ChessSoundFile = "e:\Program Basic\HChessGameProj\Sounds\Orchestra.wav"
  602. 'HChessBoard1.MoveNotAllowedSoundFile = "e:\Program Basic\HChessGameProj\Sounds\Orchestra.wav"
  603. 'Set HChessBoard1.PiecePicture = LoadPicture("e:\Program Basic\HChessGameProj\Images\PieceBR.bmp")
  604. 'Set HChessBoard1.BoardPicture = LoadPicture("e:\Program Basic\HChessGameProj\Images\BlueMarbBoard.bmp")
  605. DoEvents
  606. End Sub
  607. Private Sub CheckArg(strdata)
  608. fromServer = True
  609. Me.Visible = True
  610. Dim pos, pos2, nick, myname, hisname, caseT, hisIP
  611. pos = InStr(10, Trim(strdata), "|", vbBinaryCompare)
  612. myname = Mid(Trim(strdata), 10, pos - 10)
  613. pos2 = InStr(pos + 1, Trim(strdata), "|", vbBinaryCompare)
  614. hisname = Mid(Trim(strdata), pos + 1, pos2 - pos1)
  615. VisitorName = hisname
  616. VisitorName = myname
  617. HChessBoard1.PlayOffline = False
  618. PlayOffline = False
  619. caseT = Mid(strdata, 1, 9)
  620. If caseT = "|HostUsr|" Then
  621.   HChessBoard1.Host = True
  622.   JoueurHote = True
  623.   frmChess.SockClient.Close
  624.   frmChess.SockClient.Protocol = sckTCPProtocol
  625.   frmChess.SockClient.LocalPort = 1004
  626.   frmChess.SockClient.Listen
  627.   'frmInfoG.Label1.Caption = "Wait For Other Player"
  628.   waitforplayer = True
  629.   frmtryConnect.GetinitWaitting
  630.   DoEvents
  631.   frmtryConnect.Show 1
  632. ElseIf caseT = "|HostTsr|" Then
  633.   hisIP = Mid(Trim(strdata), pos2 + 1, Len(strdata))
  634.   HChessBoard1.Host = False
  635.   JoueurHote = False
  636.   HostName = hisIP
  637.   SockClient.RemotePort = 1004
  638.   SockClient.RemoteHost = HostName
  639.   'frmInfoG.Label1.Caption = "Try to Connect"
  640.   NameNIP.Connect
  641.   DoEvents
  642.   frmtryConnect.GetinitWaitting
  643.   DoEvents
  644.   frmtryConnect.Show 1
  645. End If
  646. 'MsgBox ArgStr
  647. End Sub
  648. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  649. Picture1.Visible = Not Picture1.Visible
  650. End Sub
  651. Private Sub HChessBoard1_PieceMoved()
  652. 'On Error Resume Next
  653.  If Not HChessBoard1.CanIPlay Then
  654.  If Connected Then
  655.   'MsgBox "j'ai bouger :" & HChessBoard1.MoveString & "    :   " & HChessBoard1.CanIPlay
  656.   Dim strtemp, code, p1, p2, p3, p4
  657.   p1 = Val(InStr(1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  658.   p2 = Val(InStr(p1 + 1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  659.   p3 = Val(InStr(p2 + 1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  660.   p4 = Val(InStr(p3 + 1, HChessBoard1.MoveString, "-", vbBinaryCompare))
  661.   Dim val1, val2, val3, val4
  662.   val1 = Val(Mid(HChessBoard1.MoveString, 15, p1 - 15)): val2 = Val(Mid(HChessBoard1.MoveString, p1 + 1, p2 - 15)): val3 = Val(Mid(HChessBoard1.MoveString, p2 + 1, p3 - 15)): val4 = Val(Mid(HChessBoard1.MoveString, p3 + 1, Len(HChessBoard1.MoveString) - 2 - (p2))) 'lit la position du move
  663.   strtemp = Str(val1) & Chr(val2 + 65) & " To " & Str(val3) & Chr(val4 + 65)
  664.   SockClient.SendData HChessBoard1.MoveString
  665.   DoEvents
  666.   'frmInfoG.List1.List(frmInfoG.List1.ListCount - 1) = "I: " & nbcoupmoi & " - " & NickName & " -T- : " & hrs & ":" & mins & ":" & secs & " -M- : " & strtemp
  667.   nbcoup = nbcoup + 1
  668.   hrs = "": mins = "": secs = ""
  669.   hr = 0: min = 0: sec = 0
  670.   'frmInfoG.List1.AddItem "I: " & (nbcoup - nbcoupmoi) & " - " & nomoposant & " -T- : " & hrs & ":" & mins & ":" & secs & " -M- : " & strtemp
  671.   'frmInfoG.List1.ListIndex = frmInfoG.List1.ListCount - 1
  672.   'frmInfoG.Label1.Caption = "Wait Your Turn"
  673.   waitforplayer = True
  674.   End If
  675.  Else
  676.   waitforplayer = False
  677.  End If
  678. End Sub
  679. Private Sub OpenFile()
  680.     Dim sFile As String
  681.     With dlgCommonDialog
  682.         'To Do
  683.         'set the flags and attributes of the
  684.         'common dialog control
  685.         .Filter = "All Files (*.*)|*.*"
  686.         .ShowOpen
  687.         If Len(.filename) = 0 Then
  688.             Exit Sub
  689.         End If
  690.         sFile = .filename
  691.     End With
  692.     'To Do
  693.     'process the opened file
  694. End Sub
  695. Private Sub Image1_Click(Index As Integer)
  696. Select Case Index
  697. Case 0: NewGame
  698. Case 1: HChessBoard1.Sound = Not HChessBoard1.Sound 'son
  699. Case 2: HChessBoard1.Music = Not HChessBoard1.Music 'music
  700. Case 3: MsgBox "This Option is not part of the Demo" 'frmInfoG.Visible = Not frmInfoG.Visible 'info
  701. Case 4: frmChat.Visible = Not frmChat.Visible 'chat
  702. Case 5: frmAbout.Show 1
  703. End Select
  704. End Sub
  705. Private Sub NewGame()
  706. Dim rep
  707. If PartiEnCour Then
  708.  rep = MsgBox("You Have a Game Currently on going do you still want to continue ?", vbYesNoCancel, "New Game")
  709.  If rep = vbYes Then
  710.      frmnewgame.Show 1
  711.  End If
  712. frmnewgame.Show 1
  713. End If
  714. End Sub
  715. Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  716. If Index <> HoldIndex Then
  717. OPTSelected = True
  718.  If HoldIndex = -1 Then HoldIndex = 0
  719.  Image1(HoldIndex).Picture = PictureClip1.GraphicCell(HoldIndex)
  720.  Image1(Index).Picture = PictureClip1.GraphicCell(Index + 6)
  721. End If
  722. HoldIndex = Index
  723. End Sub
  724. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  725. If OPTSelected Then Image1(HoldIndex).Picture = PictureClip1.GraphicCell(HoldIndex): OPTSelected = False: HoldIndex = -1
  726. End Sub
  727.