Kudo Share': vb6

Home » Posts filed under vb6

30 Dec 2012

KeyWord Option Base di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Sebelum tahun 2012 meninggalkan kita dan menyambut tahun 2013 ada baiknya sedikit membagi ilmu.
sebelumnya saya teringat materi matakuliah Pemrogramman Visual semester 2 di STMIK Megadata Tolitoli yang dibawakan oleh Kamaluddin, S.Kom.

pada postingan kali ini kudo-share.blogspot.com akan memposting bagaimana Memahami Keyword Option Base di Visual Basic 6.0.

okey cekidot.

Di bawah ini merupakan contoh kode sehingga kita bisa memahami Statement Option Base. Untuk keperluan tersebut copy dan pastekan code di bawah ini:

Kode dengan menggunakan Option Base 1

Option Explicit
Option Base 1

Private Sub Form_Load()
 Dim Larik(5) As Integer
 MsgBox LBound(Larik)
End Sub

dari kode diatas akan menampilkan MsgBox dengan pesannya adalah 1.

selanjutnya kita akan mencoba kode dengan tanpa menggunakan Option Base 1

Option Explicit

Private Sub Form_Load()
 Dim Larik(5) As Integer
 MsgBox LBound(Larik)
End Sub

Maka akan terlihat bahwa MsgBox tersebut menampilkan angka 0.

Maka kesimpulan dari 2 contoh diatas :

Dengan menggunakan Option Base 1, maka LBound atau Lower Bound (batas terendah dari sebuah array sama dengan 1)
Secara default Visual Basic 6.0 men-set Option Base 0, apabila secara explicit kita tidak menuliskan Option Base 1
Option Base tidak bisa diberi nilai yang lebih dari 1

mungkin sekian dulu dari kudo-share.blogspot.com.
semoga bermanfaat

8 Oct 2012

Mempercantik tampilan form VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Alhamdullillah bisa posting lagi...
kemarin teman saya bertanya bagaimana cara mempercantik form ketika program sedang dijalankan

ok langsung aja ke TKP

1. aktifkan component activeskin 4.0 di VB 6.0.
caranya :

lihat gambar yang berwarna biru, ocx ini merupakan bawaan instal dari vb 6.0 jadi kita tidak perlu mencari-cari file ocx tersebut di internet.

2. langkah selanjutnya buat sebuah form dan masukkan component yang sudah di aktifkan tadi

3. ketikkan coding dibawah ini di form_load.

Skin.LoadSkin App.Path & "\skins\Web-II.skn"
Skin.ApplySkin Me.hwnd

penjelasan :

app.path gunanya untuk mempermudah pemanggilan skin, jadi kita tidak perlu mengetikkan nama tempat file disimpan (drive).
skins : merupakan tempat folder dimana skin disimpan
Web-II.skn : merupakan file skin yang sedang digunakan

catatan :

1. folder skins harus berada satu folder dengan project aplikasi
2. download file skin dibawah ini
- 4shared
- ziddu

4. jalankan program, dan hasilnya seperti gambar dibawah ini.

sekian cara mempercantik tampilan form di vb 6.0
semoga bermanfaat.

28 Sept 2012

Menampilkan Data Berdasarkan Tanggal

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

salam hangat sobat blogger....

kali ini saya akan memposting cara menampilkan data dari Crystal report 8.5 ke Visual basic 6.0 berdasarkan tanggal

source code :

report.RecordSelectionFormula = "{Jurnal.tgljurnal} IN Date(" & Format
(Form2.dtpitcher1.Value, "yyyy,mm,dd") & ") TO Date(" & Format
(Form2.dtpitcher2.Value, "yyyy,mm,dd") & ")"

tampilan di VB 6.0

Perhatikan kode diatas, pada waktu commandbutton di klik, maka vb akan mengirimkan nilai tanggal dtpitcher1 dan dtpitcher2 sebagai kriteria dalam menampilkan data di crystal report. Pada contoh diatas, data jurnal yang akan ditampilkan adalah dari tgl 1 januari 2009 sampai 31 januari 2009

27 Sept 2012

Membuat form agar tidak bisa Maximize di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Sebelumnya saya telah memposting cara membuat form agar tidak bisa di resize, kali ini saya akan memposting cara membuat form agar tidak bisa Maximize

Caranya :

1. Buat 1 project Standard.EXE dengan :

1 Form

2. Copy source code berikut pada Form :

Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Sub Form_Load()
Dim lStyle As Long

    'disable MAXIMIZE button
    lStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
    lStyle = lStyle And Not WS_MAXIMIZEBOX
    Call SetWindowLong(Me.hwnd, GWL_STYLE, lStyle)
End Sub

3. Jalankan Program

Membuat form agar tidak bisa resize di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Source code berikut untuk membuat form tidak bisa di resize pada Visual Basic.

ikuti langkah-langkah berikut :

1. Buat 1 project Standard.EXE dengan :

1 Form

