L
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.
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.