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 disini
No comments:
Post a Comment