Đề tài Báo cáo quản lý điểm sinh viên

Visual Basic là một ngôn ngữ lập trình được hãng Microsoft phát triển .Visual Basic gắn liền với khái niệm lập trình trực quan, nghĩa là khi thiết kế chương trình bạn nhìn ngay thấy ngay kết quả qua từng thao tác và giao diện khi chương trình thực hiện. Đây là thuận lợi lớn so với ngôn ngữ lập trình khác, Visual Basic cho phép bạn chỉnh sửa đơn giản, nhanh chóng màu sắc, kích thước, hình dáng của các đối tượng có mặt trong ứng dụng. Về mặt công nghệ lập trình cũng như tổ chức môi trường làm việc, phiên bản 5.0 và 6.0 có nhiều ưu điểm hơn. Mặt khác, phiên bản 5.0 32 bit và 6.0 được phép xây dựng các ứng dụng 32 bit với môi trường làm việc là Microsoft Windows 95 -> 2000. Cụ thể: - Version 5.0: Phiên bản 32 bit, phiên bản tương thích hoàn toàn trên môi trường Windows. Hệ thống thư viện sử dụng các DLL ( Dynamic Link Library ) và các thư viện OLE theo công nghệ OCX. Phiên bản 32 tỏ ra thực sự có ưu điểm trong môi trường Windows 95 & 97 nếu cấu hình máy tính của người sử dụng được các nhu cầu sử dụng cao. - Version 6.0: Là phiên bản mới hiện nay chạy trên môi trường Windows 9.X. Hệ thống sử dụng thư viện DLL và các thư viện OLE theo công nghệ OCX, nhu cầu đòi hỏi cấu hình của máy tính phải đủ mạnh ( máy tính từ 586 trở lên ). 3.3.2. Tổ chức của Mirosoft Visual Basic - Project: Là sản phẩm lập trình trong môi trường Microsoft được tổ chức thành một Project bao gồm: - MDI form: Một Project có thể có một màn hình làm theo chế độ Multi Document Interfaccce. Form: Các màn hình làm việc của Project. Form: Các màn hình làm việc của Project. - Module: Được sử dụng để khai báo các Sub, Function, Type, Constant tổng quát trong Proect. Class Module: khai báo đối tượng trong Project. Controls: Các đối tượng được sử dụng trong form Prọect là các thư viện kiểu VBX hoặc OCX. Mỗi đối tượng được đặc trưng Properties và các Events. Các đối tượng của Microsoft Visual Basic có thể phân chia thành các nhóm sau: Các control chuẩn của hệ điều hành Windows. - Các đối tượng do Microsoft cung cấp (Data control, Rich Text Control...). Các đối tượng do hãng phần mền thứ ba hỗ trợ. 3.2.3. Lập trình trên Mirosoft Visual Basic có thể khái quát như sau. Xây dựng Project trên cơ sở phân tích hệ thống bài toán. Thiết kế các đối tượng. - Điều khiển tính chất các đối tượng và viết mã lệnh xử lí trên các sự kiện và các đối tượng. 3.2.4. Lập trình trên Mirosoft Visual Basic Mirosoft Visual Basic hỗ trợ sử dụng Query trong chương trình của mình. Do vậy việc xử lí dữ liệu có nhiều thuận lợi, đặc biệt CSDL của Access. Trong khi viết chương trình có một số vấn đề quan trọng cần chú ý đó là lỗi và xử lí lỗi. Công cụ gỡ rối: Khi chạy thử chương trình có thể sử dụng công cụ gỡ rối khá mạnh của Mirosoft Visual Basic ( Debug ). Công cụ này cho phép hiệu chỉnh phần câu lệnh ngay trong khi thực hiện chương tình đối với các lôĩ không quan trọng. Để thiết kế cơ sở dữ liệu có thể sử dụng một trong các công cụ sau: ư. Sử dụng phiên bản Micosofft Access tương ứng với phiên bản của Mirosoft Visual Basis. ư. Sử dụng chương trình DataManager được cung cấp kèm theo Visual Basic - Thiết kế báo cáo: Để thiết kế mẫu biểu báo cáo có thể sử dụng một trong các công cụ sau: - Sử dụng phiên bản DataEnviroment tương ứng trong Microsoft Visual Basic Sử dụng DataReport được cung cấp kèm theo. 3.2.5. Visual Basic và Microsoft Access. Visual Basic là ngôn ngữ lập trình hướng sự kiện có thể giải quyết được mọi bài toán. Visual Basic cũng giải quyết đựơc các bài toán quản lí mà các ngôn ngữ khác không có. Để phát huy hết khả năng Visual Basic hay Acces chúng ta phải hiểu thật rõ cơ chế xử lí dữ liệu ( Jet Engine ), Jet Engine cho phép làm việc với nhiều dang thức dữ liệu khác nhau và cung cấp giao diện lập trình hướng đối tượng để làm viêc với CSDL. JetEngin là thành phần cốt lõi của hệ quản trị CSDL Access do đó có thể trở thành một nhà lập trình chuyên nghiệp với Visual Basis thì điều đầu tiên là Jet Engine. Tuy nhiên mỗi ngôn ngữ lập trình có một hệ thống mạnh riêng của nó, ở lĩnh vực này nó không đáp ứng được, không thích hợp được nhưng ở lĩnh vực khác thì lại làm được. Ví dụ như Access có công cụ thiết kế báo biểu mạnh hơn nhiều so với Visual Basis, trong Visual Basic có bộ thiết kế báo biểu không do Microsoft phát triển mà lại do hãng Seagate, và được đưa vào như một OLE Custom Control độc lập. Vì vậy tuỳ theo yêu cầu của một bài toán cụ thể mà người lập trình chọn một ngôn ngữ thích hợp để giải quyết chúng. Visual Basic 6.0 cho phép người lập trình nhúng các đối tượng hay sử dụng các hàm thư viện DLL một các dễ dàng. Visual Basis 2.0 đã nhanh hơn, mạnh hơn và còn sử dụng hơn Visual Basic 1.0. Visual Basic 3.0 tăng thêm những cách thức đơn giản để điều khiển các cơ sở dữ liệu mạnh nhất sẵn có. Visual Basic 4.0 hỗ trợ sự phát triển 32 - bit và bắt đầu tiến trình chuyển Visual Basic thành một ngôn ngữ lập trình hướng đối tượng đầy đủ. Phiên bản 5.0 và 6.0 có nhiều tính năng mạnh hơn, đặc biệt là tốc độ gia tăng đáng kể (khoảng 20% nhanh hơn so với Visual Basic 4.0) và những đặc tính liên quan đến Web. Có 3 khía cạnh khẳng định Visual Basic 6.0 thực sự là một ngôn ngữ lập trình đa năng: Thời gian nhập biểu (Form) và điều khiển (control) nhanh hơn hẳn Visual Basic 4.0 tốc độ truy cập dữ liệu nhanh, công nghệ tối ưu của Mirosoft Visual C++ được dùng trong Visual Basic 5.0 và 6.0, phiên bản Visual Basic 6.0 có thêm một số tính năng ngôn ngữ mong muốn, tăng cường cho Internet và các tính năng cơ sở dữ liệu mạnh hơn. Ngoài ra Visual Basic 5.0 và 6.0 còn có công cụ trợ giúp thông minh, công cụ gỡ rối cao, các công cụ tạo lập ActiveX, cho phép truy cập nhiều nguồn dữ liệu khác nhau. Visual Basic chuyển ứng dụng sang môi trường Web được thực hiện dễ dàng và nhanh chóng hơn. 3.2.6. Mối liên hệ giữa Access và Visual Basic. Microsoft hiện đang làm chủ các hệ Quản trị CSDL: Foxpro, Access, SQL Server. Access do Microsoft phát triển từ đầu và trở thành một trong những sản phẩm thành công nhất. Visual Basic dùng kết nối database engine của Access để xử lí dữ liệu, Visual Basic không phải là một hệ quản trị dữ liệu mà là một ngôn ngữ vạn năng. Với Visual Basic ta có thể phát triển nhiều ứng dụng khác nhau. Nó bao gồm cả trình biên dịch, cho phép nhà phát triển sinh ra các tập tin .EXE chạy độc lập ( dĩ nhiễn cần có thêm các thư viện DLL, VBX, OCX ) còn Access hoàn toàn là một hệ quản trị CSDL. Access không có trình biên dịch như Visual Basic. Tuy nhiên Microsoft cung cấp thêm bộ Access Run time để chạy các ứng dụng mà không cần cài đặt Access. Cách thiết kế trực quan và cách lập trình hướng sự kiện được áp dụng trong Access và Visual Basic. Access tỏ ra mạnh hơn khi cho phép quản lí các sự kiện tinh tế hơn chẳng hạn như Text Box control, Access cho phép xử lí các cự kiện liên quan đến sự thay đổi dữ liệu: OnChange, BeforeUpdate, AfterUpdate trong khi Visual Basic 4.0 chỉ có thể kiểm tra sự kiện Change. Vì vậy Access cho phép phát triển các chương trình cập nhật dữ liệu thông minh hơn do kiểm soát được dữ liệu nhập một cách tinh tế. Ban đầu Access đơn giản chỉ là quản trị CSDL quan hệ ( Relation Database Management System ) dùng trong văn phòng ( nằm trong bộ Microsft Professional Word, Exccel, Power Point ) do đó Microsft đặc biệt chú trọng đến người sử dụng cuối (end user) hơn là nhà phát triển. Điều này làm cho công cụ hỗ trợ thiết kế ( giao diện thiết kế, các Wizard cho phép tự động hoá các quá trình thủ công trong quá trình thiết kế form, table, query ) của Access tỏ ra rất mạnh, hơn hẳn Visual Basic. Chẳng hạn nhiều lập trình viên kinh nghiệm khi viết các câu lệnh SQL trong Visual Basic thường dùng kềm bộ thiết kế Query trong Access để sinh ra trong câu lệnh SQL một cách dễ dàng. Access Basic có những khác biệt nhất định so với Visual Basic. Chỉ đến phiên bản Access 7.0. Visual Basis về sau và Access mới dùng chung ngôn ngữ lập trình mà Microsft gọi là VBA - Visual Basis for Application. Ta thấy Access và Visual Basic khác nhau ở cách chế tạo ra các ứng dụng so với các công cụ thiết kế khác nhau nhưng thành phần xử lí CSDL thì có nhiều điểm tương đồng vì cùng sử dụng Jet Engine. Visual Basic cho phép biện dịch các ứng dụng thành tập tin EXE, trong khi Access ta phỉ phân phối luôn cả tài nguyên thiết kế. Khái ngườiệm CSDL trong Access bao gồm cả phần dữ liệu (các bảng) và phần ứng dụng ( query, form, table, report, macro, module ), trong khi đối với các hệ khác, CSDL chỉ bao gồm phần dữ liệu. Chiến lược bảo mật tài nguyên thiết kế phải được đặt lên hàn đầu khi chọn Access làm công cụ phát triển ứng dụng. Hệ thống giao diện hỗ trợ thiết kế ( đặc biệt trong Access ) cũng khá rắc rối khiến người chưa có kinh nghiệm hay lẫn lộn giữa các thức dành cho người dùng cuối và những thứ dành cho người lập trình, thứ chỉ dùng cho thiết kế và thứ có thể mang vào ứng dụng. Chương 4 Các Form trong chương trình 1. Form chính của chương trình 2. Form Danh mục lớp học 3. Danh mục môn học 4. Danh mục Sinh viên 5. Bảng điểm Mã nguồn chương trình 1.FRMABOUT: Option Explicit ' Reg Key Security Options... Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' Reg Key ROOT Types... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' Unicode nul terminated string Const REG_DWORD = 4 ' 32-bit number Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" Const gREGVALSYSINFOLOC = "MSINFO" Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" Const gREGVALSYSINFO = "PATH" Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub Private Sub cmdOK_Click() Unload Me End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' Try To Get System Info Program Path\Name From Registry... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' Try To Get System Info Program Path Only From Registry... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' Validate Existance Of Known 32 Bit File Version If (Dir(SysInfoPath & "\MSINFO32.EXE") "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" ' Error - File Can Not Be Found... Else GoTo SysInfoErr End If ' Error - Registry Entry Can Not Be Found... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnly End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Loop Counter Dim rc As Long ' Return Code Dim hKey As Long ' Handle To An Open Registry Key Dim hDepth As Long ' Dim KeyValType As Long ' Data Type Of A Registry Key Dim tmpVal As String ' Tempory Storage For A Registry Key Value Dim KeyValSize As Long ' Size Of Registry Key Variable '------------------------------------------------------------ ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...} '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key If (rc ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error... tmpVal = String$(1024, 0) ' Allocate Variable Space KeyValSize = 1024 ' Mark Variable Size '------------------------------------------------------------ ' Retrieve Registry Key Value... '------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value If (rc ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '------------------------------------------------------------ ' Determine Key Value Type For Conversion... '------------------------------------------------------------ Select Case KeyValType ' Search Data Types... Case REG_SZ ' String Registry Key Data Type KeyVal = tmpVal ' Copy String Value Case REG_DWORD ' Double Word Registry Key Data Type For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char. Next KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String End Select GetKeyValue = True ' Return Success rc = RegCloseKey(hKey) ' Close Registry Key Exit Function ' Exit GetKeyError: ' Cleanup After An Error Has Occured... KeyVal = "" ' Set Return Val To Empty String GetKeyValue = False ' Return Failure rc = RegCloseKey(hKey) ' Close Registry Key End Function Private Sub lblDescription_Click() End Sub Private Sub lblDisclaimer_Click() End Sub 2.FRMADDLH: Option Explicit Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdOK_Click() If Trim(txtName.Text) = "" Or Trim(txtKhoaHoc.Text) = "" Or Trim(txtId.Text) = "" Then MsgBox "Thông tin về lớp học cần được nhập đầy đủ.", vbInformation, "Thông báo" Exit Sub End If If IsNumeric(txtKhoaHoc.Text) = False Then MsgBox "Khoá học cần được nhập theo dạng số.", vbInformation, "Thông báo" Exit Sub End If txtKhoaHoc.Text = CInt(txtKhoaHoc.Text) If v_Add = True Then If gFTenLop(txtId.Text) = "" Then gDbe.BeginTrans gSql = "Insert into LopHoc (MSLop,TenLop,KhoaHoc) " & _ " Values ('" & UCase(txtId.Text) & "', '" & txtName.Text & "', " & Trim(txtKhoaHoc.Text) & ")" gDb.Execute gSql gDbe.CommitTrans Call s_ClearText FrmLopHoc.Adodc1.Refresh FrmLopHoc.TDBGrid1.Refresh Unload Me Else MsgBox "Bạn nhập trùng mã số lớp học.", vbCritical, "Error" txtId.SetFocus Exit Sub End If Else gDbe.BeginTrans gSql = "Update LopHoc Set TenLop='" & txtName.Text & "', KhoaHoc = " & Trim(txtKhoaHoc.Text) & " " & _ "Where MSLop='" & v_IdEdit & "'" gDb.Execute gSql gDbe.CommitTrans DoEvents FrmLopHoc.Adodc1.Refresh FrmLopHoc.TDBGrid1.Refresh Unload Me End If End Sub Private Sub Form_Load() If v_Add = True Then txtId.Enabled = True Else txtId.Enabled = False txtId.Text = v_IdEdit txtName.Text = gFTenLop(v_IdEdit) txtKhoaHoc.Text = gKhoaHoc End If End Sub Private Sub s_ClearText() txtId.Text = "" txtName.Text = "" txtKhoaHoc.Text = "" End Sub 3.FRMADDMH: Option Explicit Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdOK_Click() If Trim(txtName.Text) = "" Or Trim(txtHocKy.Text) = "" Or Trim(txtId.Text) = "" Or Trim(txtSotrinh.Text) = "" Then MsgBox "Thông tin về môn học cần được nhập đầy đủ.", vbInformation, "Thông báo" Exit Sub End If If IsNumeric(txtHocKy.Text) = False Or IsNumeric(txtSotrinh.Text) = False Then MsgBox "Học kỳ, Số trình cần được nhập theo dạng số.", vbInformation, "Thông báo" Exit Sub End If txtHocKy.Text = CInt(txtHocKy.Text) txtSotrinh.Text = CInt(txtSotrinh.Text) If v_Add = True Then If gFTenMon(txtId.Text) = "" Then gDbe.BeginTrans gSql = "Insert into MonHoc (MSMon,TenMon,HocKy,SoTrinh) " & _ " Values ('" & UCase(txtId.Text) & "', '" & txtName.Text & "', " & Trim(txtHocKy.Text) & ", " & Trim(txtSotrinh.Text) & ")" gDb.Execute gSql gDbe.CommitTrans Call s_ClearText FrmMonHoc.Adodc1.Refresh FrmMonHoc.TDBGrid1.Refresh Unload Me Else MsgBox "Bạn nhập trùng mã số môn học.", vbCritical, "Error" txtId.SetFocus Exit Sub End If Else gDbe.BeginTrans gSql = "Update MonHoc Set TenMon='" & txtName.Text & "', HocKy = " & Trim(txtHocKy.Text) & ", SoTrinh = " & Trim(txtSotrinh.Text) & " " & _ "Where MSMon='" & v_IdEdit & "'" gDb.Execute gSql gDbe.CommitTrans DoEvents FrmMonHoc.Adodc1.Refresh FrmMonHoc.TDBGrid1.Refresh Unload Me End If End Sub Private Sub Form_Load() Dim rst As Recordset If v_Add = True Then txtId.Enabled = True Else txtId.Enabled = False txtId.Text = v_IdEdit Set rst = gDb.OpenRecordset("Select * From MonHoc Where MSMon='" & v_IdEdit & "'") If rst.EOF = False Or rst.BOF = False Then rst.MoveFirst txtName.Text = rst!TenMon txtHocKy.Text = rst!HocKy txtSotrinh.Text = rst!SoTrinh End If rst.Close End If End Sub Private Sub s_ClearText() txtId.Text = "" txtName.Text = "" txtHocKy.Text = "" txtSotrinh.Text = "" End Sub 4.FRMBANGDIEM: Option Explicit Private Sub CmChapNhan_Click() On Error GoTo Err_ If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveNext End If gDbe.BeginTrans gSql = "Delete From BangDiem Where BangDiem.MSMon = '" & gMSMon & _ "' And BangDiem.MSSV In (Select Distinct MSSV From BangDiemTam)" gDb.Execute gSql gSql = "Insert Into BangDiem (MSSV, Diem1, Diem2) " & _ "Select MSSV, Diem1, Diem2 From BangDiemTam" gDb.Execute gSql gSql = "Update BangDiem Set MSMon = '" & gMSMon & "' Where IsNull(MSMon)" gDb.Execute gSql gDb.Execute "Update BangDiem Set Diem2 = Null Where Diem1>=5" gDbe.CommitTrans Unload Me Exit Sub Err_: MsgBox Err.Number & " - " & Err.Description, vbCritical, "Error" gDbe.Rollback End Sub Private Sub CmHuyBo_Click() Unload Me End Sub Private Sub Form_Activate() If Adodc1.Recordset.EOF = True And Adodc1.Recordset.BOF = True Then MsgBox "Không tồn tại bản ghi", vbInformation, "Thông báo" 'Unload Me End If End Sub Private Sub Form_Load() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdTable .CursorLocation = adUseClient .RecordSource = "BangDiemTam" .Refresh End With Select Case gForm Case 2 ' Nhập điểm thi lần 1 TDBGrid1.Columns(3).Visible = False Me.Caption = "Nhập điểm thi lần 1 của môn: " & gMSMon & " - " & gFTenMon(gMSMon) Case 3 ' Nhập điểm thi lần 2 TDBGrid1.Columns(2).Visible = False Me.Caption = "Nhập điểm thi lần 2 của môn: " & gMSMon & " - " & gFTenMon(gMSMon) End Select With TDBGrid1 .Width = .Width - .Columns(3).Width FrmBangDiem.Width = FrmBangDiem.Width - .Columns(3).Width CmChapNhan.Left = CmChapNhan.Left - (.Columns(3).Width \ 2) CmHuyBo.Left = CmHuyBo.Left - (.Columns(3).Width \ 2) End With End Sub Private Sub OpDiem_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient If gForm = 2 Then .RecordSource = "Select * From BangDiemTam Order by Diem1 Desc" ElseIf gForm = 3 Then .RecordSource = "Select * From BangDiemTam Order by Diem2 Desc" End If .Refresh End With End Sub Private Sub OpHoTen_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From BangDiemTam Order by HoTen" .Refresh End With End Sub Private Sub OpMSSV_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From BangDiemTam Order by MSSV" .Refresh End With End Sub Private Sub TDBGrid1_Click() End Sub 5.FRMBANGDIEMSINHVIEN: Option Explicit Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdOK_Click() Dim rs As Recordset, rs1 As Recordset, v_st As Integer, v_d As Double If Not IsNumeric(txtHocKy.Text) Then MsgBox "Học kỳ nhập vào không đúng.", vbCritical, "Error" Exit Sub End If Set rs = gDb.OpenRecordset("Select SV.HoTen, Lop.TenLop From SinhVien SV, LopHoc Lop " & _ "Where MSSV='" & txtMSSV.Text & "' And SV.MSLop=Lop.MSLop") If rs.EOF = True And rs.BOF = True Then MsgBox "Không có sinh viên có mã số=" & txtMSSV.Text, vbCritical, "Error" rs.Close Exit Sub End If With DataEnvi.Connections("Connect") ' .Provider = "Microsoft.Jet.OLEDB.3.5" ' .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=" & v_AppPath & "Database.mdb" '.Provider = "MSDASQL.1" '.ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=Data" .ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=Data" .Open .Properties.Refresh End With With DataEnvi.Commands("BangDiem") .CommandType = adCmdText .CommandText = "SELECT MSSV, HoTen, MSMon, TenMon, HocKy, SoTrinh, Diem1, Diem2, ST_Diem FROM Query2 " & _ "WHERE MSSV='" & txtMSSV.Text & "' AND HocKy=" & txtHocKy.Text & " " & _ "ORDER BY MSSV" End With DataEnvi.Connections("Connect").Properties.Refresh Call Sleep(500) Set rs1 = gDb.OpenRecordset("Select Sum(SoTrinh) as ST,Sum(ST_Diem) As STD from Query2 " & _ "Where MSSV='" & txtMSSV.Text & "' AND HocKy=" & txtHocKy.Text) v_st = IIf(IsNull(rs1!ST), 1, rs1!ST) v_d = IIf(IsNull(rs1!STD), 0, rs1!STD) With RptBangDiem .Sections("RptHeader").Controls("lblName").Caption = rs!HoTen .Sections("RptHeader").Controls("lblLop").Caption = rs!TenLop .Sections("RptHeader").Controls("lblHocKy").Caption = "Học kỳ " & txtHocKy.Text .Sections("RptFooter").Controls("lblDTB").Caption = v_d / v_st End With rs.Close rs1.Close RptBangDiem.Show 1 Set DataEnvi = Nothing End Sub Private Sub Form_Load() End Sub 6.FRMDIEMTB: Option Explicit Private Style1 As TrueDBGrid60.Style Private Sub CmPreview_Click() With TDBGrid1.PrintInfo .PageHeaderFont.Italic = True .PageHeaderFont.Bold = True .PageHeaderFont.Size = 13 .PageHeaderFont.Name = ".VnTime" .PageHeader = "Bảng điểm trung bình học kỳ " & gHocKy & " - Lớp: " & gFTenLop(gMSLop) & " K" & gKhoaHoc .RepeatColumnHeaders = True .SettingsMarginBottom = 1000 .PageFooter = "\tTrang: \p" .PrintPreview Check1.Value End With End Sub Private Sub CmReport_Click() With CommonDialog1 .Filter = "html" .DefaultExt = "html" .DialogTitle = "Lưu lại bảng điểm dưới dạng file HTML" .ShowSave End With If Trim(CommonDialog1.FileName) "" Then TDBGrid1.ExportToFile CommonDialog1.FileName, False, Check1.Value '0 - dbgAllRows; 1 - dbgSelectedRows End If End Sub Private Sub CmThoat_Click() Unload Me End Sub Private Sub Form_Load() Dim i As Integer With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * from Temp order by Lan1" .Refresh End With With TDBGrid1 .Columns("MSSV").Width = 1200 .Columns("MSSV").BackColor = 12768977 .Columns("HoTen").Width = 2000 .Columns("HoTen").Caption = "Họ và tên" .Columns("HoTen").ForeColor = vbBlue .Columns("DTB").Width = 700 .Columns("DTB").Caption = "Điểm TB" .Columns("DTB").Alignment = 2 .Columns("DTB").BackColor = vbGreen .Columns("DTB").NumberFormat = "FormatText Event" '"Edit Mask" '.Columns("DTB").EditMask = "#.##" For i = 3 To (.Columns.Count - 2) .Columns(i).Width = 800 .Columns(i).Alignment = 2 Next .Columns(.Columns.Count - 1).Visible = False End With ' Set Style1 = TDBGrid1.Styles.Add("ChangeColor1") ' With Style1 ' .Parent = "Normal" ' .Font.Name = ".VnTime" ' .Font.Size = 10 ' .BackColor = vbWhite ' .ForeColor = vbWhite ' End With End Sub Private Sub TDBGrid1_FormatText(ByVal ColIndex As Integer, Value As Variant, Bookmark As Variant) If ColIndex = 2 Then Value = Round(Value, 2) Value = SetChamPhay(Value, True) End If End Sub 7.FRMINDS: Option Explicit Private Sub CmChapNhan_Click() If gFormIn = 1 Then If Val(TxFrom.Text) > Val(TxTo.Text) Then MsgBox "Bạn nhập khoá học không hợp lệ", vbInformation, "Thông báo" Exit Sub End If With DataEnvi.Connections("Connect") ' .Provider = "Microsoft.Jet.OLEDB.4.0" ' .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=" & v_AppPath & "Database.mdb" .Provider = "MSDASQL.1" .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=Data" .Open .Properties.Refresh End With With DataEnvi.Commands("CommandLop") .CommandType = adCmdText If Val(TxFrom.Text) = Val(TxTo.Text) Then .CommandText = "Select * From LopHoc Where KhoaHoc = " & Val(TxFrom.Text) & " Order by MSLop" Else .CommandText = "Select * From LopHoc Where KhoaHoc Between " & Val(TxFrom.Text) & " And " & _ Val(TxTo.Text) & " Order by KhoaHoc, MSLop" End If End With DataEnvi.Connections("Connect").Properties.Refresh If Val(TxFrom.Text) = Val(TxTo.Text) Then ReportLop.Sections("SectionRH").Controls("LbKhoaHoc").Caption = "Khoá học: K" & TxFrom.Text Else ReportLop.Sections("SectionRH").Controls("LbKhoaHoc").Caption = "Từ khoá: K" & TxFrom.Text & " Đến khoá: K" & TxTo.Text End If ReportLop.Show 1 ElseIf gFormIn = 2 Then If Val(TxFrom.Text) > Val(TxTo.Text) Then MsgBox "Bạn nhập học kỳ không hợp lệ", vbInformation, "Thông báo" Exit Sub End If With DataEnvi.Connections("Connect") ' .Provider = "Microsoft.Jet.OLEDB.3.51" ' .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=" & v_AppPath & "Database.mdb" .Provider = "MSDASQL.1" .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=Data" .Open End With With DataEnvi.Commands("CommandMon") .CommandType = adCmdText If Val(TxFrom.Text) = Val(TxTo.Text) Then .CommandText = "Select * From MonHoc Where HocKy = " & Val(TxFrom.Text) & " Order by MSMon" Else .CommandText = "Select * From MonHoc Where HocKy Between " & Val(TxFrom.Text) & " And " & _ Val(TxTo.Text) & " Order by HocKy, MSMon" End If End With DataEnvi.Connections("Connect").Properties.Refresh If Val(TxFrom.Text) = Val(TxTo.Text) Then ReportMon.Sections("SectionRH").Controls("LbHocKy").Caption = "Học kỳ: " & TxFrom.Text Else ReportMon.Sections("SectionRH").Controls("LbHocKy").Caption = "Từ học kỳ: " & TxFrom.Text & " Đến học kỳ: " & TxTo.Text End If ReportMon.Show 1 End If Set DataEnvi = Nothing End Sub Private Sub CmHuyBo_Click() Unload Me End Sub Private Sub Form_Load() Select Case gFormIn Case 1 Frame1.Caption = "Chọn in danh sách lớp học:" Label1.Caption = "Từ khoá học:" Label2.Caption = "Đến khoá học:" Case 2 Frame1.Caption = "Chọn in danh sách môn học:" Label1.Caption = "Từ học kỳ:" Label2.Caption = "Đến học kỳ:" End Select End Sub Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single) End Sub Private Sub TxFrom_Validate(Cancel As Boolean) If gFormIn = 1 Then If Not IsNumeric(TxFrom.Text) Then MsgBox "Bạn nhập khoá học không hợp lệ", vbInformation, "Thông báo" Cancel = True End If ElseIf gFormIn = 2 Then If Not IsNumeric(TxFrom.Text) Then MsgBox "Bạn nhập học kỳ không hợp lệ", vbInformation, "Thông báo" Cancel = True End If End If End Sub Private Sub TxTo_Validate(Cancel As Boolean) If gFormIn = 1 Then If Not IsNumeric(TxTo.Text) Then MsgBox "Bạn nhập khoá học không hợp lệ", vbInformation, "Thông báo" Cancel = True End If ElseIf gFormIn = 2 Then If Not IsNumeric(TxTo.Text) Then MsgBox "Bạn nhập học kỳ không hợp lệ", vbInformation, "Thông báo" Cancel = True End If End If End Sub 8.FRMLOGIN: Option Explicit Private dem As Integer Private Sub cmdOK_Click() dem = dem + 1 If txtPassword.Text = MatKhau Then Unload Me Else If dem = 3 Then MsgBox "Bạn không có quyền sử dụng chương trình này!", , "No permission" Unload Me Set gDb = Nothing End Else MsgBox "Mật khẩu nhập vào không đúng, hãy thử lại lần nữa!", , "Login" txtPassword.SetFocus SendKeys "{Home}+{End}" End If End If End Sub Private Sub Form_Load() Call SetFontSize(Me) dem = 0 End Sub 9.FRMLOPHOC: Option Explicit Private Sub cmdAdd_Click() v_Add = True frmAddLH.Show 1 End Sub Private Sub cmdDel_Click() On Error GoTo Err_ If MsgBox("Do you want to delete this record?", vbYesNo + vbQuestion, "Warning") = vbYes Then Adodc1.Recordset.Delete (adAffectCurrent) End If Exit Sub Err_: MsgBox Err.Number & " - " & Err.Description, vbCritical, "Error" End Sub Private Sub cmdEdit_Click() v_Add = False v_IdEdit = Adodc1.Recordset("MSLop").Value frmAddLH.Show 1 End Sub Private Sub CmIn_Click() gFormIn = 1 FrmInDS.Show 1 End Sub Private Sub CmThoat_Click() Unload Me End Sub Private Sub Form_Load() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From LopHoc Order by MSLop" .Refresh End With End Sub Private Sub OpMSLop_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From LopHoc Order by MSLop" .Refresh End With End Sub Private Sub OpTenLop_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From LopHoc Order by TenLop" .Refresh End With End Sub Private Sub OpKhoaHoc_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From LopHoc Order by KhoaHoc" .Refresh End With End Sub Private Sub TDBGrid1_KeyPress(KeyAscii As Integer) If (KeyAscii = 13 And TDBGrid1.Col = 2) Then TDBGrid1.Col = 0 SendKeys "{Down}" End If End Sub 10. FRMMAIN: Option Explicit Option Compare Text Private Sub Form_Load() Dim Database As Variant Dim gRst As Recordset v_AppPath = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") Set gDb = gDbe.Workspaces(0).OpenDatabase(v_AppPath & "Database.mdb", Database, False, ";pwd=tranduc") With gConn .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & v_AppPath & "Database.mdb;Persist Security Info=False;" .CommandTimeout = 10 .CursorLocation = adUseClient .Open End With gForm = 0 gFormIn = 0 ' Mật khẩu chương trình Set gRst = gDb.OpenRecordset("Select * From Password") If gRst.EOF = False Or gRst.BOF = False Then mnuThietLapMatKhau.Enabled = False mnuThayDoiMatKhau.Enabled = True gRst.MoveFirst MatKhau = IIf(gRst!Password "", gRst!Password, "") gRst.Close If MatKhau "" Then frmLogin.Show 1 End If Else mnuThietLapMatKhau.Enabled = True mnuThayDoiMatKhau.Enabled = False gRst.Close End If End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub mnuAbout_Click() frmAbout.Show 1 End Sub Private Sub mnuBangDiem_Click() gForm = 4 FrmMSLop.Show 1 End Sub Private Sub mnuBangDiemSV_Click() frmBangDiemSV.Show 1 End Sub Private Sub mnuExit_Click() End End Sub Private Sub mnuLopHoc_Click() FrmLopHoc.Show 1 End Sub Private Sub mnuMonHoc_Click() FrmMonHoc.Show 1 End Sub Private Sub mnuNhapDiem1_Click() gForm = 2 FrmMSLop.Show 1 End Sub Private Sub mnuNhapDiem2_Click() gForm = 3 FrmMSLop.Show 1 End Sub Private Sub mnuSinhVien_Click() gForm = 1 FrmMSLop.Show 1 End Sub Private Sub mnuThayDoiMatKhau_Click() FrgChangePassword.Show 1 End Sub Private Sub mnuThietLapMatKhau_Click() FrgPassword.Show 1 End Sub Private Sub mnuThiLan1_Click() gForm = 5 FrmMSLop.Show 1 End Sub Private Sub mnuThiLan2_Click() gForm = 6 FrmMSLop.Show 1 End Sub 11. FRMMONHOC: Option Explicit Private Sub cmdAdd_Click() v_Add = True frmAddMH.Show 1 End Sub Private Sub cmdDel_Click() On Error GoTo Err_ If MsgBox("Do you want to delete this record?", vbYesNo + vbQuestion, "Warning") = vbYes Then Adodc1.Recordset.Delete (adAffectCurrent) End If Exit Sub Err_: MsgBox Err.Number & " - " & Err.Description, vbCritical, "Error" End Sub Private Sub cmdEdit_Click() v_Add = False v_IdEdit = Adodc1.Recordset("MSMon").Value frmAddMH.Show 1 End Sub Private Sub CmIn_Click() gFormIn = 2 FrmInDS.Show 1 End Sub Private Sub CmThoat_Click() Unload Me End Sub Private Sub Form_Load() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From MonHoc Order by MSMon" .Refresh End With End Sub Private Sub OpHocKy_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From MonHoc Order by HocKy" .Refresh End With End Sub Private Sub OpMSMon_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From MonHoc Order by MSMon" .Refresh End With End Sub Private Sub OpTenMon_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From MonHoc Order by TenMon" .Refresh End With End Sub Private Sub TDBGrid1_KeyPress(KeyAscii As Integer) If (KeyAscii = 13 And TDBGrid1.Col = 3) Then TDBGrid1.Col = 0 SendKeys "{Down}" End If End Sub 12. FRMMSLOP: Option Explicit Private Sub CbMSLop_Click() LbTenLop.Caption = gFTenLop(CbMSLop.Text) End Sub Private Sub CbMSMon_Click() LbTenMon.Caption = gFTenMon(CbMSMon.Text) End Sub Private Sub CmChapNhan_Click() gMSLop = Trim(CbMSLop.Text) Select Case gForm Case 1 FrmSinhVien.Show 1 Case 2, 3 gDbe.BeginTrans gMSMon = Trim(CbMSMon.Text) gDb.Execute "Delete From BangDiemTam" If gForm = 2 Then gSql = "Insert Into BangDiemTam " & _ "Select SinhVien.MSSV, SinhVien.HoTen, BangDiem.Diem1, BangDiem.Diem2 From SinhVien, BangDiem " & _ "Where SinhVien.MSLop = '" & gMSLop & "' And SinhVien.MSSV = BangDiem.MSSV " & _ "And BangDiem.MSMon = '" & gMSMon & "'" gDb.Execute gSql gSql = "Insert Into BangDiemTam " & _ "Select SinhVien.MSSV, SinhVien.HoTen From SinhVien " & _ "Where SinhVien.MSLop = '" & gMSLop & "' And SinhVien.MSSV Not In (Select Distinct MSSV From BangDiemTam)" gDb.Execute gSql Else If Check1.Value = 1 Then gSql = "Insert Into BangDiemTam " & _ "Select BangDiem.MSSV, SinhVien.HoTen, BangDiem.Diem1, BangDiem.Diem2 From SinhVien, BangDiem " & _ "Where SinhVien.MSLop = '" & gMSLop & "' And BangDiem.MSSV = SinhVien.MSSV And BangDiem.Diem1<5 " & _ "And BangDiem.MSMon = '" & gMSMon & "'" Else gSql = "Insert Into BangDiemTam " & _ "Select BangDiem.MSSV, SinhVien.HoTen, BangDiem.Diem1, BangDiem.Diem2 From SinhVien, BangDiem " & _ "Where SinhVien.MSLop = '" & gMSLop & "' And BangDiem.MSSV = SinhVien.MSSV And ((BangDiem.Diem1<5 " & _ "And IsNull(BangDiem.Diem2)) Or BangDiem.Diem2 < 5) And BangDiem.MSMon = '" & gMSMon & "'" End If gDb.Execute gSql End If gDbe.CommitTrans FrmBangDiem.Show 1 Case 4 gHocKy = CByte(TxHocKy.Text) Call MakeRptDiem(gMSLop, CByte(TxHocKy.Text)) FrmDiemTB.Show 1 Case 5, 6 gHocKy = CByte(TxHocKy.Text) gMSMon = Trim(CbMSMon.Text) With DataEnvi.Connections("Connect") '.Provider = "Microsoft.Jet.OLEDB.3.51" '.ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=" & v_AppPath & "Database.mdb" .Provider = "MSDASQL.1" .ConnectionString = "Persist Security Info=False;Data Source=Data" .Open .Properties.Refresh End With With DataEnvi.Commands("CommandSV") .CommandType = adCmdText If gForm = 5 Then .CommandText = "Select MSSV, HoTen, NgaySinh From SinhVien Where MSLop = '" & gMSLop & "' Order by MSSV" Else .CommandText = "Select BangDiem.MSSV, SinhVien.HoTen, SinhVien.NgaySinh From SinhVien, BangDiem " & _ "Where SinhVien.MSLop = '" & gMSLop & "' And BangDiem.MSSV = SinhVien.MSSV And ((BangDiem.Diem1<5 " & _ "And IsNull(BangDiem.Diem2)) Or BangDiem.Diem2 < 5) And BangDiem.MSMon = '" & gMSMon & "'" End If End With Call Sleep(1000) DataEnvi.Connections("Connect").Properties.Refresh With ReportDSThi.Sections("SectionRH") .Controls("LbLopHoc").Caption = "Lớp: " & gFTenLop(gMSLop) .Controls("LbMon").Caption = gFTenMon(gMSMon) .Controls("LbKhoaHoc").Caption = "K" & gKhoaHoc .Controls("LbHocKy").Caption = "Học kỳ: " & TxHocKy.Text If gForm = 5 Then .Controls("LbDanhSach").Caption = "Danh sách sinh viên thi lần i" Else .Controls("LbDanhSach").Caption = "Danh sách sinh viên thi lần ii" End If End With ReportDSThi.Show 1 Set DataEnvi = Nothing End Select Unload Me End Sub Private Sub CmHuyBo_Click() Unload Me End Sub Private Sub Form_Load() Dim gRst As Recordset If gForm 1 Then CmChapNhan.Enabled = False CbMSLop.Clear Set gRst = gDb.OpenRecordset("Select MSLop, TenLop From LopHoc Order by KhoaHoc") If gRst.EOF = False Or gRst.BOF = False Then gRst.MoveFirst Do Until gRst.EOF CbMSLop.AddItem gRst!MSLop gRst.MoveNext Loop gRst.MoveFirst CbMSLop.Text = gRst!MSLop LbTenLop.Caption = gRst!TenLop End If gRst.Close Select Case gForm Case 1, 4 CbMSMon.Visible = False Label2.Visible = False LbTenMon.Caption = "" Check1.Visible = False CbMSLop.Top = CbMSLop.Top + 200 Label1.Top = Label1.Top + 200 LbTenLop.Top = LbTenLop.Top + 200 If gForm = 1 Then TxHocKy.Visible = False Label3.Visible = False End If TxHocKy.Top = TxHocKy.Top + 200 Label3.Top = Label3.Top + 200 If gForm = 1 Then Frame1.Caption = "Xem Danh sách Sinh viên:" Else Frame1.Caption = "Xem Danh sách điểm của các sinh viên:" End If Case 2, 3, 5, 6 CbMSMon.Clear CbMSMon.Enabled = False LbTenMon.Caption = "" If gForm = 2 Then Check1.Visible = False Frame1.Caption = "Nhập/xem điểm thi lần 1:" ElseIf gForm = 3 Then Frame1.Caption = "Nhập/xem điểm thi lại:" ElseIf gForm = 5 Then Check1.Visible = False Frame1.Caption = "Danh sách Sinh viên thi lần 1:" ElseIf gForm = 6 Then Check1.Visible = False Frame1.Caption = "Danh sách Sinh viên thi lần 2:" End If End Select End Sub Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single) End Sub Private Sub TxHocKy_LostFocus() If gForm = 2 Or gForm = 3 Or gForm = 5 Or gForm = 6 Then CbMSMon.SetFocus End If End Sub Private Sub TxHocKy_Validate(Cancel As Boolean) Dim gRst As Recordset If Not IsNumeric(TxHocKy.Text) Or (Val(TxHocKy.Text) - Round(Val(TxHocKy.Text), 0)) 0 Or Val(TxHocKy.Text) = 15 Then CmChapNhan.Enabled = False Cancel = True CbMSMon.Enabled = False Else If gForm = 2 Or gForm = 3 Or gForm = 5 Or gForm = 6 Then CbMSMon.Enabled = True CbMSMon.Clear Set gRst = gDb.OpenRecordset("Select MSMon, TenMon From MonHoc Where HocKy = " & Val(TxHocKy.Text) & " Order by MSMon") If gRst.EOF = False Or gRst.BOF = False Then gRst.MoveFirst Do Until gRst.EOF CbMSMon.AddItem gRst!MSMon gRst.MoveNext Loop gRst.MoveFirst CbMSMon.Text = gRst!MSMon LbTenMon.Caption = gRst!TenMon CmChapNhan.Enabled = True Else MsgBox "Không tồn tại môn học trong học kỳ này.", vbInformation, "Thông báo" CbMSMon.Locked = True CmChapNhan.Enabled = False End If gRst.Close Else CmChapNhan.Enabled = True End If End If End Sub 13. FRMSINHVIEN: Option Explicit Option Compare Text Private Sub cmdDelete_Click() On Error GoTo Err_ If MsgBox("Do you want to delete this record?", vbYesNo + vbQuestion, "Warning") = vbYes Then Adodc1.Recordset.Delete (adAffectCurrent) End If Exit Sub Err_: MsgBox Err.Number & " - " & Err.Description, vbCritical, "Error" Adodc1.Refresh End Sub Private Sub CmIn_Click() With DataEnvi.Connections("Connect") ' .Provider = "Microsoft.Jet.OLEDB.3.51" ' .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=" & v_AppPath & "Database.mdb" .Provider = "MSDASQL.1" .ConnectionString = "Password=tranduc;Persist Security Info=False;Data Source=Data" .Open .Properties.Refresh End With With DataEnvi.Commands("CommandSV") .CommandType = adCmdText .CommandText = "Select MSSV, HoTen, NgaySinh, ThuongTru, NguyenQuan From SinhVien " & _ "Where MSLop = '" & gMSLop & "' Order by MSSV" End With Call Sleep(1000) DataEnvi.Connections("Connect").Properties.Refresh With ReportSV.Sections("SectionRH") .Controls("LbLopHoc").Caption = "Lớp: " & gFTenLop(gMSLop) .Controls("LbKhoaHoc").Caption = "K" & gKhoaHoc End With ReportSV.Show 1 Set DataEnvi = Nothing End Sub Private Sub CmThoat_Click() Unload Me End Sub Private Sub Form_Load() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From SinhVien Where MSLop = '" & gMSLop & "' Order by MSSV" .Refresh End With End Sub Private Sub OpHoTen_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From SinhVien Where MSLop = '" & gMSLop & "' Order by HoTen" .Refresh End With End Sub Private Sub OpMSSV_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From SinhVien Where MSLop = '" & gMSLop & "' Order by MSSV" .Refresh End With End Sub Private Sub Option1_Click() With Adodc1 .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .CursorLocation = adUseClient .RecordSource = "Select * From SinhVien Where MSLop = '" & gMSLop & "' Order by NgaySinh" .Refresh End With End Sub Private Sub TDBGrid1_AfterColUpdate(ByVal ColIndex As Integer) If ColIndex = 0 Then TDBGrid1.Columns(6).Text = gMSLop End If End Sub Private Sub TDBGrid1_KeyPress(KeyAscii As Integer) If (KeyAscii = 13 And TDBGrid1.Col = 5) Then TDBGrid1.Col = 0 SendKeys "{Down}" End If End Sub 14. FRMSPLASH: Option Explicit Dim v_time As Byte Private Sub Form_KeyPress(KeyAscii As Integer) Unload Me End Sub Private Sub Form_Load() v_time = 0 End Sub Private Sub Form_Unload(Cancel As Integer) FrmMain.Show End Sub Private Sub Frame1_Click() Unload Me End Sub Private Sub Timer1_Timer() v_time = v_time + 1 If v_time > 25 Then Unload Me End If End Sub * MODULES: Option Explicit Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public gMSLop As String, gMSMon As String, gHocKy As Byte, gKhoaHoc As Integer Public gForm As Byte ' Default = 0; FrmSinhVien = 1; FrmBangDiem1 = 2; FrmBangDiem2 = 3; In Bảng điểm = 4; ReportDSThi = 5 Public gFormIn As Byte ' Default = 0; FrmLopHoc = 1; FrmMonHoc = 2 Public gDbe As New DBEngine Public gDb As Database Public gConn As New ADODB.Connection Public gSql As String Public MatKhau As String ' Mật khẩu chương trình Public v_AppPath As String Public v_Add As Boolean 'Add: True; Edit: False Public v_IdEdit As String ' Hàm gFTenLop trả về tên lớp học có mã lớp = MaLop Public Function gFTenLop(MaLop As String) As String Dim Rst1 As Recordset gFTenLop = "" Set Rst1 = gDb.OpenRecordset("Select TenLop, KhoaHoc From LopHoc Where MSLop = '" & MaLop & "'") If Rst1.EOF = False Or Rst1.BOF = False Then gFTenLop = Rst1!TenLop gKhoaHoc = Rst1!KhoaHoc End If Rst1.Close End Function ' Hàm gFTenMon trả về tên môn học có mã môn = MaMon Public Function gFTenMon(MaMon As String) As String Dim Rst1 As Recordset gFTenMon = "" Set Rst1 = gDb.OpenRecordset("Select TenMon From MonHoc Where MSMon = '" & MaMon & "'") If Rst1.EOF = False Or Rst1.BOF = False Then gFTenMon = Rst1!TenMon End If Rst1.Close End Function ' Hàm gFTenSV trả về tên sinh viên có MSSV = MaSo Public Function gFTenSV(MaSo As String) As String Dim Rst1 As Recordset gFTenSV = "" Set Rst1 = gDb.OpenRecordset("Select HoTen From SinhVien Where MSSV = '" & MaSo & "'") If Rst1.EOF = False Or Rst1.BOF = False Then gFTenSV = Rst1!HoTen End If Rst1.Close End Function Public Function NullNumber(ByVal Bien) As Variant If Bien "" Then NullNumber = Bien Else NullNumber = 0 End If End Function Public Function NullDate(ByVal Bien) As String If Bien "" Then 'NullDate = DoiNgayThang(Bien, True) Else NullDate = "__/__/____" End If End Function Public Function NullText(ByVal Bien) As String If Bien "" Then NullText = Bien Else NullText = "" End If End Function Public Function FillNull(ByVal Bien, ByVal KieuData As String) As String If Trim(Bien) = "" Or Bien = "____" Or Bien = "__/____" Or Bien = "__/__/____" Or IsNull(Bien) Then FillNull = "Null" Else Select Case LCase(KieuData) Case "text" FillNull = "'" & Trim(Bien) & "'" Case "number" FillNull = Trim(Bien) Case "date" FillNull = "#" & Trim(Bien) & "#" End Select End If End Function Public Sub MakeRptDiem(Lop As String, HocKy As Byte) On Error GoTo Err_ Dim Qdf1 As QueryDef, Qdf2 As QueryDef Dim Sql1 As String, Sql2 As String gDbe.BeginTrans Sql1 = "TRANSFORM First(BangDiem.Diem1) AS [The Value] " & _ "SELECT BangDiem.MSSV, SinhVien.HoTen, Sum((BangDiem.Diem1)*(MonHoc.SoTrinh))/Sum(MonHoc.SoTrinh) AS DTB " & _ "FROM SinhVien, MonHoc, BangDiem Where MonHoc.MSMon = BangDiem.MSMon And " & _ "SinhVien.MSSV = BangDiem.MSSV And SinhVien.MSLop = '" & Lop & "' And MonHoc.HocKy = " & HocKy & " " & _ "GROUP BY BangDiem.MSSV, SinhVien.HoTen " & _ "PIVOT BangDiem.MSMon" Set Qdf1 = gDb.CreateQueryDef("QdfDiem1", Sql1) If TonTaiBang("Temp") = True Then gDb.Execute "Drop Table Temp" End If gDb.Execute "Select * Into Temp From QdfDiem1" 'Qdf1.Name gDb.Execute "Alter Table Temp Add Column Lan1 Text(15)" gDb.Execute "Update Temp Set Lan1=MSSV & '-1'" gDb.Execute "Drop Table QdfDiem1" ' Xoá Query tạo ra trong Access gDb.Execute "Create Index NewIndex On Temp (MSSV)" Sql2 = "TRANSFORM First(BangDiem.Diem2) AS [The Value] " & _ "SELECT BangDiem.MSSV, SinhVien.HoTen, Sum((IIf(BangDiem.Diem2 > BangDiem.Diem1, BangDiem.Diem2, " & _ "BangDiem.Diem1))*(MonHoc.SoTrinh))/Sum(MonHoc.SoTrinh) AS DTB " & _ "FROM SinhVien, MonHoc, BangDiem " & _ "Where MonHoc.MSMon = BangDiem.MSMon And " & _ "SinhVien.MSSV = BangDiem.MSSV And SinhVien.MSLop = '" & Lop & "' And MonHoc.HocKy = " & HocKy & " " & _ "GROUP BY BangDiem.MSSV, SinhVien.HoTen " & _ "PIVOT BangDiem.MSMon" Set Qdf2 = gDb.CreateQueryDef("QdfDiem2", Sql2) gDb.Execute "Insert Into Temp Select * From QdfDiem2" 'Qdf2.Name gDb.Execute "Drop Table QdfDiem2" ' Xoá Query tạo ra trong Access gDb.Execute "Update Temp Set Lan1=MSSV & '-2' Where Lan1 Is Null" gDbe.CommitTrans gDbe.BeginTrans gDb.Execute "Update Temp Set MSSV=Null, HoTen=Null Where Lan1 like '*-2'" gDbe.CommitTrans 'Sleep (500) Exit Sub Err_: MsgBox Err.Number & " - " & Err.Description, vbCritical, "Error" gDbe.Rollback End Sub Private Function TonTaiBang(TenBang As String) As Boolean Dim i As Integer TonTaiBang = False For i = 0 To gDb.TableDefs.Count - 1 If gDb.TableDefs(i).Name = TenBang Then TonTaiBang = True Exit Function End If Next End Function Public Sub SetFontSize(Frm As Form) Dim i As Integer For i = 0 To Frm.Controls.Count - 1 If TypeOf Frm.Controls(i) Is Label Or TypeOf Frm.Controls(i) Is TextBox Or TypeOf Frm.Controls(i) Is CheckBox Or _ TypeOf Frm.Controls(i) Is OptionButton Or TypeOf Frm.Controls(i) Is ComboBox Or TypeOf Frm.Controls(i) Is ListBox Or _ TypeOf Frm.Controls(i) Is CommandButton Or TypeOf Frm.Controls(i) Is Frame Then If Frm.Controls(i).FontSize 10 Then Frm.Controls(i).FontSize = 10 End If If Frm.Controls(i).Font ".VnTime" Then Frm.Controls(i).Font = ".VnTime" End If End If Next i End Sub Public Function SetChamPhay(ByVal So As String, Cham As Boolean) As String Dim SoCham As Long, i As Long, J As Long, SoKyTu As Long, SoDau As Long, DauAm As String * 1 Dim Mang() As String * 4 SoCham = 0 DauAm = "" If Cham = True Then ' Chuyển Anh sang Việt If Left(So, 1) = "-" Then So = Mid(So, 2) DauAm = "-" End If SoKyTu = IIf(InStr(1, So, ".", vbBinaryCompare) 0, InStr(1, So, ".", vbBinaryCompare) - 1, Len(So)) SoCham = (SoKyTu - 1) \ 3 'Lấy phần nguyên SoDau = IIf((SoKyTu Mod 3) = 0, 3, SoKyTu Mod 3) 'Lấy phần dư ReDim Mang(SoCham + 1) So = Replace(So, ".", ",", 1, -1, vbBinaryCompare) SetChamPhay = So If SoCham > 0 Then i = 1 For J = SoKyTu + 1 To 3 Step (-3) Mang(i) = "." & Mid(So, J - 3, 3) i = i + 1 If i > SoCham Then Exit For Next If Len(So) > SoKyTu Then Mang(0) = Mid(So, SoKyTu + 1, Len(So) - SoKyTu) Else Mang(0) = "" End If Mang(SoCham + 1) = Mid(So, 1, SoDau) SetChamPhay = "" For i = SoCham + 1 To 0 Step -1 SetChamPhay = SetChamPhay & Trim(Mang(i)) Next End If SetChamPhay = DauAm & SetChamPhay Else ' Chuyển Việt thành Anh - dùng khi Update vào Data So = Replace(So, ".", "", 1, -1, vbBinaryCompare) So = Replace(So, ",", ".", 1, -1, vbBinaryCompare) SetChamPhay = So End If End Function Tài liệu tham khảo Microsoft Visual Basic 6.0 & Lập trình cơ sở dữ liệu - Nhà xuất bản giáo dục. Beginning Visual basic 6 - Peter Wright, Wrox Press. Database Access with Visual Basic 6 - Jeffrey P.McManus, SAMS Publishing. Beginning Visual Basic 6 Database Programming - John connell, Wrox Press. Visual Basic 6 Database Programming - John W.Fronckowiak và David J.Helda , IDG Books Worldwide, Inc. MSDN Library Visual Basic 6.0 - Microsoft. Các chương trình mẫu Visual Basic 6.0 - Tác giả Võ Hiếu Nghĩa - Nhà xuất bản thống kê. Ngoài ra còn một số tài liệu và tạp chí Tin học