Module VB với các ứng dụng dữ liệu cơ bản

  • Thread starter luongvanluyen
  • Ngày gửi
L

luongvanluyen

Guest
2/9/05
27
0
0
HCM CITY
Chào các bạn,
Tôi xin đưa lên một vài đọan mã mà các bạn thường sử dụng khi làm việc với cơ sở dữ liệu trong Visual basic (đọan mã tôi sưu tầm được, không nhớ tên tác giả). Tôi nghĩ rằng khi đọc đọan mã này các bạn có thể tìm thấy một vài điều gì đó...hay hay...
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public cnn As New ADODB.Connection
Public nmthg As String
Public username As String
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal _
hwndinsertafter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wflagsv As Long) As Long
Public Sub Dchuyen(frm As Form, rst As ADODB.Recordset, Index As Integer)
If Not Capnhat(frm, rst) Then Exit Sub
With rst
Select Case Index
Case 0
.MoveFirst
Case 1
.MovePrevious
If .BOF Then .MoveFirst
Case 2
.MoveNext
If .EOF Then .MoveLast
Case 3
.MoveLast
End Select
End With
End Sub
Public Sub CheDC(frm As Form, rst As ADODB.Recordset)
Dim i%
For i = 0 To 3
frm.Cmddc(i).Enabled = False
Next
If rst.BOF Or rst.EOF Then Exit Sub
If rst.EditMode = adEditAdd Then Exit Sub
With frm.Cmddc
.Item(0).Enabled = rst.AbsolutePosition <> 1
.Item(1).Enabled = .Item(0).Enabled
.Item(2).Enabled = rst.AbsolutePosition <> rst.RecordCount
.Item(3).Enabled = .Item(2).Enabled
End With
End Sub
Public Sub Chnang(frm As Form, rst As ADODB.Recordset, Index As Integer)
On Error GoTo loi
Dim bmk
If (Index = 0 And rst.EditMode <> adEditAdd) Or Index > 3 Then
If Not Capnhat(frm, rst) Then Exit Sub
End If
Select Case Index
Case 0
If rst.EditMode = adEditNone Then
rst.AddNew
End If
Case 1
Dim ctrl As Control, biloi As Boolean
Set ctrl = XdinhCtrl(frm, rst, biloi)
If biloi Then
Dim vung() As String, i%
vung = frm.Napvung()
For i = 0 To UBound(vung)
If LCase(ctrl.DataField) = LCase(vung(i, 1)) Then Exit For
Next
Thongbao vung(i, 0) & " bт nhaдp lieдu sai kieеu", 16, "Xin chu y"
ctrl.SetFocus
Exit Sub
End If
rst.Update
Case 2
If rst.EditMode = adEditAdd Then
KTKieu frm, rst
Else
Phuchoi frm, rst
End If
rst.CancelUpdate
rst.Move 0
Case 3
If Thongbao("Maгu tin hieдn haшnh seх bт huыy. Baпn coщ сoаng yщ ?", 32 + 4, "Xin chu y") = 6 Then
If rst.EditMode = adEditAdd Then
KTKieu frm, rst
rst.CancelUpdate
Exit Sub
End If
bmk = rst.Bookmark
rst.Delete
rst.MoveNext
If rst.EOF Then rst.MoveLast
End If
Case 4
Set FrmTimN.rstim = rst
Set FrmTimN.mh = frm
FrmTimN.Show 0, MDIQLNS
Case 5
If FrmTimN.tenmh = frm.Name Then Unload FrmTimN
Unload frm
End Select
If Index <> 5 Then CheDC frm, rst
Exit Sub
loi:
Dim tloi As String
tloi = frm.Baoloi()
If Index = 3 Then
rst.CancelBatch
rst.Bookmark = bmk
End If
Thongbao tloi, 16, "Xin chu y"
If Index = 3 Then CheDC frm, rst
End Sub