2. Copy source code berikut pada Form :

Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Sub Form_Load()
Dim lStyle As Long

    lStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
    lStyle = lStyle And Not WS_THICKFRAME
    Call SetWindowLong(Me.hwnd, GWL_STYLE, lStyle)
End Sub

3. Jalankan Program

Membuat Text Berkedip di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Source code berikut untuk membuat tulisan pada label (teks) berkedip berwarna-warni.

caranya :

1. Buat 1 project Standard.EXE dengan :

1 Form
1 Label
1 Timer

2. Copy source code berikut pada Form :

Dim i As Long
Dim merah, hijau, biru As Integer

Private Sub Form_Load()
i = 0     'Inisialisasi detik
Timer1.Interval = 100   'Kalau 1000 biasanya lompat 1 detik
Label1.Caption = "Ini contoh tulisan kelap-kelip"
End Sub

Private Sub Timer1_Timer()
i = i + 1
If i = 1000000 Then i = 0 'Supaya tdk overflow, dsb...
merah = Int(255 * Rnd)    'Bangkitkan angka random untuk merah
hijau = Int(255 * Rnd)    'Bangkitkan angka random untuk hijau
biru = Int(255 * Rnd)     'Bangkitkan angka random untuk biru
Label1.ForeColor = RGB(merah, hijau, biru)   'Campur tiga warna
If i Mod 2 = 0 Then       'Jika counter habis dibagi 2
     Label1.Visible = True 'Tampilkan label
Else                      'Jika counter tidak habis dibagi 2
     Label1.Visible = False 'Sembunyikan label
End If                    'Akhir pemeriksaan
End Sub

3. Jalankan program dan lihat hasilnya

Fungsi String pada vb 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Fungsi-fungsi VB 6 di bawah ini digunakan untuk mengolah data string.

Left : mengambil n karakter di sebelah kiri suatu string
karakter = Left(“abcdef”,2) ‘karakter = “ab”

Right : mengambil n karakter di sebelah kanan suatu string
karakter = Right(“abcdef”,2) ‘karakter = “ef”

Trim : menghilangkan spasi kosong di awal dan akhir suatu string
karakter = Trim(“ abc def ”) ‘karakter = “abc def”

Ltrim : menghilangkan spasi kosong di awal suatu string
MyStr = Ltrim(AnyString)

Rtrim : menghilangkan spasi kosong di akhir suatu string
MyStr = Rtrim(AnyString)

Ucase : mengubah suatu string menjadi huruf besar semua
MyStr = UCase(AnyString)

Lcase : mengubah suatu string menjadi huruf kecil semua
MyStr = LCase(AnyString)

Mid : mengambil n karakter dari suatu posisi yang ditetapkan
MyStr = Mid(“abcdefghij”, 3, 4) ‘hasil “cdef”

Len : menghitung jumlah karakter yang membentuk suatu string
MyStr = Len(“abcdef”) ‘hasil=6

LSet : menempatkan string di dalam string yang lain, di sebelah kiri
MyStr = “0123456789”
Lset MyStr = “<-Left” ‘hasil “<-Left “

RSet : menempatkan string di dalam string yang lain, di sebelah kanan
MyStr = “0123456789”
Rset MyStr = “>-Right” ‘hasil “ >-Right“

