Task Editor

by Peter Elisa Souhoka (21 Submissions)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 4^th November 2008
Date Added: Mon 8^th February 2021
Rating: (1 Votes)
Task Editor
Rate Task Editor



Private Sub Command1_Click()
    If RTF1.SelText = "" Then
        Form3.RTF1.Text = RTF1.Text
    Else
        Form3.RTF1.Text = RTF1.SelText
    End If
End Sub

Private Sub Form_Resize()
    RTF1.Width = Form1.Width - 150
    RTF1.Height = Form1.Height - 500
    Web1.Width = Form1.Width - 150
    Web1.Height = Form1.Height - 500
End Sub

Private Sub RTF1_Change()
    With MDIForm1
        If Len(RTF1.Text) > 0 Then
            .Toolbar1.Buttons.Item(16).Enabled = True
            .pEnkripsi.Enabled = True
            .pDeskripsi.Enabled = True
        Else
            .Toolbar1.Buttons.Item(16).Enabled = False
            .pEnkripsi.Enabled = False
            .pDeskripsi.Enabled = False
        End If
    End With
End Sub

Private Sub RTF1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then PopupMenu MDIForm1.pop
End Sub

------
Form 2:
Dim posisi As Integer

Private Sub Command1_Click()
    posisi = 0
    Cari
End Sub

Private Sub Command2_Click()
    posisi = 0
    Cari
    If posisi > 0 Then Form1.RTF1.SelText = Text2.Text
End Sub

Private Sub Command3_Click()
    Cari
End Sub

Private Sub Command4_Click()
    Cari
    If posisi > 0 Then Form1.RTF1.SelText = Text2.Text
End Sub

Private Sub Command5_Click()
    Form2.Hide
End Sub

Private Sub Form_Load()
    posisi = 0
    If Len(Text1.Text) > 0 Then
        Text2.Enabled = True
    Else
        Text2.Enabled = False
    End If
End Sub

Private Sub Text1_Change()
    If Len(Text1.Text) > 0 Then
        Command1.Enabled = True
        Text2.Enabled = True
    Else
        Command1.Enabled = False
        Text2.Enabled = False
    End If
End Sub

Private Sub Text2_Change()
    If Len(Text2.Text) > 0 Then
        Command2.Enabled = True
    Else
        Command2.Enabled = False
    End If
End Sub

Sub Cari()
    Dim jenis As String
    If Check1.Value = 1 Then
        jenis = vbBinaryCompare
    Else
        jenis = vbTextCompare
    End If
    
    posisi = InStr(posisi + 1, Form1.RTF1.Text, Text1.Text, jenis)
    
    If posisi > 0 Then
        Form1.RTF1.SelStart = posisi - 1
        Form1.RTF1.SelLength = Len(Text1.Text)
        Command3.Enabled = True
        If Len(Text2.Text) > 0 Then
            Command2.Enabled = True
            Command4.Enabled = True
        End If
        Form1.RTF1.SetFocus
    Else
        MsgBox ("Ndak ketemu, coba yang lain")
        Text1.SetFocus
    End If
 End Sub

------
Form3

Function EnskripXOR(Kode As String, data As String) As String
    
    Dim Putar As Long
    Dim DataKeluar As String
    Dim temp As Integer
    Dim tempstring As String
    Dim Nilai1 As Integer
    Dim Nilai2 As Integer
    
    For Putar = 1 To Len(data)
        Nilai1 = Asc(Mid$(data, Putar, 1))
        Nilai2 = Asc(Mid$(Kode, ((Putar Mod Len(Kode)) + 1), 1))
        
        temp = (Nilai1 Xor Nilai2)
        tempstring = Hex(temp)
        If Len(tempstring) = 1 Then tempstring = "0" & tempstring
        
        DataKeluar = DataKeluar + tempstring
    Next Putar
    
    EnskripXOR = DataKeluar
End Function