Public Function Thongbao(tbao As String, Optional bonut As Integer, Optional tde As String) As Byte
Dim nut As Byte, img As Byte, mdinh As Integer
Dim dai As Long, i%
nut = bonut Mod 16
With F_tbao
.Caption = IIf(IsMissing(tde) Or tde = "", F_tbao.Caption, tde)
.tb = tbao
dai = Len(.tb) \ 25 + 1
dai = dai * 250
.Height = .Height + dai - .tb.Height
.tb.Height = dai
For i = 1 To 3
.nut(i).Top = .tb.Top + .tb.Height + 200
Next
Select Case nut
Case 0
.nut(1).Caption = "&Tieбp"
.nut(1).Visible = True
.nut(1).Left = .Width / 2 - .nut(1).Width / 2
Case 1
.nut(1).Caption = "&Tieбp"
.nut(1).Visible = True
.nut(1).Left = .Width / 3 - .nut(1).Width / 2
.nut(3).Visible = True
.nut(3).Left = .nut(1).Left + .Width / 3
Case 2
.nut(1).Caption = "&Boы"
.nut(2).Caption = "&Thцы laпi"
.nut(3).Caption = "&Cho qua"
.nut(1).Visible = True
.nut(2).Visible = True
.nut(3).Visible = True
Case 3
.nut(1).Visible = True
.nut(2).Visible = True
.nut(3).Visible = True
Case 4
.nut(1).Visible = True
.nut(2).Visible = True
.nut(1).Left = .Width / 3 - .nut(1).Width / 2
.nut(2).Left = .nut(1).Left + .Width / 3
Case 5
.nut(2).Caption = "&Thцы laпi"
.nut(2).Visible = True
.nut(3).Visible = True
.nut(2).Left = .Width / 3 - .nut(2).Width / 2
.nut(3).Left = .nut(2).Left + .Width / 3
End Select
img = (bonut - nut) Mod 256
Select Case img
Case 16
.hinh.Picture = LoadPicture(App.Path & "\graphics\w95mbx01.ico")
Case 32
.hinh.Picture = LoadPicture(App.Path & "\graphics\w95mbx02.ico")
Case 48
.hinh.Picture = LoadPicture(App.Path & "\graphics\w95mbx03.ico")
Case 64
.hinh.Picture = LoadPicture(App.Path & "\graphics\w95mbx04.ico")
End Select
.Show 1
Thongbao = .dap
End With
End Function

Public Sub KTKieu(frm As Form, rst As ADODB.Recordset)
Dim i%
For i = 0 To rst.Fields.Count - 1
Select Case rst(i).Type
Case adDate
rst(i) = Date
Case adBigInt, adCurrency, adDecimal, adDouble, adInteger, adNumeric, adSingle, adSmallInt, adTinyInt, adVarNumeric
rst(i) = 0
End Select
Next
End Sub

Public Sub LinkCtrl(frm As Form, rst As ADODB.Recordset)
Dim ctrl As Control
For Each ctrl In frm.Controls
If TypeOf ctrl Is CheckBox Or TypeOf ctrl Is TextBox Or TypeOf ctrl Is DataCombo Then
Set ctrl.DataSource = rst
ctrl.DataField = IIf(Mid(ctrl.Name, 4) <> "", Mid(ctrl.Name, 4), "")
If TypeOf ctrl Is TextBox Then
Select Case rst(ctrl.DataField).Type
Case adChar, adWChar, adVarChar, adVarWChar, adLongVarChar, adLongVarWChar
ctrl.MaxLength = IIf(rst(ctrl.DataField).DefinedSize <= 255, rst(ctrl.DataField).DefinedSize, 0)
End Select
End If
End If
Next
End Sub

Public Function Capnhat(frm As Form, rst As ADODB.Recordset) As Boolean
Capnhat = True
If Thaydoi(frm, rst) Then
If Thongbao("Maгu tin сaх thay сoеi. Coщ lцu caщc thay сoеi naшy laпi khoвng ?", 32 + 4, "Xin cho biet") = 6 Then
Chnang frm, rst, 1
Else
Chnang frm, rst, 2
End If
Capnhat = Not Thaydoi(frm, rst)
End If
End Function

Public Function XdinhCtrl(frm As Form, rst As ADODB.Recordset, Optional loi As Boolean) As Control
Dim ctrl As Control
For Each ctrl In frm.Controls
If TypeOf ctrl Is TextBox Then
If ctrl.DataField <> "" Then
Select Case rst(ctrl.DataField).Type
Case adDate
If Not (IsDate(ctrl) Or IsNull(rst(ctrl.DataField))) Or _
(ctrl <> "" And IsNull(rst(ctrl.DataField))) Then
loi = True
End If
Case adBigInt, adCurrency, adDecimal, adDouble, adInteger, adNumeric, adSingle, adSmallInt, adTinyInt, adVarNumeric
If Not (IsNumeric(ctrl) Or IsNull(rst(ctrl.DataField))) Or _
(ctrl <> "" And IsNull(rst(ctrl.DataField))) Then
loi = True
End If
End Select
End If
If loi Then
Set XdinhCtrl = ctrl
Exit For
End If
End If
Next
End Function

