Bạn đang xem trang 1 / 1 trang

Tạo cơ sở dữ liệu cho chương trình quản lý đơn giản

Đã gửi: Thứ 2 01/08/2011 12:58 pm
by nhochoclaptrinh
Tên bài viết: Chương trinh quản lý đơn giản
Tác giả: nhochoclaptrinh
Cấp độ bài viết: Cơ bản
Tóm tắt: sử dụng kiểu bản ghi 'type .... end type' để tạo chương trình quản lý
Sử dụng kiểu bản ghi có dạng:

Mã: Chọn tất cả

Type [tên]
...
...
end type
Vào mục đích chính, bây giờ mình sẽ chọn chủ đề là quản lý học sinh một lớp học - đơn giản thôi :D

Bước đầu tiên, tạo cấu trúc bản ghi:
Sau khi chọn kiểu dự án Standard EXE, Chọn menu Project > Add Module bạn đặt tên bất kỳ:
Cơ bản một chương trình quản lý học sinh (theo mình) cần các thông tin về hs như: Họ và tên, Lớp, GVCN, Cha mẹ, Địa chỉ, Ghi chú học sinh.
vậy mình sẽ viết code như sau:
  1. Option Explicit
  2. Public Type DataRec
  3.     sName As String * 15  'Tên hs giới hạn 15 ký tự
  4.    sClass As String * 3  'Tên lớpgiới hạn 3 ký tự
  5.    sTeacher As String * 15 'Tên giáo viên giới hạn 15 ký tự
  6.    sAddress As String * 255 'Địa chỉ giới hạn 255 ký tự
  7.    sNote As String * 510 'Ghi chú giới hạn 510 ký tự
  8.    sPhone As Integer 'Số dt của hs kiểu số
  9. End Type


Tiếp theo bước 2, ta tạo các thủ tục [Lưu thông tin] và [lấy thông tin]
Khai báo các biến dữ liệu thực hiện kết nối dữ liệu
  1. Public DataEngine As DataRec 'Biến của DataRec
  2. Public FilePort As Integer 'Cổng kết nối file
  3. Public RecordSize As Long 'Chiều dài tập tin
  4. Public CurrentRec As Long 'Mẫu tin hiện hành
  5. Public LastRec As Long 'Mẫu tin cuối cùng


Đến phần tạo giao diện:
Add form tên FrmMain
_.PNG
Bảng control và các thuộc tính cơ bản:
__.PNG
__.PNG (17.85 KiB) Đã xem 4475 lần
Các thông tin sẽ được lưu vào file với tên [hs.dat]
Sang module đã tạo
Thủ tục tạo tập tin
  1. Public Sub StartEngine()
  2.     'Tính chiều dài mẫu tin
  3.    RecordSize = Len(DataEngine)
  4.     'Chọn cổng ghi file
  5.    FilePort = FreeFile
  6.     Open "hs.dat" For Random As FilePort Len = RecordSize
  7.     'Tạo file hs.dat nếu có rồi thì đọc
  8.     'Khởi tạo giá trị
  9.    CurrentRec = 1
  10.     LastRec = FileLen("hs.dat") / RecordSize
  11.     If LastRec = 0 Then LastRec = 1
  12.     'Gọi thủ tục hiện tin
  13. End Sub

Trong thủ tục trên, ta chưa đóng FilePort để tiện dùng,
Tiếp theo là code thủ tục [ShowRec] hiển thị thông tin:
  1.  
  2. Public Sub ShowCurrentRec()
  3.     Get #FilePort, CurrentRec, DataEngine
  4.     With frmMain
  5.         .txtName.Text = Trim(DataEngine.sName)
  6.         .txtClass.Text = Trim(DataEngine.sClass)
  7.         .txtAddress.Text = Trim(DataEngine.sAddress)
  8.         .txtNote.Text = Trim(DataEngine.sNote)
  9.         .txtTeacher.Text = Trim(DataEngine.sTeacher)
  10.         .txtPhone.Text = Trim(DataEngine.sPhone)
  11.         'If FileLen("hs.dat") = 0 Then .Frame1.Caption = "Record 0 / 0" Else .Frame1.Caption = "Record " & Str(CurrentRec) & " / " & Str(LastRec)
  12.    End With
  13. End Sub


Thủ tục lưu tin:

  1. Public Sub SaveCurrentRec()
  2.     With frmMain
  3.           DataEngine.sName = .txtName.Text
  4.           DataEngine.sClass = .txtClass.Text
  5.           DataEngine.sAddress = .txtAddress.Text
  6.           DataEngine.sNote = .txtNote.Text
  7.           DataEngine.sTeacher = .txtTeacher.Text
  8.           DataEngine.sPhone = .txtPhone.Text
  9.           'Str (CurrentRec) & " / " & Str(LastRec) = .txtInfo.Text
  10.    End With
  11.     Put #FilePort, CurrentRec, DataEngine
  12. End Sub