Function DeskripXOR(Kode As String, data As String) As String
    
    Dim Putar As Long
    Dim DataKeluar As String
    Dim Nilai1 As Integer
    Dim Nilai2 As Integer
    
    For Putar = 1 To (Len(data) / 2)
        Nilai1 = Val("&H" & (Mid$(data, (2 * Putar) - 1, 2)))
        Nilai2 = Asc(Mid$(Kode, ((Putar Mod Len(Kode)) + 1), 1))
        DataKeluar = DataKeluar + Chr(Nilai1 Xor Nilai2)
    Next Putar
    
   DeskripXOR = DataKeluar
End Function


Private Sub Command1_Click()
    If Option1.Value = True Then
        RTF1.Text = EnskripXOR(Text1.Text, RTF1.Text)
    Else
        RTF1.Text = DeskripXOR(Text1.Text, RTF1.Text)
    End If
End Sub

Private Sub Command2_Click()
    If Form1.RTF1.SelText = "" Then
        RTF1.Text = Form1.RTF1.Text
    Else
        RTF1.Text = Form1.RTF1.SelText
    End If
End Sub

Private Sub Command3_Click()
    If Form1.RTF1.SelText = "" Then
        Form1.RTF1.Text = RTF1.Text
    Else
        Form1.RTF1.SelText = RTF1.Text
    End If
End Sub

Private Sub Form_Load()

End Sub

----
MDIForm
Private Sub Command1_Click()
    If Toolbar1.Buttons.Item(2).Value = tbrPressed And Len(Text1.Text) > 0 Then
        Form1.Web1.Navigate (Text1.Text)
    End If
End Sub

Private Sub MDIForm_Load()

End Sub

Private Sub pAbout_Click()
    MsgBox ("Text Editor Plus By Peter")
End Sub

Private Sub pBold_Click()
    TBold
End Sub

Private Sub pCenter_Click()
    TCenter
End Sub

Private Sub pCopy_Click()
    If Form1.RTF1.SelText <> "" Then Clipboard.SetText Form1.RTF1.SelText
End Sub

Private Sub pCut_Click()
    If Form1.RTF1.SelText <> "" Then
        Clipboard.SetText Form1.RTF1.SelText
        Form1.RTF1.SelText = ""
    End If
End Sub

Private Sub pDeskripsi_Click()
    Form3.Option2.Value = True
    TEnkripsi
    Form3.Show
End Sub

Private Sub pEnkripsi_Click()
    Form3.Option1.Value = True
    TEnkripsi
    Form3.Show
End Sub

Private Sub pExit_Click()
    End
End Sub

Private Sub pFind_Click()
    If Form1.RTF1.SelText <> "" Then Form2.Text1.Text = Form1.RTF1.SelText
    Form2.Show
End Sub

Private Sub pFont_Click()
    TFont
End Sub

Private Sub pFormat_Click()
    If Form1.RTF1.SelLength > 0 Then
        If Form1.RTF1.SelBold = True Then
            pBold.Checked = True
        Else
            pBold.Checked = False
        End If
        If Form1.RTF1.SelItalic = True Then
            pItalic.Checked = True
        Else
            pItalic.Checked = False
        End If
        If Form1.RTF1.SelUnderline = True Then
            pUnderline.Checked = True
        Else
            pUnderline.Checked = False
        End If
    Else
        If Form1.RTF1.Font.Bold = True Then
            pBold.Checked = True
        Else
            pBold.Checked = False
        End If
        If Form1.RTF1.Font.Italic = True Then
            pItalic.Checked = True
        Else
            pItalic.Checked = False
        End If
        If Form1.RTF1.Font.Underline = True Then
            pUnderline.Checked = True
        Else
            pUnderline.Checked = False
        End If
    End If
End Sub

Private Sub pHtml_Click()
    THtml
End Sub

Private Sub pInternet_Click()
    TInternet
End Sub

Private Sub pItalic_Click()
    TItalic
End Sub

Private Sub pLeft_Click()
    TLeft
End Sub

Private Sub pNew_Click()
    TNew
