'======================================================================================================
'======================================================================================================
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

Edited 2 Years Ago by nayzin.phyo: forgot pic

Attachments Untitled.png 164.52 KB

Sorry but no one will read this code to find out what is wrong. Simply post your problem in couple of lines so we could help.

This article has been dead for over six months. Start a new discussion instead.