Public Sub Phuchoi(frm As Form, rst As ADODB.Recordset)
Dim ctrl As Control
For Each ctrl In frm.Controls
If TypeOf ctrl Is TextBox Then
If ctrl.DataField <> "" Then
If IsNull(rst(ctrl.DataField).OriginalValue) Then
ctrl = ""
Else
ctrl = Format(rst(ctrl.DataField).OriginalValue, ctrl.DataFormat.Format)
End If
End If
ElseIf TypeOf ctrl Is CheckBox Then
If ctrl.DataField <> "" Then ctrl = IIf(rst(ctrl.DataField).OriginalValue, 1, 0)
ElseIf TypeOf ctrl Is DataCombo Or TypeOf ctrl Is DataList Then
If ctrl.DataField <> "" Then ctrl.BoundText = rst(ctrl.DataField).OriginalValue
End If
Next
End Sub

Public Function Thaydoi(frm As Form, rst As ADODB.Recordset) As Boolean
Dim ctrl As Control, tri As String
Thaydoi = rst.EditMode <> adEditNone
If Not Thaydoi Then
For Each ctrl In frm.Controls
If TypeOf ctrl Is TextBox Then
tri = IIf(IsNull(rst(ctrl.DataField).OriginalValue), "", rst(ctrl.DataField).OriginalValue)
If ctrl.DataField <> "" Then
Dim dd As String
dd = ctrl.DataFormat.Format
Thaydoi = ctrl <> Format(tri, dd)
End If
ElseIf TypeOf ctrl Is CheckBox Then
If ctrl.DataField <> "" Then Thaydoi = ctrl <> IIf(rst(ctrl.DataField).OriginalValue, 1, 0)
ElseIf TypeOf ctrl Is DataCombo Or TypeOf ctrl Is DataList Then
If ctrl.DataField <> "" Then Thaydoi = ctrl.BoundText <> rst(ctrl.DataField).OriginalValue
End If
If Thaydoi Then Exit For
Next
If Not Thaydoi And rst.EditMode = adEditNone Then rst.Update
End If
End Function
Public Function Ctrlrong(frm As Form, rst As ADODB.Recordset) As Control
Dim ctrl As Control
For Each ctrl In frm.Controls
If TypeOf ctrl Is TextBox Or TypeOf ctrl Is DataCombo Or TypeOf ctrl Is DataList Then
If ctrl.DataField <> "" Then
Select Case rst(ctrl.DataField).Type
Case adChar, adWChar, adVarChar, adVarWChar, adLongVarChar, adLongVarWChar
If ctrl = "" Then Exit For
End Select
End If
End If
Next
Set Ctrlrong = ctrl
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Lương Văn Luyện.
 
Khóa học Quản trị dòng tiền
paulsteigel

paulsteigel

Trung cấp
13/11/05
103
0
16
48
Hoà Bình
www.sfdp.net
Bạn Luyện thân mến! Cám ơn bạn vì đã rất nhiệt tình đăng bài, tuy nhiên mình xin góp ý thế này nhé:
1. Nên đăng bài hướng chủ đề hơn - tức là bạn nên nêu ra mục đích chủ yếu của nội dung bạn định đăng vì điều này sẽ tiết kiệm được thời gian của bạn đọc, họ sẽ thấy được nội dung qua sự tóm tắt của bạn ngay mà không phải mất thời gian tự tìm tòi nữa.
2. Với các đoạn mã, có lẽ bạn nên gưỉ kèm hoặc nếu có thể thì bạn nên chú thích - ít nhất là cho các hàm hoặc thủ tục (ví dụ là để làm gì chẳng hạn), vì điều đó sẽ dễ theo dõi hơn.
Có vài ý kiến như vậy, mong bạn thông cảm.
 
L

luongvanluyen

Guest
2/9/05
27
0
0
HCM CITY
Vâng,
Các bài sau tôi sẽ chú ý hơn.
LVL
 
hai2hai

hai2hai

VNUNI Makes a difference
29/4/04
2,032
125
63
50
Hà nội
vnuni.net
Đồng ý với paulsteigel về vấn đề này. Mình cũng đang định nói như thế.

To luongvanluyen: Anh D.t à :), Code như vừa rồi em có cả mấy chục cái CD chỉ có code ko thôi. Nếu list ra thì nhiều vô kể.

Tuy nhiên, em nhìn thấy mấy đoạn code trên (ko biết của tác giả nào) mà thấy buồn quá. Hình như mọi người ko bao giờ tuân thủ coding convention 1 tẹo nào trong quá trình coding. Nhìn tên hàm, thủ tục...chẳng hiểu mục đích của nó, tên biến hầu như ko có chuẩn. Đã thế, trong code ko hề có tý comment nào. Error handling thì ... quá tệ.

Em mong anh hãy nêu ra vấn đề cần giải quyết trong 1 ứng dụng, sau đó mọi người cùng bàn về cách giải quyết vấn đề đó trong Access. Phương án cuối cùng thì mới đưa ra code để minh họa. (Vì theo em, đưa ra cách suy nghĩ để giải quyết vấn đề mới là quan trọng - quan trọng hơn là những dòng code cụ thể)

Cheers!
 
Đào Việt Cường

Đào Việt Cường

Moderator
22/11/05
400
4
18
Khánh Hòa
Có chủ để - Tóm tắt -Dễ hiểu - Dễ thấy!

Dear LuongVanLuyen,
Cùng toàn thể các mem quan tâm đến "Module VB và các ứng dụng cơ sở dữ liệu cơ bản"
--------------------
Trước hết cũng như các bác mem, xin cám ơn bác luongvanluyen đã cung cấp cho Access và Kế toán những đoạn chương trình hữu ích. Không thể phủ nhận, đối với các bạn lập trình ứng dụng Access, việc tham khảo các đoạn mã chương trình là rất bổ ích - nhất là lập trình cơ sở dữ liệu nâng cao!
Nhưng hầu hết các Acc&Acc mem - và bản thân em - cũng không tán thành cách tiếp cận không có trọng tâm (thấy hay mà thích) như thế vì suy cho cùng, Access hay "vi bi" cũng chỉ là công cụ của kế toán mà thôi! Mọi người gặp nhau, cùng trao đổi trên diễn đàn này là để được giải toả những khó khăn trong nghề kế toán của mình. Va chạm đến lĩnh vực nào thì nêu những khúc mắc đó ra để được giải quyết. Tất nhiên được sự góp ý và nhận xét của các chuyên gia quản trị hệ thống, quản trị cơ sở dữ liệu thì thật là quý báu!
Xung quanh những vấn đề của bác đưa ra và thảo luận của các thành viên, xin được phép nhận xét và có ý kiến như sau:
I. Mã chương trình của bác luongvanluyen là một hệ các hàm và thủ tục được sử dụng phổ biến trong lập trình ứng dụng cơ sở dữ liệu. Nói là "hệ" nghĩa là chúng có quan hệ với nhau, bổ trợ cho nhau trong module chương trình - nếu thiếu hàm này, thủ tục kia thì không thực hiện được. Tôi xin tóm tắt giúp bác LuongVanLuyen - theo cách hiểu của tôi như sau:
1. Sub Dchuyen(Form, ADODB.Recordset, Index): Xử lý & điều khiển Cursor trong recordset
2. Sub CheDC(Form, rst As ADODB.Recordset): Xử lý nút điều khiển cursor
3. Sub Chnang(Form,ADODB.Recordset, Index ): Xử lý nút chức năng (Update, Addnew, Edit)
4. Function Thongbao(tbao, bonut, tde): Message Box "tự chế"
5. Sub KTKieu(Form, ADODB.Recordset): Kiểm tra, xử lý kiểu dữ liệu
6. Function Capnhat(Form, ADODB.Recordset) As Boolean: Chức năng update dữ liệu vào recordset
7. Function XdinhCtrl(Form, ADODB.Recordset, loi As Boolean) As Control: Validation: kiểm tra các dàng buộc và xác định điều kiển gây lỗi trước khi update
8. Sub Phuchoi(Form, ADODB.Recordset): Undo hoặc cancel quá trình update dữ liệu
9. Thaydoi(Form, ADODB.Recordset) As Boolean: Kiểm tra xử lý khi dữ liệu bị thay đổi
10. Function Ctrlrong(Form, ADODB.Recordset) As Control: Xử lý khi recordset rỗng
(...vvvvv...)
Các thủ tục/hàm này được xây dựng trên cơ sở đáp ứng các công việc cụ thể của tác giả, do đó để tận dụng lại, "người tận dụng" phải có thời gian nghiên cứu để hiểu mục tiêu và chức xử lý của chương trình. Mặc dù "thấy hay... hay..." (luongvanluyen) nhưng phải là "hay...hay..." với ai (!).
II. Qua đây, Acc&Acc cũng nảy sinh một vấn đề là cần có một thư viện tổng hợp các hàm, thủ tục, các ví dụ minh hoạ có chủ đề - giống như các box vẫn thấy trên WKT. (Chuyên mục Ebook chỉ là sách và tài liệu tham khảo) Thư viện này sẽ là nơi giúp các "Accesser" tìm kiếm nhanh nhất các công cụ nâng cao của mình. Điều đó thật là bổ ích
Xin các bác cho ý kiến!
 
Sửa lần cuối:

Xem nhiều

Webketoan Zalo OA