End Sub

Private Sub popBold_Click()
    TBold
End Sub

Private Sub popCopy_Click()
    If Form1.RTF1.SelText <> "" Then Clipboard.SetText Form1.RTF1.SelText
End Sub

Private Sub popCut_Click()
    If Form1.RTF1.SelText <> "" Then
        Clipboard.SetText Form1.RTF1.SelText
        Form1.RTF1.SelText = ""
    End If
End Sub

Private Sub popDelete_Click()
    If Form1.RTF1.SelText <> "" Then Form1.RTF1.SelText = ""
End Sub

Private Sub pOpen_Click()
   TOpen
End Sub

Private Sub popFont_Click()
    TFont
End Sub

Private Sub popItalic_Click()
    TItalic
End Sub

Private Sub popNormal_Click()
    If pBold.Checked = True Then
        pBold.Checked = False
        If Form1.RTF1.SelLength > 0 Then
            Form1.RTF1.SelBold = False
        Else
            Form1.RTF1.Font.Bold = False
        End If
    End If
    
    If pItalic.Checked = True Then
        pItalic.Checked = False
        If Form1.RTF1.SelLength > 0 Then
            Form1.RTF1.SelItalic = False
        Else
            Form1.RTF1.Font.Italic = False
        End If
    End If
    
    If pUnderline.Checked = True Then
        pUnderline.Checked = False
        If Form1.RTF1.SelLength > 0 Then
            Form1.RTF1.SelUnderline = False
        Else
            Form1.RTF1.Font.Underline = False
        End If
    End If
End Sub

Private Sub popPaste_Click()
    Form1.RTF1.SelText = Clipboard.GetText
End Sub

Private Sub popUnderline_Click()
    TUnderline
End Sub

Private Sub pPaste_Click()
    Form1.RTF1.SelText = Clipboard.GetText
End Sub

Private Sub pPrint_Click()
    TPrint
End Sub

Private Sub pRight_Click()
    TRight
End Sub

Private Sub pSave_Click()
    TSave
End Sub

Private Sub pTeks_Click()
    TTeks
End Sub

Sub Tipe()
    pTeks.Checked = False
    pHtml.Checked = False
    pInternet.Checked = False
    Toolbar1.Buttons.Item(1).Value = tbrUnpressed
    Toolbar1.Buttons.Item(2).Value = tbrUnpressed
    Toolbar1.Buttons.Item(3).Value = tbrUnpressed
End Sub

Sub TTeks()
    Tipe
    pTeks.Checked = True
    Toolbar1.Buttons.Item(1).Value = tbrPressed
    Form1.Web1.Visible = False
    Form1.RTF1.Visible = True
    If Len(Form1.RTF1.Text) = 0 Then TNew
    
    Toolbar1.Buttons.Item(8).Enabled = True
    Toolbar1.Buttons.Item(9).Enabled = True
    pPrint.Enabled = True
    pFormat.Enabled = True
    
    Toolbar2.Buttons.Item(9).Visible = False
    Toolbar2.Buttons.Item(10).Visible = False
    Toolbar2.Buttons.Item(11).Visible = False
    Toolbar2.Buttons.Item(12).Visible = False
    Form1.Caption = "New Doc"
    Form1.RTF1.Text = ""
End Sub

Sub TInternet()
    Tipe
    pInternet.Checked = True
    Toolbar1.Buttons.Item(2).Value = tbrPressed
    Form1.RTF1.Visible = False
    Form1.Web1.Visible = True
    
    Toolbar2.Buttons.Item(9).Visible = True
    Toolbar2.Buttons.Item(10).Visible = True
    Toolbar2.Buttons.Item(11).Visible = True
    Toolbar2.Buttons.Item(12).Visible = True
    
    Toolbar1.Buttons.Item(8).Enabled = False
   Toolbar1.Buttons.Item(9).Enabled = False
    pPrint.Enabled = False
    pFormat.Enabled = False
    
    If Len(Form1.RTF1.Text) = 0 Then Text1.Text = ""
    Text1.SetFocus
    If Len(Form1.RTF1.Text) > 0 Then
        Open ("C:\temporary.html") For Output As 1
            Print #1, Form1.RTF1.Text
        Close #1
        Form1.Web1.Navigate ("file:\\\C:\temporary.html")
    End If
    
