我想做五子棋程序,希望高手提点意见,不会的也可以探讨一下。
解决方案 »
- 急!全局 变量的定义?????如何定义这个值
- 各位大哥来看看这个查询汇总怎么写呀!vb+access
- 请高手们指点一下...
- 求助:一个求助问题!!!
- VBA 为何物
- 本人刚学VB,求教变更焦点问题,请赐教!
- Com打开服务器的Word文档,Asp调用Com,为何Word文档打开时出错了?谢谢!
- 分多得用不了,问一个简单的。如何将平面的数据结构转换为树状的?
- sos:请问:怎样得到汉字的ascii,能否给出通用程序?
- 请问如何得到本机的CPU、内存大小、磁盘空间等信息?
- 如何在msflexgrid控件的click事件中判断单击的Cell是固定行或列中的一个单元?
- 帮帮忙各位大哥,一个关于Ture DBGrid Pro控件的问题
api好像可以画圆的。
光picture=*。ico是不行的。
api不太熟,怎么入手?
先画好棋子...
然后,用
Microsoft Photo Editor(OFFICE自带,如果没有安装,可在OFFICE光盘中找到.)
将其背景设置成透明即可...
只是首次加载窗体的时候需要等上5到6秒钟,第二次的话就不会如此了~~~~~~~~~~~~~~~~~以下是窗体的代码~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim blnServer As Boolean
Dim blnStart As Boolean
Dim blnReady As Boolean
Dim blnWaitReady As Boolean
Dim blnCend As Boolean
Dim lngFirst&
Dim lngWins&(2)Private Sub chkConnect()
Select Case ChatTcp.State
Case 0
Label1.Caption = "Á¬½Ó¹Ø±Õ"
Case 1
Label1.Caption = "Á¬½Ó´ò¿ª"
Case 2
Label1.Caption = "ÕýÔÚÕìÌý"
Case 3
Label1.Caption = "¹ÒÆðÁ¬½Ó"
Case 4
Label1.Caption = "ÕýÔÚ½âÎöÖ÷»ú"
Case 5
Label1.Caption = "ÒѽâÎöÖ÷»ú"
Case 6
Label1.Caption = "ÕýÔÚÁ¬½Ó"
Case 7
Label1.Caption = "ÒÑÁ¬½Ó"
cmdStart.Enabled = True
Case 8
Label1.Caption = "·þÎñÆ÷ÕýÔڹرÕÁ¬½Ó"
If blnServer Then
ChatTcp.Close
ChatTcp.Listen
End If
Case 9
Label1.Caption = "Á¬½Ó´íÎó"
End Select
End Sub内容太长待续!!!!!!!!!!!!!!!!!!!!!!
~~~~~~~~~~~~~~~~~以下是窗体的代码~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub ChatTcp_ConnectionRequest(ByVal requestID As Long)
If ChatTcp.State <> sckClosed Then ChatTcp.Close
ChatTcp.Accept requestID
End SubPrivate Sub ChatTcp_DataArrival(ByVal bytesTotal As Long)
Dim strData$, lngRow&, lngCol&
ChatTcp.GetData strData
If blnReady Then
If strData = "Ready" Then
blnStart = True
End If
Else
If strData = "Ready" Then
MsgBox "¶Ô·½ÒѾ­×¼±¸ºÃÁË,Ç뿪ʼ£¡£¡£¡", vbOKOnly, "ÌáʾÐÅÏ¢"
blnWaitReady = True
End If
End If
If strData = "Start" And Label2.Caption <> "ÓÎÏ·¿ªÊ¼" Then
Label2.Caption = "ÓÎÏ·¿ªÊ¼"
ChatTcp.SendData "Start"
If lngFirst Mod 2 = 1 Then
myFiveChess.Enabled = True
End If
End If
If Left(strData, 3) = "Row" Then
myFiveChess.Enabled = True
lngRow = CLng(Mid(strData, 4, 2))
lngCol = CLng(Mid(strData, 9, 2))
myFiveChess.Play lngRow, lngCol
End If
If Left(strData, 4) = "MSG_" Then
txtContent = txtContent & Right(strData, Len(strData) - 4)
End If
End SubPrivate Sub cmdCut_Click()
If ChatTcp.State <> 0 Then ChatTcp.Close
cmdServerA.Enabled = True
cmdServerC.Enabled = True
txtServer.Enabled = True
blnServer = False
End SubPrivate Sub cmdCut_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdBackColor Me, &HFFFFC0
cmdCut.BackColor = vbWhite
End SubPrivate Sub cmdServerA_Click()
If Trim(txtServer) = "" Then
MsgBox "ÇëÏÈÊäÈëÒªµÇ¼µÄ·þÎñÆ÷Ãû", vbCritical, "´íÎóÌáʾ"
txtServer.SetFocus
Exit Sub
End If
cmdServerC.Enabled = False
cmdServerA.Enabled = False
If ChatTcp.State <> 0 Then ChatTcp.Close
ChatTcp.RemoteHost = Trim(txtServer)
ChatTcp.RemotePort = 1888
ChatTcp.Connect
lngFirst = 2
End SubPrivate Sub cmdServerA_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdBackColor Me, &HFFFFC0
cmdServerA.BackColor = vbWhite
End SubPrivate Sub cmdServerC_Click()
Dim strServerName As String * 255
Dim atIndex&
If ChatTcp.State <> 0 Then ChatTcp.Close
cmdServerA.Enabled = False
cmdServerC.Enabled = False
ChatTcp.LocalPort = 1888
ChatTcp.Listen
blnServer = True
GetComputerName strServerName, 255
atIndex = InStr(1, strServerName, Chr$(0))
txtServer = Left(strServerName, atIndex - 1)
txtServer.Enabled = False
lngFirst = 1
End SubPrivate Sub cmdServerC_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdBackColor Me, &HFFFFC0
cmdServerC.BackColor = vbWhite
End SubPrivate Sub cmdStart_Click()
If ChatTcp.State = 7 Then
blnReady = True
If blnWaitReady Then
blnStart = True
ChatTcp.SendData "Start"
Label2.Caption = "ÓÎÏ·¿ªÊ¼"
If lngFirst Mod 2 = 1 Then
myFiveChess.Enabled = True
End If
Else
Label2.Caption = "µÈ´ý¶Ô·½¿ªÊ¼"
If ChatTcp.State = 7 And blnReady And Not myFiveChess.Enabled Then
ChatTcp.SendData "Ready"
End If
End If
End If
End SubPrivate Sub cmdStart_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdBackColor Me, &HFFFFC0
cmdStart.BackColor = vbWhite
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdBackColor Me, &HFFFFC0
End SubPrivate Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdBackColor Me, &HFFFFC0
End SubPrivate Sub myFiveChess_Win(ByVal lngWin As Long)
If lngFirst Mod 2 = lngWin Mod 2 Then
lngWins(1) = lngWins(1) + 1
Else
lngWins(2) = lngWins(2) + 1
End If
lngFirst = lngFirst + 1
If lngFirst Mod 2 <> 0 Then
myFiveChess.Enabled = True
Else
myFiveChess.Enabled = False
End If
blnCend = False
End SubPrivate Sub myFiveChess_Âä×Ó(ByVal lngStep As Long, ByVal RowStep As Long, ByVal ColStep As Long)
If Not blnCend Then
myFiveChess.Enabled = False
blnCend = False
End If
ChatTcp.SendData "Row" & Format(CStr(RowStep), "00") & "Col" & Format(CStr(ColStep), "00")
End SubPrivate Sub myFiveChess_ÏÂÆå(ByVal lngStep As Long, ByVal RowStep As Long, ByVal ColStep As Long)
Dim lngHand&, lngOtherHand&
If lngFirst Mod 2 <> 0 Then
If lngFirst Mod 2 <> lngStep Mod 2 Then
lngHand = lngStep \ 2 + 1
lngOtherHand = lngHand - 1
Else
lngHand = lngStep \ 2 + 1
lngOtherHand = lngHand - 1
End If
Else
If lngFirst Mod 2 <> lngStep Mod 2 Then '½ÓÊÕ
lngHand = lngStep \ 2 + 1
lngOtherHand = lngHand
Else 'Âä×Ó'right
lngHand = lngStep \ 2
lngOtherHand = lngHand
End If
End If
lblChessInfo(0).Caption = "±¾»úµÚ" & lngHand & "ÊÖ"
lblChessInfo(1).Caption = "¶Ô·½µÚ" & lngOtherHand & "ÊÖ"
lblChessInfo(2).Caption = "±¾»úÓ®" & lngWins(1) & "ÅÌ"
lblChessInfo(3).Caption = "¶Ô·½Ó®" & lngWins(2) & "ÅÌ"
End SubPrivate Sub Timer1_Timer()
chkConnect
End SubPrivate Sub txtName_GotFocus()
txtBackColor Me, &HC0FFC0
txtName.BackColor = vbWhite
End SubPrivate Sub txtName_LostFocus()
txtBackColor Me, &HC0FFC0
End SubPrivate Sub txtSend_GotFocus()
txtBackColor Me, &HC0FFC0
txtSend.BackColor = vbWhite
End SubPrivate Sub txtSend_KeyDown(KeyCode As Integer, Shift As Integer)
Dim lngCtrlDown&
lngCtrlDown = (Shift And vbCtrlMask) > 0
If lngCtrlDown And KeyCode = vbKeyReturn Then
msgSend
End If
End SubPrivate Sub msgSend()
Dim strContent$
If ChatTcp.State = 7 Then
strContent = strContent & "[" & txtName & "]:" & txtSend & vbCrLf
txtContent = txtContent & strContent
txtContent.SelStart = Len(txtContent)
txtSend = ""
txtSend.SelStart = 0
ChatTcp.SendData "MSG_" & strContent
Else
MsgBox "ÇëÏȽ¨Á¢Á¬½Ó", vbCritical, "´íÎóÌáʾ"
End If
End SubPrivate Sub txtSend_LostFocus()
txtBackColor Me, &HC0FFC0
End SubPrivate Sub txtServer_GotFocus()
txtBackColor Me, &HC0FFC0
txtServer.BackColor = vbWhite
End SubPrivate Sub txtServer_LostFocus()
txtBackColor Me, &HC0FFC0
End Sub内容太长待续!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!**************接起来是一个完整的程序代码了!!!!!!!!!!!!!***********Public Sub cmdBackColor(ByRef frmTmp As Form, Optional lngColor& = &HE0E0E0)
Dim ctlTmp As Control
For Each ctlTmp In frmTmp.Controls
If TypeOf ctlTmp Is CommandButton Then
If ctlTmp.BackColor <> lngColor Then ctlTmp.BackColor = lngColor
End If
Next
End SubPublic Sub txtBackColor(ByRef frmTmp As Form, Optional lngColor& = &HC0C0C0)
Dim ctlTmp As Control
For Each ctlTmp In frmTmp.Controls
If TypeOf ctlTmp Is TextBox Then
ctlTmp.BackColor = lngColor
End If
Next
End SubPublic Function txtFormat$(ByVal strTxt$)
txtFormat = Trim(Replace(strTxt, "'", "''"))
End Function
pic.PaintPicture 模图,.... vbSrcAnd
pic.PaintPicture 源图,.... vbSrcPaint
先要图片,无论源或模都是矩形,这个是windows系统规则
源图 棋子图片,要求棋子之外的空间全部涂成黑色
模图 棋子图片的掩模,要求和棋子图片大小一致,相应棋子之外的空间全部涂成白色,棋子空间涂成白色解释:
因为白色rgb为全1,黑色rpg为全0
x and 0=0 ,x and 1=1,x or 1=1 ,x or 0=x
这样将模图以And运算绘制到棋盘的结果是棋盘上出现一个棋子大小的黑孔,其它地方仍保持原样
再将源图以or运算绘制到棋盘的结果是棋盘上实现了绘制一个棋子,其它地方仍保持原样不知你能不能看明白,不行你看图形方面的书好了
源图 棋子图片,要求棋子之外的空间全部涂成黑色
模图 棋子图片的掩模,要求和源图大小一致,相应棋子之外的空间全部涂成白色,棋子空间涂成黑色
解释:
因为白色rgb为全1,黑色rpg为全0
x and 0=0 ,x and 1=x,x or 1=1 ,x or 0=x
上面打错了,另外再详细一点
x and 1=x,x or 1=1 表示这两种运算可以保持背景不变
x and 0=0 ,x or 1=1 表示这两种运算可以是背景变白色或黑色