?? sihuapinban.frm
字號:
Back(UBound(Back)) = i - 1
End If
End If
End If
If i Mod Scope < Scope - 1 Then
If pin(i + 1) > -1 Then
If LeftNum(pin(i + 1)) <> RightNum(i) Then
ReDim Preserve Back(UBound(Back) + 1)
Back(UBound(Back)) = i + 1
End If
End If
End If
If UBound(Back) = 0 Then
For j = 0 To Scope * Scope - 1
If pin(j) = i Then Back(0) = j: Exit For
Next
If j < Scope * Scope Then
Image5(i).Left = 20 * Sx + Scope * 49 * Sx
If locked(i) Then
Picture1.PaintPicture Image5(i), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(i) = Picture1.Image
locked(i) = False
End If
remain = remain + 1
card(remain) = i
pin(Back(0)) = -1
Else
Image5(i).Move (i Mod Scope) * 49 * Sx + 10 * Sx, (i \ Scope) * 49 * Sy + 30 * Sy
pin(i) = i
For j = 0 To remain
If card(j) = i Then
card(j) = card(remain)
Exit For
End If
Next
remain = remain - 1
Picture1.PaintPicture Image5(i), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 114 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(i) = Picture1.Image
locked(i) = True
End If
Else
j = Int(Rnd * UBound(Back)) + 1
j = Back(j)
Image5(pin(j)).Left = 20 * Sx + Scope * 49 * Sx
If locked(pin(j)) Then
Picture1.PaintPicture Image5(pin(j)), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(pin(j)) = Picture1.Image
locked(pin(j)) = False
End If
remain = remain + 1
card(remain) = pin(j)
pin(j) = -1
End If
End If
Exit Sub
End If
Loop
End Sub
'返回拼板屏幕
Private Sub Image4_Click()
Image4.Visible = False
Game.Enabled = True
Options.Enabled = True
Help.Enabled = True
Width = Scope * 52 * Sx + 32 * Sx + Scope * 49 * Sx
Height = Scope * 49 * Sy + 39 * Sy + sizableForm * Sy
End Sub
'開始移動拼板
Private Sub Image5_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dx As Long
Dim dy As Long
Dim cc As RECT
Dim dd As RECT
'如果移動已開始則退出
If moveit = True Then Exit Sub
'移動開始
moveit = True
cx = X
cy = Y - 3 * Sy
'剪切鼠標 (將鼠標指針限定到窗體Form1內拼板移動區域):
GetWindowRect hwnd, cc
dd.Bottom = cc.Bottom + 1 + cy / Sy - 49
dd.Left = cc.Left + 3 + cx / Sx
dd.Right = cc.Right - 2 + cx / Sx - 49
dd.Top = cc.Top - 2 + cy / Sy + sizableForm
ClipCursor dd
If Image5(Index).Left <= 10 * Sx + (Scope - 1) * 49 * Sx Then
dx = (Image5(Index).Left - 10 * Sx) \ (49 * Sx)
dy = (Image5(Index).Top - 30 * Sy) \ (49 * Sy)
pin(dy * Scope + dx) = -1
remain = remain + 1
card(remain) = Index
End If
End Sub
'移動拼板
Private Sub Image5_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If moveit And locked(Index) = False Then
GetCursorPos z
Image5(Index).Move (z.X - 3) * Sx - cx - Left, (z.Y + 2) * Sy - cy - Top - sizableForm * Sy
Image5(Index).ZOrder 0
End If
End Sub
'放下拼板并作出相應處理
Private Sub Image5_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Long
Dim j As Long
Dim k As Long
Dim dx As Long
Dim dy As Long
Dim putit As Boolean
Dim temp(2400)
'如果移動已結束則退出
If moveit = False Then flag Index: Exit Sub
'釋放鼠標:
ClipCursorBynum 0
'移動結束
moveit = False
If Image5(Index).Left + 24 * Sx > 10 * Sx + Scope * 49 * Sx Then
If Image5(Index).Left < 10 * Sx + Scope * 49 * Sx Then Image5(Index).Left = 20 * Sx + Scope * 49 * Sx
Solve.Enabled = True
Exit Sub
End If
dx = (Image5(Index).Left + 24 * Sx - 10 * Sx) \ (49 * Sx)
dy = (Image5(Index).Top + 24 * Sy - 30 * Sy)
If dy < 0 Then
Image5(Index).Left = 20 * Sx + Scope * 49 * Sx
Solve.Enabled = True
Else
dy = dy \ (49 * Sy)
putit = True
If pin(dy * Scope + dx) > -1 Then
putit = False
Else
If dy > 0 Then
If pin((dy - 1) * Scope + dx) > -1 Then
If DownNum(pin((dy - 1) * Scope + dx)) <> UpNum(Index) Then putit = False
End If
End If
If dy < Scope - 1 Then
If pin((dy + 1) * Scope + dx) > -1 Then
If DownNum(Index) <> UpNum(pin((dy + 1) * Scope + dx)) Then putit = False
End If
End If
If dx > 0 Then
If pin(dy * Scope + dx - 1) > -1 Then
If RightNum(pin(dy * Scope + dx - 1)) <> LeftNum(Index) Then putit = False
End If
End If
If dx < Scope - 1 Then
If pin(dy * Scope + dx + 1) > -1 Then
If RightNum(Index) <> LeftNum(pin(dy * Scope + dx + 1)) Then putit = False
End If
End If
End If
If putit = True Then
Image5(Index).Move dx * 49 * Sx + 10 * Sx, dy * 49 * Sy + 30 * Sy
pin(dy * Scope + dx) = Index
For i = 0 To remain
If card(i) = Index Then
card(i) = card(remain)
Exit For
End If
Next
remain = remain - 1
Else
Image5(Index).Left = 20 * Sx + Scope * 49 * Sx
Solve.Enabled = True
End If
End If
If remain = -1 And Solve.Enabled = True Then
Picture1.Cls
Picture1.Move 10 * Sx, 30 * Sy
Picture1.Width = Scope * 49 * Sx
Picture1.Height = Scope * 49 * Sy
For i = 0 To 2400
temp(i) = i
Next
For i = 0 To 2400
j = Int(Rnd * (48 - i)) + i
k = temp(i)
temp(i) = temp(j)
temp(j) = k
Next
For i = 0 To 2400
DoEvents
Picture1.PaintPicture Image3, (temp(i) Mod 49) * Scope * Sx, (temp(i) \ 49) * Scope * Sy, Scope * Sx, Scope * Sy, (temp(i) Mod 49) * Sx, (temp(i) \ 49) * Sy, Sx, Sy
Next
Help.Enabled = False
End If
End Sub
'鎖住拼板
Private Sub flag(Index As Integer)
Dim i As Long
For i = 0 To Scope * Scope - 1
If pin(i) = Index Then Exit For
Next
If i = Scope * Scope Then Exit Sub
If locked(Index) = False Then
Picture1.PaintPicture Image5(Index), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 114 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(Index) = Picture1.Image
locked(Index) = True
Else
Picture1.PaintPicture Image5(Index), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(Index) = Picture1.Image
locked(Index) = False
End If
End Sub
'選擇花色
Private Sub Maximum_Click(Index As Integer)
Maximum(Max - 5).Checked = False
Maximum(Index).Checked = True
Max = Index + 5
NewGame_Click
End Sub
'新游戲
Private Sub NewGame_Click()
Dim i As Long
Dim j As Long
Dim radius As Long
Help.Enabled = True
Picture1.Cls
Picture1.Move 688 * Sx, 376 * Sy
Picture1.Width = 49 * Sx
Picture1.Height = 49 * Sy
Cls
For i = 0 To 35
Image5(i).Visible = False
Next
Width = Scope * 52 * Sx + 32 * Sx + Scope * 49 * Sx
Height = Scope * 49 * Sy + 39 * Sy + sizableForm * Sy
radius = Int(Rnd * 11 + 5) * Sx
For i = 0 To Width Step 10 * Sx
For j = 0 To Height Step 10 * Sy
Circle (i, j), radius, RGB(180, 140, 100)
Next
Next
For i = 0 To Scope - 1
For j = 0 To Scope - 1
PaintPicture Image2, j * 49 * Sx + 10 * Sx, i * 49 * Sy + 30 * Sy, 49 * Sx, 49 * Sy, 0, 0, 49 * Sx, 49 * Sy
Next
Next
ReDim UpNum(Scope * Scope - 1)
ReDim DownNum(Scope * Scope - 1)
ReDim LeftNum(Scope * Scope - 1)
ReDim RightNum(Scope * Scope - 1)
ReDim card(Scope * Scope - 1)
ReDim pin(Scope * Scope - 1)
ReDim locked(Scope * Scope - 1)
remain = Scope * Scope - 1
For i = 0 To Scope * Scope - 1
pin(i) = -1
If i < Scope Then UpNum(i) = Int(Rnd * (Max + 1)) Else UpNum(i) = DownNum(i - Scope)
DownNum(i) = Int(Rnd * (Max + 1))
If i Mod Scope = 0 Then LeftNum(i) = Int(Rnd * (Max + 1)) Else LeftNum(i) = RightNum(i - 1)
RightNum(i) = Int(Rnd * (Max + 1))
Picture1.PaintPicture Image2, 0, 0, 49 * Sx, 49 * Sy, 49 * Sx, 0, 49 * Sx, 49 * Sy
Picture1.PaintPicture Image1(Design), 20 * Sx, 4 * Sy, 9 * Sx, 9 * Sy, UpNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
Picture1.PaintPicture Image1(Design), 20 * Sx, 34 * Sy, 9 * Sx, 9 * Sy, DownNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
Picture1.PaintPicture Image1(Design), 7 * Sx, 19 * Sy, 9 * Sx, 9 * Sy, LeftNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
Picture1.PaintPicture Image1(Design), 33 * Sx, 19 * Sy, 9 * Sx, 9 * Sy, RightNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
Image5(i) = Picture1.Image
Image5(i).Visible = True
Next
For i = 0 To Scope * Scope - 1
card(i) = i
Next
Solve.Enabled = True
Arrange_Click
End Sub
'選擇圖案
Private Sub Pattern_Click(Index As Integer)
Pattern(Design).Checked = False
Design = Index
Pattern(Design).Checked = True
NewGame_Click
End Sub
'新游戲
Private Sub Picture1_Click()
NewGame_Click
End Sub
'解答
Private Sub Solve_Click()
Dim i As Long
Dim j As Long
For i = 0 To Scope * Scope - 1
If pin(i) <> i Then
Image5(i).Move (i Mod Scope) * 49 * Sx + 10 * Sx, (i \ Scope) * 49 * Sy + 30 * Sy
pin(i) = i
Picture1.PaintPicture Image5(i), 0, 0
Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 114 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
Image5(i) = Picture1.Image
locked(i) = True
End If
Next
remain = -1
Solve.Enabled = False
End Sub
'調整窗體以及控件的尺寸與位置
Private Sub SetControls()
Dim myControl As Control
Dim k As Single
k = Screen.TwipsPerPixelX / 15
On Error Resume Next
For Each myControl In SihuaPinban
With myControl
.Height = .Height * k
.Width = .Width * k
.Move .Left * k, .Top * k
.FontSize = .FontSize * k
End With
Next
Height = Height * k
Width = Width * k
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -