frmdocument.frm

Code Library - visualbasic source code

      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   2
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "&File description"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "&Code"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Pesan As Long
Dim Nilai As String
Dim NilaiCat As String
Dim NilaiTip As String
Dim Hancurkan As Boolean

Sub KunciKontrol(En As Boolean)
    Combo1.Enabled = Not En
    Combo2.Enabled = Not En
    Text1.Locked = En
    Text2.Locked = En
    Text3.Locked = En
    rtfText.Locked = En
    Command4.Enabled = Not En
    Command6.Enabled = Not En
End Sub

Private Sub Combo1_Click()
    TampilTipe
End Sub

Private Sub Combo2_Click()
    Combo4.ListIndex = Combo2.ListIndex
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Public Sub Command2_Click()
    
    Select Case Command2.Caption
    Case "&Edit"
        
        KunciKontrol False
        Command2.Caption = "&Save"
        Command3.Caption = "&Cancel"
        
    Case "&Save"
        
        If Combo1.ListIndex < 0 Or Combo2.ListIndex < 0 Or _
            Text1.Text = "" Or Text2.Text = "" Or rtfText.Text = "" Then
            
            MsgBox "Your data is not complete", vbExclamation, "Warning"
            Exit Sub
            
        End If
        
        KunciKontrol True
        
        If RS.State = 1 Then RS.Close
        
        If Nilai = "open" Then
            RS.Open "SELECT * FROM TBL_CODE WHERE ID_CODE=" & Pesan, DB, adOpenKeyset, adLockOptimistic
             
             RS!ID_TIPE = Combo4.Text
             RS!JUDUL = Text1.Text
             RS!AUTHOR = Text2.Text
             RS!EMAIL = Text3.Text
             RS!TANGGAL = Date & " " & Time
             RS!CODE = rtfText.TextRTF
            
            RS.Update
        Else
        
            RS.Open "SELECT * FROM TBL_CODE", DB, adOpenKeyset, adLockOptimistic
            RS.AddNew
            
             RS!ID_TIPE = Combo4.Text
             RS!JUDUL = Text1.Text
             RS!AUTHOR = Text2.Text
             RS!EMAIL = Text3.Text
             RS!TANGGAL = Date & " " & Time
             RS!CODE = rtfText.TextRTF
            
            RS.Update
            
            Nilai = "open"
            
            If RS.State = 1 Then RS.Close
            RS.Open "SELECT ID_CODE FROM TBL_CODE WHERE ID_TIPE=" & Combo4.Text, DB, adOpenKeyset, adLockOptimistic
            
            RS.MoveLast
            
            Pesan = RS!ID_CODE
            
        End If
        RS.Close
            
        Me.Caption = "Title : " & Text1.Text
        
        Command2.Caption = "&Edit"
        
        Command3.Caption = "&Delete"
        
    End Select
End Sub

Private Sub Command3_Click()
    Dim h As Long
    Select Case Command3.Caption
    Case "&Delete"
        h = MsgBox("Are you sure to delete " & Text1.Text, vbQuestion + vbYesNo, "Confirmation")
        If h = vbYes Then DB.Execute "DELETE FROM TBL_CODE WHERE ID_CODE=" & Pesan
    End Select
    Hancurkan = True
    Unload Me
End Sub

Private Sub Command4_Click()
    Unload Me
    frmType.Show vbModal, frmMain
End Sub

Private Sub Command6_Click()
    Unload Me
    frmCategories.Show vbModal, frmMain
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim h As Long
    If Command2.Caption = "&Save" Then
      If Not Hancurkan Then
        h = MsgBox("Do you want to save the changes you made to Database", vbQuestion + vbYesNoCancel, "Programmer library")
        If h = vbYes Then
            Command2_Click
            Cancel = 7
            Exit Sub
        ElseIf h = vbNo Then
            Command2.Caption = "&Edit"
            Unload Me
        Else
            Cancel = 7
        End If
      End If
    End If
    h = 0
    PesanCat = ""
    PesanTip = ""
    Pekerjaan = ""
    Nilai = ""
    NilaiCat = ""
    NilaiTip = ""
    Pesan = 0
End Sub