Thủ tục xem tin trước và mẫu tin sau

  1. Public Sub NextRec()
  2.     If CurrentRec = LastRec Then
  3.         MsgBox "This is a Last rec", vbExclamation, "rec"
  4.     Else
  5.         CurrentRec = CurrentRec + 1
  6.         ShowCurrentRec
  7.     End If
  8. End Sub
  9.  
  10. Public Sub PrevRec()
  11.     If CurrentRec = 1 Then
  12.         MsgBox "This is a First rec", vbExclamation, "rec"
  13.     Else
  14.         CurrentRec = CurrentRec - 1
  15.         ShowCurrentRec
  16.     End If
  17. End Sub


Các thủ tục hỗ trợ xóa tin
  1. Private Sub RemoveRec()
  2.         Dim NewFilePort As Integer
  3.         Dim FindRec As Long, CurRec As Long
  4.         Dim tmpDataEngine As DataRec
  5.         NewFilePort = FreeFile
  6.        
  7.         If Dir("hs.tmp") <> "" Then Kill "hs.tmp"
  8.         Open "hs.tmp" For Random As NewFilePort Len = RecordSize
  9.         FindRec = 1
  10.         CurRec = 1
  11.         Do While CurRec <= LastRec
  12.             If CurRec <> CurrentRec Then
  13.                 Get #FilePort, CurRec, tmpDataEngine
  14.                 Put #NewFilePort, FindRec, tmpDataEngine
  15.                 FindRec = FindRec + 1
  16.             End If
  17.             CurRec = CurRec + 1
  18.         Loop
  19.         Close FilePort
  20.         Close NewFilePort
  21.         Kill "hs.dat"
  22.         Name "hs.tmp" As "hs.dat"
  23.         FilePort = FreeFile
  24.         StartEngine
  25.         LastRec = LastRec - 1
  26.         If LastRec = 0 Then LastRec = 1
  27.         CurrentRec = LastRec
  28.         ShowCurrentRec
  29. End Sub
  30. Public Sub RemoveRecord(Optional ByVal bHidden As Boolean = False)
  31.     If bHidden = False Then
  32.         If MsgBox("Are you sure you want to remove this record ?", vbExclamation + vbYesNo, "Rec") = vbYes Then
  33.             Call RemoveRec
  34.         End If
  35.     Else
  36.         Call RemoveRec
  37.     End If
  38. End Sub


Thủ tục tìm một mẫu tin theo tên hs:
  1. Public Sub FindName(ByVal sName As String)
  2.     sName = LCase(Trim(sName))
  3.     Dim b As Boolean
  4.     Dim FindRec As Long
  5.     Dim tmpDat As DataRec
  6.    
  7.     b = False
  8.     FindRec = 1
  9.     Do While FindRec <= LastRec
  10.         Get #FilePort, FindRec, tmpDat
  11.         If sName = LCase(Trim(tmpDat.sName)) Then
  12.             b = True
  13.             Exit Do
  14.         End If
  15.         FindRec = FindRec + 1
  16.     Loop
  17.    
  18.     If b Then
  19.         CurrentRec = FindRec
  20.         ShowCurrentRec
  21.         Unload frmFind
  22.     Else
  23.         MsgBox "Not found !", vbInformation, "Rec"
  24.         Unload frmFind
  25.     End If
  26. End Sub


Thủ tục kết thúc phiên làm việc
  1. Public Sub StopEngine()
  2.     Close FilePort
  3.     End
  4. End Sub


OK - thế là xong phần module, vì không có thời gian nên mình không thể giải thích từng dòng code, nhưng nó cũng đơn giản thôi,
Vào frmMain, với các code xử lý dữ liệu:


  1. Private bNew As Boolean
  2.  
  3. Private Sub cmdDel_Click()
  4.     If FileLen("hs.dat") = 0 Then MsgBox "There are no any records", vbCritical, "rec" Exit Sub
  5.     Call RemoveRecord
  6. End Sub
  7.  
  8. Private Sub cmdEdit_Click()
  9.     If FileLen("hs.dat") = 0 Then
  10.         MsgBox "There are no any records", vbCritical
  11.         Exit Sub
  12.     End If
  13.     Call LockTextBox(False)
  14.     frmeNav.Enabled = False
  15.     cmdNew.Enabled = False
  16.     cmdFind.Enabled = False
  17.     cmdDel.Enabled = False
  18.     cmdSave.Enabled = True
  19.     cmdEdit.Enabled = False
  20.    
  21. End Sub
  22.  
  23. Private Sub cmdExit_Click()
  24.     End
  25. End Sub
  26.  
  27. Private Sub LockTextBox(ByVal b As Boolean)
  28.     Dim ctrls As Control
  29.     For Each ctrls In Me.Controls
  30.         If Left(ctrls.Name, 3) = "txt" Then ctrls.Locked = b
  31.     Next
  32. End Sub
  33.  
  34. Private Sub cmdFind_Click()
  35.     frmFind.Show 1
  36. End Sub
  37.  
  38. Private Sub cmdFirst_Click()
  39.     If FileLen("hs.dat") = 0 Then MsgBox "There are no any records", vbCritical Exit Sub
  40.     CurrentRec = 1
  41.     Call ShowCurrentRec
  42. End Sub
  43.  
  44. Private Sub cmdLast_Click()
  45.     If FileLen("hs.dat") = 0 Then MsgBox "There are no any records", vbCritical Exit Sub
  46.     CurrentRec = LastRec
  47.     Call ShowCurrentRec
  48. End Sub
  49.  
  50. Private Sub cmdNew_Click()
  51.     bNew = True
  52.     LockTextBox False
  53.     frmeNav.Enabled = False
  54.     cmdNew.Enabled = False
  55.     cmdFind.Enabled = False
  56.     cmdDel.Enabled = False
  57.     cmdSave.Enabled = True
  58.     cmdEdit.Enabled = False
  59.     If FileLen("hs.dat") = 0 Then
  60.         SaveCurrentRec
  61.         With DataEngine
  62.             .sName = ""
  63.             .sAddress = ""
  64.             .sNote = ""
  65.             .sPhone = ""
  66.             .sClass = ""
  67.         End With
  68.     Else
  69.         SaveCurrentRec
  70.         LastRec = LastRec + 1
  71.         With DataEngine
  72.             .sName = ""
  73.             .sAddress = ""
  74.             .sNote = ""
  75.             .sTeacher = ""
  76.             .sPhone = ""
  77.             .sClass = ""
  78.         End With
  79.     End If
  80.         Put #FilePort, LastRec, DataEngine
  81.         CurrentRec = LastRec
  82.         Call ShowCurrentRec
  83.        
  84. End Sub
  85.  
  86. Private Sub cmdNext_Click()
  87.     If FileLen("hs.dat") = 0 Then MsgBox "There are no any records", vbCritical Exit Sub
  88.     Call NextRec
  89. End Sub
  90.  
  91. Private Sub cmdPrev_Click()
  92.     If FileLen("hs.dat") = 0 Then MsgBox "There are no any records", vbCritical Exit Sub
  93.     Call PrevRec
  94. End Sub
  95.  
  96. Private Sub cmdSave_Click()
  97.     If Trim(txtName.Text) = "" And Trim(txtClass.Text) = "" And _
  98.     Trim(txtTeacher.Text) = "" And Trim(txtNote.Text) = "" And Trim(txtPhone.Text) = "" Then
  99.         MsgBox "No information inputed", vbCritical, "rec"
  100.         Call RemoveRecord(True)
  101.     Else
  102.         Call SaveCurrentRec
  103.         Call ShowCurrentRec
  104.     End If
  105.    
  106.     cmdEdit.Enabled = True
  107.     frmeNav.Enabled = True
  108.     cmdNew.Enabled = True
  109.     cmdFind.Enabled = True
  110.     cmdDel.Enabled = True
  111.     cmdSave.Enabled = False
  112.     Call LockTextBox(True)
  113. End Sub
  114.  
  115. Private Sub Form_Load()
  116.     Call StartEngine
  117.     Call ShowCurrentRec
  118. End Sub
  119.  
  120. Private Sub Form_Terminate()
  121.     Call StopEngine
  122. End Sub


Tiếp theo tạo một frmFind, để tìm kiếm tên:
___.PNG
___.PNG (5.01 KiB) Đã xem 4475 lần
code của frmFind
  1. Private Sub cmdFind_Click()
  2.     FindName txtName.Text
  3. End Sub


OK - -đây là project mẫu:

Re: Tạo cơ sở dữ liệu cho chương trình quản lý đơn giản

Đã gửi: Thứ 4 19/10/2011 9:07 pm
by HungNQ
Bài viết rất hay, mình đang muốn làm 1 ý tưởng như bạn ấp ủ lâu rồi, hi. tại mới họch vb mà:)

Re: Tạo cơ sở dữ liệu cho chương trình quản lý đơn giản

Đã gửi: Chủ nhật 22/04/2012 3:52 pm
by hoainampro90
tác giả có thể tạo 1 cơ sở dữ liệu sau đó xuất ra access giúp em được không,em mới tìm hiểu về vb nên lơ mơ quá

Re: Tạo cơ sở dữ liệu cho chương trình quản lý đơn giản

Đã gửi: Thứ 2 23/04/2012 5:45 am
by VuVanHoanh
xài cấu trúc như INI file để làm CSDL cũng đc mà :|