Pages

Friday, January 24, 2014

Form grouping

this is the coding of form grouping
'variable declaration
Dim Edit As Boolean
Dim RsGroup As New ADODB.Recordset
Private Sub Command1_Click()
FrmCariGroup.Show 1
MsgBox FrmCariGroup.Kodex
MsgBox FrmCariGroup.Namax
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'form shortcut button
Select Case KeyCode
' press F2 call procedure to create new data
Case vbKeyF2:
    KeyCode = 0
    Baru
' press F3 call procedure to save data to database
Case vbKeyF3:
    KeyCode = 0
    simpan
' press F5 call procedure to cancel the current operatiohhhhhhHHhhhhHHHHn
Case vbKeyF5:
    KeyCode = 0
    batal
' press F6 call procedure to delete data on database
Case vbKeyF4:
    KeyCode = 0
    Hapus
' press ESC to unload form
Case vbKeyEscape:
    KeyCode = 0
    Unload Me
End Select
End Sub
Sub simpan()
' procedure of saving data
If Trim(TxtNama) = "" Then
    'if textbox txtnama empty then show alert
    MsgBox "Nama group masih kosong."
    TxtNama.SetFocus
    Exit Sub
End If
If Edit Then
    ' if editing data
    SQL = "update ItemGroup set GroupName='" & Trim(TxtNama) & "' where GroupCode='" & Trim(TxtKode) & "'"
Else
    'if not editing data
    SQL = "insert into itemgroup(GroupCode,GroupName,GroupCreated,Status,Transfered) values ('" & Trim(KodeAuto) & _
        "','" & Trim(TxtNama) & "'," & LocalToStamp(Date) & ",'I','N')"
End If
' open database connection
If buka Then
    ' executing sql query
    DbCon.Execute (SQL)
    ' closing database connection
    DbCon.Close
    ' call procedure refreshdata
    RefreshData
    ' message box
    frmMsgBox.Msg "Data tersimpan.", mbOKOnly
End If
batal
End Sub
Private Sub TxtCari_Change()
If Edit And Trim(TxtCari) <> "" Then
    RsGroup.Find "GroupName like '%" & TxtCari & "%'", , adSearchForward, 1
    If Not RsGroup.EOF Then
        TxtKode = RsGroup!GroupCode
        TxtNama = RsGroup!GroupName
    Else
        TxtNama = ""
        TxtKode = ""
    End If
End If
End Sub
Sub Hapus()
If frmMsgBox.Msg("Hapus " & Trim(Grid.Columns(0).Text) & "?", mbYesNo, "", mbQuestion) = 1 Then
    ' if messagebox return yes then deleting record
    ' quering sql
    SQL = "delete from ItemGroup where GroupCode='" & Trim(Grid.Columns(0).Text) & "'"
    DbCon.Execute SQL
   
    ' show alert
    frmMsgBox.Msg "Data terhapus.", mbOKOnly
   
    ' get data from database
    ' open database connection
    If buka Then
        ' executing sql query
        DbCon.Execute (SQL)
        ' closing database connection
        DbCon.Close
        ' call procedure refreshdata
        RefreshData
        ' message box
        frmMsgBox.Msg "Data terhapus.", mbOKOnly
    End If
End If
End Sub
Sub batal()
' procedure to cancel current operation
' clear all fields
Bersih
' get data from database
RefreshData
End Sub
Sub Baru()
' procedure to create new data
' clear all fields
Bersih
' fill txtkode with generate code
TxtKode = KodeAuto
TxtNama.SetFocus
Edit = False
End Sub
Sub Bersih()
' clear all fields
TxtKode = ""
TxtNama = ""
End Sub
Private Sub Form_Load()
' when form loading to memory
' organize the form
Me.Height = Me.BasForm1.Height
Me.Width = Me.BasForm1.Width
GetLocation Me
ResizeForm Me
CenterForm Me
' built connection to database
If DbCon.State Then DbCon.Close
' create a recordset for data
With RsGroup
    .Fields.Append "GroupCode", adVarChar, 10
    .Fields.Append "GroupName", adVarChar, 50
    .Open
End With
' get data from database
RefreshData
' editing data is false
Edit = True
End Sub
Sub DropRs()
' delete data on recordset
If RsGroup.RecordCount > 0 Then
    ' if recordcount in recordset more then 0 then
    ' delete all data on recordset with looping method
    RsGroup.MoveFirst
    While Not RsGroup.EOF
        RsGroup.Delete
        RsGroup.MoveNext
    Wend
End If
End Sub
Sub RefreshData()
' procedure to get data from database
' clear data on recordset
DropRs
SQL = "select groupcode,groupname from itemgroup order by GroupCode"
' set recordset to get query result
If buka Then
' open connection to database
    Set RSFind = DbCon.Execute(SQL)
   
    ' tranfer data from database to recordset
    If Not RSFind.BOF Then
        RSFind.MoveFirst
        While Not RSFind.EOF
            RsGroup.AddNew
            RsGroup!GroupCode = RSFind!GroupCode
            RsGroup!GroupName = RSFind!GroupName
            RSFind.MoveNext
        Wend
   
    ' set grid's datasource to the recordset
        Grid.DataSource = RsGroup
        RsGroup.MoveFirst
        Edit = True
    End If
    DbCon.Close
End If
TxtCari = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
If frmMsgBox.Msg("Keluar program?", mbYesNo, , mbQuestion) = 1 Then
    If RsGroup.State Then RsGroup.Close
    Cancel = 0
Else
    Cancel = 1
End If
End Sub
Private Sub Grid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
' change data when the cursor moving on grid
TxtKode = Trim(Grid.Columns(0).Text)
TxtNama = Trim(Grid.Columns(1).Text)
End Sub
Private Sub TxtCari_KeyPress(KeyAscii As MSForms.ReturnInteger)
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub TxtKode_KeyPress(KeyAscii As MSForms.ReturnInteger)
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub TxtNama_KeyPress(KeyAscii As MSForms.ReturnInteger)
' make all character to upper case
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Function KodeAuto()
' procedure to generate code
' select data where filter by GroupCode from last to first
SQL = "Select GroupCode from ItemGroup order by GroupCode Desc"
If buka Then
    Set RSFind = DbCon.Execute(SQL)
    If RSFind.BOF Then
        ' when data is empty return this code
        KodeAuto = "GRP-" & "00001"
    Else
        ' when data is not empty return this auto increasement code
        KodeAuto = "GRP-" & Format(CInt(Right(RSFind!GroupCode, 4)) + 1, "00000")
    End If
    DbCon.Close
End If
End Function

No comments:

Post a Comment