Membuat program text editor menggunakan VB

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 disini

Membuat form menjadi tembus pandang

Jika kalian ingin membuat form menjadi tembus pandang mungkin artikel berikut bisa sebagai referensi, dengan memanfaatkan fungsi API dari windows penulis akan mencoba membuat tampilan form menjadi terlihat transparan.
Berikut preview dari form yang sudah dijalankan

Nah ini untuk scriptnya codenya :
'script code untuk form-nya
Private Sub Form_Load()
Dim bool As Boolean
GetWindowsVersion bool
If Not bool Then
MsgBox "Diperlukan Sistem Operasi Windows 2000 atau Lebih" & vbCrLf & "Program dibatalkan", , "Perhatian"
End
End If
SetLayeredWindow Me.hWnd, True
SetLayeredWindowAttributes Me.hWnd, 0, (255 * 70) / 100, LWA_ALPHA
End Sub

'script code untuk module-nya
Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long

Public Type POINTAPI
x As Long
y As Long
End Type

Public Type SIZE
cx As Long
cy As Long
End Type

Public Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type

Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4
Public Const AC_SRC_OVER = &H0
Public Const AC_SRC_ALPHA = &H1
Public Const AC_SRC_NO_PREMULT_ALPHA = &H1
Public Const AC_SRC_NO_ALPHA = &H2
Public Const AC_DST_NO_PREMULT_ALPHA = &H10
Public Const AC_DST_NO_ALPHA = &H20
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type



Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2


Public Function IsLayeredWindow(ByVal hWnd As Long) As Boolean
Dim WinInfo As Long

WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)
If (WinInfo And WS_EX_LAYERED) = WS_EX_LAYERED Then
IsLayeredWindow = True
Else
IsLayeredWindow = False
End If
End Function

Public Sub SetLayeredWindow(ByVal hWnd As Long, _
ByVal bIsLayered As Boolean)
Dim WinInfo As Long

WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)
If bIsLayered = True Then
WinInfo = WinInfo Or WS_EX_LAYERED
Else
WinInfo = WinInfo And Not WS_EX_LAYERED
End If
SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
End Sub

' ambil deskripsi sistem operasi
Public Function GetWindowsVersion(ByRef IsWin2000 As Boolean) As String
Dim TheOS As OSVERSIONINFO
Dim strCSDVersion As String

TheOS.dwOSVersionInfoSize = Len(TheOS)
GetVersionEx TheOS
Select Case TheOS.dwPlatformId
Case VER_PLATFORM_WIN32_WINDOWS
If TheOS.dwMinorVersion >= 10 Then
GetWindowsVersion = "Windows 98 version: "
Else
GetWindowsVersion = "Windows 95 version: "
End If
Case VER_PLATFORM_WIN32_NT
GetWindowsVersion = "Windows NT version: "
End Select

' uraikan informasi tambahan dari string dengan null char
If InStr(TheOS.szCSDVersion, Chr(0)) <> 0 Then
strCSDVersion = ": " & Left(TheOS.szCSDVersion, InStr(TheOS.szCSDVersion, Chr(0)) - 1)
Else
strCSDVersion = ""
End If
GetWindowsVersion = GetWindowsVersion & TheOS.dwMajorVersion & "." & _
TheOS.dwMinorVersion & " (Build " & TheOS.dwBuildNumber & strCSDVersion & ")"

' set dalam mode parameter ByRef
If TheOS.dwMajorVersion = 5 Then
IsWin2000 = True
Else
IsWin2000 = False
End If
End Function

Oke deeh silakan kalian mengembangkan tampilan form sesuai dengan ide kalian masing2, maaf kalo penulis terlalu simple memberikan contoh2 pembahasanya karena penulis juga masih amatiran...so kita sharing bareng disini...Oke? yang pasti tetap semangat!!!
oiya yang mo download source code disini

Menghitung selisih hari menggunakan DTPICKER

Kemaren ada yang bertanya kepada penulis tentang bagaimana cara melihat selisih hari jika menggunakan komponen DTpicker, untuk itu penulis akan mencoba membahasnya biar vbthok mania yg pemula juga tahu, untuk yang sudah expert kyknya gak perlu deh..hehehe
Berikut ini tampilan formnya


