Tìm hiểu Hệ chuyên gia

 

 

 

I. CHƯƠNG I. HỆ CHUYÊN GIA

1. Hệ chuyên gia la gì ? .1

2. ý nghĩa của một hệ chuyên gia .1

1.1 ưu điểm của vệc xây dựng một hệ chuyên gia ứng dụng .1

1.2 Nhược điểm 1

3. Cấu trúc của hệ chuyên gia .2

3.1 Cơ sở tri thức .2

3.2 Mô tơ suy diễn 2

II. CHƯƠNG II. PHÂN TÍCH

1. Yêu cầu .3

2. Phân tích .3

III. CHƯƠNG III. THIẾT KẾ VÀ XÂY DỰNG CHƯƠNG TRÌNH

1. Thiết kế .5

2. Các thủ tục cho chương trình .5

3. Mã nguồn của chương trình .7

 

 

 

 

doc22 trang | Chia sẻ: huong.duong | Ngày: 12/09/2015 | Lượt xem: 840 | Lượt tải: 2download
Bạn đang xem trước 20 trang tài liệu Tìm hiểu Hệ chuyên gia, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
nh vi nhất quán. Chi phí thấp. Những đặc điểm trên không dễ có được ở một chuyên gia con người, bởi vì ở con người, làm việc không chỉ theo lý chí mà đôi khi còn theo tình cảm, tâm sinh lý, điều kiện ngoại cảnh vv b) Nhược điểm Bất cứ một hệ thống nào bên cạnh những ưu điểm thì vẫn còn những nhược điểm. Một hệ chuyên gia còn có những nhược điểm không thể hoặc chưa có khả năng khắc phục được : Việc suy diễn, diễn giải cứng nhắc khuôn sáo, không linh động. Không có những “kinh nghiệm” tự đúc kết trong công việc như chuyên gia con người. Ngôn ngữ giao tiếp chỉ dừng ở mức độ “tựa tự nhiên” sẽ gây ra sự cản trở đối với những người sử dụng không chuyên. Phạm vi bài toán hẹp. Tri thức cập nhật không đầy đủ hoặc thiếu chính xác sẽ gây ra hiện tượng không thể đưa ra kết quả hoặc cho kết quả sai. Chuyên gia Kỹ sư tri thức Thu nạp Tri thức Giao diện Giải thích CS luật CSSK USER Mô tơ suy diễn Cơ chế suy diễn CSSK cấu trúc hệ chuyên gia. Cơ sở tri thức Cơ sở sự kiện Cơ sở luật Người sử dụng Tài liệu chuyên môn (Tri thức sâu) Chuyên gia (Tri thức nông) a) Cơ sở tri thức : Cơ sở tri thức Cơ chế suy diễn Cơ chế lùi Cơ chế tiến Chọn hướng suy diễn Chiến lược ĐK Giải quyết xung đột b) Mô tơ suy diễn: Chương II: Phân tích Yêu cầu. Khi một mẫu hình rơi cần kiểm tra nó đã chạm đáy hộp hay chạm một mẫu hình có sẵn phía dưới hay chưa, nếu chạm thì mẫu hình dừng lại. Trong khi mẫu hình đang rơi, có thể dùng các phím di chuyển sang trái hay phải để di chuyển mẫu hình, kiểm tra xem có thể di chuyển hay không, nếu được thì di chuyển đi một đơn vị. Một mẫu hình di chuyển được khi và chỉ khi chưa chạm các mép trái, phải, trên, dưới của hộp chứa nó. Dùng phím mũi tên đi lên để xoay mẫu hình, kiểm tra nếu mẫu hình xoay được thì sẽ xoay 90 độ. Dùng mũi tên đi xuống để mẫu hình rơi nhanh xuống đáy hộp. Mỗi khi mẫu hình rơi xuống thì kiểm tra xem dòng nào phía dưới bị kín sẽ biến mất. Mỗi lần một dòng biến mất, người chơi sẽ được thêm 10 điểm. Khi người chơi tăng thêm được 200 điểm thì vận tốc rơi của mẫu hình sẽ tăng lên. ( 100 điểm 1 cửa ) Trên cửa sổ chương trình cho phép hiện hoặc ẩn mẫu hình kế tiếp. Ngoài ra còn cho hiện điểm số và số cửa đang chơi. Trò chơi kết thúc khi hộp bị đầy các mẫu hình. Phân tích: Vẽ các mẫu hình: Trong chương trình có 8 mẫu hình với hình dạng khác nhau. Quan sát các mẫu hình ta có thể hình dung ra cách quản lý những mẫu hình này bằng một mảng 2 chiều 4x4 (=16 ô). Khai báo mảng quản lý từng mẫu hình trên: Dim MItem (4, 4) As Byte - Tùy theo hình dạng của mẫu hình mà ô nào trong 16 ô đó được tô, ta quản lý mẫu hình theo chuỗi, qui ước ô được tô = 1, ô không được tô = 0. Ví dụ: Xét mẫu hình "Mẫu 1" trong bảng mẫu hình : ta có thể quản lý nó bằng một chuỗi "100011000100000" (Đọc theo thứ tự từ trái sang phải, từ trên xuống dưới). Khai báo mảng lưu 8 mẫu hình trên: Dim PicShapes (8) As String - Khi chương trình cần sử dụng mẫu hình nào thì phần tử PicShapes tương ứng sẽ được lấy để phân tích và gán vào mảng MItem. Mảng MItem (J, I) sẽ ứng với ký tự thứ (J - 1) * 4 + I. Ta xây dựng thủ tục CreateItem để giải quyết việc này. - Thể hiện mẫu hình trên hộp và rơi trong phạm vi hộp thì hộp này phải là một ma trận, giả sử hộp này có chiều ngang 10 ô và chiều dọc là 20 ô ( Ma trận 20x10). Mỗi ô trong hộp sẽ là một đối tượng Image để quản lý mẫu hình theo từng màu riêng biệt. Khi một ô được vẽ nghĩa là thuộc tính Picture của Image được gán là mẫu hình, ngược lại thuộc tính Picture là Nothing. Thủ tục CreateCell sẽ thực hiện việc chia ô lưới cho hộp, mỗi ô có kích thước 18x18. - Để vẽ một mẫu hình lên vị trí nào đó trên ô lưới, ta phải đặt giá trị truy xuất là ô thứ mấy. Ví dụ : lấy ô vị trí (2,7) (dòng 2, cột 7) thì thứ tự của ô trong ô lưới là 27. Công thức tổng quát: vị trí ô (Dòng, Cột) truy xuất ô thứ (Dòng * số cột trên 1 hàng + Cột). Xây dựng thủ tục DrawItem để vẽ. - Khi mẫu hình chuyển động thì vị trí của nó liên tục thay đổi và sẽ xóa đi vị trí cũ, tạo thủ tục ClearItem để xóa. - Khi lập một mẫu hình mới, hình sẽ được đặt vào mảng, mẫu hình được lấy ngẫu nhiên và ứng với một mẫu hình sẽ cho một màu riêng biệt. Thủ tục NewItem làm điều này. - Khi một mẫu hình được đặt trên bề mặt hộp thì sẽ xuất hiện mẫu hình sẽ ra kế tiếp nó, ta cần phân tích chuỗi đã lấy ngẫu nhiên tương ứng và đặt giá trị của nó vào mảng thể hiện mẫu hình kế. Thủ tục CreateNext làm việc này. - Khi thực hiện xoay mẫu hình với một góc 90 độ, nghĩa là đổi các phần tử trong mảng với nhau, ta dùng công thức: Jx = 4 + I * Cos (Pi / 2) - J * Sin (Pi / 2) Ix = 4 + I * Sin (Pi / 2) - J * Cos (Pi / 2) Xây dựng thủ tục RotateItem để xoay. - Xét mẫu hình sau khi xoay, các phần tử ở hàng trên cùng là 0 thì mẫu hình sẽ dời lên cho đến khi hàng trên cùng không trống. Điều này tạo cảm giác khi xoay, mẫu hình không bị dời tọa độ xuống dưới. Thủ tục MoveUp để dời. - Xét trong quá trình rơi và di chuyển của mẫu hình, nó có bị chạm vào các cạnh hộp hay ô nào đã bị kín trong hộp hay không, ô bị kín được xác định bằng thuộc tính Tag = 1, ngược lại thuộc tính Tag = 0. Xét mẫu hình đang di chuyển có chạm trái hay chưa, nghĩa là phần tử ở cột thứ X xét với ô lưới thứ X-1 cùng hàng. Nếu phần tử ở cột X trong mẫu hình = 1, ô X - 1 có thuộc tính Tag = 1 thì chạm. Hàm MoveLeft kiểm tra việc này, nếu chạm trả về True. Xét mẫu hình đang di chuyển có chạm phải hay chưa, nghĩa là phần tử ở cột thứ X xét với ô lưới thứ X+1 cùng hàng. Nếu phần tử ở cột X trong mẫu hình = 1, ô X + 1 có thuộc tính Tag = 1 thì chạm. Hàm MoveRight kiểm tra việc này, nếu chạm trả về True. Xét mẫu hình đang di chuyển có chạm dưới hay chưa, nghĩa là phần tử ở hàng cuối của mẫu hình ở hàng thứ Y xét với hàng thứ Y+1 của ô lưới. Nếu phần tử ở hàng thứ Y trong mẫu hình = 1, hàng Y+1 của ô lưới có thuộc tính Tag = 1 thì chạm. Hàm Touch kiểm tra việc này, nếu chạm trả về True. Xét mẫu hình có thể xoay hay không khi hàng cuối cùng của mẫu hình được tô có chạm hay không. Hàm Rotate kiểm tra việc này, nếu có thể xoay trả về True. - Thủ tục StopDown đặt mẫu hình nằm yên trong hộp khi đã chạm. - Nếu không tác động đến các phím di chuyển trên bàn phím thì mẫu hình sẽ rơi thẳng xuống phía dưới đáy hộp cho đến khi bị chạm dưới. Thủ tục DropItem làm việc này. Xét một hàng đã kín hay chưa, ta xét các ô cùng hàng có thuộc tính Tag = 1 thì hàng kín. Hàm RowFull làm việc này. Nếu hàng đã kín, mẫu hình trong hàng sẽ biến mất bằng cách gán các ô trong hàng kín bằng các ô trên nó. Thủ tục ClearRow giải quyết việc này. - Khi một mẫu hình rơi xuống có thể có nhiều hàng kín nên phải xét tất cả các hàng, thủ tục Check kiểm tra điều này. Hộp đầy khi mẫu hình vừa xuất hiện đã chạm dưới, lúc này trò chơi kết thúc. Thủ tục StopGame thực hiện việc kết thúc trò chơi. Giải thích: - Mảng imgNext dùng để hiển thị mẫu hình sẽ hiện ra kế tiếp trong hộp, số đối tượng tương ứng với số phần tử của mẫu hình, do đó phải đặt chỉ số của đối tượng imgNext chính xác từ trái sang phải, từ trên xuống dưới. - Đặt thuộc tính Index của imgCell là 0 để trong chương trình khi viết mã lệnh có thể tạo mảng cho nó. - Mảng imgColor dùng để tạo màu sắc cho mẫu hình, mỗi mẫu hình sẽ mang một màu sắc riêng biệt. Các phần tử trong mảng này có thuộc tính Picture gọi đến các hình với màu sắc khác nhau. Các hình này tự tạo ở ngoài môi trường VB có kích thước là 18x18 pixel. - Khi trò chơi bắt đầu thì đối tượng Timer tmrTime mới hoạt động, lúc này có thể màn hình đã xuất hiện nhưng trò chơi chưa bắt đầu nên thuộc tính Enabled gán bằng False. Khi chọn Start Game trên thanh trình đơn thì trò chơi bắt đầu và thuộc tính này bằng True. Chương III: Thiết kế và xây dựng chương trình 1. Thiết kế: Thiết kế Form giao diện tương tự như hình. 2. Các thủ tục cho chương trình: Trong phần General của cửa sổ lệnh khai báo các biến toàn cục sử dụng trên Form. Option Explicit Option Base 1 (chỉ số của mảng qui định từ 1) Const Rows = 20 Const Cols = 10 Const M = 4 Dim MItem(M, M) As Byte Dim PicShapes(8) As String Dim Px, Py As Integer Dim Color As Integer Dim NextShape As Integer Dim NextColor As Integer Dim Score As Long Dim Level As Integer Dim Start As Boolean Định nghĩa các thủ tục : Thủ tục CreateItem(I As Integer): Thủ tục này phân tích chuỗi PicShapes, sau đó gán giá trị vào mảng chứa mẫu hình MItem, tham số I cho biết số thứ tự của hình đem ra phân tích. Private Sub CreateItem(Index As Integer) Dim I, J As Integer For J = 1 To M For I = 1 To M MItem(J, I) = Val(Mid(PicShapes(Index), (J - 1) * M + I, 1)) Next I Next J End Sub Thủ tục CreateCell(): Chia hộp thành các ô lưới tương ứng với số hàng và cột, mỗi ô có kích thước là 18x18. Thủ tục DrawItem(ByVal X, Y As Integer): Vẽ mẫu hình lên vị trí cột X, hàng Y trên hộp. Thủ tục ClearItem(ByVal X, Y As Integer): Xóa mẫu hình đang hiện hành tại tọa độ cột X, hàng Y trong hộp sau khi hình dịch chuyển. Thủ tục NewItem(): Lấy hình dạng cho mẫu hình và đặt màu tương ứng. Thủ tục CreateNext(): Phân tích chuỗi tương ứng của mẫu hình kế và gán giá trị vào mảng chứa mẫu hình kế tiếp. Thủ tục RotateItem(): Xoay mẫu hình . Thủ tục MoveUp(): Dồn hàng có phần tử được tô lên trên cùng của mảng, nó thi hành khi hàng trên cùng trong mảng không có phần tử nào bị tô. Hàm MoveLeft(): Kiểm tra khả năng di chuyển sang trái có thể được hay không, nếu được trả về True. Hàm MoveRight(): Kiểm tra khả năng di chuyển sang phải có thể được hay không, nếu được trả về True. Hàm Touch(): Kiểm tra mẫu hình đã chạm dưới hay chưa. Hàm Rotate(): Kiểm tra mẫu hình có xoay được hay không. Thủ tục StopDown(): Đặt mẫu hình nằm yên trong hộp khi đã bị chạm dưới. Thủ tục DropItem(): Thực hiện công việc cho mẫu hình rơi thẳng xuống phía dưới đáy hộp. Thủ tục RowFull(Num As Integer): Kiểm tra một hàng đã kín hay chưa, tức là các phần tử trong hàng có Tag = 1 hay không. Thủ tục ClearRow(Num As Integer): làm cho hàng bị đầy biến mất và đẩy hàng trên nó xuống dưới một hàng. Thủ tục Check(): Kiểm tra tất cả các hàng khi có một mẫu hình vừa mới chạm, nếu có hàng nào kín sẽ biến mất. Thủ tục StopGame(): Gọi thủ tục này để kết thúc trò chơi, có thể ngắt trò chơi khi mẫu hình chưa đầy hộp bằng cách gọi thủ tục này ở vị trí muốn ngắt dừng trò chơi. Thủ tục mnuStart_Click(): Thủ tục này được thi hành để bắt đầu trò chơi. Thủ tục mnuRestart_Click(): Thi hành việc bắt đầu lại trò chơi khi trò chơi đang chưa có dấu hiệu kết thúc. Thủ tục mnuStop_Click(): Kết thúc trò chơi. Private Sub mnuStop_Click() StopGame End Sub Thủ tục mnuShowNext(): Cho phép hiện hoặc ẩn mẫu hình kế tiếp. Private Sub mnuShowNext_Click() Dim I As Integer For I = 0 To 15 imgeNext(I).Visible = Not imgNext(I).Visible Next I mnuShowNext.Checked = imgNext(0).Visible End Sub Thủ tục mnuExit_Click(): Kết thúc chương trình. Private Sub mnuExit_Click() StopGame End End Sub Thủ tục tmrTime_Timer(): Thủ tục thực hiện khi có sự kiện về thời gian xảy ra. Thủ tục Form_Load(): Định nghĩa các dạng mẫu hình và khởi tạo mẫu hình khi xuất hiện là ngẫu nhiên. Private Sub Form_Load() PicShapes(1) = "1000100011000000" PicShapes(2) = "0100010011000000" PicShapes(3) = "1000110001000000" PicShapes(4) = "0100110010000000" PicShapes(5) = "1100110000000000" PicShapes(6) = "1111000000000000" PicShapes(7) = "1100100000000000" PicShapes(8) = "1110010000000000" Randomize CreateCell End Sub Thủ tục picBox_Keydown(): Thực hiện khi một phím di chuyển trên bàn phím được nhấn. 3. Mã nguồn của chương trình : Option Explicit Option Base 1 Const Rows = 20 Const Cols = 10 Const M = 4 Dim MItem(M, M) As Byte Dim PicShapes(8) As String Dim Px, Py As Integer Dim Color As Integer Dim NextShape As Integer Dim NextColor As Integer Dim Score As Long Dim Level As Integer Dim Start As Boolean Private Sub CreateCells() Dim i, J As Integer Dim Indx As Integer ScaleMode = ((ScaleMode + 1) Mod 7) + 1 picBox.ScaleMode = 3 picBox.Width = 20 * Cols picBox.Height = 20 * Rows With picBox shpBox.Move .Left - 2, .Top - 2, .ScaleWidth + 4, .ScaleHeight + 4 End With imgCell(0).Tag = 0 imgCell(0).Move 0, 0, 20, 20 For J = 0 To Rows - 1 For i = 0 To Cols - 1 Indx = J * Cols + i If Indx 0 Then Load imgCell(Indx) imgCell(Indx).Move i * 20, J * 20 imgCell(Indx).Visible = True imgCell(Indx).Tag = 0 End If Next i Next J End Sub Private Sub CreateItem(Ind As Integer) Dim i, J As Integer For J = 1 To M For i = 1 To M MItem(J, i) = Val(Mid(PicShapes(Ind), (J - 1) * M + i, 1)) Next i Next J End Sub Private Sub MoveUp() Dim i, J As Integer For J = 1 To M - 1 For i = 1 To M MItem(J, i) = MItem(J + 1, i) Next i Next J For i = 1 To M MItem(M, i) = 0 Next End Sub Private Sub RotateItem() Const Pi = 3.141592653 Dim i, J As Integer Dim X, Y As Integer Dim Temp(M, M) For J = 1 To M For i = 1 To M Temp(J, i) = MItem(J, i) Next i Next J For J = 1 To M For i = 1 To M X = 4 + Fix(i * Cos(Pi / 2) - J * Sin(Pi / 2)) Y = 1 + Fix(i * Sin(Pi / 2) - J * Cos(Pi / 2)) MItem(J, i) = Temp(Y, X) Next i Next J Do While MItem(1, 1) = 0 And MItem(1, 2) = 0 And MItem(1, 3) = 0 MoveUp Loop End Sub Private Function CellAt(ByVal X As Integer, ByVal Y As Integer, ByVal J As Integer, ByVal i As Integer) As Integer CellAt = (Y + J - 1) * Cols + X + i - 1 End Function Private Sub DrawItem(ByVal X As Integer, ByVal Y As Integer) Dim i, J As Integer Dim Indx As Integer For J = 1 To M For i = 1 To M Indx = CellAt(X, Y, J, i) If (Indx < Rows * Cols) Then If imgCell(Indx).Tag 1 Then If MItem(J, i) = 1 Then imgCell(Indx).Picture = imgColor(Color).Picture Else imgCell(Indx).Picture = Nothing End If End If End If Next i Next J End Sub Private Sub ClearItem(ByVal X, Y As Integer) Dim i, J As Integer Dim Indx As Integer For J = 1 To M For i = 1 To M Indx = CellAt(X, Y, J, i) If (Indx < Rows * Cols) Then If imgCell(Indx).Tag 1 And (MItem(J, i) = 1) Then imgCell(Indx).Picture = Nothing End If End If Next i Next J End Sub Private Sub CreateNext() Dim i As Byte For i = 1 To 16 If Mid(PicShapes(NextShape), i, 1) = "1" Then imgNext(i - 1).Picture = imgColor(NextColor).Picture Else imgNext(i - 1).Picture = Nothing End If Next i End Sub Private Sub NewItem() Dim i As Integer CreateItem NextShape Color = NextColor Do NextShape = Int(Rnd * 100) Mod 8 + 1 Select Case NextShape Case "1" NextColor = 0 Case "2" NextColor = 1 Case "3" NextColor = 2 Case "4" NextColor = 3 Case "5" NextColor = 4 Case "6" NextColor = 5 Case "7" NextColor = 6 Case "8" NextColor = 7 End Select Loop Until (NextShape > 0) And (NextShape <= 8) CreateNext Px = 5 Py = 0 End Sub Private Function Touch() As Boolean Dim i, J As Integer Dim Indx As Integer Dim Found As Boolean J = 4 Found = False Do i = 1 Do If (Py + J + 1 <= Rows) Then Indx = CellAt(Px, Py + 1, J, i) Found = CBool((MItem(J, i) = 1) And (imgCell(Indx).Tag = 1)) Else Found = CBool(MItem(J, i) = 1) End If i = i + 1 Loop Until Found Or (i > M) Or (Px + i >= Cols) J = J - 1 Loop Until Found Or (J < 1) Touch = Found End Function Private Function MoveLeft() As Boolean Dim i, J As Integer Dim Indx As Integer Dim Found As Boolean If Px = 0 Then Found = True Else i = 1 Do J = 3 Do If Py + J <= Rows Then Indx = CellAt(Px - 1, Py, J, i) Found = CBool((MItem(J, i) = 1) And (imgCell(Indx).Tag = 1)) End If J = J - 1 Loop Until Found Or J < 1 i = i + 1 Loop Until Found Or (i > M) MoveLeft = Not Found End If End Function Private Function MoveRight() As Boolean Dim i, J As Integer Dim Indx As Integer Dim Found As Boolean i = M Do J = M Do If Px + i < Cols Then If Py + J <= Rows Then Indx = CellAt(Px + 1, Py, J, i) Found = CBool((MItem(J, i) = 1) And (imgCell(Indx).Tag = 1)) End If Else Found = CBool(MItem(J, i) = 1) End If J = J - 1 Loop Until Found Or (J < 1) i = i - 1 Loop Until Found Or (i < 1) MoveRight = Not Found End Function Private Function Rotate() Dim J As Integer J = M Do While (MItem(J, 1) = 0) And (MItem(J, 2) = 0) And (MItem(J, 3) = 0) And (MItem(J, 4) = 0) J = J - 1 Loop If Px + J <= Cols Then Rotate = CBool((imgCell(CellAt(Px, Py, 1, J)).Tag = 0) And (imgCell(CellAt(Px, Py, 2, J)).Tag = 0) And (imgCell(CellAt(Px, Py, 3, J)).Tag = 0) And (imgCell(CellAt(Px, Py, 4, J)).Tag = 0)) Else Rotate = False End If End Function Private Sub StopDown() Dim J, i As Integer Dim Indx As Integer For J = 1 To M For i = 1 To M Indx = CellAt(Px, Py, J, i) If Indx < Rows * Cols Then If MItem(J, i) = 1 Then imgCell(Indx).Tag = 1 End If End If Next i Next J Check End Sub Private Sub DropItem() Do While Not Touch ClearItem Px, Py Py = Py + 1 DrawItem Px, Py Loop StopDown NewItem DrawItem Px, Py End Sub Private Function RowFull(Num As Integer) Dim i As Integer Dim Indx As Integer Dim RFull As Boolean RFull = True For i = 0 To Cols - 1 Indx = Num * Cols + i RFull = RFull And CBool(imgCell(Indx).Tag = 1) Next i RowFull = RFull End Function Private Sub ClearRow(Num As Integer) Dim i, J, sl, slp As Integer Dim Indx1, Indx2 As Integer For i = 0 To Cols - 1 Indx1 = Num + Cols + i imgCell(Indx1).Picture = Nothing Next i For J = Num To 1 Step -1 For i = 0 To Cols - 1 Indx1 = J * Cols + i Indx2 = (J - 1) * Cols + i imgCell(Indx1).Picture = imgCell(Indx2).Picture imgCell(Indx1).Tag = imgCell(Indx2).Tag imgCell(Indx2).Picture = Nothing imgCell(Indx2).Tag = 0 Next i Next J Score = Score + 10 lblScor.Caption = CStr(Score) If (Score Mod 200 = 0) Then Level = Level + 1 tmrTime.Interval = 50 + (10 - Level) * 50 lblLevel = CStr(Level) End If End Sub Private Sub Check() Dim i As Integer i = Rows - 1 Do If RowFull(i) Then ClearRow i Else i = i - 1 End If Loop Until i < 1 End Sub Private Sub StopGame() Dim i As Integer tmrTime.Enabled = False For i = 0 To Rows * Cols - 1 imgCell(i).Picture = imgEnd.Picture Next i For i = 0 To 15 imgNext(i).Picture = Nothing Next i lblStop.Visible = True Start = False mnuStart.Enabled = True mnuStop.Enabled = False End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu mnuhung, 0 End If End Sub Private Sub mnuabout_Click() frmabout.Show End Sub Private Sub mnuabout0_Click() frmabout.Show End Sub Private Sub mnucaculate_Click() Shell "c:\windows\CALC.EXE", vbNormalFocus End Sub Private Sub mnucleanmgr_Click() Shell "c:\windows\CLEANMGR.EXE", vbNormalFocus End Sub Private Sub mnuclock_Click() MsgBox "Chương trình chưa hoàn thiện bạn phải chờ thời gian nữa !", vbInformation, "Thông Báo" End Sub Private Sub mnuDefrag_Click() Shell "c:\windows\DEFRAG.EXE", vbNormalFocus End Sub Private Sub mnudemo_Click() MsgBox "Chương trình chưa hoàn thiện bạn phải chờ thời gian nữa !", vbInformation, "Thông Báo" End Sub Private Sub mnudosprompt_Click() Shell "c:\windows\DOSPRMPT.exe", vbNormalFocus End Sub Private Sub mnuduchung_Click() frmabout.Show End Sub Private Sub mnuEXPLORER_Click() Shell "c:\windows\explorer.exe", vbNormalFocus End Sub Private Sub mnuhung0_Click() frmabout.Show End Sub Private Sub mnuimaging_Click() Shell "c:\windows\KODAKIMG.EXE", vbNormalFocus End Sub Private Sub mnumediaplayer_Click() Shell "c:\windows\MPLAYER.EXE", vbNormalFocus End Sub Private Sub mnumsconfig_Click() Shell "c:\windows\system\msconfig.exe", vbNormalFocus End Sub Private Sub mnumucdo_Click() MsgBox "Chương trình chưa hoàn thiện bạn phải chờ thời gian nữa !", vbInformation, "Thông Báo" End Sub Private Sub mnuNOTEPAD_Click() Shell "c:\windows\notepad.exe", vbNormalFocus End Sub Private Sub mnupassword_Click() Frmpassword.Show End Sub Private Sub mnuprogram_Click() MsgBox "Chương trình chưa hoàn thiện bạn phải chờ thời gian nữa !", vbInformation, "Thông Báo" End Sub Private Sub mnureadme_Click() Shell "explorer.exe c:\windows\readme.htm", vbNormalFocus End Sub Private Sub mnureg_Click() Shell "c:\windows\regedit.exe", vbNormalFocus End Sub Private Sub mnuRestart_Click() Dim i As Integer lblStop.Visible = False Start = True mnuStart.Enabled = False mnuStop.Enabled = True tmrTime.Interval = 50 + 10 * 80 tmrTime.Enabled = True For i = 0 To (Rows * Cols) - 1 imgCell(i).Picture = Nothing imgCell(i).Tag = 0 Next i NextShape = 1 NextColor = 0 NewItem Score = 0 Level = 1 lblScor.Caption = "0" lblLevel.Caption = "1" End Sub Private Sub mnuscandisk_Click() Shell "c:\windows\SCANDSKW.EXE", vbNormalFocus End Sub Private Sub mnuscanregw_Click() Shell "c:\windows\SCANREGW.EXE", vbNormalFocus End Sub Private Sub mnusckey_Click() frmTip.Show End Sub Private Sub mnutaskman_Click() Shell "c:\windows\TASKMAN.EXE", vbNormalFocus End Sub Private Sub picBox_KeyDown(KeyCode As Integer, Shift As Integer) If Not Start Then Exit Sub End If Select Case KeyCode Case vbKeyLeft, vbKeyNumpad4 If MoveLeft Then ClearItem Px, Py Px = Px - 1 DrawItem Px, Py End If Case vbKeyRight, vbKeyNumpad6 If MoveRight Then ClearItem Px, Py Px = Px + 1 DrawItem Px, Py End If Case vbKeyUp, vbKeyNumpad8 If Rotate Then ClearItem Px, Py RotateItem DrawItem Px, Py End If Case vbKeyDown, vbKeyNumpad5, vbKeySpace DropItem Case vbKeyEscape tmrTime.Enabled = Not tmrTime.Enabled End Select End Sub Private Sub Form_Load() Dim getpass As String getpass = GetSetting("zentrix", "symantech", "login") PicShapes(1) = "1000100011000000" PicShapes(2) = "0100010011000000" PicShapes(3) = "1000110001000000" PicShapes(4) = "0100110010000000" PicShapes(5) = "1100110000000000" PicShapes(6) = "1000100010001000" PicShapes(7) = "1100100000000000" PicShapes(8) = "1110010000000000" Randomize CreateCells If getpass = "*H+U+N+G+F*" Then frmZentrix.Show Else frmLogin.Show frmZentrix.Hide End If frmZentrix.Caption = "Trò chơi xếp hình - Nguyễn Đức Hùng" End Sub Private Sub mnuExit_Click() StopGame End End Sub Private Sub mnuNext_Click() Dim i As Integer For i = 0 To 15 imgNext(i).Visible = Not imgNext(i).Visible Next i mnunext.Checked = imgNext(0).Visible End Sub Private Sub mnuStart_Click() Dim i As Integer lblStop.Visible = False Start = True mnuStart.Enabled = False mnuStop.Enabled = True tmrTime.Interval = 50 + 7 * 80 tmrTime.Enabled = True For i = 0 To (Rows * Cols) - 1 imgCell(i).Picture = Nothing imgCell(i).Tag = 0 Next i NextShape = 1 NextColor = 0 NewItem Score = 0 Level = 1 lblScor.Caption = "0" lblLevel.Caption = "1" End Sub Private Sub mnuStop_Click() StopGame End Sub Private Sub Timer1_Timer() Lbltime1.Caption = Time End Sub Private Sub tmrTime_Timer() If Touch Then StopDown NewItem Px = 5 Py = 0 If Touch Then StopGame Else DrawItem Px, Py End If Else ClearItem Px, Py Py = Py + 1 DrawItem Px, Py End If End Sub Formlogin Option Explicit Public LoginSucceeded As Boolean Private Sub cmdCancel_Click() 'set the global var to false 'to denote a failed login LoginSucceeded = False Unload Me End Sub Private Sub cmdOK_Click() Dim pw$, temp$, login$ pw = GetSetting("zentrix", "symantech", "password") temp = GetSetting("zentrix", "symantech", "name") login = GetSetting("zentrix", "symantech", "login") If txtPassword.Text = pw And txtUserName.Text = temp And login = "1" Then Unload Me frmZentrix.Show Else End End If End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtUserName.Appearance = 0 txtPassword.Appearance = 0 cmdOK.Appearance = 0 cmdCancel.Appearance = 0 End Sub Private Sub txtUserName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtUserName.Appearance = 1 End Sub Private Sub txtPassword_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtPassword.Appearance = 1 End Sub Private Sub cmdok_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) cmdOK.Appearance = 1 End Sub Private Sub cmdcancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) cmdCancel.Appearance = 1 End Sub Frmpassword Option Explicit Private Sub Check1_Click() SaveSetting "zentrix", "symantech", "login", "*H+U+N+G+F*" Me.Hide End Sub Private Sub cmdOK_Click() SaveSetting "zentrix", "symantech", "name", "nguyen duc hung" SaveSetting "zentrix", "symantech", "password", Txtname.Text SaveSetting "zentrix", "symantech", "login", "1" Txtname.Text = "" Me.Hide End Sub Private Sub Form_Load() Frmpassword.Caption

Các file đính kèm theo tài liệu này:

  • docP0116.doc
Tài liệu liên quan