Source Code Untuk Membuat RichTextBox versi WindowsMediaPlayer

Option Explicit

'Deklarasi fungsi API
Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Private Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long

Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1

Dim suara As String
Dim Teks As String
Dim i As Integer
Dim digit As Integer
Dim x!

Private Sub cmdBold_Click()
With Me.rtbEditor
If Not .SelBold Then
.SelBold = True
Else
.SelBold = False
End If
End With

suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC

End Sub

Private Sub cmdBuka_Click()
With Me.cdlEditor
.DialogTitle = "Buka File"
.CancelError = True
.FileName = ""

.Filter = "Rich Tect Format (*.rtf)" & _
"|*.rtf|Word Document (*.doc)" & _
"|*.doc|Text Document (*.txt)" & _
"|*.txt|semua File (.)|*.*"

On Error Resume Next
.ShowOpen

On Error GoTo 0
If .FileName = "" Then
Exit Sub
Else
Me.rtbEditor.FileName = .FileName
End If
End With

suara = App.Path & "\MASUKAJA.wav"
sndPlaySound suara, SND_ASYNC

End Sub

Private Sub cmdExit_Click()
Timer1.Interval = 1
Trans = 255
SetTrans Me.hwnd, Trans

suara = App.Path & "\KELUAR.wav"
sndPlaySound suara, SND_ASYNC

End Sub

Private Sub cmdFont_Click()
With Me.cdlEditor
.Flags = &H3 Or &H100 Or &H1
.FontBold = Me.rtbEditor.SelBold
.FontItalic = Me.rtbEditor.SelItalic
.FontUnderline = _
.FontName = Me.rtbEditor.SelFontName
.FontSize = Me.rtbEditor.SelFontSize
.ShowFont
Me.rtbEditor.SelBold = .FontBold
Me.rtbEditor.SelItalic = .FontItalic
Me.rtbEditor.SelUnderline = _
.FontUnderline
Me.rtbEditor.SelColor = .Color
Me.rtbEditor.SelFontSize = .FontSize
Me.rtbEditor.SelFontName = .FontName
End With

suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC


End Sub

Private Sub cmdGambar_Click(Index As Integer)
Dim pic As StdPicture
With Me.cdlEditor
.DialogTitle = "Buka File"
.CancelError = True
.FileName = ""
.Filter = "Gambar JPG (*.jpg)" & _
"|*.jpg|Gambar Bmp (*.bmp)" & _
"|*.bmp"

On Error Resume Next
.ShowOpen

On Error GoTo 0
If .FileName = "" Then
Exit Sub
Else
Set pic = LoadPicture(.FileName)
Clipboard.Clear
Clipboard.SetData pic
SendMessage rtbEditor.hwnd, _
&H302, 0, 0
rtbEditor.SelText = vbCrLf
End If
End With


suara = App.Path & "\cached_hypergem_creation.wav"
sndPlaySound suara, SND_ASYNC
End Sub


Private Sub cmdItalic_Click()
With Me.rtbEditor
If Not .SelItalic Then
.SelItalic = True
Else
.SelItalic = False
End If
End With

suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC

End Sub

Private Sub cmdKanan_Click()
Me.rtbEditor.SelAlignment = rtfRight
suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC

End Sub


Private Sub cmdKiri_Click()
Me.rtbEditor.SelAlignment = rtfLeft
suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC
End Sub

Private Sub cmdSimpan_Click()
With Me.cdlEditor
.DialogTitle = "Simpan File"
.CancelError = True
.FileName = ""

.Filter = "Rich Tect Format (*.rtf)" & _
"|*.rtf"

On Error Resume Next
.ShowSave

On Error GoTo 0
If .FileName = "" Then
Exit Sub
Else

On Error Resume Next
Me.rtbEditor.SaveFile .FileName
End If
End With

suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC

End Sub

Private Sub cmdTengah_Click()
Me.rtbEditor.SelAlignment = rtfCenter
suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC
End Sub

Private Sub cmdUnderline_Click()
With Me.rtbEditor
If Not .SelUnderline Then
.SelUnderline = True
Else
.SelUnderline = False
End If
End With

suara = App.Path & "\cached_multishot.wav"
sndPlaySound suara, SND_ASYNC

End Sub

Private Sub Form_Load()
Dim kanvas, half, Font, clr, bgr
Dim TxtAnimasi, pos, scl, xf
Set kanvas = DAVCW.MeterLibrary


Set half = kanvas.DANumber(0.5)
Set clr = kanvas.ColorHslAnim(kanvas.Mul _
(kanvas.LocalTime, _
kanvas.DANumber(0.345)), half, half)

Set Font = kanvas.Font("comic sans ms", 9, clr)
Set TxtAnimasi = kanvas.StringImage _
("SELAMAT DATANG DI APLIKASI SEDERHANA INI", Font)

Set pos = kanvas.Mul(kanvas.Sin(kanvas.LocalTime), _
kanvas.DANumber(0.02))
Set scl = kanvas.Add(kanvas.DANumber(2), _
kanvas.Abs(kanvas.Mul(kanvas.Sin _
(kanvas.LocalTime), kanvas.DANumber(3))))

Set xf = kanvas.Compose2(kanvas.Translate2Anim _
(kanvas.DANumber(0), pos), _
kanvas.Scale2UniformAnim(scl))

Set TxtAnimasi = TxtAnimasi.Transform(xf)

Set bgr = kanvas.Rotate3RateDegrees _
(kanvas.Vector3(1, 1, 1), 45) _
.ParallelTransform2
Set TxtAnimasi = TxtAnimasi.Transform(bgr)

DAVCW.BackgroundImage = _
kanvas.SolidColorImage(kanvas.Blue)

DAVCW.Image = TxtAnimasi
DAVCW.Start
suara = App.Path & "\cached_electro_start.wav"

sndPlaySound suara, SND_ASYNC

End Sub

Private Sub Timer1_Timer()
If Trans <> 0 Then
Trans = Trans - 1
End If

SetTrans Me.hwnd, Trans
If Trans = 0 Then
Me.Enabled = True
Unload Me
End If
End Sub