Sebetulnya sangat mudah menghitung hari berdasarkan DTPicker ataupun menggunakan textbox so jangan dibikin pusing ya..hehehe
ini untuk script codenya..

Private Sub DTPicker2_CloseUp()
Text1.Text = DTPicker2.Value - DTPicker1.Value
End Sub

weedewwww cuma segitu aja script codenya?? yaiyalah kan gampang bgt, hehehe...
So silakan berekspresi dengan VB dan tetep SEMANGAT!!!

Teknik mengurutkan data

Dalam pembuatan aplikasi sebuah program biasanya memiki teknik pengurutan data yang berbeda beda, untuk itu penulis mencoba mengangkat topik ini sebagai bahan referensi bagi vbthok mania khususnya programmer pemula, untuk yang sudah advance kayaknya ini topik terlalu mudah. Jadi sowry yaa…hehehe…

Berikut ini komponen yang harus diaktifkan

Microsoft DataGrid Control 6.0 (OLEDB)

Microsoft ActiveX Data Objects 2.1 Library

Oiya jangan lupa buat database dari microsoft acces yang terdiri field nama dan nilai ipk.

Kemudian buatlah form seperti tampilan yang dibuat penulis berikut

Kemudian tuliskan scriptnya berikut

Option Explicit

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Private Sub Casc_Click()

'membuat koneksi baru pada databese ipk

Dim cn2 As New ADODB.Connection

Dim rs As New ADODB.Recordset

cn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ipk.mdb;Persist Security Info=False"

cn2.Open

rs.CursorLocation = adUseClient

'mengurutkan data secara Ascending, pertama seleksi dimulai dari field ipk lalu kemudian field nama

rs.Open "select * from nilai order by ipk asc,nama", cn2, adOpenDynamic, adLockOptimistic

'mengkoneksikan record ke DataGrid

Set DataGrid1.DataSource = rs

End Sub

Private Sub CDesc_Click()

'membuat koneksi baru pada databese ipk

Dim cn3 As New ADODB.Connection

Dim rs As New ADODB.Recordset

cn3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ipk.mdb;Persist Security Info=False"

cn3.Open

rs.CursorLocation = adUseClient

'mengurutkan data secara Descending, pertama seleksi dimulai dari field ipk lalu kemudian field nama

rs.Open "select * from nilai order by ipk desc,nama", cn3, adOpenDynamic, adLockOptimistic

'mengkoneksikan record ke DataGrid

Set DataGrid1.DataSource = rs

End Sub

Private Sub Form_Load()

'mengkoneksikan dan membuka database ipk

cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ipk.mdb;Persist Security Info=False"

cn.Open

rs.CursorLocation = adUseClient

rs.Open "nilai", cn, adOpenDynamic, adLockOptimistic

'mengkoneksikan record ke DataGrid

Set DataGrid1.DataSource = rs

End Sub

Bagi yang tidak ingin ribet silakan download source codenya disini

Teknik Perulangan atau Looping pada Visual Basic

Kali ini penulis coba angkat topik teori perulangan, kemaren sempet ada yang menanyakan hal ini kepada penulis akhirnya penulis ingin membahasnya.

Loop adalah proses perulangan yang mengerjakan satu atau lebih statement. Loop diperlukan untuk mengerjakan suatu proses operasi secara tahap demi tahap dengan nilai variabel yang menaik atau menurun.

Bila digambarkan aliran loop seperti gambar berikut

Function Do…Loop

Fungsi ini digunakan untuk mengulang blok statement bila kondisi benar atau sampai kondisi menjadi benar. Bila tidak ada perintah keluar fungsi loop akan terus berjalan.

Contoh sintaksnya sebagai berikut

Do [while|until] kondisi

Statement

Exit do

Statement

Loop

Nah sebagai contoh dalam pemrogramannya seperti berikut :

Coba buat 1 project dengan 1 form kemudian isikan script berikut

Private sub form_load()

Dim stptrs, bilrndm, helpfile, context

Do until stptrs = vbno

Bilrndm = int(3 * rnd + 1)

Stptrs = msgbox (“berhenti/lanjut?”, vbyesno, “bilangan random: “&bilrndm, helpfile, context)

Loop

End sub

Nah berikut hasil dari tampilan tersebut

Oke Silakan kalian kembangkan funtion loop ini secara maksimal dengan cara yang kalian inginkan…dan tetap semangat buat belajar