'======================================================================================================
'======================================================================================================
Option Explicit
'For Log ID
Public RUNNINGID As String
Private Sub butBrand_Click()
On Error GoTo ErrorHandler
Dim colData As New Collection
frmSearch.SQL_Statement = "SELECT ROW_NUMBER () OVER (ORDER BY brand_type_code) AS [NO.] , " & _
"[brand_type_code] AS [Brand Type] , " & _
"[brand_type_name] AS [Brand Name] " & _
"FROM [pos_brand_type] "
frmSearch.Top = butBrand.Top + butBrand.Height
Call clsGen.FormLoader(frmSearch, Me, vbModal, True)
Set colData = frmSearch.ReturnAllData
If colData.Count > 0 Then
txtBrandType.Text = colData("Brand Type")
End If
Exit Sub
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "butBrand"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Sub
Private Sub butCategory_Click()
On Error GoTo ErrorHandler
Dim colData As New Collection
frmSearch.SQL_Statement = "SELECT ROW_NUMBER () OVER (ORDER BY category_code) AS [NO.] , " & _
"[category_code] AS [Category Code] , " & _
"[description] AS [Description] " & _
"FROM [pos_category] "
frmSearch.Top = butCategory.Top + butCategory.Height
Call clsGen.FormLoader(frmSearch, Me, vbModal, True)
Set colData = frmSearch.ReturnAllData
If colData.Count > 0 Then
txtCategory.Text = colData("Category Code")
End If
Exit Sub
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "butCategory"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Sub
Private Sub butPic_Click()
On Error GoTo ErrorHandler
Me.cPhoto.ShowOpen
If Me.cPhoto.FileName & "" <> "" Then
Set Me.Picture1.Picture = LoadPicture(Me.cPhoto.FileName)
End If
Exit Sub
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "butPic"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Sub
Private Sub butUnit_Click()
On Error GoTo ErrorHandler
Dim colData As New Collection
frmSearch.SQL_Statement = "SELECT ROW_NUMBER () OVER (ORDER BY unit_code) AS [NO.] , " & _
"[unit_code] AS [Unit Code] , " & _
"[description] AS [Description], " & _
"[basic_unit] AS [Basic Unit] " & _
"FROM [pos_unit] "
frmSearch.Top = butUnit.Top + butUnit.Height
Call clsGen.FormLoader(frmSearch, Me, vbModal, True)
Set colData = frmSearch.ReturnAllData
If colData.Count > 0 Then
txtUnit.Text = colData("Unit Code")
End If
Exit Sub
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "butUnit"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case Is = vbKeyF12 'save
Call ButtonClick(1)
Case Is = vbKeyEscape 'close
Call ButtonClick(0)
End Select
End Sub
'========================================================================================================
'Event : Form
'========================================================================================================
Private Sub Form_Load()
Call basGeneral.setFormControls(Me)
Call basGeneral.setLabel(Me, gFormSettingFilePath)
Call MaxLength
' cnnConnection.Open ("Provider=SQLOLEDB; " & _
' "data Source=SERVER01\SQLEXPRESS;" & _
' "Initial Catalog=CPSI_POS; " & _
' "User Id=sa;Password=sa")
' rstRecordset.Open "SELECT * FROM pos_product", cnnConnection, _
' adOpenKeyset, adLockOptimistic
Select Case gFormAction
Case Is = [NEW DATA]
Call initialized
Case Is = [EDIT DATA]
txtProductCode.Enabled = False
Call showData(gParameter)
End Select
End Sub
Private Sub butAction_Click(Index As Integer)
Call ButtonClick(Index)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmProduct = Nothing
End Sub
'========================================================================================================
'Event : Input Controls
'========================================================================================================
Private Sub txtProductName_GotFocus()
Call basGeneral.SelectAllText(txtProductName)
End Sub
Private Sub txtProductCode_GotFocus()
Call basGeneral.SelectAllText(txtProductCode)
End Sub
'========================================================================================================
'Event : Check
'========================================================================================================
'========================================================================================================
'Function Name : Button Click
'Description : check what button click
'Parameter : Index As Integer
'Return : Null
'Development By : YKN
'=======================================================================================================
Private Sub ButtonClick(Optional ByVal Index As Integer)
Select Case Index
Case Is = 0 'close[Esc]
Unload Me
If gFromMenu Then
gParameter = vbNullString
Else
Call clsGen.POS_FormLoader(frmPOSManagement, False, "Product", frmMainMenu.lblProgramName)
End If
Case Is = 1 'save[F12]
Call saveConfirm
End Select
End Sub
'======================================================================================================
'======================================================================================================
Private Sub initialized(Optional ByVal Index As Integer)
txtBrandType.Text = vbNullString
txtCategory.Text = vbNullString
txtProductCode.Text = vbNullString
txtProductName.Text = vbNullString
txtUnit.Text = vbNullString
txtPicture.Text = vbNullString
'Picture1.Picture = Nothing
End Sub
'======================================================================================================
'======================================================================================================
Private Function isProductCode() As Boolean
On Error GoTo ErrorHandler
Dim strSQL As String
If txtProductCode.Text = vbNullString Then 'check blank
clsErrHd.InputError (lblProduct.Caption & " " & basMessage.blankMessage)
Exit Function
Else 'check duplicate
If gFormAction = [NEW DATA] Then
strSQL = "SELECT * FROM pos_product WHERE product_code = " & clsStr.FormatString(txtProductCode.Text)
If Not basGeneral.checkData(strSQL) Then
clsErrHd.InputError (lblProduct.Caption & " " & basMessage.duplicateMessage)
Exit Function
End If
End If
End If
isProductCode = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "isProductCode"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
Private Sub txtProductCode_Validate(Cancel As Boolean)
If gFromMenu Then
Cancel = Not isProductCode
If Cancel Then txtProductCode.SetFocus
End If
End Sub
'======================================================================================================
'======================================================================================================
Private Function isProductName() As Boolean
On Error GoTo ErrorHandler
If txtProductName.Text = vbNullString Then
clsErrHd.InputError (lblProductName.Caption & " " & basMessage.blankMessage)
Exit Function
End If
isProductName = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "isProductName"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
Private Sub txtProductName_Validate(Cancel As Boolean)
If gFromMenu Then
Cancel = Not isProductName
If Cancel Then txtProductName.SetFocus
End If
End Sub
'======================================================================================================
'======================================================================================================
Private Sub MaxLength(Optional ByVal Index As Integer)
On Error GoTo ErrorHandler
Dim adoConn As New ADODB.Connection
Dim adoRset As New ADODB.Recordset
Dim strSQL As String
strSQL = "SELECT * FROM sys_table_info WHERE table_name = 'pos_product'"
adoConn.Open gConnectionString
With adoRset
.Open strSQL, adoConn, adOpenForwardOnly, adLockReadOnly
While Not .EOF
Select Case .Fields("column_name").Value
Case Is = "product_code"
txtProductCode.MaxLength = .Fields("max_length").Value
Case Is = "product_name"
txtProductName.MaxLength = .Fields("max_length").Value
Case Is = "Picture"
txtPicture.MaxLength = .Fields("max_length").Value
End Select
.MoveNext
Wend
.Close
End With
adoConn.Close
Set adoConn = Nothing
Set adoRset = Nothing
Exit Sub
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "maxLength"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Sub
'======================================================================================================
'======================================================================================================
Private Function isBrandType() As Boolean
On Error GoTo ErrorHandler
If txtBrandType.Text = vbNullString Then
clsErrHd.InputError (lblBrandType.Caption & " " & basMessage.blankMessage)
Exit Function
End If
isBrandType = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "isBrandType"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
Private Sub txtBrandType_Validate(Cancel As Boolean)
If gFromMenu Then
Cancel = Not isBrandType
If Cancel Then txtBrandType.SetFocus
End If
End Sub
'======================================================================================================
'======================================================================================================
Private Function isCategoryCode() As Boolean
On Error GoTo ErrorHandler
If txtCategory.Text = vbNullString Then
clsErrHd.InputError (lblCategory.Caption & " " & basMessage.blankMessage)
Exit Function
End If
isCategoryCode = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "isCategoryCode"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
Private Sub txtCategory_Validate(Cancel As Boolean)
If gFromMenu Then
Cancel = Not isCategoryCode
If Cancel Then txtCategory.SetFocus
End If
End Sub
'======================================================================================================
'======================================================================================================
Private Function isUnit() As Boolean
On Error GoTo ErrorHandler
If txtUnit.Text = vbNullString Then
clsErrHd.InputError (lblUnit.Caption & " " & basMessage.blankMessage)
Exit Function
End If
isUnit = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "isUnit"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
Private Sub txtUnit_Validate(Cancel As Boolean)
If gFromMenu Then
Cancel = Not isUnit
If Cancel Then txtUnit.SetFocus
End If
End Sub
'========================================================================================================
'Event : Save
'========================================================================================================
Private Sub saveConfirm()
On Error GoTo ErrorHandler
Dim strMessage As String
Dim varConfirm As Variant
strMessage = basConfirmMessage.saveConfirm
varConfirm = MsgBox(strMessage, vbYesNoCancel, App.Title)
Select Case varConfirm
Case Is = vbYes
If saveCheck Then
If SaveData Then
Call initialized
PicSave
If Not gFromMenu Then
Unload Me
Call clsGen.POS_FormLoader(frmPOSManagement, False, "Product", frmMainMenu.lblProgramName)
End If
End If
End If
Case Is = vbNo
Call initialized
Case Is = vbCancel
Exit Sub
End Select
Exit Sub
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "saveConfirm"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Sub
'======================================================================================================
'======================================================================================================
Private Function saveCheck() As Boolean
On Error GoTo ErrorHandler
If Not isProductCode Then txtProductCode.SetFocus: Exit Function
If Not isProductName Then txtProductName.SetFocus: Exit Function
If Not isBrandType Then txtBrandType.SetFocus: Exit Function
If Not isCategoryCode Then txtCategory.SetFocus: Exit Function
If Not isUnit Then txtUnit.SetFocus: Exit Function
If txtPicture.Text = vbNullString Then txtPicture.SetFocus: Exit Function
saveCheck = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "saveCheck"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
'======================================================================================================
'======================================================================================================
Private Function SaveData() As Boolean
On Error GoTo ErrorHandler
Dim adoConn As New ADODB.Connection
Dim blnTran As Boolean
Dim strSQL As String
If gFormAction = [NEW DATA] Then
strSQL = "INSERT INTO pos_product ( " & _
" product_code , product_name, " & _
" unit_code, category_code , " & _
" brand_type_code, " & _
" Picture " & _
") VALUES ( " & _
clsStr.FormatString(txtProductCode.Text) & "," & clsStr.FormatString(txtProductName.Text) & "," & _
clsStr.FormatString(txtUnit.Text) & "," & clsStr.FormatString(txtCategory.Text) & "," & _
clsStr.FormatString(txtBrandType.Text) & "," & clsStr.FormatString(txtPicture.Text) & " ) "
'clsStr.FormatString(txtPicture.Text) & " ) "
ElseIf gFormAction = [EDIT DATA] Then
strSQL = "UPDATE pos_product SET " & _
"product_name =" & clsStr.FormatString(txtProductName.Text) & "," & _
"unit_code = " & clsStr.FormatString(txtUnit.Text) & "," & "category_code= " & clsStr.FormatString(txtCategory.Text) & "," & _
"brand_type_code = " & clsStr.FormatString(txtBrandType.Text) & "," & "Picture = " & clsStr.FormatString(txtPicture.Text) & " " & _
"WHERE product_code = " & clsStr.FormatString(txtProductCode.Text) & ""
End If
With adoConn
.Open gConnectionString
.BeginTrans: blnTran = True
.Execute strSQL
.CommitTrans: blnTran = False
.Close
End With
Set adoConn = Nothing
SaveData = True
Exit Function
If blnTran Then
adoConn.RollbackTrans
adoConn.Close
Set adoConn = Nothing
blnTran = False
End If
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "saveData"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
'======================================================================================================
'======================================================================================================
Private Function showData(ByVal ProductCode As String) As Boolean
On Error GoTo ErrorHandler
Dim adoConn As New ADODB.Connection
Dim adoRset As New ADODB.Recordset
Dim strSQL As String
strSQL = "SELECT * FROM pos_product WHERE " & gParameter
adoConn.Open gConnectionString
With adoRset
.CursorLocation = adUseClient
.Open strSQL, adoConn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
txtProductCode.Text = .Fields("product_code").Value
txtProductName.Text = .Fields("product_name").Value
txtUnit.Text = .Fields("unit_code").Value
txtCategory.Text = .Fields("category_code").Value
txtBrandType.Text = .Fields("brand_type_code").Value
txtPicture.Text = .Fields("Picture").Value
Picture1.Picture = LoadPicture(txtPicture.Text)
End If
.Close
End With
adoConn.Close
Set adoConn = Nothing
Set adoRset = Nothing
showData = True
Exit Function
ErrorHandler:
clsErrHd.ErrorNo = Err.Number
clsErrHd.ErrorDescription = Err.Description
clsErrHd.Source = "frmProduct"
clsErrHd.FunctionName = "showData"
clsErrHd.showError
clsErrHd.OutPutLogFile
End Function
'======================================================================================================
'======================================================================================================
Sub PicSave()
Dim arrImageByte() As Byte
Dim fNum As Integer
Dim adoConn As New ADODB.Connection
Dim adoRset As New ADODB.Recordset
Dim strPhotoPath As String
Dim isImage As Boolean
Dim strSQL As String
If Me.Picture1.Picture <> LoadPicture("") Then
SavePicture Me.Picture1.Picture, App.Path & "\tmpphoto.jpg"
strPhotoPath = App.Path & "\tmpphoto.jpg"
ReDim arrImageByte(FileLen(strPhotoPath))
fNum = FreeFile()
Open strPhotoPath For Binary As #fNum
Get #fNum, , arrImageByte
Close #fNum
isImage = True
End If
strSQL = "SELECT * FROM sys_table_info WHERE table_name = 'pos_product'"
adoConn.Open gConnectionString
With adoRset
.Open strSQL, adoConn, adOpenForwardOnly, adLockReadOnly, adCmdTable
.AddNew
.Fields("Picture").AppendChunk arrImageByte
.Update
End With
adoRset.Close
Set adoRset = Nothing
End Sub
I know that my save pic code might be wrong..and I want to know how to save and retrieve the pic