End Sub

Sub THtml()
    On Error Resume Next
    Tipe
    pHtml.Checked = True
    Toolbar1.Buttons.Item(3).Value = tbrPressed
    Form1.RTF1.Visible = True
    Form1.Web1.Visible = False
    
    Toolbar1.Buttons.Item(8).Enabled = True
    Toolbar1.Buttons.Item(9).Enabled = True
    pPrint.Enabled = True
    pFormat.Enabled = True
    
    If Right(Left(Text1.Text, 2), 1) = ":" Then
        Dim data As String
        Dim tampung As String
        Open Text1.Text For Input As 1
               Do While Not EOF(1)
                    Line Input #1, data
                    tampung = tampung + data + Chr(10) + Chr(13)
                Loop
        Close #1
        Form1.RTF1.Text = tampung
    Else
        Form1.RTF1.Text = Form1.Inet1.OpenURL(Text1.Text)
    End If
End Sub

Private Sub pUnderline_Click()
    TUnderline
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "iTeks"
            TTeks
        Case "iInternet"
            TInternet
        Case "iHtml"
            THtml
        Case "iNew"
            TNew
        Case "iOpen"
            TOpen
        Case "iSave"
            TSave
        Case "iPrint"
            TPrint
        Case "iFind"
            If Form1.RTF1.SelText <> "" Then Form2.Text1.Text = Form1.RTF1.SelText
            Form2.Show
        Case "iCut"
            If Form1.RTF1.SelText <> "" Then
                Clipboard.SetText Form1.RTF1.SelText
                Form1.RTF1.SelText = ""
            End If
        Case "iCopy"
            If Form1.RTF1.SelText <> "" Then Clipboard.SetText Form1.RTF1.SelText
        Case "iPaste"
            Form1.RTF1.SelText = Clipboard.GetText
        Case "iEnkripsi"
            Form3.Option1.Value = True
           TEnkripsi
            Form3.Show
        Case "iHelp"
            MsgBox ("Help")
    End Select
End Sub

Sub TNew()
    If pTeks.Checked = True Then Text1.Text = "New RTF Document  (New Doc.RTF)"
    If pHtml.Checked = True Then Text1.Text = "New Html Document (New Web.Html)"
    Form1.RTF1.Text = ""
    Form1.Web1.Navigate ("")
End Sub

Sub TOpen()
On Error Resume Next
With CoDialog1
     If Toolbar1.Buttons.Item(1).Value = tbrPressed Then
            .Filter = "File Teks (*.txt)|*.txt| File RTF (*.rtf)|*.rft"
            .ShowOpen
            If Len(.FileName) = 0 Then Exit Sub
            Form1.RTF1.LoadFile .FileName
            Text1.Text = .FileName
    End If
    
    If Toolbar1.Buttons.Item(2).Value = tbrPressed Then
            .Filter = "File htm (*.htm)|*.htm| File html (*.html)|*.html"
            .ShowOpen
            If Len(.FileName) = 0 Then Exit Sub
            Form1.Web1.Navigate ("file:///" & .FileName)
            Text1.Text = .FileName
    End If
            
    If Toolbar1.Buttons.Item(3).Value = tbrPressed Then
        Dim data As String
        Dim tampung As String
        
            .Filter = "File htm (*.htm)|*.htm| File html (*.html)|*.html"
            .ShowOpen
            If Len(.FileName) = 0 Then Exit Sub
            Open .FileName For Input As 1
                Do While Not EOF(1)
                    Line Input #1, data
                    tampung = tampung + data + Chr(10) + Chr(13)
                Loop
            Close #1
            Form1.RTF1.Text = tampung
            Text1.Text = .FileName
    End If
    If Len(.FileTitle) > 0 Then Form1.Caption = .FileTitle
    End With
End Sub

Sub TSave()
    On Error Resume Next
     If Form1 Is Nothing Then Exit Sub
    With CoDialog1
    If Toolbar1.Buttons.Item(1).Value = tbrPressed Then
            .Filter = "File Rich Text (*.rtf)|*.rtf|File Text (*.txt)|*.txt"
            .ShowSave
            If Len(.FileName) = 0 Then Exit Sub
            If UCase(Right(Form1.RTF1.FileName, 3)) = "RTF" Then
                Form1.RTF1.SaveFile .FileName, rtfRTF
            Else
                Form1.RTF1.SaveFile .FileName, rtfText
            End If
    End If
    
    If Toolbar1.Buttons.Item(2).Value = tbrPressed Then
        THtml
            .Filter = "File htm (*.htm)|*.htm|File html (*.html)|*.html"
            .ShowSave
            If Len(.FileName) = 0 Then Exit Sub
            Open .FileName For Output As 1
                Print #1, Form1.RTF1.Text
            Close #1
        TInternet
    End If
     
     If Toolbar1.Buttons.Item(3).Value = tbrPressed Then
            .Filter = "File htm (*.htm)|*.htm|File html (*.html)|*.html"
            .ShowSave
            If Len(.FileName) = 0 Then Exit Sub
            Open .FileName For Output As 1
                Print #1, Form1.RTF1.Text
            Close #1
    End If
    If Len(.FileTitle) > 0 Then Form1.Caption = .FileTitle
    End With
End Sub

Sub TPrint()
    On Error Resume Next
    If Form1 Is Nothing Then Exit Sub
    If Toolbar1.Buttons.Item(1).Value = tbrPressed Or Toolbar1.Buttons.Item(3).Value = tbrPressed Then
        With CoDialog1
            .CancelError = True
            .Flags = cdlPDReturnDC + cdlPDNoPageNums
            If Form1.RTF1.SelLength = 0 Then
                .Flags = .Flags + cdlPDAllPages
            Else
                .Flags = .Flags + cdlPDSelection
            End If
            .ShowPrinter
            Form1.RTF1.SelPrint .hDC
        End With
   End If

End Sub

Sub TFont()
On Error Resume Next
    
    With CoDialog1
        .CancelError = True
        .Flags = cdlCFBoth
        If Form1.RTF1.SelLength > 0 Then
            .FontName = Form1.RTF1.SelFontName
            .FontBold = Form1.RTF1.SelBold
            .FontItalic = Form1.RTF1.SelItalic
            .FontSize = Form1.RTF1.SelFontSize
            .ShowFont
            Form1.RTF1.SelFontName = .FontName
            Form1.RTF1.SelBold = .FontBold
            Form1.RTF1.SelItalic = .FontItalic
            Form1.RTF1.SelFontSize = .FontSize
        Else
            .FontName = Form1.RTF1.Font.Name
            .FontBold = Form1.RTF1.Font.Bold
            .FontItalic = Form1.RTF1.Font.Italic
            .FontSize = Form1.RTF1.Font.Size
            .ShowFont
            Form1.RTF1.Font.Name = .FontName
            Form1.RTF1.Font.Bold = .FontBold
            Form1.RTF1.Font.Italic = .FontItalic
            Form1.RTF1.Font.Size = .FontSize
        End If
    End With
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
   Select Case Button.Key
        Case "iBold"
            TBold
        Case "iItalic"
            TItalic
        Case "iUnderline"
            TUnderline
        Case "iLeft"
            TLeft
        Case "iCenter"
            TCenter
        Case "iRight"
            TRight
        Case "iBack"
            Form1.Web1.GoBack
        Case "iForward"
            Form1.Web1.GoForward
        Case "iRefresh"
            Form1.Web1.Refresh
        Case "iStop"
            Form1.Web1.Stop
    End Select
End Sub

Sub TBold()
    If Form1.RTF1.SelLength > 0 Then
        If Form1.RTF1.SelBold = True Then
            Form1.RTF1.SelBold = False
            pBold.Checked = False
            Toolbar2.Buttons.Item(1).Value = tbrUnpressed
        Else
            Form1.RTF1.SelBold = True
            pBold.Checked = True
            Toolbar2.Buttons.Item(1).Value = tbrPressed
        End If
    Else
        If Form1.RTF1.Font.Bold = True Then
            Form1.RTF1.Font.Bold = False
            pBold.Checked = False
            Toolbar2.Buttons.Item(1).Value = tbrUnpressed
        Else
            Form1.RTF1.Font.Bold = True
            pBold.Checked = True
            Toolbar2.Buttons.Item(1).Value = tbrPressed
        End If
    End If
End Sub

Sub TItalic()
     If Form1.RTF1.SelLength > 0 Then
        If Form1.RTF1.SelItalic = True Then
            Form1.RTF1.SelItalic = False
            pItalic.Checked = False
            Toolbar2.Buttons.Item(2).Value = tbrUnpressed
        Else
            Form1.RTF1.SelItalic = True
            pItalic.Checked = True
            Toolbar2.Buttons.Item(2).Value = tbrPressed
        End If
    Else
        If Form1.RTF1.Font.Italic = True Then
            Form1.RTF1.Font.Italic = False
            pItalic.Checked = False
            Toolbar2.Buttons.Item(2).Value = tbrUnpressed
        Else
            Form1.RTF1.Font.Italic = True
            pItalic.Checked = True
            Toolbar2.Buttons.Item(2).Value = tbrPressed
        End If
    End If
End Sub

Sub TUnderline()
    If Form1.RTF1.SelLength > 0 Then
        If Form1.RTF1.SelUnderline = False Then
            Form1.RTF1.SelUnderline = True
            pUnderline.Checked = True
        Else
            Form1.RTF1.SelUnderline = False
            pUnderline.Checked = False
        End If
    Else
        If Form1.RTF1.Font.Underline = False Then
            Form1.RTF1.Font.Underline = True
            pUnderline.Checked = True
        Else
            Form1.RTF1.Font.Underline = False
            pUnderline.Checked = False
        End If
    End If
End Sub

Sub TLeft()
    Form1.RTF1.SelAlignment = rtfLeft
    pLeft.Checked = True
    pCenter.Checked = False
    pRight.Checked = False
    
    Toolbar2.Buttons.Item(5).Value = tbrPressed
    Toolbar2.Buttons.Item(6).Value = tbrUnpressed
    Toolbar2.Buttons.Item(7).Value = tbrUnpressed
End Sub

Sub TCenter()
    Form1.RTF1.SelAlignment = rtfCenter
    pCenter.Checked = True
    pLeft.Checked = False
    pRight.Checked = False
    
    Toolbar2.Buttons.Item(6).Value = tbrPressed
    Toolbar2.Buttons.Item(5).Value = tbrUnpressed
    Toolbar2.Buttons.Item(7).Value = tbrUnpressed
End Sub

Sub TRight()
    Form1.RTF1.SelAlignment = rtfRight
    pRight.Checked = True
    pLeft.Checked = False
    pCenter.Checked = False
        
    Toolbar2.Buttons.Item(7).Value = tbrPressed
    Toolbar2.Buttons.Item(5).Value = tbrUnpressed
    Toolbar2.Buttons.Item(6).Value = tbrUnpressed
End Sub

Sub TEnkripsi()
    If Form1.RTF1.SelText = "" Then
        Form3.RTF1.Text = Form1.RTF1.Text
    Else
         Form3.RTF1.Text = Form1.RTF1.SelText
    End If
End Sub
Download this snippet Add to My Saved Code
Task Editor Comments

No comments have been posted about Task Editor. Why not be the first to post a comment about Task Editor.
Task Editor

Task Editor Comments

Post your comment

Difficulty