Private Sub rtfText_SelChange()
    fMainForm.tbToolBar.Buttons("Bold").Value = IIf(rtfText.SelBold, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Italic").Value = IIf(rtfText.SelItalic, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Underline").Value = IIf(rtfText.SelUnderline, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Align Left").Value = IIf(rtfText.SelAlignment = rtfLeft, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Center").Value = IIf(rtfText.SelAlignment = rtfCenter, tbrPressed, tbrUnpressed)
    fMainForm.tbToolBar.Buttons("Align Right").Value = IIf(rtfText.SelAlignment = rtfRight, tbrPressed, tbrUnpressed)
    

End Sub

Private Sub Form_Load()
    Combo1.Enabled = False
    Combo2.Enabled = False
    Interface
    Form_Resize
    Me.Width = 6100
    Me.Height = 5000
    rtfText.SelIndent = 50
End Sub

Sub Interface()
On Error Resume Next

    Nilai = Pekerjaan
    Select Case Nilai
    Case "open"
        Pesan = ID_KODE
        
        tbS.Tabs(2).Selected = True
        
        Command2.Caption = "&Edit"
        Command3.Caption = "&Delete"
        
        If RS.State = 1 Then RS.Close
        
        NilaiCat = PesanCat
                       
        Combo1.AddItem NilaiCat
        Combo1.ListIndex = 0
        
        If RS.State = 1 Then RS.Close
        
        RS.Open "SELECT * FROM TBL_CODE WHERE ID_CODE=" & Pesan, DB, adOpenKeyset, adLockOptimistic
        NilaiTip = PesanTip
        
        Combo2.AddItem NilaiTip
        Combo2.ListIndex = 0
        
        Text1.Text = RS!JUDUL
        Text2.Text = RS!AUTHOR
        Text3.Text = RS!EMAIL
        Text4.Text = Format(RS!TANGGAL, "dd-MM-yyyy hh:mm:ss")
        rtfText.TextRTF = RS!CODE
        
        KunciKontrol True
        
        If RS.State = 1 Then RS.Close
    
    Case "new"
        TampilCategories
        TampilTipe
        KunciKontrol False
        Command2.Caption = "&Save"
        Command3.Caption = "C&ancel"
        Text4.Text = Format(Date, "dd-MM-yyyy") & " " & Format(Time, "hh:mm:ss")
    End Select
End Sub

Sub TampilCategories()
    If RS.State = 1 Then RS.Close
    
    RS.Open "SELECT * FROM TBL_CATEGORIES", DB, adOpenKeyset, adLockOptimistic
    
    With Combo1
        .Clear
        
        While Not RS.EOF
            .AddItem RS!CATEGORIES
            RS.MoveNext
        Wend
        
        RS.Close
        
        If Combo1.ListCount > -1 Then Combo1.ListIndex = 0
    
    End With
End Sub

Sub TampilTipe()
    If RS.State = 1 Then RS.Close
    
    RS.Open "SELECT * FROM TBL_TIPE WHERE CATEGORIES='" & Combo1.List(Combo1.ListIndex) & "'", DB, adOpenKeyset, adLockOptimistic
    
    With Combo2
        .Clear
        Combo4.Clear
        
        While Not RS.EOF
            .AddItem RS!TIPE
            Combo4.AddItem RS!ID_TIPE
            
            
            RS.MoveNext
        Wend
        
        RS.Close
        
        If Combo2.ListCount > 0 Then Combo2.ListIndex = 0
    
    
    End With
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    If Me.Height < 5000 Then Me.Height = 5000
    If Me.Width < 6000 Then Me.Width = 6100
    tbS.Move 100, 100, Me.ScaleWidth - 200, Me.ScaleHeight - 900
    Frame1.Move 100, (tbS.Top + tbS.Height + 20)
    Command1.Move (tbS.Left + tbS.Width) - Command1.Width, (tbS.Top + tbS.Height + 150)
    fr2.Move (tbS.Left + 200), (tbS.Top + 400), (tbS.Width - 400), (tbS.Height - 600)
    bingKai.Move (fr2.Width / 2) - (bingKai.Width / 2), (fr2.Height / 2) - (bingKai.Height / 2 - 30)
    fr1.Move fr2.Left, fr2.Top, fr2.Width, fr2.Height
    rtfText.Move 100, 200, fr1.Width - 200, fr1.Height - 300
End Sub

Private Sub tbS_Click()
    If tbS.Tabs(1).Selected Then
        fr1.Visible = False
        fr2.Visible = True
    Else
        fr1.Visible = True
        fr2.Visible = False
    End If
End Sub