membuat program text editor dengan vb6

Mungkin dari kalian ada yang ingin membuat program text editor sendiri, yah smacam program notepad milik windows gtu deeh...Nah kali ini penulis mencoba membuat program text editor sederhana.
Oke berikut tampilan dari program text editornya
tambahkan common dialog control pada formnya
Dan berikut script kodenya

Dim saved As Boolean

Private Sub bkcolor_Click()
On Error Resume Next
cd.ShowColor
Text1.BackColor = cd.Color
End Sub

Private Sub close_Click()
Dim retval As VbMsgBoxResult
If saved = False Then
retval = MsgBox("Do you want to save your file?", vbQuestion Or vbYesNoCancel, "Save file?")
If retval = vbYes Then save_Click
If retval = vbCancel Then Exit Sub
End If
Unload Me
End Sub

Private Sub copy_Click()
Clipboard.Clear
Clipboard.SetText Text1.Text
End Sub

Private Sub cut_Click()
Clipboard.Clear
Clipboard.SetText Text1.Text
Text1.Text = ""
End Sub

Private Sub font_Click()
On Error Resume Next
With cd
.Flags = cdlCFBoth Or cdlCFEffects
.DialogTitle = "Choose a font"
.ShowFont
End With

With Text1
.SelFontName = cd.FontName
.SelFontSize = cd.FontSize
.SelBold = cd.FontBold
.SelItalic = cd.FontItalic
.SelColor = cd.Color
.SelUnderline = cd.FontUnderline
.SelStrikeThru = cd.FontStrikethru
End With

End Sub

Private Sub Form_Load()
Dim argz As String
argz = Command
If argz <> "" Then
openfile (argz)
End If

saved = True
End Sub

Private Sub Form_Resize()

If Me.ScaleWidth > 250 And Me.ScaleHeight > 300 Then
Text1.Width = Me.ScaleWidth - 250
Text1.Height = Me.ScaleHeight - 300
End If
End Sub

Private Sub new_Click()
Dim retval As VbMsgBoxResult
If saved = False Then
retval = MsgBox("Do you want to save your file?", vbQuestion Or vbYesNoCancel, "Save file?")
If retval = vbYes Then save_Click
If retval = vbCancel Then Exit Sub
End If
Text1.Text = ""
End Sub

Private Sub open_Click()
cd.ShowOpen
Text1.LoadFile cd.FileName

End Sub

Private Sub paste_Click()
If (Clipboard.GetFormat(rtfCFRTF) = True Or Clipboard.GetFormat(rtfCFText) = True) Then
Text1.Text = Clipboard.GetText
Else
MsgBox "Clipboard contains unknown data type!", vbCritical, "Error"
End If
End Sub

Private Sub save_Click()
On Error GoTo canc
cd.ShowSave
Text1.SaveFile cd.FileName
saved = True
GoTo end1
canc:
saved = False
end1:
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
saved = False
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu edit
End If
End Sub


Private Sub txtcolor_Click()
On Error Resume Next
cd.ShowColor
Text1.SelColor = cd.Color
End Sub

Private Function openfile(ByVal fn As String)
Text1.FileName = fn
End Function

Yups sgitua aja scriptnya, semoga pembahasan ini bermanfaat dan bisa menjadi bahan referensi bagi vbthok mania. Bagi yang tidak ingin pusing tetep silakan download scritpnya

• Tweet
• Share

Artikel Terkait