Format : mengatur string sehingga terformat sesuai yang ditentukan
A$ = Format (5455.4, “##,##0.00”) ‘A$ = “5,459.40”
A$ = Format (334.9, “####.##”) ‘A$ = “334.9”
A$ = Format (5, “0.00%”) ‘A$ = “500.00%”
A$ = Format (“HELLO”, “<”) ‘A$ = “hello”
A$ = Format (“This is”, “>”) ‘A$ = “THIS IS”

String: membuat string yang berisi sejumlah karakter yang digandakan
A$ = String (5, “*”) ‘A$ = “*****”

Chr: menghasilkan karakter yang terwakili oleh suatu angka tertentu
A$ = Chr (65) ‘A$ = A
A$ = Chr (97) ‘A$ = a
A$ = Chr (62) ‘A$ = >

Asc: menghasilkan angka ASCII dari suatu karakter tunggal
MyNumber = Asc(‘A’) ‘’hasilnya 65
MyNumber = Asc(‘a’) ‘’hasilnya 97
MyNumber = Asc(‘Apple’) ‘’hasilnya 65

Space: menghasilkan ruang kosong sebanyak n karakter
MyStr = Space(10) ‘buat string 10 spasi
MyStr = “Hello” & Space(10) & “World” ‘menyisipkan 10 spasi diantara kata Hello World

InStr: menentukan apakah string tertentu berada pada string lain
Dim CariString, CariChar, MyPos
CariString = ‘XXpXXpXXPXXP” ‘String yang dianalis
CariChar = “P” ‘String yang dicari “P”
‘mencari mulai dari kolom ke-4, hasilnya 6
MyPos = InStr(4, CariString, CariChar, 1)
‘mencari mulai dari kolom ke-1, hasilnya 9
MyPos = InStr(1, CariString, CariChar, 0)
MyPos = InStr(CariString, CariChar) ‘hasilnya 9
MyPos = InStr(1, SearchString, “W”) ‘hasilnya 0

InStrRev: cari posisi string dalam string yang lain, mulai dari akhir
i = InStrRev(StringCheck, StringMatch[, start[, compare]])

StrComp: membandingkan dua variabel string

StrComp(string1, string2 [, compare] )

Jika	Hasilnya
String1 < String2	-1
string1= string 2	0
string1> string 2	1
string1atau string 2 = Null	Null

Dim MyStr1, MyStr2, MyComp
MyStr1 = “ABCD” : MyStr2 = “abcd” ‘nilai awal
A = StrComp(MyStr1, MyStr2, 1) ‘A = 0
A = StrComp(MyStr1, MyStr2, 0) ‘A = -1
A = StrComp(MyStr2, MyStr1) ‘A = 1

StrConv: mengubah huruf besar atau kecil suatu karakter string
A$ = StrConv(“Semua Besar”, 1) ‘A$ = “SEMUA BESAR”
A$ = StrConv(“Semua Kecil”, 2) ‘A$ = “semua kecil”
A$ = StrConv(“pertama BESAR”, 3) ‘A$ = “Pertama Besar”

StrReverse: mengubah urutan karakter suatu string
A$ = StrReverse(“12345678”) ‘A$ = “87654321”
A$ = StrReverse(“abcdefg”) ‘A$ = “gfedcba”

Replace: menggantikan string dari kelompok string
Replace(expression, find, replace[, start[, count[, compare]]])

FormatCurrency: string memakai format currency yang ditetapkan
A$ = FormatCurrency(12000, 1) ‘A$ = “$12,000.0”
A$ = FormatCurrency(12000, 2) ‘A$ = “$12,000.00”
Catatan, untuk mengubah mata uang, gunakan Regional Settings Currency dari sistem operasi Windows

FormatDateTime: menghasilkan ekspresi tanggal dan waktu
A$ = FormatDateTime(Now) ‘hasilnya “10/8/02 11:15:46 AM”
A$ = FormatDateTime(Now, vbLongDate) ‘hasilnya “Tuesday, March 02, 2008”
A$ = FormatDateTime(“3/2/99”, vbShortDate) ‘hasilnya “3/2/99”
A$ = FormatDateTime(“3/2/99”, vbLongDate) ‘hasilnya “12:00:00 AM”

FormatNumber: membuat format bilangan sesuai option yang diberikan
FormatNumber(var1, 2)

FormatPerCent: membuat format bilangan dalam prosentase
A$ = FormatPerCent(0.1255, 2) ‘A$ = 12.55%
A$ = FormatPerCent(0.12555) ‘A$ = 12.56%
A$ = FormatPerCent(12.55, 2) ‘A$ = 1,255.00%
A$ = FormatPerCent(12.55) ‘A$ = 1,255.00%

Koneksi Database Access di Vb 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Source code berikut untuk mengoneksikan VB 6 dengan database Access. Agar aplikasi bisa di running dimana saja, dengan menggunakan fungsi App.Path, dan database Access disimpan dalam satu folder yang sama dengan project VB nya.

caranya :
1. Buat sebuah module, kemudian masukkan source code berikut :

Public Conn As New ADODB.Connection

Public Sub koneksi()
On Error GoTo konekErr

If Conn.State = 1 Then Conn.Close

'sesuaikan database .mdb nya dengan database anda
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\db_tes.mdb;Persist Security Info=False"
Exit Sub

konekErr:
MsgBox "Gagal menghubungkan ke Database ! Kesalahan pada : " & Err.Description, vbCritical, "Peringatan"
End Sub

2. Untuk penggunaannya dengan Adodc dan DataGrid, seperti contoh berikut :

Private Sub Form_Load()
koneksi 'pemanggilan koneksi database

Adodc1.ConnectionString = Conn.ConnectionString
Adodc1.RecordSource = "select * from contoh"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub

3. Untuk lebih jelasnya, download source code berikut

4. selesai...

Menginput data dengan TrueDBGrid

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Udah jam 2 malam nie...
seperti janji saya pada postingan yang lalu saya akan memposting cara menginput data dengan TrueDBGrid

oke langsung saja...

Untuk bisa menggunakan Truedatagrid sebagai objek yang bisa diinput maka terlebih dulu buat referensi seperti gambar dibawah ini :

Dari gambar diatas beri tanda centang ComponentOne XArrayDB 8.0 Object
Setelah itu baru deklarasikan object XArray tersebut seperti kode selengkapnya dibawah ini

Dim arr As New XArrayDB
Dim conn As New Connection
Dim rs As New Recordset

Private Sub cmdAdd_Click()
'---menghapus semua nilai array di memory
arr.Clear
TDBGrid1.ReBind
End Sub

Private Sub cmdSave_Click()
For iRow = arr.LowerBound(1) To arr.UpperBound(1)
TDBGrid1.Row = 0
If arr(i, 0) <> "" Then
rs.AddNew
rs.Fields("KODE") = arr(iRow, 0)
rs.Fields("NAMA") = arr(iRow, 1)
rs.Fields("ALAMAT") = arr(iRow, 2)
rs.Update
End If
Next
End Sub

Private Sub Form_Load()
'---membuat 2 baris, 2 kolom
arr.ReDim 0, 1, 0, 2
Set TDBGrid1.Array = arr

TDBGrid1.Columns(0).Caption = "KODE"
TDBGrid1.Columns(1).Caption = "NAMA"
TDBGrid1.Columns(2).Caption = "ALAMAT"

conn.Provider = "Microsoft.Jet.OLEDB.4.0"
conn.Open App.Path & "\db.mdb"

rs.CursorLocation = adUseClient
rs.Open "SELECT * FROM Table1", conn, adOpenStatic, adLockOptimistic

End Sub

sekarang kalo kita periksa tablenya di database access hasilnya seperti gambar dibawah ini

Nah sekarang, bagaimana kalo kita tambahkan DropDown atau ComboBox pada TrueDBGrid
Silahkan tambahkan control TDBDropDown ke form
untuk mengisi data kedalam TDBDropDown perhatikan kode dibawah ini

'---tambahkan kode dibawah ini di form load
rs2.CursorLocation = adUseClient
rs2.Open "SELECT kota FROM Table2", conn, adOpenStatic, adLockOptimistic

TDBDropDown1.DataSource = rs2
TDBDropDown1.Columns(0).Caption = "Asal Kota"

TDBGrid1.Columns(2).DropDown = TDBDropDown1

dan hasilnya akan seperti dibawah ini

ok sekian dulu dari saya...
silahkan langsung dipraktekkan dan dikembangkan

Menginput Data dengan MSFlexGrid

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Setelah memposting menginput data dengan DataGrid, kali ini saya akan memposting artikel tentang menginput data dengan MSFlexGrid

source code :

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset

Private Sub cmdSave_Click()
For i = 1 To MSHFlexGrid1.Rows - 1
If MSHFlexGrid1.TextMatrix(i, 0) <> "" Then
rs.AddNew
rs(0) = MSHFlexGrid1.TextMatrix(i, 0)
rs(1) = MSHFlexGrid1.TextMatrix(i, 1)
rs(2) = MSHFlexGrid1.TextMatrix(i, 2)
rs(3) = MSHFlexGrid1.TextMatrix(i, 3)
rs(4) = MSHFlexGrid1.TextMatrix(i, 4)
rs(5) = MSHFlexGrid1.TextMatrix(i, 5)
rs(6) = MSHFlexGrid1.TextMatrix(i, 6)
rs.Update
Else
Exit For
End If
Next
End Sub

Private Sub Form_Load()
With MSHFlexGrid1
.TextMatrix(0, 0) = "Kolom 1"
.TextMatrix(0, 1) = "Kolom 2"
.TextMatrix(0, 2) = "Kolom 3"
.TextMatrix(0, 3) = "Kolom 4"
.TextMatrix(0, 4) = "Kolom 5"
.TextMatrix(0, 5) = "Kolom 6"
.TextMatrix(0, 6) = "Kolom 7"
End With

Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset

conn.Provider = "Microsoft.Jet.OleDB.4.0"
conn.Open App.Path & "\nwind.mdb"

rs.Open "Customers", conn, adOpenDynamic, adLockOptimistic

End Sub

Private Sub MSHFlexGrid1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyReturn, vbKeyTab
'---pindah ke cell berikutnya
With MSHFlexGrid1
If .Col + 1 <= .Cols - 1 Then
.Col = .Col + 1
Else
If .Row + 1 <= .Rows - 1 Then
.Row = .Row + 1
.Col = 0
Else
.Row = 1
.Col = 0
End If
End If
End With
Case vbKeyBack
With MSHFlexGrid1
'---hapus karakter terakhir
If Len(.Text) Then
.Text = Left(.Text, Len(.Text) - 1)
End If
End With
Case Is < 32 '---selain alfabet ga bisa dimasukkin
Case Else
'---masukkan karakter ke flexgrid
MSHFlexGrid1.Text = MSHFlexGrid1.Text & Chr(KeyAscii)
End Select
End Sub

gambar hasil output :

selesay...
selanjutnya saya akan memposting bagaimana cara menginput Data dengan TrueDBGrid

jadi ikuti terus Blog ini ....

Menginput data dengan DataGrid

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Sebenarnya di Visual basic 6.0 terdapat banyak toolbox yang dapat digunakan untuk menginput data kedalam database yaitu dengan : DataGrid, TrueDBGrid, MSFlexGrid, dll

kali ini saya akan membahas tentang menginput data dengan DataGrid

source code :

Dim conn As New Connection
Dim rsInput As New Recordset '--recordset sbg utk input
Dim rsSave As New Recordset

'---membuat recordset yg akan digunakan
'---sbg datasource dari datagrid
Private Sub CreateFields()
rsInput.Fields.Append "KODE", adVarChar, 4
rsInput.Fields.Append "NAMA", adVarChar, 15
rsInput.Fields.Append "ALAMAT", adVarChar, 25
rsInput.CursorLocation = adUseClient
rsInput.Open
Set DataGrid1.DataSource = rsInput
End Sub

'---mendesign bentuk tampilan datagrid
Private Sub FormatGrid()
DataGrid1.Columns(0).Button = True
DataGrid1.Columns(1).Button = True

With DataGrid1
.Columns(0).Caption = "Kode"
.Columns(1).Caption = "Nama"
.Columns(2).Caption = "Alamat"
End With
End Sub

Private Sub Form_Load()
conn.Provider = "microsoft.jet.oledb.4.0"
conn.Open App.Path & "\nwind.mdb"

Call CreateFields

Call FormatGrid
End Sub

'---pd saat grid diklik, buat row baru pd recordset
'---sehingga grid bisa menerima inputan
Private Sub DataGrid1_Click()
'--jika tidak dalam mode edit
If rsInput.EditMode = adEditNone Then
rsInput.AddNew '--tambahkan baris baru
Else
Exit Sub
End If
End Sub

'---utk mendetek posisi kolom, apabila pointer
'---berada pd posisi kolom ke 2 atau kolom akhir
'---maka tambahkan baris baru
Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If DataGrid1.Col = 2 Then
rsInput.AddNew
DataGrid1.Col = rsInput(0)
Exit Sub
End If
SendKeys "{RIGHT}"
End If
End Sub

'---inilah kode utk menyimpan semua data yg di input
'---dalam datagrid ke database
Private Sub cmdSave_Click()
rsSave.CursorLocation = adUseClient
rsSave.Open "test", conn, adOpenStatic, adLockOptimistic

rsInput.MoveFirst
For i = 0 To rsInput.RecordCount - 1
If Len(DataGrid1.Columns(0).Text) > 0 Then
rsSave.AddNew
rsSave(0) = rsInput(0)
rsSave(1) = rsInput(1)
rsSave(2) = rsInput(2)
rsSave.Update
End If
rsInput.MoveNext
Next

rsInput.Close
rsSave.Close
Set rsInput = Nothing
Set rsSave = Nothing

Call CreateFields
Call FormatGrid
End Sub

contoh outputnya seperti ini :

Import Tabel ke tabel yang lain

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

artikel ini bercerita tentang proses bagaimana mengimport data yang berada pada database satu(tabel) ke database yang lain(tabel lain) tanpa harus menghapus data yang sudah ada. Artinya cara ini seperti anti virus yang di update.

oke... go to TKP

1. seperti biasa, desainlah form kira" seperti gambar dibawah ini

2. ketiklah kodenya seperti dibawah ini di level General Declaration

Pada event Form Load ketiklah kodenya seperti dibawah ini

Dan ketik kode dibawah ini untuk menghubungkan database yg mau di transfer

Lalu untuk event pada List1, kodenya seperti dibawah ini gunanya untuk menampilkan semua tabel yang ada pada database yang mau ditransfer. Jadi dalam hal ini, tabelnya dipilih terlebih dahulu, baru di transfer

Nah ini inti dari proses mentransfer/export ke tabel

Lalu, ketik kode dibawah ini yang sebenarnya untuk memilih Field-field tertentu yang mau di transfer/export dengan cara meng klik tipe-tipe Header Caption dari datagrid

Dan terakhir, ketik kode dibawah ini untuk menampilkan data-data yang ada pada tabel yang digunakan pada aplikasi/tabel asli ke datagrid

Bila dijalankan maka hasilnya akan seperti penampakan dibawah ini

Klik button Database, maka akan ada penampakan seperti gambar dibawah ini

Dan hasilnya akan seperti gambar dibawah ini, semua tabel akan terlihat pada List

Apabila tiap nama tabel di klik, maka otomatis akan tampil di datagrid dan juga otomatis menjadi tabel yang terpilih untuk di transfer/export. Hasilnya seperti gambar dibawah ini :

Setelah tabel dipilih, klik button Transfer untuk siap di transfer dan hasilnya seperti gambar dibawah ini

Apabila field-field tertentu saja yang mau di transfer/export maka klik tiap-tiap header caption dari datagrid maka setiap field yang terpilih akan masuk ke list seperti gambar dibawah ini

Dan hasilnya seperti gambar dibawah ini

seperti biasa... Catatan Kecil :

proses mentransfer ini, yang kodenya ada di button Transfer kalo ga mau menggunakan pengulangan, bisa juga diganti dengan kode seperti dibawah ini
sql = "INSERT INTO " & namaTabel & " &" _
SELECT * FROM [MS Access;DATABASE=" & Text1.Text & "].[" & namaTabel & "]"
Dim cmd As New Command
cmd.ActiveConnection = dbOriginal
cmd.CommandType = adCmdText
cmd.CommandText = sql
cmd.Execute

Text1.Text adalah path/alamat lengkap dari database yang mau ditransfer/export

huuuuuuuffftt capek euy... :-*

Mencari Bilangan Prima di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Program ini merupakan soal MID Test semester 3 saya.

oke langsung kita buat programnya :

1. Desain form seperti gambar dibawah ini.

2. Masukkan Script dibawah ini di form

Dim BanyaknyaBilanganPrima, i, AngkaPrima, j As Integer
Dim Prima As Boolean

Private Sub Command1_Click()
BanyaknyaBilanganPrima = Val(Text1.Text)
List1.Clear
i = 0
AngkaPrima = 2

'---buat bilangan prima sebanyak yang di masukkan di textbox
While i < BanyaknyaBilanganPrima
Prima = True
For j = 2 To AngkaPrima - 1

'---kalo sisa baginya=0 berati bukan bilangan prima
If AngkaPrima Mod j = 0 Then Prima = False

Next j

If Prima = True Then
List1.AddItem AngkaPrima
i = i + 1
End If
AngkaPrima = AngkaPrima + 1
Wend
End Sub

3. Hasil Output Program

Auto Number di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Biasanya aplikasi untuk perdagangan atau penjurnalan memerlukan id atau no urut yang sudah ditentukan.Jadi pada saat ada penambahan record baru, maka id tersebut sudah otomatis masuk dalam textbox.Nah dibawah ini ada contoh sederhana bagaimana membuat no urut yg otomatis.

Perhatikan gambar diatas, pada saat tombol New Record di klik maka otomatis akan membuat suatuno urut dgn format Kasus/Per-XXX/26022009-00001.
Angka 26022009 ini artinya 26 Februari 2009 dan 00001 adalah no urutnya.
Nah berikut ini adalah kode utk membuat nya

Perhatikan lagi gambar diatas, pada saat tombol New Record di klik maka otomatis no urutnya
sudah berubah menjadi 00002 karena dalam tabel angka 00001 sudah ada.

Menghitung Selisih Waktu

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Di Visaul Basic, kita dapat membuat apapun termasuk menghitung selisih waktu/jam.
berikut gambar hasil output dan source codenya :

Private Function totalWaktu (jamAwal As Variant, jamAkhir As Variant) As String

Dim detikAkhir, detikAwal, jumlahDetik As Long

detikAwal = (Hour(jamAwal) * 3600) + (Minute(jamAwal) * 60) + (Second(jamAwal))

detikAkhir = (Hour(jamAkhir) * 3600) + (Minute(jamAkhir) * 60) + (Second(jamAkhir))

If jamAkhir < jamAwal Then
'----di hitung satu hari
jumlahDetik = 86400
Else
jumlahDetik = 0
End If

jumlahDetik = jumlahDetik + (detikAkhir - detikAwal)

totalWaktu = Format(Str(Int((Int((jumlahDetik / 3600)) Mod 24))), "00") + _
":" + Format(Str(Int((Int((jumlahDetik / 60)) Mod 60))), "00") + _
":" + Format(Str(Int((jumlahDetik Mod 60))), "00")

End Function

Private Sub Command1_Click()
Text3.Text = totalWaktu(Text1, Text2)
End Sub

sedikit catatan kecil :

1 Detik = Seper 60 Menit (1/60 Detik)
1 Menit = 60 Detik
1 Jam = 60 Menit
1 Jam = 3.600 Detik
1 Hari = 1.440 Menit
1 Hari = 86.400 Detik

Form selalu di tengah layar

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Terkadang dalam Visual Basic 6.0, pengaturan posisi form itu dapat di tentukan secara manual, tetapi jika sudah menggunakan MDI Form makan posisi Form tersebut selalu berubah.
maka apabila agan" ingin agar Form selalu berada di tengah layar, cara terbaik adalah melalui prosedur load dari form.
caranya sangat mudah, cukup mengetikkan script berikut di Form Load

Private sub form_load() Left = (screen.width - width) \ 2 Top = (screen.height - height) \ 2 End Sub

hasilnya ketika program di jalankan maka formnya akan berada di tengah...
gampang kan...???

Fungsi Pecahan uang (recehan)

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Banyak teman seangkatan saya menanyakan cara membuat fungsi receh, setelah menjelajah dibeberapa website/blog ketemulah script berikut :

sebelumnya perlu agan" ketahui bahwa fungsi receh hampir sama logikanya dengan fungsi terbilang (serupa tapi tak sama)...

ok langsung ke TKP :

1. buatlah sebuah modul, kemudian isikan fungsi/script di bawah ini :

Function Pecahan(Angka As Long, Index As Integer) As Integer
    Dim Angka2 As Long
    Dim NominalUang(1 To 10) As Integer

    Angka2 = Angka

        If Angka2 >= 100000 Then
            NominalUang(1) = Angka2 \ 100000
            Angka2 = Angka2 Mod 100000
        End If

        If Angka2 >= 50000 Then
            NominalUang(2) = Angka2 \ 50000
            Angka2 = Angka2 Mod 50000
        End If

        If Angka2 >= 20000 Then
            NominalUang(3) = Angka2 \ 20000
            Angka2 = Angka2 Mod 20000
        End If

        If Angka2 >= 10000 Then
            NominalUang(4) = Angka2 \ 10000
            Angka2 = Angka Mod 10000
        End If

        If Angka2 >= 5000 Then
            NominalUang(5) = Angka2 \ 5000
            Angka2 = Angka2 Mod 5000
        End If

        If Angka2 >= 1000 Then
            NominalUang(6) = Angka2 \ 1000
            Angka2 = Angka2 Mod 1000
        End If

        If Angka2 >= 500 Then
            NominalUang(7) = Angka2 \ 500
            Angka2 = Angka2 Mod 500
        End If

        If Angka2 >= 200 Then
            NominalUang(8) = Angka2 \ 200
            Angka2 = Angka2 Mod 200
        End If

        If Angka2 >= 100 Then
            NominalUang(9) = Angka2 \ 100
            Angka2 = Angka2 Mod 100
        End If

        If Angka2 >= 50 Then
            NominalUang(10) = Angka2 \ 50
            Angka2 = Angka2 Mod 100
        End If
    Pecahan = NominalUang(Index)
End Function

2. Tambahkan sebuah TextBox pada form, namai dengan txtNominal. Tambahkan pula sebuah CommandButton, ketik kode di bawah ini :

Private Sub Command1_Click()

    Dim i As Integer

    MsgBox Pecahan(CLng(Me.txtNominal), 1) & " SeratusRibuan"
    MsgBox Pecahan(CLng(Me.txtNominal), 2) & " LimaPuluhRibuan"
    MsgBox Pecahan(CLng(Me.txtNominal), 3) & " DuaPuluhRibuan"
    MsgBox Pecahan(CLng(Me.txtNominal), 4) & " SepuluhRibuan"
    MsgBox Pecahan(CLng(Me.txtNominal), 5) & " LimaRibuan"
    MsgBox Pecahan(CLng(Me.txtNominal), 6) & " Seribuan"
    MsgBox Pecahan(CLng(Me.txtNominal), 7) & " LimaRatusan"
    MsgBox Pecahan(CLng(Me.txtNominal), 8) & " DuaRatusan"
    MsgBox Pecahan(CLng(Me.txtNominal), 9) & " Seratusan"
    MsgBox Pecahan(CLng(Me.txtNominal), 10) & " LimaPuluhan"
End Sub

3. Jalankan programnya.

semoga berhasil.

Bentuk form sesuai dengan gambar

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Bosan dengan tampilan form yang berbentuk persegi? Ingin mengubahnya dengan bentuk lain yang lebih dinamis? ikuti langkah-lagkah berikut !

Ubah BorderStyle form menjadi 0-None, tempatkan sebuah PictureBox, namai dengan “picMainSkin”. Tambahkan sebuah Module, ketik kode di bawah:

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetPixel Lib "gdi32" _
(ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long) As Long

Declare Function CreateRectRgn Lib "gdi32" _
(ByVal x1 As Long, _
ByVal y1 As Long, _
ByVal x2 As Long, _
ByVal y2 As Long) As Long

Declare Function CombineRgn Lib "gdi32" _
(ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Public Declare Function _
ReleaseCapture Lib "user32" () As Long

Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long

Declare Function CreateRoundRectRgn Lib "gdi32" _
(ByVal x1 As Long, _
ByVal y1 As Long, _
ByVal x2 As Long, _
ByVal y2 As Long, _
ByVal X3 As Long, _
ByVal Y3 As Long) As Long

Public StartX!
Public StartY!

Public Function BentukDaerah(picSkin As PictureBox) As Long
    Dim X As Long, Y As Long
    Dim AwalGaris As Long
    Dim DaerahPenuh As Long
    Dim GarisDaerah As Long
    Dim GarisDalam As Boolean
    Dim AwalDaerah As Boolean
    Dim hDC As Long
    Dim Lebar As Long
    Dim Tinggi As Long

    hDC = picSkin.hDC
    Lebar = picSkin.Width / Screen.TwipsPerPixelX
    Tinggi = picSkin.Height / Screen.TwipsPerPixelY

    AwalDaerah = True: GarisDalam = False

    X = AwalGaris = 0
    Y = 200

    For Y = 0 To Tinggi - 1
        For X = 0 To Lebar - 1
            If GetPixel(hDC, X, Y) = vbWhite Or X = Lebar Then
                If GarisDalam Then
                    GarisDalam = False
                    GarisDaerah = CreateRectRgn(AwalGaris, Y, X, Y + 1)
                    If AwalDaerah Then
                        DaerahPenuh = GarisDaerah
                        AwalDaerah = False
                    Else
                        CombineRgn DaerahPenuh, DaerahPenuh, GarisDaerah, 2
                        DeleteObject GarisDaerah
                    End If
                End If
            Else
                If Not GarisDalam Then
                    GarisDalam = True
                    AwalGaris = X
                End If
            End If
        Next
    Next

    BentukDaerah = DaerahPenuh
End Function

Public Sub PindahDonk(ctl As Object, Button As Integer, _
X As Single, Y As Single)
    If Button = 1 Then
        ctl.Left = IIf(X < StartX, ctl.Left - (StartX - X), _
        ctl.Left + (X - StartX))
        ctl.Top = IIf(Y < StartY, _
        ctl.Top - (StartY - Y), ctl.Top + (Y - StartY))
    End If
End Sub

Ketikkan source code di bawah ini pada form:

Option Explicit

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim WindowRegion As Long
    '
    With Me.picMainSkin
        .ScaleMode = 3

        .Move 0, 0
        .DrawWidth = 10

        .FillStyle = 0
        .FillColor = vbRed
        Me.picMainSkin.Circle (105, 105), 90, vbYellow

        .FillColor = vbBlue
        Me.picMainSkin.Circle (400, 105), 40, vbYellow

        .FillStyle = 1
        .ForeColor = vbYellow
        Me.picMainSkin.Line (105, 10)-(400, 60.5)
        Me.picMainSkin.Line (105, 200)-(400, 150)

        Width = .Width
        Height = .Height
    End With

    WindowRegion = BentukDaerah(Me.picMainSkin)
    SetWindowRgn Me.hwnd, WindowRegion, True

End Sub

Private Sub picMainSkin_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        StartX = X
        StartY = Y
    End If
End Sub

Private Sub picMainSkin_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
    PindahDonk Me, Button, X, Y
End Sub

jalankan program dan lihat hasilnya...
jangan lupa dikembangkan

Membuat PictureBox Transparant (seperti kaca) di VB 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Pengertian PictureBox Transparan adalah mengatur gambar pada PictureBox, dimana gambar tersebut disesuaikan dengan gambar pada form menurut letak dan ukuran PictureBox sehingga menciptakan efek PictureBox seolah-olah transparan. Simak penjelasannya di bawah ini!
Mulailah sebuah project baru! Ubah properti Picture dari form, sesuai dengan selera! Tambahkan sebuah PictureBox, namai dengan “picTrans”!

Ketikkan kode di bawah ini:

Option Explicit

Private Sub cmdTransparan_Click()
    With Me.picTrans
        .AutoRedraw = True

        'Menghilangkan "bingkai"
        .BorderStyle = 0

        'Menggambar pada PictureBox
        .PaintPicture Me.Image, 0, 0, .Width, _
        .Height, .Left, .Top, .Width, .Height
    End With
End Sub

Jalankan program! Klik pada PictureBox! Bisakah Anda menentukan letak dan ukuran PictureBox yang telah Anda tempatkan pada form sekarang?

Animasi Flash di vb 6.0

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Animasi flash adalah gambar animasi bergerak berekstensi *.swf dan biasanya dijalankan dengan menggunakan flash player. Animasi flash banyak digunakan untuk membuat banner pada website, game dan bahkan banyak aplikasi yang dibuat dengan Flash. Selain itu kita juga bisa memainkan animasi flash melalui Visual Basic yaitu dengan menggunakan komponen ShockwaveFlash

Langkah – langkah memainkan animasi flash di VB:

Buat project baru pada Visual Basic 6.0 kemudian pilih Standard.exe
Tambahkan komponen ShockwaveFlash , pilih menu project -> components, maka akan muncul kotak dialog sebagai berikut :

Kemudian tambahkan ke Form, 1 buah object ShockwaveFlah, 4 buah CommandButton, dan 1 buah CommonDialog sehingga tampilannya menjadi seperti ini :

Selanjutnya Copy Paste Source Code Berikut ini :

Private Sub Command1_Click()
Me.CommonDialog1.Filter = "Flash File (*.swf) | *.swf"
Me.CommonDialog1.ShowOpen
End Sub
Private Sub Command2_Click()
Me.ShockwaveFlash1.Movie = Me.CommonDialog1.FileName
Me.ShockwaveFlash1.Play
End Sub
Private Sub Command3_Click()
Me.ShockwaveFlash1.StopPlay
End Sub
Private Sub Command4_Click()
End
End Sub

Jalankan program yang telah dibuat, klik tombol Open File kemudian cari file flash yang ingin dimainkan, kemudian klik tombol Play.

Kudo Share'

30 Dec 2012

KeyWord Option Base di VB 6.0

8 Oct 2012

Mempercantik tampilan form VB 6.0

28 Sept 2012

Menampilkan Data Berdasarkan Tanggal

27 Sept 2012

Membuat form agar tidak bisa Maximize di VB 6.0

Membuat form agar tidak bisa resize di VB 6.0

Membuat Text Berkedip di VB 6.0

Fungsi String pada vb 6.0

Koneksi Database Access di Vb 6.0

Menginput data dengan TrueDBGrid

Menginput Data dengan MSFlexGrid

Menginput data dengan DataGrid

Import Tabel ke tabel yang lain

Mencari Bilangan Prima di VB 6.0

Auto Number di VB 6.0

Menghitung Selisih Waktu

Form selalu di tengah layar

Fungsi Pecahan uang (recehan)

Bentuk form sesuai dengan gambar

Membuat PictureBox Transparant (seperti kaca) di VB 6.0

Animasi Flash di vb 6.0

Sahabat Blogger

Profil Admin