Chương trình được thực hiện bằng ngôn ngữ Visual Basic 6.0.
Bài 1: Tính giá điện
Private Sub Command1_Click() frmSinhHoat.Show
End Sub
Private Sub Command2_Click() frmSanXuat.Show
End Sub
Private Sub Command5_Click() Unload frmMain
End Sub
Option Explicit
'Define Variables here
Dim cnAP As ADODB.Connection 'Connection to ADODB Dim rsDienSH As ADODB.Recordset 'Holds records
Dim mDuplicate As Boolean 'Variable to indicate if data has to be duplicated Dim mNew As Boolean 'Variable to indicate if it's a new record
Dim mDirty As Boolean 'Variable to indicate if data is dirty or not
Dim mMove As Boolean 'To Find out if Data Changed or Traversed Recordset Dim mBkMark As Variant 'Variable to Store BookMark
Dim bBookMarkable As Boolean 'Variable to indicate whether the recordset is bookmarkable or not
Public Sub DimControls(cString As String)
'Procedure to Enable or Disable The Control Buttons (Add,Delete,Duplicate,Save,Abandon...
Dim i As Integer Dim jcStr() As String jcStr = Split(cString, ",")
For i = LBound(jcStr) To UBound(jcStr) cmdControl(i).Enabled = Val(jcStr(i)) Next
End Sub
Private Sub cmdControl_Click(Index As Integer)
'This module controls the click event of four command buttons 'Add, Delete, Duplicate & Save
If bBookMarkable And rsDienSH.RecordCount > 0 Then mBkMark = rsDienSH.Bookmark
End If
Dim strSQL As String Select Case Index
Case 0 'Add New Record
'New Record, Just Blank the Text boxes and set the focus on the first text box
ClearControls mNew = True
DimControls "0,0,0,1,1" DimNav "0,0,0,0"
Case 1 'Delete Current Record
'Delete! Just Confirm this so that you don't accidentally delete info If rsDienSH.RecordCount > 0 Then
If (MsgBox("Are You Sure You Want To Delete this record : " &
rsDienSH!MaKH & "," & rsDienSH!TenKH & "," & rsDienSH!LoaiSD, vbYesNo, "Dien Sinh Hoat") = vbYes) Then
With rsDienSH .Delete .Requery If EmptyDB(rsDienSH) Then Call ClearControls mDirty = False End If LoadControls Call cmdNavigate_Click(2) End With End If End If
Case 2 'Duplicate Record
'Duplicate, Don't Clear the text boxes. 'Wait for user to click SAVE.
mDuplicate = True DimControls "0,0,0,1,1" DimNav "0,0,0,0"
'Save.
If mDuplicate Or mNew Then
'Record is either new or duplicated. 'So Insert it as a new record to the table strSQL = "INSERT INTO DienSH
(MaKH,TenKH,LoaiSD,SoKwhT1,SoKwhT2,SoKwhT3,SoKwhT4,SoKwhT5,SoKwhT6, SoKwhT7,SoKwhT8,SoKwhT9,SoKwhT10,SoKwhT11,SoKwhT12) VALUES ( '" & txtMaKH.Text & " ','" & txtTenKH.Text & " ','" & txtLoaiSD.Text & "','" & Text1.Text & "','" & Text2.Text & "','" & Text3.Text & "','" & Text4.Text & "','" & Text5.Text & "','" & Text6.Text & "','" & Text7.Text & "','" & Text8.Text & "','" & Text9.Text & "','" & Text10.Text & "','" & Text11.Text & "','" & Text12.Text & "');"
Else
'Record is edited
'Update the existing record 'Check for empty database If EmptyDB(rsDienSH) Then LoadControls
Exit Sub End If
strSQL = "UPDATE DienSH SET MaKH = '" & txtMaKH.Text & "',TenKH = '" & txtTenKH.Text & "', LoaiSD = '" & txtLoaiSD.Text & "', SoKwhT1 = '" & Text1.Text & "', SoKwhT2 = '" & Text2.Text & "', SoKwhT3 = '" & Text3.Text & "', SoKwhT4 = '" & Text4.Text & "', SoKwhT5 = '" & Text5.Text & "', SoKwhT6 = '" & Text6.Text & "', SoKwhT7 = '" & Text7.Text & "', SoKwhT8 = '" & Text8.Text & "', SoKwhT9 = '" & Text9.Text & "', SoKwhT10 = '" & Text10.Text & "', SoKwhT11 = '" & Text11.Text & "', SoKwhT12 = '" & Text12.Text & "'" _
& "WHERE DienSH.MaKH = " & rsDienSH!MaKH & " AND DienSH.TenKH = " & rsDienSH!TenKH & " AND DienSH.LoaiSD = " & rsDienSH!LoaiSD & " &; "
End If cnAP.Execute strSQL rsDienSH.Requery mDuplicate = False mNew = False mDirty = False DimControls "1,1,1,0,0" DimNavX '
Me.Caption = "DienSH Tester (" & rsDienSH.AbsolutePosition & " of " & rsDienSH.RecordCount & ")"
Case 4 'Abandon
rsDienSH.Bookmark = mBkMark End If LoadControls mDuplicate = False mNew = False mDirty = False End Select mBkMark = -1 End Sub
Private Sub ClearControls()
'This procedure clears the text boxes so that the user can type in new info 'Called when the user click Add
txtMaKH.Text = vbNullString txtTenKH.Text = vbNullString txtLoaiSD.Text = vbNullString Text1.Text = vbNullString Text2.Text = vbNullString ……….
„tương tự cho các Text: 3, 4, 5, 6, 7, 8, 9,10, 11 và 12
End Sub
Private Sub cmdNavigate_Click(Index As Integer) 'This is the navigational routine
'When user clicks First, Previous, Next or Last buttons 'the record pointer is moved accordingly
'Navigational buttons are dimmed 'and data is displayed on the form With rsDienSH If EmptyDB(rsDienSH) Then DimNavX Exit Sub End If
Select Case Index Case 0 .MoveFirst Case 1 'Previous .MovePrevious If .BOF Then .MoveFirst End If
Case 2 'Next .MoveNext If .EOF Then .MoveLast End If Case 3 'Last .MoveLast End Select
'Me.Caption = "DienSH Tester (" & .AbsolutePosition & " of " & .RecordCount & ")" End With
mMove = True LoadControls End Sub
Public Sub DimNav(cString As String)
'Routine to disable / enable the navigational buttons 'Same as dimcontrol
'Both can be combined as a single routine,
'taking cString and the control name as arguments.
Dim jcStr() As String Dim i As Integer
jcStr = Split(cString, ",")
For i = LBound(jcStr) To UBound(jcStr) cmdNavigate(i).Enabled = Val(jcStr(i)) Next
End Sub
Private Sub Command1_Click() Call ClearControls
End Sub
Private Sub Command2_Click() 'Thang 1
If Text1.Text = "" Then
MsgBox "Hay nhap so dien cho thang 1" Exit Sub
End If
If Not IsNumeric(Text1.Text) Then
MsgBox "So dien cua thang 1 phai la so" Exit Sub
If Val(Text1.Text) < 0 Then
MsgBox "So dien thang 1 phai duong " Exit Sub End If ………. „tương tự cho các tháng 2, 3, 4, 5, 6, 7, 8, 9,10, 11 và 12 dlgConfirmSH.Show End Sub
Private Sub Command3_Click() Unload frmSinhHoat
End Sub
Private Sub Form_Load()
Set cnAP = New ADODB.Connection 'Creates a new connection object
Set rsDienSH = New ADODB.Recordset 'Creates a new Recordset object
rsDienSH.CursorLocation = adUseClient
cnAP.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=" & App.Path & "\mydb.mdb;" & _
"Uid=admin;" & _ "Pwd="
'opens mydb.mdb which is located in the application path. cnAP.CursorLocation = adUseClient
rsDienSH.Open "SELECT * FROM DienSH;", cnAP, adOpenDynamic, adLockPessimistic
'Opens the record set.
LoadControls
'Call the procedure to read data from recordset and display it in text boxes
Me.Caption = "DienSH Tester (" & rsDienSH.AbsolutePosition & " of " & rsDienSH.RecordCount & ")"
bBookMarkable = IIf(rsDienSH.Supports(adBookmark), True, False) 'All recordsets does not support bookmarking, so make sure that
'our recordset supports it, and if it does, then set bBookMarkable to True
'We are using iif function here aswell (this has nothing to do with ADO though!) 'iif is a short form of the if..else..endif block
'the above statement can be written also as ' If rsDienSH.Supports(adBookmark) Then ' bBookMarkable = True ' Else ' bBookMarkable = False ' End If End Sub
Private Sub LoadControls() With rsDienSH If .RecordCount <= 1 Then DimNavX '"0,0,0,0" End If If EmptyDB(rsDienSH) Then DimControls "1,0,0,0,0" Exit Sub End If If .BOF Then .MoveFirst End If If .EOF Then .MoveLast End If
'This is the place where we read the information from recordset ' 'and store it to the variables.
txtMaKH.Text = !MaKH & ""
txtTenKH.Text = !TenKH & "" 'This assignment will err out if we ' try to assign a null value to the textbox 'So an empty string is appended to it txtLoaiSD.Text = !LoaiSD & ""
Text1.Text = !SoKwhT1 & "" Text2.Text = !SoKwhT2 & "" ………..
„tương tự cho các tháng 3, 4, 5, 6, 7, 8, 9,10, 11 và 12 End With
'The information is just displayed on the form and hence nothing is changed, 'so We don't require Save & Abandon - disable it.
DimNavX
DimControls "1,1,1,0,0"
'We check this variable when we unload the form to determine whether 'any changes were made to the data.
mDirty = False
Me.Caption = "DienSH tester (" & rsDienSH.AbsolutePosition & " of " & rsDienSH.RecordCount & ")"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim jAnswer As Long
If mDirty Then
'This is where we check if the form is dirty (any data is changed). 'If so, give the user a chance to save changes
jAnswer = MsgBox("Do You Want To Save The Changes You Made To DienSH?", vbYesNoCancel + vbExclamation, "DienSH Tester")
Select Case jAnswer Case vbYes
Call cmdControl_Click(3) 'User Clicked Yes
'Call the procedure to save the information Cancel = False
Case vbNo
'User clicked No
'Does not wish to save changes, So unload the form without saving Cancel = False
Case vbCancel
'User clicked cancel by mistake or changed mind to exit the app 'so cancel unloading the form
Cancel = True
End Select End If End Sub
Private Sub Form_Unload(Cancel As Integer) 'This is where we do the clean up routine 'Close all open connections
'and set all objects to Nothing
cnAP.Close
Set rsDienSH = Nothing Set cnAP = Nothing End Sub
Private Sub txtPwd_Change()
'User changed data in the textbox, change the property Dirty to True If Not mMove Then
DimControls "0,0,0,1,1" DimNav "0,0,0,0" mDirty = True End If
End Sub
Private Sub txtTenKH_Change()
'User changed data in the textbox, change the property Dirty to True If Not mMove Then
DimControls "0,0,0,1,1" DimNav "0,0,0,0" mDirty = True End If End Sub
Private Function EmptyDB(objrs As ADODB.Recordset) As Boolean If objrs.BOF And objrs.EOF Then
EmptyDB = True Else
EmptyDB = False End If
End Function
Private Sub DimNavX()
'Enhancement of DimNav Procedure 'Tested only with ClientSideCursors
Dim jPos, jCount As Long With rsDienSH
jPos = .AbsolutePosition jCount = .RecordCount End With If jCount > 0 Then If jPos = 1 Then DimNav "0,0,1,1" Else
If jPos = jCount Then DimNav "1,1,0,0" Else DimNav "1,1,1,1" End If End If If jCount = 1 Then DimNav "0,0,0,0" End If Else DimNav "0,0,0,0" End If End Sub
Private Sub txtLenght_Change()
End Sub
Private Sub txtPrice1_Click() End Sub
Option Explicit
Private Sub Form_Load()
Dim Mn1, Mn2, Mn3, Mn4, Mn5, Mn6, Mn7, Mn8, Mn9, Mn10, Mn11, Mn12 Dim Price1, Price2
Dim Mn
'tinh rieng theo tung thang
'/////////////////////////////////////////////////////////////////////////////////// 'Thang 1
Mn1 = Val(frmSinhHoat.Text1) * 0.55 End If If 100 < Val(frmSinhHoat.Text1) <= 150 Then Mn1 = Val(frmSinhHoat.Text1) * 1.11 End If If 150 < Val(frmSinhHoat.Text1) <= 200 Then Mn1 = Val(frmSinhHoat.Text1) * 1.47 End If If 200 < Val(frmSinhHoat.Text1) <= 300 Then Mn1 = Val(frmSinhHoat.Text1) * 1.6 End If If 300 < Val(frmSinhHoat.Text1) <= 400 Then Mn1 = Val(frmSinhHoat.Text1) * 1.72 End If If Val(frmSinhHoat.Text1) > 400 Then Mn1 = Val(frmSinhHoat.Text1) * 1.78 End If ……… „tương tự cho các tháng 3, 4, 5, 6, 7, 8, 9,10, 11 và 12 Price1 = Mn1 + Mn2 + Mn3 + Mn4 + Mn5 + Mn6 + Mn7 + Mn8 + Mn9 + Mn10 + Mn11 + Mn12 '/////////////////////////////////////////////////////////////////////////////////// 'Tinh gop 12 '///////////////////////////////////////////////////////////////////////////////////
Mn = Val(frmSinhHoat.Text1) + Val(frmSinhHoat.Text2) + Val(frmSinhHoat.Text3) + Val(frmSinhHoat.Text4) + Val(frmSinhHoat.Text5) + Val(frmSinhHoat.Text6) + _ Val(frmSinhHoat.Text7) + Val(frmSinhHoat.Text8) + Val(frmSinhHoat.Text9) + Val(frmSinhHoat.Text10) + Val(frmSinhHoat.Text11) + Val(frmSinhHoat.Text12)
If Mn <= 100 Then Price2 = Mn * 0.55 End If If 100 < Mn <= 150 Then Price2 = Mn * 1.11 End If If 150 < Mn <= 200 Then Price2 = Mn * 1.47 End If If 200 < Mn <= 300 Then
Price2 = Mn * 1.6 End If If 300 < Mn <= 400 Then Price2 = Mn * 1.72 End If If Mn > 400 Then Price2 = Mn * 1.78 End If '/////////////////////////////////////////////////////////////////////////////////// Label3.Caption = Price1 Label5.Caption = Price2 End Sub
Private Sub OKButton_Click() Unload dlgConfirmSH End Sub
Bài 2: Tính giá đất
Option Explicit
'Define Variables here
Dim cnAP As ADODB.Connection 'Connection to ADODB Dim rsLandPrice As ADODB.Recordset 'Holds records
Dim mDuplicate As Boolean 'Variable to indicate if data has to be duplicated Dim mNew As Boolean 'Variable to indicate if it's a new record
Dim mDirty As Boolean 'Variable to indicate if data is dirty or not
Dim mMove As Boolean 'To Find out if Data Changed or Traversed Recordset Dim mBkMark As Variant 'Variable to Store BookMark
Dim bBookMarkable As Boolean 'Variable to indicate whether the recordset is bookmarkable or not
Public Sub DimControls(cString As String)
'Procedure to Enable or Disable The Control Buttons (Add,Delete,Duplicate,Save,Abandon...
Dim i As Integer Dim jcStr() As String jcStr = Split(cString, ",")
For i = LBound(jcStr) To UBound(jcStr) cmdControl(i).Enabled = Val(jcStr(i)) Next
End Sub
Private Sub cmdControl_Click(Index As Integer)
'This module controls the click event of four command buttons 'Add, Delete, Duplicate & Save
If bBookMarkable And rsLandPrice.RecordCount > 0 Then mBkMark = rsLandPrice.Bookmark
End If
Dim strSQL As String Select Case Index
Case 0 'Add New Record
'New Record, Just Blank the Text boxes and set the focus on the first text box
ClearControls mNew = True
DimControls "0,0,0,1,1" DimNav "0,0,0,0"
Case 1 'Delete Current Record
If rsLandPrice.RecordCount > 0 Then
If (MsgBox("Are You Sure You Want To Delete this record : " & rsLandPrice!LandNumber & "," & rsLandPrice!Length & "," & rsLandPrice!Width & "," & rsLandPrice!Price1 & "," & rsLandPrice!Price2, _
vbYesNo, "Land Price") = vbYes) Then With rsLandPrice .Delete .Requery If EmptyDB(rsLandPrice) Then Call ClearControls mDirty = False End If LoadControls Call cmdNavigate_Click(2) End With End If End If
Case 2 'Duplicate Record
'Duplicate, Don't Clear the text boxes. 'Wait for user to click SAVE.
mDuplicate = True DimControls "0,0,0,1,1" DimNav "0,0,0,0" Case 3 'Save 'Save.
If mDuplicate Or mNew Then
'Record is either new or duplicated. 'So Insert it as a new record to the table
strSQL = "INSERT INTO LandPrice (LandNumber,Length,Width,Price1,Price2) VALUES ( '" & txtLandNumber.Text & " ','" & txtLength.Text & "','" & txtWidth.Text & "','" & Price1.Text & "','" & Price2.Text & "');"
Else
'Record is edited
'Update the existing record 'Check for empty database If EmptyDB(rsLandPrice) Then LoadControls
Exit Sub End If
strSQL = "UPDATE LandPrice SET LandNuber = '" & txtLandNumber.Text & "', Length = '" & txtLength.Text & "', Width = '" & txtWidth.Text & "', Price1 = '" & Price1.Text & "', Price2 = '" & Price2.Text & "'" _
& "WHERE LandPrice.ID = " & rsLandPrice!id & ";" End If cnAP.Execute strSQL rsLandPrice.Requery mDuplicate = False mNew = False mDirty = False DimControls "1,1,1,0,0" DimNavX '
Me.Caption = "LandPrice Tester (" & rsLandPrice.AbsolutePosition & " of " & rsLandPrice.RecordCount & ")"
Case 4 'Abandon
If bBookMarkable And rsLandPrice.RecordCount > 0 Then rsLandPrice.Bookmark = mBkMark End If LoadControls mDuplicate = False mNew = False mDirty = False End Select mBkMark = -1 End Sub
PHỤ LỤC 2: MÔ TẢ DỮ LIỆU
Cơ sở dữ liệu gốc: DB
Bài 1. Tính giá điện
Loại Sinh hoạt
Field Name Data Type
MaKH Text TenKH Text LoaiSD Text SoKwhT1 Number SoKwhT2 Number SoKwhT3 Number SoKwhT4 Number SoKwhT5 Number SoKwhT6 Number SoKwhT7 Number vSoKwhT8 Number SoKwhT9 Number SoKwhT10 Number SoKwhT11 Number SoKwhT12 Number
Loại sản xuất:
Field Name Data Type
MaKH Text TenKH Text LoaiSD Text CapDA Number SoKwhT1_BT Number SoKwhT1_TD Number SoKwhT1_CD Number SoKwhT2_BT Number SoKwhT2_TD Number SoKwhT2_CD Number SoKwhT3_BT Number SoKwhT3_TD Number SoKwhT3_CD Number SoKwhT4_BT Number SoKwhT4_TD Number SoKwhT4_CD Number SoKwhT5_BT Number SoKwhT5_TD Number SoKwhT5_CD Number SoKwhT6_BT Number SoKwhT6_TD Number SoKwhT6_CD Number SoKwhT7_BT Number SoKwhT7_TD Number SoKwhT7_CD Number SoKwhT8_BT Number SoKwhT8_TD Number SoKwhT8_CD Number SoKwhT9_BT Number SoKwhT9_TD Number SoKwhT9_CD Number
Bài 2: Tính giá đất SoKwhT10_BT Number SoKwhT10_TD Number SoKwhT10_CD Number SoKwhT11_BT Number SoKwhT11_TD Number SoKwhT11_CD Number SoKwhT12_BT Number SoKwhT12_TD Number SoKwhT12_CD Number
Field Name Data Type
LendNumber Number
Width Number
Length Number
Price1 Number
PDF Merger
Thank you for evaluating AnyBizSoft PDF Merger! To remove this page, please
register your program!
Go to Purchase Now>>
Merge multiple PDF files into one
Select page range of PDF to merge
Select specific page(s) to merge
Extract page(s) from different PDF