?? sihuapinban.frm
字號(hào):
VERSION 5.00
Begin VB.Form SihuaPinban
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "四花拼板"
ClientHeight = 4440
ClientLeft = 4170
ClientTop = 2940
ClientWidth = 4410
Icon = "SIHUAP~1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4440
ScaleWidth = 4410
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00A2C3C3&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 735
Left = 10320
ScaleHeight = 735
ScaleWidth = 735
TabIndex = 0
Top = 5640
Width = 735
End
Begin VB.Image Image4
Height = 4410
Left = 0
Picture = "SIHUAP~1.frx":030A
Stretch = -1 'True
Top = 0
Visible = 0 'False
Width = 4410
End
Begin VB.Image Image1
Height = 135
Index = 1
Left = 10320
Picture = "SIHUAP~1.frx":22BF
Top = 240
Width = 1350
End
Begin VB.Image Image5
Height = 735
Index = 0
Left = 11160
Top = 1080
Width = 735
End
Begin VB.Image Image3
Height = 735
Left = 10320
Picture = "SIHUAP~1.frx":248E
Top = 1320
Width = 735
End
Begin VB.Image Image2
Height = 735
Left = 10320
Picture = "SIHUAP~1.frx":262A
Top = 480
Width = 2205
End
Begin VB.Image Image1
Height = 135
Index = 0
Left = 10320
Picture = "SIHUAP~1.frx":2958
Top = 0
Width = 1350
End
Begin VB.Menu Game
Caption = "游戲(&G)"
Begin VB.Menu NewGame
Caption = "新游戲(&N)"
Shortcut = ^N
End
Begin VB.Menu Separation1
Caption = "-"
End
Begin VB.Menu Arrange
Caption = "排列(&A)"
Shortcut = ^A
End
Begin VB.Menu Hint
Caption = "提示(&H)"
Shortcut = ^H
End
Begin VB.Menu Solve
Caption = "解答(&S)"
Shortcut = ^S
End
Begin VB.Menu Separation2
Caption = "-"
End
Begin VB.Menu Exit
Caption = "退出(&E)"
Shortcut = ^E
End
End
Begin VB.Menu Options
Caption = "選項(xiàng)(&O)"
Begin VB.Menu Size
Caption = "拼盤大小(&S)"
Begin VB.Menu Extent
Caption = "&2×2"
Index = 0
End
Begin VB.Menu Extent
Caption = "&3×3"
Index = 1
End
Begin VB.Menu Extent
Caption = "&4×4"
Checked = -1 'True
Index = 2
End
Begin VB.Menu Extent
Caption = "&5×5"
Index = 3
End
Begin VB.Menu Extent
Caption = "&6×6"
Index = 4
End
End
Begin VB.Menu Digits
Caption = "拼板花色(&D)"
Begin VB.Menu Maximum
Caption = "&6"
Index = 0
End
Begin VB.Menu Maximum
Caption = "&7"
Index = 1
End
Begin VB.Menu Maximum
Caption = "&8"
Checked = -1 'True
Index = 2
End
Begin VB.Menu Maximum
Caption = "&9"
Index = 3
End
Begin VB.Menu Maximum
Caption = "&10"
Index = 4
End
End
Begin VB.Menu Separation3
Caption = "-"
End
Begin VB.Menu Pattern
Caption = "水晶珠寶(&B)"
Checked = -1 'True
Index = 0
End
Begin VB.Menu Pattern
Caption = "數(shù)字圖案(&N)"
Index = 1
End
End
Begin VB.Menu Help
Caption = "幫助(&H)"
End
End
Attribute VB_Name = "SihuaPinban"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sizableForm As Long '窗口標(biāo)題欄和菜單欄高度
Dim Scope As Long '拼盤大小
Dim Max As Long '拼板花色多少
Dim Design As Long '拼板圖案類型
Dim card() As Long '拼板排列序號(hào)
Dim pin() As Long '拼盤拼板記錄
Dim remain As Long '等待拼板數(shù)
Dim UpNum() As Long '拼板上部數(shù)字
Dim DownNum() As Long '拼板下部數(shù)字
Dim LeftNum() As Long '拼板左部數(shù)字
Dim RightNum() As Long '拼板右部數(shù)字
Dim locked() As Boolean '拼板是否鎖住
'獲取鼠標(biāo)位置函數(shù)(以窗體ScaleMode屬性值為單位)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'聲明類型
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim z As POINTAPI
Dim cx As Integer
Dim cy As Integer
Dim moveit As Boolean
Dim Sx As Long
Dim Sy As Long
'所謂剪切鼠標(biāo)就是將鼠標(biāo)指針限定到指定區(qū)域,在該區(qū)域內(nèi),鼠標(biāo)能進(jìn)行如單擊、雙擊的動(dòng)作。方法如下:
'聲明API函數(shù)及類型:
Private Declare Function ClipCursorBynum& Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'排列整齊拼板
Private Sub Arrange_Click()
Dim i As Long
Dim j As Long
Dim k As Long
Do
For i = 0 To remain
j = Int(Rnd * (remain - i)) + i
k = card(i)
card(i) = card(j)
card(j) = k
Next
'初始化或拼盤無拼板排列時(shí)不出現(xiàn)解題序列
If remain < Scope * Scope - 1 Then Exit Do
For i = 0 To Scope - 1
For j = 0 To Scope - 2
If RightNum(card(i * Scope + j)) <> LeftNum(card(i * Scope + j + 1)) Then Exit Do
Next
Next
For i = 0 To Scope - 2
For j = 0 To Scope - 1
If DownNum(card(i * Scope + j)) <> UpNum(card(i * Scope + j + Scope)) Then Exit Do
Next
Next
Loop
For i = 0 To remain
Image5(card(i)).Move (i Mod Scope) * 52 * Sx + 20 * Sx + Scope * 49 * Sx, (i \ Scope) * 52 * Sy + 33 * Sy - Scope * 3 * Sy
Next
End Sub
'退出
Private Sub Exit_Click()
End
End Sub
'選擇拼板大小
Private Sub Extent_Click(Index As Integer)
Extent(Scope - 2).Checked = False
Extent(Index).Checked = True
Scope = Index + 2
NewGame_Click
End Sub
'啟動(dòng)初始化
Private Sub Form_Load()
Dim i As Long
Show
SetControls
Randomize
Sx = Screen.TwipsPerPixelY
Sy = Screen.TwipsPerPixelY
'獲取窗口標(biāo)題欄和菜單欄高度
sizableForm = Height / Sy - Image4.Height / Sy
'讓窗口寬度和image4寬度同步大小
Width = Image4.Width + 6 * Sx
Image4.Width = Width - 6 * Sx
For i = 1 To 35
Load Image5(i)
Next
Scope = 4
Max = 7
NewGame_Click
End Sub
'顯示幫助屏幕
Private Sub Help_Click()
Image4.Visible = True
Image4.ZOrder 0
Width = Image4.Width + 6 * Sx
Height = Image4.Height + sizableForm * Sy
Game.Enabled = False
Options.Enabled = False
Help.Enabled = False
End Sub
'提示
Private Sub Hint_Click()
Dim i As Long
Dim j As Long
Dim Back() As Long
If remain = -1 Then Solve.Enabled = False: Exit Sub
Do
i = Int(Rnd * Scope * Scope)
If pin(i) <> i Then
If pin(i) > -1 Then
Image5(pin(i)).Left = 20 * Sx + Scope * 49 * Sx
If locked(pin(i)) Then
Picture1.PaintPicture Image5(pin(i)), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(pin(i)) = Picture1.Image
locked(pin(i)) = False
End If
remain = remain + 1
card(remain) = pin(i)
pin(i) = -1
Else
ReDim Back(0)
If i > Scope - 1 Then
If pin(i - Scope) > -1 Then
If DownNum(pin(i - Scope)) <> UpNum(i) Then
ReDim Preserve Back(UBound(Back) + 1)
Back(UBound(Back)) = i - Scope
End If
End If
End If
If i < Scope * Scope - Scope Then
If pin(i + Scope) > -1 Then
If UpNum(pin(i + Scope)) <> DownNum(i) Then
ReDim Preserve Back(UBound(Back) + 1)
Back(UBound(Back)) = i + Scope
End If
End If
End If
If i Mod Scope > 0 Then
If pin(i - 1) > -1 Then
If RightNum(pin(i - 1)) <> LeftNum(i) Then
ReDim Preserve Back(UBound(Back) + 1)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -