frmmain.frm

Code Library - visualbasic source code

      Begin VB.Menu mnuEditCopy 
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "&Paste"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "&View"
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "&Toolbar"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "Status &Bar"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowNewWindow 
         Caption         =   "&New Window"
      End
      Begin VB.Menu mnuWindowBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "&Cascade"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "Tile &Horizontal"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "Tile &Vertical"
      End
      Begin VB.Menu mnuWindowArrangeIcons 
         Caption         =   "&Arrange Icons"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    frmSplash.Show vbModal
End Sub

Private Sub LoadNewDoc()
    Static lDocumentCount As Long
    Dim FrmD As frmDocument
    Pekerjaan = "new"
    lDocumentCount = lDocumentCount + 1
    Set FrmD = New frmDocument
    FrmD.Caption = "Untitled " & lDocumentCount
    FrmD.Show
End Sub


Private Sub MDIForm_Terminate()
    If DB.State = 1 Then DB.Close
    If RS.State = 1 Then RS.Close
    
    Set DB = Nothing
    Set RS = Nothing
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub mnuDataCat_Click()
End Sub

Private Sub mnuEditCat_Click()
    frmCategories.Show vbModal
End Sub

Private Sub mnuEditType_Click()
    frmType.Show vbModal
End Sub

Private Sub mnuSaveAs_Click()
    On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    With ActiveForm
        If .Combo1.Text = "" Or .Combo2.Text = "" Or _
            .Text1.Text = "" Or .Text2.Text = "" Or .rtfText.Text = "" Then
            MsgBox "Your data is not complete", vbExclamation, "Error"
            Exit Sub
        End If
    End With
    With CommonDialog1
        .DialogTitle = "Save source as File"
        .Filter = "File RTF (*.RTF)|*.RTF"
        
        .ShowSave
        If Err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SaveFile .FileName
        End If
    End With
End Sub

Private Sub mnuSearch_Click()
    frmSearch.Show vbModal
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "New"
            LoadNewDoc
        Case "Open"
            mnuFileOpen_Click
        Case "Save"
            mnuFileSave_Click
        Case "Print"
            mnuFilePrint_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
        Case "Bold"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            
            ActiveForm.rtfText.SelBold = Not ActiveForm.rtfText.SelBold
            Button.Value = IIf(ActiveForm.rtfText.SelBold, tbrPressed, tbrUnpressed)
        Case "Italic"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            
            ActiveForm.rtfText.SelItalic = Not ActiveForm.rtfText.SelItalic
            Button.Value = IIf(ActiveForm.rtfText.SelItalic, tbrPressed, tbrUnpressed)
        Case "Underline"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            ActiveForm.rtfText.SelUnderline = Not ActiveForm.rtfText.SelUnderline
            Button.Value = IIf(ActiveForm.rtfText.SelUnderline, tbrPressed, tbrUnpressed)
        Case "Align Left"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            
            ActiveForm.rtfText.SelAlignment = rtfLeft
        Case "Center"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            
            ActiveForm.rtfText.SelAlignment = rtfCenter
        Case "Align Right"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            
            ActiveForm.rtfText.SelAlignment = rtfRight
        Case "Font"
            If ActiveForm.Command2.Caption = "&Edit" Then Exit Sub
            
            With CommonDialog1
            .Flags = cdlCFBoth + cdlCFEffects
            .ShowFont
            
            ActiveForm.rtfText.SelFontName = .FontName
            ActiveForm.rtfText.SelBold = .FontBold
            ActiveForm.rtfText.SelFontSize = .FontSize
            ActiveForm.rtfText.SelColor = .Color
            ActiveForm.rtfText.SelItalic = .FontItalic
            
            End With
    End Select
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowNewWindow_Click()
    LoadNewDoc
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.rtfText.SelRTF = Clipboard.GetText

End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF

End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF
    ActiveForm.rtfText.SelText = vbNullString
    
End Sub

Private Sub mnuEditUndo_Click()
    'ToDo: Add 'mnuEditUndo_Click' code.
    MsgBox "Add 'mnuEditUndo_Click' code."
End Sub


Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me

End Sub

Private Sub mnuFilePrint_Click()
    On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    

    With CommonDialog1
        .DialogTitle = "Print"
        .CancelError = True
        .Flags = cdlPDReturnDC + cdlPDNoPageNums
        If ActiveForm.rtfText.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
        If Err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SelPrint .hDC
        End If
    End With

End Sub

Private Sub mnuFileSave_Click()
    If Not ActiveForm Is Nothing Then ActiveForm.Command2_Click
End Sub

Private Sub mnuFileClose_Click()
    If Not ActiveForm Is Nothing Then Unload ActiveForm
End Sub

Private Sub mnuFileOpen_Click()
    frmOpen.Show vbModal
End Sub

Private Sub mnuFileNew_Click()
    LoadNewDoc
End Sub