'版面更新設計：為充分利用有限的版面，將按鈕與combo等改以【功能表】之型態設計
'【工具/功能表編輯器】
'功能表按鈕控制管理：以mnuControl程序專案管理
'功能表按鈕選項陣列應用：下拉式選項按鈕，具有相同類型選項，以控制項陣列管理，如範例中的 mnuPlay,puzzleSize
'以Tag記錄圖片額外資訊，可用於ToolTip顯示依據。
'以陣列儲存亂數排列後的圖片編號順序。
'空白母片：作為後續『圖片移動』時的暫存區，它『被排在那個位置』極為重要，必須有效的掌握，它是後續的移動圖片方向判斷的依據。
'範例中，以母片在順序陣列中的位置可以得知其座標值，例：3*3的拼圖，Position=4，表示它位於第2列，第1行。詳情參考程式碼。
'使用Timer計時秒數。
Dim RowNUM, ColNUM As Integer
Dim totPic As Integer
Dim t As Integer
Dim seqArray() As Integer
Dim Position As Integer '空白母片位置
'---------------------------------------------------------------------------------------------------------
Private Sub Form_Load()
Me.ScaleMode = 1
RowNUM = 4 '預設值
ColNUM = 4
Call initPuzzle '初始化
oPicture.Visible = False
LastPic.Visible = False '未開檔
Label1.Visible = False
Label2.Visible = False
lblTime.Visible = False
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub Reset()
For i = 1 To RowNUM * ColNUM
Unload MovingPic(i) '載出
DoEvents
Next
Call initPuzzle
mnuControl (0)
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub initPuzzle()
oPicture.Visible = True '顯示原圖
LastPic.Visible = False '隱藏拼圖
Timer1.Enabled = False
t = 0
lblTime = t
mnuControl (0)
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub mnuControl(ByVal s As Integer)
Select Case s
Case 0 '開啟檔案
mnuOpen.Enabled = True '可開檔
mnuPuzzle.Enabled = True '可設拼圖大小
mnuGame.Enabled = False '還沒開始
Case 1 '開始遊戲
mnuGame.Enabled = True '可開始遊戲
mnuOpen.Enabled = True '可開檔
mnuPuzzle.Enabled = False '不可設拼圖大小
mnuPlay(0).Enabled = True '開始
mnuPlay(1).Enabled = False '暫停
mnuPlay(2).Enabled = False '重來
Case 2 '暫停
mnuGame.Enabled = True
mnuOpen.Enabled = False '不可開檔
mnuPuzzle.Enabled = False '不可設拼圖大小
mnuPlay(0).Enabled = False '不可重新開始
mnuPlay(1).Enabled = True '暫停/繼續
mnuPlay(2).Enabled = True '可重來
Case 3 '重來
mnuGame.Enabled = True '可開始
mnuOpen.Enabled = True '可開檔
mnuPuzzle.Enabled = True '可設拼圖大小
mnuPlay(0).Enabled = True '可重新開始
mnuPlay(1).Enabled = False '還沒開始
mnuPlay(2).Enabled = False '還沒開始
End Select
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub Play()
Dim ww, hh As Single
Dim putWidth, putHeight, cutWidth, cutHeight As Single
'-----------------------------------------------------------------------
'動態宣告陣列，seqArray
ReDim seqArray(RowNUM * ColNUM) As Integer '依拼圖大小宣告,用於儲存圖片順序
Timer1.Enabled = True
mnuControl (2) '按鈕控制
oPicture.Visible = False '隱藏原圖
LastPic.Visible = True '顯示分割圖
ww = oPicture.Width '原圖大小
hh = oPicture.Height
cutWidth = ww / ColNUM '原圖分割後之寬度
cutHeight = hh / RowNUM '原圖分割後之高度
putWidth = LastPic.Width / ColNUM '每一併圖的寬度
putHeight = LastPic.Height / RowNUM '每一併圖的高度
MovingPic(0).Width = putWidth '重設定空白圖片大小
MovingPic(0).Height = putHeight
MovingPic(0).Visible = False '隱藏空白母片
ImageList1.ListImages.Clear '清除
'----------------------------------------------------------------------
'分割原圖，共RowNUM*ColNUM 小塊
'----------------------------------------------------------------------
For i = 1 To RowNUM
For j = 1 To ColNUM
k = (i - 1) * ColNUM + j
Load MovingPic(k)
MovingPic(k).Width = putWidth '設定動態分割圖之分割大小
MovingPic(k).Height = putHeight
MovingPic(k).Visible = True '屬性設定
MovingPic(k).AutoRedraw = True
MovingPic(k).AutoSize = True
'--------------------------------------------------------------
px = (j - 1) * cutWidth '原圖分割之起點座標
py = (i - 1) * cutHeight
'--------------------------------------------------------------
'將分割後之圖片繪製於動態分割圖裡，並逐一顯示於相對座標
MovingPic(k).PaintPicture oPicture.Picture, 0, 0, putWidth, putHeight, px, py, cutWidth, cutHeight
MovingPic(k).Move (j - 1) * putWidth, (i - 1) * putHeight
'--------------------------------------------------------------
'記錄額外資訊於Tag
'記錄排序順序於陣列
MovingPic(k).Tag = k
seqArray(k) = k
'--------------------------------------------------------------
'將分割後之圖片存入imageList
ImageList1.ListImages.Add k, , MovingPic(k).Image
Next
Next
'--------------------------------------------------------------
'攪亂順序，顯示重排結果
Call HASH
Call ShowseqArray
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub HASH() '攪亂順序
Position = RowNUM * ColNUM '空白母片目前位置(最後一張)
totPic = RowNUM * ColNUM '圖片總張數
Position = totPic '母片之目前位置(最後一張)
Randomize '亂數種子
For i = 1 To RowNUM * ColNUM
flag = False '預設值
Do
num = Fix(Rnd * totPic + 1) '1~totPic，不重複
flag = check(num, i) '檢查至目前為止是否重複
Loop Until Not flag '直到沒有重複
seqArray(i) = num
Next
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub ShowseqArray()
putWidth = MovingPic(totPic).Width
putHeight = MovingPic(totPic).Height
For i = 1 To RowNUM
For j = 1 To ColNUM
k = seqArray((i - 1) * ColNUM + j) '取出陣列數值
MovingPic(k).Move (j - 1) * putWidth, (i - 1) * putHeight
MovingPic(k).Visible = True
'-------------------------------------------------------------------------------
'決定母片的位置
If k = totPic Then
Position = (i - 1) * ColNUM + j '找到母片在第幾張
lblPosition = "空白母片位置：" & Position
End If
Next
Next
'將最大號碼的一張變裝成空白母片
'變裝後，成為拼圖之移動圖片暫存區
MovingPic(totPic).BackColor = QBColor(4) '改變色彩
MovingPic(totPic).Picture = MovingPic(0).Picture '圖片替換
If Position Mod ColNUM = 0 Then '是否被整除
lblRC = "空白母片座標：第 " & Position \ ColNUM & "列，第" & ColNUM - Position Mod ColNUM & "行"
Else
lblRC = "空白母片座標：第 " & Position \ ColNUM + 1 & "列，第" & Position Mod ColNUM & "行"
End If
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub mnuOpen_Click() '功能表-開啟圖檔
mnuControl (0) '還沒開檔
oPicture.Visible = False
fileDialog.Filter = "開啟圖檔 ( *.bmp;*.jpg;*.gif) | *.bmp; *.jpg; *.gif;"
fileDialog.ShowOpen
oPicture.Picture = LoadPicture(fileDialog.FileName)
oPicture.Visible = True '顯示原圖
LastPic.Visible = False '
Label1.Visible = True
Label2.Visible = True
lblTime.Visible = True
mnuControl (3)
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub mnuEnd_Click()
End
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub mnuPlay_Click(Index As Integer)
Select Case Index
Case 0
Call Play '開始遊戲
mnuControl (2)
Case 1 '暫停
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled Then
mnuPlay(1).Caption = "暫停"
Else
mnuPlay(1).Caption = "繼續"
End If
mnuControl (2)
Case 2 'Reset
Call Reset
mnuControl (3)
End Select
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub MovingPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
MovingPic(Index).ToolTipText = MovingPic(Index).Tag 'Tag值當作ToolTip顯示之文字
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub puzzleSize_Click(Index As Integer) '拼圖大小
Select Case Index
Case 0
ColNUM = 3
RowNUM = 3
Case 1
ColNUM = 3
RowNUM = 4
Case 2
ColNUM = 4
RowNUM = 3
Case 3
ColNUM = 4
RowNUM = 4
Case 4
ColNUM = 5
RowNUM = 5
End Select
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub Timer1_Timer()
t = t + 1
lblTime = t
End Sub
'---------------------------------------------------------------------------------------------------------
Private Sub mnuAbout_Click()
msg = msg & "說明：" & vbNewLine
msg = msg & "原圖大小：請自製大小 320 x 270 圖片若干" & vbNewLine
msg = msg & "圖檔格式：BMP,JPG,GIF" & vbNewLine
msg = msg & "操作說明：" & vbNewLine
msg = msg & "拼圖區置空白圖片一張，其相鄤圖片可移向這張空白圖片" & vbNewLine
msg = msg & "使拼圖後之結果與原圖相關位置相同，即算拼圖成功。"
MsgBox msg, vbOKOnly, "操作說明"
End Sub
'---------------------------------------------------------------------------------------------------------
Private Function check(ByVal new_num As Integer, ByVal idnum As Integer) As Boolean '函數判斷亂數是否重複
reg = False '預設未重複
For i = 1 To idnum '從第1個到目前的第幾個
If new_num = seqArray(i) Then
reg = True '已重複
Exit For
End If
Next
check = IIf(reg, True, False)
End Function
