Thursday, December 23, 2010

Cetak Ke Printer Via LPT Port Menggunakan VB6

Di bawah ini merupakan contoh cara mencetak ke printer via LPT Port menggunakan Visual Basic 6 - Adapun kodenya adalah sebagai berikut:
Public Function PrintToLPTPort(ByVal port As String, ByVal text As String) As Boolean 
On Error GoTo
ErrHandler
Dim l As Long
l = FreeFile
Open
port For Output As #l
Print #F, text
Close #l
PrintToLPTPort = True
Exit Function

ErrHandler:
PrintToLPTPort = False
End Function
Contoh penggunaan cetak ke printer via LPT Port:
Private Sub Command1_Click() 
PrintToLPTPort "LPT1", "Test Print"
End Sub
READ MORE - Cetak Ke Printer Via LPT Port Menggunakan VB6

Wednesday, December 22, 2010

Web Color Spy - Mendeteksi Warna Standar Web

Di bawah ini merupakan project VB6 sederhana untuk mendeteksi warna standar web. Bagaimana kode project web color spy untuk mendeteksi warna standar web, bisa lihat di bawah ini:
'simpan kode di bawah pada module 
Option Explicit

Public Declare Function
CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any)
Public Declare Function DeleteDC& Lib "gdi32" (ByVal hdc As Long)
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Type
POINTAPI
X As Long
Y As Long
End Type

Public Declare Function
GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'simpan kode di bawah pada form 
'Timer.Interval = 1
'Picture1.AutoRedraw = True

Option Explicit

Dim pt As
POINTAPI
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Timer1.Enabled = True
Picture1.MousePointer = vbCrosshair
End Sub

Private Sub
Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = False
Picture1.MousePointer = vbDefault
End Sub

Private Sub
Timer1_Timer()
Dim screendc As Long
GetCursorPos pt
screendc = CreateDC("DISPLAY", "", "", 0&)
Picture1.BackColor = GetPixel(screendc, pt.X, pt.Y)
Text1.Text = "#" & Hex(GetPixel(screendc, pt.X, pt.Y))
DeleteDC (screendc)
End Sub
READ MORE - Web Color Spy - Mendeteksi Warna Standar Web

Friday, October 8, 2010

Download Software Faraidh (Hitung Warits) At-Tashil Versi 4.1

At-Tashil, merupakan software faraidh (hitung warits) , dilengkapi dengan fasilitas struktur pohonnya yang sangat membantu mempermudah dalam penggunaan. At-Tashil dibuat oleh Mas Ahmad Ruswandi. Dalam At-Tashil v4.0 terdapat dua tambahan bahasa, yakni Arab dan Inggris. Versi 4.1 (Oktober 2010) merupakan versi terakhir yang telah dirilis.

Menurut pembuatnya, Software ini masih dalam tahap evaluasi. Silahkan download dan diperiksa, bilamana terdapat bugs dan errors dalam software ini, Anda dapat berbagi dengan pengembangnya melalui email kaisansoft [at] gmail.com atau diskusikan melalui forum di situs kaisansoft.com.

Download Software At-Tashil Versi 4.1

Perhatian: 
Saat ini situ http://kaisansoft.com sudah tidak bisa di akses lagi.
READ MORE - Download Software Faraidh (Hitung Warits) At-Tashil Versi 4.1

Friday, October 1, 2010

Manteq - Faraidh : Contoh Soal - 5

Seseorang meninggal dunia dengan meninggalkan harta 216.000, adapun ahli waritsnya: Istri, ayah, ibu, anak perempuan, cucu perempuan

Istri
Apakah: terdapat far'ul warits?
YA maka 1/8
JIKA TIDAK maka 1/4

Maka kesimpulannya istri 1/8

Ayah
Apakah: Bersama far'ul warits mudzakkar?
YA maka 1/6
JIKA TIDAK, apakah bersama far'ul warits muannats?
YA maka 1/6 + ( ashabah jika radd)
JIKA TIDAK, maka ashabah (binafsihi).

Maka kesimpulannya ayah 1/6 + ( ashabah jika radd)

Ibu
Apakah: masalah gharrawain?
YA maka 1/3 sisa
JIKA TIDAK, apakah bersama far'ul warits atau sekumpulan saudara/saudari?
YA maka 1/6
Jika tidak maka 1/3

Maka kesimpulannya ibu 1/6

Anak perempuan
Apakah:Bersama mua'shibnya (anak laki-laki)?
YA maka ashabah (bilghairi)
JIKA TIDAK, apakah 1 orang?
YA maka 1/2
JIKA TIDAK, maka 2/3

Maka kesimpulannya anak perempuan 1/2

Cucu Perempuan
Apakah: Ada anak laki-laki?
YA, maka mahjub
JIKA TIDAK, apakah bersama muashibnya (cucu laki-laki)?
YA maka ashabah (bilghairi)
JIKA TIDAK, apakah ada anak perempuan > 1 orang?
YA maka mahjub
JIKA TIDAK, apakah ada anak perempuan = 1 orang?
YA maka 1/6
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK, maka 2/3

Maka kesimpulannya cucu perempuan 1/6

1/8 x 24 = 3
1/6 x 24 = 4
1/6 x 24 = 4
1/2 x 24 = 12
1/6 x 24 = 4

3 + 4 + 4 + 12 + 4 = 27
Jika hasilnya lebih dari 24 maka aul dan 27 lebih dari 24 maka aul.

Istri : 3/27 x 216.000 = 24.000
Ayah : 4/27 x 216.000 = 32.000
Ibu : 4/27 x 216.000 = 32.000
Anak perempuan : 12/27 x 216.000 = 96.000
Cucu perempuan : 4/27 x 216.000 = 32.000

SELESAI
READ MORE - Manteq - Faraidh : Contoh Soal - 5

Manteq - Faraidh: Contoh Soal - 4

Seseorang meninggal dunia dengan meninggalkan harta 300.000, adapun ahli waritsnya: Saudari kandung, saudari seibu, saudari seayah

Saudari kandung
Apakah bersama ayah ATAU far'ul warits mudzakkar?
YA maka mahjub
JIKA TIDAK, apakah bersama muashibnya (saudara kandung)?
YA maka ashabah (bilghair)
JIKA TIDAK, apakah bersama far'ul warits muannats?
YA maka ashabah (ma'al ghair)
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK 2/3

Maka kesimpulannya saudari kandung mendapatkan 1/2

Saudari seibu
Apakah bersama ashlul warits mudzakkar ATAU far'ul warits?
YA maka mahjub
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/6
JIKA TIDAK, maka 1/3

Maka kesimpulannya saudari seibu mendapatkan 1/6

Saudari seayah
Apakah bersama ayah ATAU far'ul warits mudzakkar ATAU Saudari kandung yang menjadi ashabah (ma'al ghair) ATAU saudara kandung?
YA maka mahjub
JIKA TIDAK, apakah bersama muashibnya (saudara seayah)?
YA maka ashabah (bilghair)
JIKA TIDAK, apakah bersama 2 saudari kandung atau lebih?
YA maka mahjub
JIKA TIDAK, apakah bersama 1 saudari kandung?
YA maka 1/6
JIKA TIDAK, apakah bersama far'ul warits muannats?
YA maka ashabah ma'al ghair
JIKA TIDAK, apakah berjumlah satu orang?
YA maka 1/2
JIKA TIDAK, 2/3

Maka kesimpulannya saudari seayah mendapatkan 1/6

1/2 x 24 = 12
1/6 x 24 = 4
1/6 x 24 = 4

12 + 4 + 4 = 20
Jika hasilnya kurang dari 24 maka radd, dan 20 kurang dari 24 maka radd.

Saudari kandung : 12/20 x 300.000 = 180.000
Saudari seibu : 4/20 x 300.000 = 60.000
Saudari seayah : 4/20 x 300.000 = 60.000

SELESAI
READ MORE - Manteq - Faraidh: Contoh Soal - 4

Manteq - Faraidh: Contoh Soal - 3

Seseorang meninggal dunia dengan meninggalkan harta 240.000, Adapun ahli waritsnya: Istri, ibu, saudara seibu

Istri
Apakah: terdapat far'ul warits?
YA maka 1/8
JIKA TIDAK maka 1/4

Maka kesimpulannya istri mendapatkan 1/4

Ibu
Apakah: masalah gharrawain?
YA maka 1/3 sisa
JIKA TIDAK, apakah bersama far'ul warits atau sekumpulan saudara/saudari?
YA maka 1/6
JIKA TIDAK maka 1/3

Maka kesimpulannya ibu mendapatkan 1/3

Saudara seibu
Apakah bersama ashlul warits mudzakkar ATAU far'ul warits?
YA maka mahjub
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/6
JIKA TIDAK, maka 1/3

Maka kesimpulannya saudara seibu mendapat 1/3

Istri : 1/4
Ibu : 1/3
Saudara seibu : 1/6

1/4 x 240.000 = 60.000
maka sisanya (240.000 – 60.000) = 180.000
1/3 x 24 = 8
1/6 x 24 = 4

6 + 8 = 12
Jika hasilnya kurang dari 24 maka radd, dan 12 kurang dari 24 maka radd.

Ibu : 8/12 x 180.000 = 120.000
Saudara seibu : 4/12 x 18.000 = 60.000

Catatan:
Istri atau suami tidak mendapatkan harta radd.

SELESAI
READ MORE - Manteq - Faraidh: Contoh Soal - 3

Manteq - Faraidh: Contoh Soal - 2

Seseorang meninggal dunia dengan meninggalkan harta 600.000, adapun ahli waritsnya: Suami, ibu, 2 saudara seibu, saudari kandung, saudari seayah

Suami
Apakah: terdapat far'ul warits?
YA maka 1/4
JIKA TIDAK maka 1/2

Maka kesimpulannya suami mendapat 1/2

Ibu
Apakah: masalah gharrawain?
YA maka 1/3 sisa
JIKA TIDAK, apakah bersama far'ul warits ATAU sekumpulan saudara/saudari?
YA maka 1/6
Jika tidak maka 1/3

Maka kesimpulannya ibu mendapat 1/6

2 Saudara seibu
Apakah bersama ashlul warits mudzakkar ATAU far'ul warits?
YA maka mahjub
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/6
JIKA TIDAK, maka 1/3

Maka kesimpulannya 2 saudara seibu mendapat 1/3

Saudari kandung
Apakah bersama ayah ATAU far'ul warits mudzakkar?
YA maka mahjub
JIKA TIDAK, apakah bersama muashibnya (saudara kandung)?
YA maka ashabah (bilghair)
JIKA TIDAK, apakah bersama far'ul warits muannats?
YA maka ashabah (ma'al ghair)
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK 2/3

Maka kesimpulannya saudari kandung mendapat 1/2

Saudari seayah
Apakah bersama ayah ATAU far'ul warits mudzakkar ATAU Saudari kandung yang menjadi ashabah (ma'al ghair) ATAU saudara kandung?
YA maka mahjub
JIKA TIDAK, apakah bersama muashibnya (saudara seayah)?
YA maka ashabah (bilghair)
JIKA TIDAK, apakah bersama 2 saudari kandung atau lebih?
YA maka mahjub
JIKA TIDAK, apakah bersama 1 saudari kandung?
YA maka 1/6
JIKA TIDAK, apakah bersama far'ul warits muannats?
YA maka ashabah ma'al ghair
JIKA TIDAK, apakah berjumlah satu orang?
YA maka 1/2
JIKA TIDAK, 2/3

Maka kesimpulannya saudari seayah mendapatkan 1/6

Suami 1/2
Ibu 1/6
2 saudara seibu 1/3
Saudari kandung 1/2
Saudari seayah 1/6

1/2 x 24 = 12
1/6 x 24 = 4
1/3 x 24 = 8
1/2 x 24 = 12
1/6 x 24 = 4

12 + 4 + 8 + 12 + 4 = 40
Jika hasilnya lebih dari 24 maka aul dan 40 lebih dari 24 maka aul.

Suami : 12/40 x 600.000 = 180.000
Ibu : 4/40 x 600.000 = 60.000
2 Saudara seibu : 8/40 x 600.000 = 120.000
Saudari kandung : 12/40 x 600.000 = 180.000
Saudari seayah : 4/40 x 600.000 = 60.000

SELESAI
READ MORE - Manteq - Faraidh: Contoh Soal - 2

Manteq - Faraidh: Contoh Soal - 1

Soal: Seseorang meninggal dunia meninggalkan harta 54.000, adapun ahli waritsnya: Anak perempuan, cucu perempuan, ibunya bapak, saudari kandung, ibu dari ibunya ibu

Agar jelas bagiannya, kita ulangi kembali dari masing-masing ahli waritsnya:

Anak perempuan.
Apakah:Bersama mua'shibnya (anak laki-laki)?
YA maka ashabah (bilghairi)
JIKA TIDAK, apakah 1 orang?
YA maka 1/2
JIKA TIDAK, maka 2/3

Maka kesimpulannya anak perempuan mendapat 1/2

Cucu Perempuan
Apakah: Ada anak laki-laki?
YA, maka mahjub
JIKA TIDAK, apakah bersama muashibnya (cucu laki-laki)?
YA maka ashabah (bilghairi)
JIKA TIDAK, apakah ada anak perempuan > 1 orang?
YA maka mahjub
JIKA TIDAK, apakah ada anak perempuan = 1 orang?
YA maka 1/6
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK, maka 2/3

Maka kesimpulannya cucu perempuan mendapat 1/6

Ibunya Bapak (nenek shahih jurusan bapak)
Apakah bersama ibu ATAU ayah ATAU kakek shahih?
YA maka mahjub
JIKA TIDAK maka 1/6

Maka kesimpulannya ibunya ibu mendapat 1/6

Saudari kandung
Apakah bersama ayah ATAU far'ul warits mudzakkar?
YA maka mahjub
JIKA TIDAK, apakah bersama muashibnya (saudara kandung)?
YA maka ashabah (bilghair)
JIKA TIDAK, apakah bersama far'ul warits muannats?
YA maka ashabah (ma'al ghair)
JIKA TIDAK, apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK 2/3

Maka kesimpulannya saudari kandung menjadi ashabah (ma’al ghair)

Ibu dari ibunya ibu (ibunya nenek shahih jurusan ibu)
Apakah bersama ibu ATAU nenek yang lebih dekat?
YA maka mahjub
JIKA TIDAK maka 1/6

Maka kesimpulannya ibu dari ibunya ibu terhijab oleh nenek yang lebih dekat (ibunya bapak)

Anak perempuan 1/2
Cucu perempuan 1/6
Ibunya bapak 1/6
Saudari kandung Ashabah (ma’al ghair)
Ibu dari ibunya ibu terhijab oleh nenek yang lebih dekat (ibunya bapak)

Anak perempuan : 1/2 x 54.000 = 27.000
Cucu perempuan : 1/6 x 54.000 = 9.000
Ibunya bapak : 1/6 x 54.000 = 9.000
Saudari kandung (Ashabah ma’al ghair) : 54.000 – (27.000 + 9.000 + 9.000) = 9.000

SELESAI
READ MORE - Manteq - Faraidh: Contoh Soal - 1

Manteq - Faraidh: Anak paman seayah

Apakah bersama salah satu para penghijab anak paman kandung ATAU anak paman kandung?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Anak paman seayah

Manteq - Faraidh: Anak paman kandung

Apakah bersama salah satu para penghijab paman seayah ATAU paman seayah?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Anak paman kandung

Manteq - Faraidh: paman seayah

Apakah bersama salah satu para penghijab paman kandung ATAU paman kandung?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: paman seayah

Manteq - Faraidh: Paman kandung

Apakah bersama salah satu para penghijab anak saudara seayah ATAU anak saudara seayah?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Paman kandung

Manteq - Faraidh: Anak saudara kandung

Apakah bersama salah satu para penghijab saudara seayah ATAU saudara seayah ATAU kakek shahih?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Anak saudara kandung

Manteq - Faraidh: Anak saudara seayah

Apakah bersama salah satu para penghijab saudara kandung ATAU anak saudara kandung?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Anak saudara seayah

Manteq - Faraidh: Saudara seayah

Apakah bersama salah satu para penghijab saudara kandung ATAU saudara kandung ATAU saudari kandung ma'al ghair?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Saudara seayah

Manteq - Faraidh: Saudara kandung

Apakah bersama far'ul warits mudzakkar ATAU ayah?
YA maka MAHJUB
Apakah masalah musyarakah?
YA maka selesaikan dengan MASALAH MUSYARAKAH
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Saudara kandung

Manteq - Faraidh: Saudara/Saudari seibu

Apakah bersama ashlul warits mudzakkar ATAU far'ul warits?
YA maka mahjub
JIKA TIDAK apakah berjumlah 1 orang?
YA maka 1/6
JIKA TIDAK maka 1/3
READ MORE - Manteq - Faraidh: Saudara/Saudari seibu

Manteq - Faraidh: Saudari seayah

Apakah bersama ayah ATAU far'ul warits mudzakkar ATAU Saudari kandung yang menjadi ashabah (ma'al ghair) ATAU saudara kandung?
YA maka MAHJUB
JIKA TIDAK apakah bersama muashibnya (saudara seayah)?
YA maka ASHABAH (BILGHAIR)
JIKA TIDAK apakah bersama 2 saudari kandung atau lebih?
YA maka MAHJUB
JIKA TIDAK apakah bersama 1 saudari kandung?
YA maka 1/6
JIKA TIDAK apakah bersama far'ul warits muannats?
YA maka ASHABAH (MA'AL GHAIR)
JIKA TIDAK apakah berjumlah satu orang?
YA maka 1/2
JIKA TIDAK maka 2/3
READ MORE - Manteq - Faraidh: Saudari seayah

Manteq - Faraidh: Saudari kandung

Apakah bersama ayah ATAU far'ul warits mudzakkar?
YA maka MAHJUB
JIKA TIDAK apakah bersama muashibnya (saudara kandung)?
YA maka ASHABAH (BILGHAIR)
JIKA TIDAK apakah bersama far'ul warits muannats?
YA maka ASHABAH (MA'AL GHAIR)
JIKA TIDAK apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK maka 2/3
READ MORE - Manteq - Faraidh: Saudari kandung

Manteq - Faraidh: Nenek shahihah jurusan ibu

Apakah bersama ibu?
YA maka MAHJUB
JIKA TIDAK maka 1/6
READ MORE - Manteq - Faraidh: Nenek shahihah jurusan ibu

Manteq - Faraidh: Nenek shahihah jurusan ayah

Apakah bersama ibu ATAU ayah ATAU kakek shahih?
YA maka MAHJUB
JIKA TIDAK maka 1/6
READ MORE - Manteq - Faraidh: Nenek shahihah jurusan ayah

Manteq - Faraidh: Ibu

Apakah masalah gharrawain?
YA maka 1/3 SISA
JIKA TIDAK apakah bersama far'ul warits ATAU sekumpulan saudara/saudari?
YA maka 1/6
JIKA TIDAK maka 1/3
READ MORE - Manteq - Faraidh: Ibu

Manteq - Faraidh: Kakek shahih

Apakah bersama ayah?
YA maka MAHJUB
JIKA TIDAK apakah bersama far'ul warits mudzakar?
YA maka 1/6
JIKA TIDAK apakah bersama far'ul warits muannats?
YA maka 1/6 + ASHABAH
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Kakek shahih

Manteq - Faraidh: Ayah

Apakah bersama far'ul warits mudzakkar?
YA maka 1/6
JIKA TIDAK apakah bersama far'ul warits muannats?
YA maka 1/6 + ASHABAH
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Ayah

Manteq - Faraidh: Cucu Perempuan pancar laki-laki

APAKAH ada anak laki-laki?
YA maka MAHJUB
JIKA TIDAK apakah bersama muashibnya (cucu laki-laki)?
YA maka ASHABAH (BILGHAIRI)
JIKA TIDAK apakah ada anak perempuan > 1 orang?
YA maka MAHJUB
JIKA TIDAK apakah ada anak perempuan = 1 orang?
YA maka 1/6
JIKA TIDAK apakah berjumlah 1 orang?
YA maka 1/2
JIKA TIDAK maka 2/3
READ MORE - Manteq - Faraidh: Cucu Perempuan pancar laki-laki

Manteq - Faraidh: Anak Perempuan

Apakah bersama mua'shibnya (anak laki-laki)?
YA maka ASHABAH (BILGHAIRI)
JIKA TIDAK apakah 1 orang?
YA maka 1/2
JIKA TIDAK maka 2/3
READ MORE - Manteq - Faraidh: Anak Perempuan

Manteq - Faraidh: Cucu laki-laki pancar laki-laki

Apakah ada anak laki-laki?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Cucu laki-laki pancar laki-laki

Manteq - Faraidh: Anak laki-laki

Apakah anak laki-laki?
YA
maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Anak laki-laki

Manteq - Faraidh: Suami

Apakah terdapat far'ul warits?
YA maka 1/4
JIKA TIDAK maka 1/2
READ MORE - Manteq - Faraidh: Suami

Manteq - Faraidh: Istri

Apakah terdapat far'ul warits?
YA maka 1/8
JIKA TIDAK maka 1/4
READ MORE - Manteq - Faraidh: Istri

Manteq - Faraidh: Mu’tiq/Mu’tiqah

Apakah Terdapat ahli warits (dzawil furudh/ashabah) ATAU dzawil arham?
YA maka MAHJUB
JIKA TIDAK maka ASHABAH (BINAFSIHI)
READ MORE - Manteq - Faraidh: Mu’tiq/Mu’tiqah

Monday, April 26, 2010

Visual Basic 6.0 Database Code Generator

Postingan kali ini kami beri judul Visual Basic 6.0 Database Code Generator. Ceritanya (apabila waktunya memungkinkan untuk diselesaikan): Code Generator ini dapat membuat sebuah project database hanya dalam hitungan puluhan menit. Tetapi sayang, ia baru selesai 30% saja adapun selebihnya (yang 70% lagi) belum kami selesaikan, sehingga tidak mengherankan jika masih banyak kekurangan disana-sini. Walaupun demikian, sebagai sebuah Visual Basic 6.0 Database Code Generator, ia sempurna, karena telah memenuhi prasyarat utamanya, yakni:

Insert VBobject, yang meliputi:

  • Insert form
  • Insert module
  • Insert class
  • dan lain-lain yang sebangsanya.
Insert control, yang meliputi:
  • Insert common control
  • Insert control yang tidak common
  • Insert contol dari pihak ketiga (misalnya codejock, vbAccelerator, dll). Dalam hal ini diwakili oleh satu ocx saja yakni ctxhookmenu/menu.ocx (salah satu ocx yang pernah menjadi winner di PSC)
  • dan lain-lain yang sebangsanya.
Mengendalikan VBobject dan control melalui pengkodean, yang meliputi:
  • Memanipulasi seluruh method (ActiveX OCX, dll)
  • Memanipulasi seluruh properties (ActiveX OCX, dll)
  • Mereferensi seluruh DLL (Dynamic Link Liblary) yang diperlukan.
  • Dan terakhir, yang terpenting dari point di atas adalah:
  • Insert code!
Bagaimana cara instalasinya?
  • Download
  • Ekstrak
  • Double click file install activex.bat
Bagaimana cara menggunakannya?
  • Jalankan Visual Basic 6.0
  • Klik menu Add-Ins >> Add-In Manager >> ADO Project Builder 1.0
  • Klik satu-satunya tombol yang masih enable (di sebelah kanan).
  • Buatlah sebuah folder baru dan beri nama misalnya "db project"
  • Klik tombol Open DB
  • Pilihlah table serta field yang diperlukan
  • Klik tombol Generate Code
Berapa table yang dapat ia generate?
  • Ribuan, ratusan, bahkan puluhan table.
Bagaimana jika ingin merubah tampilan form yang dihasilkan dari Software?
  • Buka folder template
  • Buka folder form
  • Pelajari, selanjutnya lakukan perubahan yang dibutuhkan
Bagaimana jika ingin menambahkan referensi dll?
  • Buka file data.mdb yang terdapat pada folder database
  • Buka table Reference
  • Tambahkan GUID dari dll yang diperlukan.
Bagaimana jika ingin menambahkan referensi ocx?
  • Buka file data.mdb yang terdapat pada folder database
  • Buka table Components
  • Tambahkan GUID dari ocx yang ingin ditambahkan tersebut
Bagaimana jika ingin menambahkan menu pada Main Form?
  • Buka file data.mdb yang terdapat pada folder database
  • Buka table ChooseMenu
  • Tambahkan menu yang diperlukan
Bagaimana dan bagaimana jika ingin...dan selanjutnya?
  • Seluruhnya ada pada data.mdb yang terdapat pada folder database, termasuk jika Anda ingin merubah kode hasil dari software generator ini.

Akhirul kalam, seperti yang telah kami ceritakan di atas, software ini baru selesai 30%-nya saja, tetapi jika Anda penasaran ingin melihat keindahan code generator dalam melakukan aksinya, bisa Anda download pada link di bawah ini:

Download: Software Database Code Generator 1.0 (5 MB lebih sedikit).

Keterangan:

Software di atas bukan software open source.

Username : admin
Password : admin
READ MORE - Visual Basic 6.0 Database Code Generator

Thursday, April 22, 2010

Membuat Efek Blow pada Form

Membuat efek/animasi blow/explode pada sebuah form.
Option Explicit 

Type
RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Declare Function
GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function
GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function
ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function
SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function
Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function
CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function
SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function
DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Const
IMPLODE_EXPLODE_VALUE = 1500 'you can change the value

Sub
ExplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim
Brush As Long
GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = 1 To Movement
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub

Public Sub
ImplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim
Brush As Long
GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = Movement To 1 Step -1
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub
Contoh penggunaan membuat efek ledakan pada form
Private Sub Command1_Click() 
Call ImplodeForm(Me, IMPLODE_EXPLODE_VALUE)
End
Set
Form1 = Nothing
End Sub

Private Sub
Form_Load()
Call ExplodeForm(Me, IMPLODE_EXPLODE_VALUE)
End Sub
READ MORE - Membuat Efek Blow pada Form

Membuat Text Area, Bagaimanakah Caranya?

Apa yang dimaksud dengan Text Area, perhatikan di bawah ini:
Setelah Anda faham apa yang dimaksud dengan Text Area, sekarang tentu Anda bertanya bagaimanakah cara membuatnya? di bawah ini merupakan kode HTML untuk membuat Text Area di atas:
<p align="center">
<textarea name="code" rows="6" cols="40"> 
Ini merupakan text area, dalam text area Anda dapat menyimpan kode HTML, tulisan, dan sebagainya 
</textarea>
</p>
Penjelesan mengenai variable Text Area:
  • align: posisi, dapat Anda pilih center (tengah), left (kiri), right (kanan)
  • row: merupakan tinggi area
  • col: merupakan lebar area
READ MORE - Membuat Text Area, Bagaimanakah Caranya?

Saturday, April 17, 2010

Menampilkan Kata Yang Berada Di atas Pointer Mouse - VB6

Ini merupakan fungsi untuk menampilkan kata yang berada tepat di bawah pointer mouse. Fungsi ini hanya berjalan pada object RichTextBox. Bagaimana implementasi dari kodenya? bisa Anda perhatikan di bawah:
Option Explicit 

Private Const
EM_CHARFROMPOS& = &HD7

Private Type
POINTAPI
x As Long
y As Long
End Type

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

' Return the word the mouse is over.
Public Function RichWordOver(rch As RichTextBox, x As Single, y As Single) As String

Dim pt As
POINTAPI
Dim Pos As Integer
Dim
start_pos As Integer
Dim
end_pos As Integer
Dim ch As String
Dim
txt As String
Dim
txtlen As Integer

' Convert the position to pixels.
pt.x = x \ Screen.TwipsPerPixelX
pt.y = y \ Screen.TwipsPerPixelY

' Get the character number
Pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
If Pos <= 0 Then Exit Function

' Find the start of the word.
txt = rch.Text
For start_pos = Pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
' Allow digits, letters, and underscores.
If Not _
ch >= "0" And ch <= "9") Or _
ch >= "a" And ch <= "z") Or _
ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next
start_pos
start_pos = start_pos + 1

' Find the end of the word.
txtlen = Len(txt)
For end_pos = Pos To txtlen
ch = Mid$(txt, end_pos, 1)
' Allow digits, letters, and underscores.
If Not _
ch >= "0" And ch <= "9") Or _
ch >= "a" And ch <= "z") Or _
ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next
end_pos
end_pos = end_pos - 1

If
start_pos <= end_pos Then RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End Function
Contoh penggunaanya:
Option Explicit 

Dim
strWordOver As String

Private Sub
RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
strWordOver = RichWordOver(RichTextBox1, x, y)
If Trim(strWordOver) = "" Then Exit Sub
If
Text1.Text <> strWordOver Then
Text1.Text = strWordOver
End If
End Sub
READ MORE - Menampilkan Kata Yang Berada Di atas Pointer Mouse - VB6

Thursday, April 15, 2010

Mengirim Email Lewat VB6.0 Menggunakan Vbsendmail.dll

Di bawah ini merupakan contoh kode untuk mengirim email lewat VB6.0 menggunakan bantuan ActiveX (vbSendMail.dll). VB SendMail merupakan ActiveX yang digunakan untuk mengirim email, terdokumentasi dengan baik dan lengkap. Anda dapat memperoleh komponen tersebut di freevbsource.com silakan Anda kunjungi situsnya.
Option Explicit

Private WithEvents poSendMail As vbSendMail.clsSendMail
Private bSendFailed As Boolean

Private Sub Command1_Click()
Dim lCount As Long
Dim lCtr As Long
Dim t!

Command1.Enabled = False
bSendFailed = False
lstStatus.Clear
lblTime.Caption = ""
Screen.MousePointer = vbHourglass

With poSendMail
.SMTPHost = "smtp.telkom.net"
.From = txtSender.Text
.FromDisplayName = txtName.Text
.Message = txtMsg.Text
.AsHTML = True
t! = Timer
.Recipient = txtRecipient.Text
RecipientDisplayName = txtRecName.Text
.Subject = txtSubject.Text
lblTime = "Sending message " & Str(lCtr)
.Send
End With

If Not bSendFailed Then lblTime.Caption = Str(lCount) & " Messages sent in " & Format$(Timer - t!, "#,##0.0") & " seconds."
Screen.MousePointer = vbDefault
Command1.Enabled = True
End Sub

Private Sub Form_Load()
Set poSendMail = New clsSendMail
End Sub

Private Sub poSendMail_Progress(lPercentCompete As Long)
lblProgress = lPercentCompete & "% complete"
End Sub

Private Sub poSendMail_SendFailed(Explanation As String)
MsgBox ("Your attempt to send mail failed for the following reason(s): " & vbCrLf & Explanation)
bSendFailed = True
lblProgress = ""
lblTime = ""
End Sub

Private Sub poSendMail_SendSuccesful()
lblProgress = "Send Successful!"
End Sub

Private Sub poSendMail_Status(Status As String)
lstStatus.AddItem Status
lstStatus.ListIndex = lstStatus.ListCount - 1
lstStatus.ListIndex = -1
End Sub
Download: Source Code
READ MORE - Mengirim Email Lewat VB6.0 Menggunakan Vbsendmail.dll

Wednesday, April 14, 2010

VB6 Code - Fungsi Format RTF Untuk Pembuatan Kamus

Pernah menggunakan Kamus 2.04 (Kamus Bahasa Inggris)? Di sana terdapat objek RichTextBox yang memuat terjemahan bahasa Inggris yang diformat secara warna-warni. Kamus tersebut dibuat dengan bahasa pemrograman Delphi. Nah, Bagaimana imlementasi format RichTextBox tersebut dalam bahasa pemrograman VB6.0.
Di bawah ini merupakan contoh format RTF untuk keperluan pembuatan kamus Bahasa Inggris. Fungsi di bawah ini dapat bekerja dengan sangat cepat, mengapa? karena ia tidak memformat tulisan pada objeknya secara langsung akan tetapi, memformat string yang terdapat dalam memori kemudian mem-feed-nya kembali ke dalam objek RichTextBox.

Bukankah:
Private Sub Command1_Click()
Dim i As Integer
For i = 1 To 1000
Text1.Text = Text1.Text & "contoh tulisan" & vbCrLf
Next
End Sub
Berbeda dengan kode di bawah ini:
Private Sub Command1_Click()
Dim i As Integer
Dim sText As String
sText = Text1.Text
For i = 1 To 1000
sText = sText & "contoh tulisan" & vbCrLf
Next
Text1.Text = sText
End Sub
Sepintas dua kode di atas akan memberikan hasil yang sama akan tetapi berbeda jauh dalam segi kecepatan.

Di bawah ini merupakan fungsi format RTF untuk pembuatan kamus bahasa inggris:
Option Explicit

Public Function FormatSentence(sSentence As String) As String
Dim sFormat As String
Dim sKosakata As String
Dim sText As String
Dim i As Integer
sFormat = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fswiss\fcharset0 Arial;}}" & vbCrLf & _
"{\colortbl ;\red128\green0\blue0;\red0\green0\blue255;\red0\green128\blue128;\red0\green0\blue128;\red255\green0\blue0;\red128\green0\blue128;}" & vbCrLf & _
"{\*\generator Msftedit 5.41.15.1512;}\viewkind4\uc1\pard\ltrpar\lang1033\f0\fs17"
sKosakata = sSentence
sText = " " & Text1.Text
sText = Replace(sText, vbCrLf, " \Par" & vbCrLf)
sText = Replace(sText, " kb. ", " \cf2\b kb. \cf0\b0 ")
sText = Replace(sText, " -kki. ", " \cf5\b kki. \cf0\b0 ")
sText = Replace(sText, " kk. ", " \cf1\b kk. \cf0\b0 ")
sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ")
sText = Replace(sText, " -ks. ", " \cf3\b -ks. \cf0\b0 ")
sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ")
sText = Replace(sText, "(", "\cf5(\cf0 ")
sText = Replace(sText, ")", "\cf5)\cf0 ")
For i = 1 To 100
If InStr(1, sText, i) Then
sText = Replace(sText, " " & i & " ", " \b " & i & " \cf0\b0 ")
End If
Next
sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ")
sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ")
sText = sFormat & "\b " & sKosakata & "\b0 " & sText & "\par" & vbCrLf & "}"
FormatSentence = sText
End Function

Private Sub Form_Load()
RTF.BackColor = RGB(241, 243, 241)
End Sub
Contoh penggunaan fungsi di atas:
Private Sub Command1_Click()
RTF.TextRTF = FormatSentence(Text2.Text)
End Sub
Maka hasilnya seperti gambar di bawah ini:


Catatan:
Fungsi di atas hanyalah sekadar contoh, Anda dapat memodifikasinya untuk disesuaikan dengan kebutuhan.

Download: Source code fungsi format RTF untuk Kamus Bahasa Inggris
READ MORE - VB6 Code - Fungsi Format RTF Untuk Pembuatan Kamus

Advance Form Center - Bagian Dua

Advance form center - Ini merupakan fungsi untuk menyimpan form di tengah layar, adapun ditambah kata advance, karena ia memiliki beberapa keunggulan, yaitu:menjalankan form dan menempatkannya di tengah layar, ini hanya dilakukan sekali pada saat ia ditampilkan pertama kali, setelah itu form akan mengikuti nilai yang ada pada registry.
'simpan kode di bawah pada module 
Option Explicit

Private Declare Function
GetSystemMetrics Lib "user32" ByVal nIndex As Long) As Long
Private Const
SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17

Private Const
strKey As String = "HKEY_CURRENT_USER\Software\"

Public Function
SavePositionsInRegistry(frm As Form)

If
frm.WindowState = vbMaximized Or frm.WindowState = vbMinimized Then Exit Function

Dim
KeyReg As String, k As String

KeyReg = strKey & App.Title & "\" & frm.Name & "\"
RegWrite KeyReg & "FormLeft", frm.Left
RegWrite KeyReg & "FormTop", frm.Top
RegWrite KeyReg & "FormWidth", frm.Width
RegWrite KeyReg & "FormHeight", frm.Height

End Function

Public Function
GetPositionsFromRegistry(frm As Form)

If
frm.WindowState = vbMaximized Or frm.WindowState = vbMinimized Then Exit Function

Dim
KeyReg As String
Dim
ileft, itop, iwidth, iheight
Dim lCenterLeft As Long, lCenterTop As Long

GetFormCenter frm, lCenterLeft, lCenterTop
KeyReg = strKey & App.Title & "\" & frm.Name & "\"

ileft = IIf(IsEmpty(RegRead(KeyReg & "FormLeft")), lCenterLeft, RegRead(KeyReg & "FormLeft"))
itop = IIf(IsEmpty(RegRead(KeyReg & "FormTop")), lCenterTop, RegRead(KeyReg & "FormTop"))
iwidth = IIf(IsEmpty(RegRead(KeyReg & "FormWidth")), frm.Width, RegRead(KeyReg & "FormWidth"))
iheight = IIf(IsEmpty(RegRead(KeyReg & "FormHeight")), frm.Height, RegRead(KeyReg & "FormHeight"))

frm.Move ileft, itop, iwidth, iheight

End Function

Private Function
GetFormCenter(frm As Form, lLeft As Long, lTop As Long)
With frm
lLeft = Screen.TwipsPerPixelX * GetSystemMetrics(SM_CXFULLSCREEN) / 2)) - .Width / 2)
lTop = Screen.TwipsPerPixelY * GetSystemMetrics(SM_CYFULLSCREEN) / 2)) - .Height / 2)
End With
End Function
READ MORE - Advance Form Center - Bagian Dua

Saturday, April 10, 2010

Kamus Bahasa Arab v3.0 | Sebelum Memulai

Software Kamus Bahasa Arab v3.0 hanya dapat berjalan pada windows yang mendukung penulisan arab, diantaranya:
  1. Windows 98 Arabic Enable
  2. Windows Me Arabic Enable
  3. Windows XP (yang telah disetting arabic)
Sebelum proses instalasi Software Kamus Bahasa Arab v3.0, pastikan bahwa windows Anda mendukung penulisan arab penuh. Mengenai tatacara setting arabic pada windows XP klik link disamping Cara Setting Arabic Pada Windows XP

Untuk mengunduh aplikasi Kamus Bahasa Arab v3.0 silakan klik tautan disamping: unduh Kamus Bahasa Arab v3.0
READ MORE - Kamus Bahasa Arab v3.0 | Sebelum Memulai

Wednesday, April 7, 2010

Parse HTML Code Untuk Postingan

Fasilitas di bawah ini adalah untuk mengkonversi kode HTML yang diperuntukan untuk postingan, sehingga tampil sesuai dengan yang diharapkan.


Jika Anda ingin memasangnya di blog Anda sendiri, di bawah ini adalah kodenya, kopi dan pastekan:
<script src="http://www.gmodules.com/ig/ifr?url=http://hosting.gmodules.com/ig/gadgets/file/102462998830435293579/post-Code.xml&amp;up_grows=10&amp;up_conv1=1&amp;up_conv2=1&amp;up_conv3=1&amp;up_conv4=1&amp;up_conv5=1&amp;synd=open&amp;w=520&amp;h=500&amp;title=Post-Code%3A+code+converter&amp;border=%23ffffff%5C0px%2C1px+solid+%23595959%5C0px%2C1px+solid+%23797979%7C0px%2C2px+solid+%23898989&amp;output=js"></script>
READ MORE - Parse HTML Code Untuk Postingan

Kode Kerangka Untuk Template Blogspot

<html>
<head>
<title>Skeleton of a 2 Column Blogger Template</title>
<style type='text/css'>
body
{
 font-family:Arial;
}
#outer-wrapper
{
 width: 682px;
 border: 1px dotted;
 background: #dddddd;
 margin:0px auto 0;
 padding:10px;
}
#header-wrapper
{
 width:660px;
 height: 100px;
 border: 1px dotted;
 background: #fefe99;
 margin-bottom: 10px;
 padding:10px;
}
#content-wrapper
{
 width: 660px;
 height: 280px;
 border: 1px dotted;
 background: #fefe99;
 margin-bottom: 10px;
 padding:10px;
}
#main-wrapper
{
 width: 410px;
 height: 200px;
 border: 1px dotted;
 background: #a0cffd;
 float: left;
}
#sidebar-wrapper
{
 width: 220px;
 height: 250px;
 border: 1px dotted;
 background: #a0cffd;
 float: right;
}
#footer-wrapper
{
 width: 660px;
 height: 50px;
 border: 1px dotted;
 background: #fefe99;
 padding:10px;
}
</style>
</head>
<body>
<div id='outer-wrapper'>
  <div id='header-wrapper'>
   <p>Header</p>
   </div>
  <div id='content-wrapper'>
   <div id='main-wrapper'>
    <p>Main</p>
   </div>
   <div id='sidebar-wrapper'>
    <p>Side Bar</p>
   </div>
   </div>
  <div id='footer-wrapper'>
   <p>Footer</p>
  </div> 
</div>
</body>
</html>
READ MORE - Kode Kerangka Untuk Template Blogspot

Sunday, April 4, 2010

VB6 Code - Apakah SoundCard Ada?

Di bawah ini merupakan fungsi VB6 untuk mengetahui apakah komputer memiliki souncard atau tidak.
Option Explicit

Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Public Function IsExistSoundCard() As Boolean
Dim I As Integer
I = waveOutGetNumDevs()
IsExistSoundCard = (I > 0)
End Function
Contoh penggunaan fungsi memeriksa keberadaan sound card pada komputer
Private Sub Command1_Click()
MsgBox IsExistSoundCard
End Sub
READ MORE - VB6 Code - Apakah SoundCard Ada?

VB6 Code - Membuat Kata Secara Acak (Random)

Di bawah ini merupakan fungsi VB6 code untuk membuat sebuah kata secara acak.
Option Explicit

Public Function RandomString(Optional Max As Integer = 5) As String

Dim sAlpha As String
Dim iLoop As Integer
Dim iRandNum As Integer
Dim sMatch As String
Dim str As String
sAlpha = "abcdefghijklmnopqrstuvwxyz"

Randomize

For iLoop = 1 To Max
iRandNum = Int((26 - 1 + 1) * Rnd + 1)
sMatch = Mid(sAlpha, iRandNum, 1)
str = str & sMatch
Next iLoop

RandomString = str

End Function
Contoh penggunaan fungsi menampilkan kata secara acak
Private Sub Command1_Click()
MsgBox RandomString 10
End Sub
READ MORE - VB6 Code - Membuat Kata Secara Acak (Random)

VB6 Code - Fungsi Untuk Menjadikan Blank Layar Komputer

Di bawah ini merupakan fungsi VB6 untuk mematikan layar monitor.
Option Explicit

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 Const MONITOR_ON = -1&
Private Const MONITOR_LOWPOWER = 1&
Private Const MONITOR_OFF = 2&
Private Const SC_MONITORPOWER = &HF170&
Private Const WM_SYSCOMMAND = &H112

Public Function TurnOnMonitor(hwnd As Long, bFlag As Boolean) As Boolean
If bFlag Then
Call SendMessage(hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal MONITOR_ON)
Else
Call SendMessage(hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal MONITOR_OFF)
End If
End Function
Contoh penggunaan kode di atas:
Option Explicit

Private Sub Command1_Click()
TurnOnMonitor Me.hwnd, False
End Sub
READ MORE - VB6 Code - Fungsi Untuk Menjadikan Blank Layar Komputer

VB6 Code - Informasi Mengenai Printer Yang Terinstall

Di bawah ini merupakan cara memperoleh/mengetahui informasi mengenai printer yang terinstall.
Option Explicit

Public Function ListAllPrinters(lst As Control)
Dim oPrint As Object
For Each oPrint In Printers
List1.AddItem oPrint.DeviceName
Next
End Function
Contoh penggunaan mengenai printer yang terinstall
Private Sub Form_Load()
ListAllPrinters List1
End Sub
READ MORE - VB6 Code - Informasi Mengenai Printer Yang Terinstall

VB6 Code - Fungsi Untuk Mengetahui Default Printer

Di bawah ini merupakan fungsi untuk mengetahui default printer yang sedang digunakan menggunakan kode VB6:
Option Explicit

Function DefPrintName() As String
DefPrintName = Printer.DeviceName
End Function
Contoh penggunaan kode di atas
Private Sub Command1_Click()
MsgBox DefPrintName, vbInformation, "Default Printer"
End Sub
READ MORE - VB6 Code - Fungsi Untuk Mengetahui Default Printer

VB6 Code - Mendownload Sebuah URL

Di bawah ini merupakan fungsi VB6 untuk mendownload sebuah URL. Adapun kode VB6 untuk mendownload sebuah URL adalah sebagai berikut:
Option Explicit

Private Function DownloadFile(ByVal sFileSource As String, ByVal sDestFile As String) As Boolean
Dim bytes() As Byte
Dim fnum As Integer
bytes() = Inet1.OpenUrl(sFileSource, icByteArray)
fnum = FreeFile

Open sDestFile For Binary Access Write As #fnum
Put #fnum, , bytes()
Close #fnum

DownloadFile = True
End Function
Contoh penggunaan fungsi di atas:
Private Sub Command1_Click()
Call DownloadFile("http://4basic-vb.blogspot.com", "C:\download.html")
End Sub
Demikian kode VB6 untuk mendownload sebuah URL. Semoga bermanfaat.
READ MORE - VB6 Code - Mendownload Sebuah URL

VB6 Code - Memeriksa Apakah Komputer Terhubung Ke Internet

Di bawah ini merupakan fungsi VB6 untuk memeriksa sebuah komputer terhubung ke internet atau tidak?. Adapun kode VB6 untuk memeriksa sebuah komputer apakah terhubung ke internet adalah sebagai berikut:
Option Explicit

Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
'
Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceType = 16
Const RAS95_MaxDeviceName = 32
'
Private Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'
Private Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Private Function IsConnected() As Boolean
'
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
'
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
MsgBox "ERROR "
Exit Function
End If
'
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
IsConnected = True
Else
IsConnected = False
End If
End Function
Contoh penggunaan fungsi VB6 di atas:
Private Sub Command1_Click()
MsgBox IsConnected
End Sub
Demikian mengenai fungsi VB6 untuk memeriksa apakah sebuah komputer terhubung ke internet?
READ MORE - VB6 Code - Memeriksa Apakah Komputer Terhubung Ke Internet

VB6 Code - Membuat Label Yang Berkedip-kedip

Bagaimana cara membuat label yang berkedip-kedip, simak kodenya di bawah ini:
Private Sub Form_Load()
Label1.Caption = "http://4basic-vb.blogspot.com"
Timer1.Interval = 300
End Sub

Private Sub Timer1_Timer()
Label1.Visible = Not Label1.Visible
End Sub
READ MORE - VB6 Code - Membuat Label Yang Berkedip-kedip

VB6 Code - Baca Tulis INI File

Di bawah ini merupakan fungsi untuk baca tulis file .INI. menggunakan Visual Basic 6:
Option Explicit

Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Function ReadIni(ByVal strSection As String, ByVal strKey As String, ByVal strDefault As String, ByVal strFileName As String) As String
Dim intRes As Integer, strRet As String
strRet = Space$(32400)
intRes = GetPrivateProfileString(strSection, strKey, strDefault, strRet, Len(strRet), strFileName)
ReadIni = Left$(strRet, intRes)
End Function

Public Sub WriteIni(ByVal strSection As String, ByVal strKey As String, ByVal strSetting As Variant, ByVal strFileName As String)
WritePrivateProfileString strSection, strKey, CStr(strSetting), strFileName
End Sub

Public Function ReadWinIni(strSection As String, strKey As String) As String
Dim Result As String * 128
Dim Temp As Integer
Temp = GetProfileString(strSection, strKey, "", Result, Len(Result))
ReadWinIni = Left$(Result, Temp)
End Function

Public Sub WriteWinIni(strSection As String, strKey As String, strSetting As String)
WriteProfileString strSection, strKey, strSetting
End Sub


READ MORE - VB6 Code - Baca Tulis INI File

VB6 Code - Memilih Item Listbox Secara Otomatis

Bagaimana cara memilih item yang terdapat pada ListBox secara otomatis pada saat mouse berada di atasnya menggunakan kode Visual Basic 6?
Option Explicit

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Const LB_SETCURSEL = &H186
Private Const LB_GETCURSEL = &H188

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Sub HightLightListBox(ByVal hwndLB As Long, ByVal X As Single, ByVal Y As Single)

Dim IndexItem As Long
Dim Point As POINTAPI

Point.X = X \ Screen.TwipsPerPixelX
Point.Y = Y \ Screen.TwipsPerPixelY

Call ClientToScreen(hwndLB, Point)

IndexItem = LBItemFromPt(hwndLB, Point.X, Point.Y, False)

If IndexItem <> SendMessage(hwndLB, LB_GETCURSEL, 0, 0) Then
Call SendMessage(hwndLB, LB_SETCURSEL, IndexItem, 0)
End If

End Sub
READ MORE - VB6 Code - Memilih Item Listbox Secara Otomatis

VB6 Code - Encrypt Dan Decrypt Sederhana


Di bawah ini merupakan fungsi VB6 untuk melakukan encrypt dan decrypt string secara sederhana, adapun kode VB6 untuk melakukan encrypt dan decrypt string secara sederhana adalah sebagai berikut:
Option Explicit

Public Function Encrypt(sText As String) As String
Dim i As Integer
Dim msg As String
For i = 1 To Len(sText)
msg = msg & Chr(Asc(Mid(sText, i, 1)) + 9)
Next
Encrypt = msg
End Function

Public Function Decrypt(sText As String) As String
Dim i As Integer
Dim msg As String
For i = 1 To Len(sText)
msg = msg & Chr(Asc(Mid(sText, i, 1)) - 9)
Next
Decrypt = msg
End Function
Contoh penggunaan fungsi encrypt dan decrypt sederhana
Private Sub Command1_Click()
Text2.Text = Encrypt(Text1.Text)
End Sub

Private Sub Command2_Click()
Text3.Text = Decrypt(Text2.Text)
End Sub
READ MORE - VB6 Code - Encrypt Dan Decrypt Sederhana

VB6 Code - Mengetahui Bilangan Apakah Ganjil Atau Genap?

Di bawah ini merupakan fungsi VB6 yang sangat sederhana untuk mengetahui sebuah bilangan, apakah ia genap atau ganjil?
Option Explicit

Public Function IsEven(Number As Double) As Boolean
IsEven = IIf(Number Mod 2 = 0, True, False)
End Function
Contoh penggunakan kode VB6 di atas:
Private Sub Command1_Click()
MsgBox IsEven(20) 'return true
End Sub

Private Sub Command1_Click()
MsgBox IsEven(21) 'return false
End Sub
READ MORE - VB6 Code - Mengetahui Bilangan Apakah Ganjil Atau Genap?

VB6 Code - Konfirmasi Sebelum Keluar Dari Aplikasi

Di bawah ini merupakan fungsi VB6 untuk melakukan konfirmasi sebelum keluar dari aplikasi. Mengapa dibuat menjadi fungsi? agar memiliki sifat mudah digunakan kembali, karena hampir tiap software yang dibuat, memerlukan fungsi di bawah ini:
Option Explicit

Public Function ConfirmExit(Optional Title As String = "Konfirmasi") As Boolean
If MsgBox("Are you sure want to exit?", vbQuestion + vbYesNo, Title) = vbYes Then
ConfirmExit = ConfirmExit
Else
ConfirmExit = True
End If
End Function
Contoh penggunaan fungsi di atas:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = ConfirmExit
End Sub
Penggunaan fungsi di atas dapat kita tempatkan pada event Unload ataupun QueryUnload.
READ MORE - VB6 Code - Konfirmasi Sebelum Keluar Dari Aplikasi

VB6 Code - Memeriksa Bahasa dari Keyboard Digunakan

Di bawah ini merupakan procedure VB6 untuk mengetahui bahasa dari keyboard yang sedang digunakan.
Option Explicit

Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Public Sub KeyBoardLanguage()

Dim TheardId As Long
Dim TheardLang As Long
Dim processid As Long

TheardId = GetWindowThreadProcessId(hwnd, processid)
TheardLang = GetKeyboardLayout(ByVal TheardId)
TheardLang = TheardLang Mod 10000

Select Case TheardLang
Case "9721"
MsgBox "English"
Case "5425"
MsgBox "Arabic"
Case Else
MsgBox "I don't know atuh, cari weh ku anjeun sorangan", vbInformation, "Don't Know"
End Select

End Sub
Contoh penggunaan procedure VB6 di atas:
Private Sub  Command1_Click()
KeyBoardLanguage
End Sub
Demikian kode VB6 untuk memmeriksa bahasa dari keyboard yang sedang digunakan. Semoga bermanfaat.
READ MORE - VB6 Code - Memeriksa Bahasa dari Keyboard Digunakan

VB6 Code - Menjadikan Form Semi Transparan

Bagaimana cara membuat form semi transparan menggunakan Visual Basic 6.0?. Simaklah kode VB6 di bawah ini:
Option Explicit

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean

Const LWA_BOTH = 3
Const LWA_ALPHA = 2
Const LWA_COLORKEY = 1
Const GWL_EXSTYLE = -20
Const WS_EX_LAYERED = &H80000

Dim iTransparant As Integer

Sub MakeTransparan(hWndBro As Long, iTransp As Integer)
On Error Resume Next

Dim ret As Long
ret = GetWindowLong(hWndBro, GWL_EXSTYLE)

SetWindowLong hWndBro, GWL_EXSTYLE, ret Or WS_EX_LAYERED
SetLayeredWindowAttributes hWndBro, RGB(255, 255, 0), iTransp, LWA_ALPHA
Exit Sub

End Sub
Contoh penggunaan fungsi VB6 di atas:
Option Explicit

Private Sub Form_Load()
On Error Resume Next
MakeTransparan Me.hWnd, 75
End Sub
Demikian mengenai cara membuat form menjadi semi transparant menggunakan VB6. Semoga bermanfaat.
READ MORE - VB6 Code - Menjadikan Form Semi Transparan

VB6 Code - Generate Nomor Secara Unik

Di bawah ini merupakan fungsi VB6 yang berlaku sebagai sebuah generator agar menampilkan nomor secara unik (tidak ada yang sama satu dengan yang lainnya). Adapun kode VB6 untuk melakukannya adalah sebagai berikut:
Option Explicit

Private Function GenRanUnix(MIN As Integer, MAX As Integer) As Collection

Dim iMax As Integer
Dim iRan As Integer
Dim g As Integer
Dim y As Integer
Dim c As New Collection
Dim k As New Collection
Dim f As Integer
Dim x As Integer

For f = MIN To MAX
c.Add f
Next

y = c.Count
Randomize

For x = 1 To y
g = Int(y * Rnd + 1)
k.Add c.Item(g)
c.Remove g
y = c.Count
Next

Set GenRanUnix = k

End Function
Contoh penggunaan fungsi VB6 di atas:
Private Sub Command1_Click()
Dim b As New Collection
Dim i As Integer
Dim msg As String
List1.Clear
Set b = GenRanUnix(0, 100)
For i = 1 To b.Count
List1.AddItem b.Item(i)
Next
End Sub
Demikian mengenai cara membuat fungsi VB6 untuk men-generate nomor secara unik.
READ MORE - VB6 Code - Generate Nomor Secara Unik

VB6 Code - Menjadikan Form Berada Paling Depan

Fungsi VB6 di bawah ini merupakana cara menampilkan form agar berada paling depan (Form On Top/Top Most). Adapun kode VB6 untuk melakukan hal tersebut adalah sebagai berikut:
Option Explicit

Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Function TopMost(frm As Form, bTopMost As Boolean)
If bTopMost Then
Call SetWindowPos(frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
Call SetWindowPos(frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Function
Contoh penggunaan menjadikan form berada paling depan menggunakan VB6:
Private Sub Form_Load()
TopMost Me, True
End Sub
Demikian mengenai cara membuat fungsi VB6 (fungsi API) agar menjadikan sebuah form paling depan.
READ MORE - VB6 Code - Menjadikan Form Berada Paling Depan

VB6 Code - Membuat Efek Fade Pada Form

Di bawah ini merupakan fungsi VB6 untuk membuat efek fade pada sebuah form. Adapun kode VB6 untuk membuat efek fade pada sebuah form yang ditampilkan adalah sebagai berikut:
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean

Const LWA_BOTH = 3
Const LWA_ALPHA = 2
Const LWA_COLORKEY = 1
Const GWL_EXSTYLE = -20
Const WS_EX_LAYERED = &H80000

Dim iTransparant As Integer

Sub MakeTransparan(hWndBro As Long, iTransp As Integer)
On Error Resume Next

Dim ret As Long
ret = GetWindowLong(hWndBro, GWL_EXSTYLE)

SetWindowLong hWndBro, GWL_EXSTYLE, ret Or WS_EX_LAYERED
SetLayeredWindowAttributes hWndBro, RGB(255, 255, 0), iTransp, LWA_ALPHA
Exit Sub
End Sub

Private Sub Command1_Click()
Unload Me
End Sub


Private Sub Form_Load()
Timer1.Enabled = False
Timer2.Enabled = False
Timer1.Interval = 1
Timer2.Interval = 1
Me.Visible = False
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = 1
Timer1.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
iTransparant = iTransparant + 5
If iTransparant > 255 Then
iTransparant = 255
Timer1.Enabled = False
End If
MakeTransparan Me.hWnd, iTransparant
Me.Show
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
iTransparant = iTransparant - 5
If iTransparant < 0 Then
iTransparant = 0
Timer2.Enabled = False
End
End If
MakeTransparan Me.hWnd, iTransparant
End Sub
Demikian kode VB6 untuk membuat efek fade pada sebuah form.
READ MORE - VB6 Code - Membuat Efek Fade Pada Form

VB6 Code - Membuat Explode Effect Pada Form

Membuat efek/animasi blow/explode pada sebuah form menggunakan kode VB6. Adapun cara membut efek animasi blow/explode dengan menggunakan VB6 adalah sebagai berikut:
Option Explicit

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Const IMPLODE_EXPLODE_VALUE = 1500 'you can change the value

Sub ExplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long
GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = 1 To Movement
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub

Public Sub ImplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long
GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = Movement To 1 Step -1
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub
Contoh penggunaan membuat efek ledakan pada form:
Private Sub Command1_Click()
Call ImplodeForm(Me, IMPLODE_EXPLODE_VALUE)
End
Set Form1 = Nothing
End Sub

Private Sub Form_Load()
Call ExplodeForm(Me, IMPLODE_EXPLODE_VALUE)
End Sub
Demikian mengenai cara membuat efek ledakan (blow/explode) dengan menggunakan kode VB6. Semoga bermanfaat.
READ MORE - VB6 Code - Membuat Explode Effect Pada Form

VB6 Code - Menutup Seluruh Form For...each

Di bawah ini merupakan procedure VB6 untuk menutup seluruh form dengan menggunakan for...each.
Option Explicit

Public Sub CloseAllForm()
Dim frm As Form
For Each frm In Forms
Unload frm
Next
End Sub
Contoh penggunaan procedure di atas:
Private Sub Form_Unload(Cancel As Integer)
CloseAllForm
End Sub
Demikian contoh kode VB6 untuk menutup seluruh form menggunakan for .. each. Semoga bermanfaat.
READ MORE - VB6 Code - Menutup Seluruh Form For...each

VB6 Code - Membuat Form Yang Berbentuk Lingkaran

Mengenai cara membuat form yang berbentuk lingkarang menggunakan VB6 - Adapun cara membuat form berbentuk lingkaran menggunakan VB6 adalah sebagai berikut:
Option Explicit

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "User32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Function CutCirCle(frm As Form, Left, Top, Fat, Tall)
With frm
.Width = (Fat + 10) * 15
.Height = (Tall + 10) * 15
End With
SetWindowRgn frm.hWnd, CreateEllipticRgn(Left, Top, Fat, Tall), True
End Function
Contoh penggunaan kode VB6 di atas:
Private Sub Command1_Click()
Call CutCirCle(Me, 0, 0, 600, 600)
End Sub

Private Sub Form_Resize()
Command1.Left = ((610 * 15) / 2) - (Command1.Width / 2)
End Sub
Demikian kode VB6 untuk membuat form yang berbentuk lingkaran. Semoga bermanfaat.
READ MORE - VB6 Code - Membuat Form Yang Berbentuk Lingkaran

VB6 Code - Menyimpan Form Di Tengah Layar (screen)

Di bawah ini merupkan procedure VB6 untuk menyimpan/memindahkan form tepat di tengah layar.
Option Explicit

Private Sub CenterForm(frmIn As Object)

Dim iTop As Integer, ileft As Integer

If frmIn.WindowState <> 0 Then
'prevent if form maximized or minimized
'the form must in normal condition
Exit Sub
End If

ileft = (Screen.Width - frmIn.Width) \ 2
iTop = (Screen.Height - frmIn.Height) \ 2
frmIn.Move ileft, iTop

End Sub
Cara penggunaan kode VB6 di atas:
Private Sub Form_Load()
Form_Resize
End Sub

Private Sub Form_Resize()
CenterForm Me
End Sub
READ MORE - VB6 Code - Menyimpan Form Di Tengah Layar (screen)

VB6 Code - Membuat Form Yang Berbentuk Elips

Bagaimanakah cara membuat form yang berbentuk elips menggunakan kode Vb6? tentu saja untuk keperluan ini kita harus memanggil beberapa fungsi API. Bagaimana kode lengkap dari VB6 tersebut \? simaklah di bawah ini:
Option Explicit

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "USER32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Contoh penggunaan fungsi API agar form berbentuk Elips
Private Sub Form_Click()
Unload Me
End Sub

Private Sub Form_Load()
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 299, 200), True
End Sub
Demikian kode VB6 untuk membuat form yang berbentuk lingkaran.
READ MORE - VB6 Code - Membuat Form Yang Berbentuk Elips

VB6 Code - Menampilkan Dialog Properties Sebuah File

Di bawah ini merupakan fungsi VB6 untuk menampilkan kotak dialog properties sebuah file.
Option Explicit

Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type

Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400

Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

Public Sub ShowProps(FileName As String, OwnerhWnd As Long)

Dim SEI As SHELLEXECUTEINFO
Dim lngReturn As Long

With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or _
SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = FileName
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With

lngReturn = ShellExecuteEX(SEI)

End Sub
Contoh menggunakan dialog properties sebuah file
Option Explicit

Private Sub Command1_Click()
Call ShowProps("C:\boot.ini", Me.hwnd)
End Sub
READ MORE - VB6 Code - Menampilkan Dialog Properties Sebuah File

VB6 Code - Fungsi API Untuk Browse For Folder

Mengenai fungsi-fungsi API untuk menampilkan dialog browse for folder dengan menggunakan kode-kode VB6:
Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public Function BrowseForFolder(hwnd As Long, Optional Title As String = "Browse For Folder") As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "This Is My Title"
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
End If
End Function
Adapun contoh untuk fungsi API diatas:

Private Sub Command1_Click()
Text1.Text = BrowseForFolder(Me.hwnd)
End Sub
READ MORE - VB6 Code - Fungsi API Untuk Browse For Folder

VB6 Code - Horizontal Scrollbar Pada Listbox

Di bawah ini merupakan procedure VB6 untuk menambah ScrollBar pada objek ListBox. Seperti yang kita ketahui, ListBox tidak memiliki properties horizontal scroll bar akan tetapi dengan memanggil beberapa fungsi API hal tersebut mungkin untuk dilakukan.
Option Explicit

Private Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LB_SETHORIZONTALEXTENT = &H194

Public Sub AddHSBToListBox(sText As String, lst As ListBox)
Static x As Long
lst.AddItem sText
If x < TextWidth(sText & " ") Then
x = TextWidth(sText & " ")
End If
If ScaleMode = vbTwips Then
x = x / Screen.TwipsPerPixelX
SendMessageByNum lst.hwnd, LB_SETHORIZONTALEXTENT, x, 0
End If
End Sub
Contoh penggunaan menambah horizontal scrollbar pada listbox
Private Sub  Command1_Click()
Dim sText As String
sText = ("This is a sample of long text, if the text longer than listbox, it will be create horizontal scrollbar automatically")
AddHSBToListBox sText, List1
End Sub
READ MORE - VB6 Code - Horizontal Scrollbar Pada Listbox

VB6 Code - Horizontal Scrollbar Pada Richtextbox

Di bawah ini merupakan kode VB6 mengenai cara menambah horizontal scrollbar pada objek richtextbox.
Option Explicit

Private Sub Form_Load()
With RichTextBox1
.Text = "Visual Basic :: Horizontal Scroll Position In A Richtextbox, you must set the scrollbar properties to 1 or 3"
.RightMargin = RichTextBox1.Width + 600
End With
End Sub
READ MORE - VB6 Code - Horizontal Scrollbar Pada Richtextbox

VB6 Code - Procedure Auto Drop Down Pada Combobox

Di bawah ini merupakan procedure VB6 yang digunakan untuk membuat auto drop down pada objek ComboBox standar. Maksudnya, drop down otomatis apabila mouse berada di atasnya tanpa harus mengkliknya terlebih dahulu.
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const CB_SHOWDROPDOWN = &H14F

Public Sub AutoDropDown(cmb As ComboBox)
Call SendMessage(cmb.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&)
If cmb.ListIndex = -1 Then cmb.ListIndex = 0
End Sub
Contoh penggunaan proceder auto drop down pada combobox
Private Sub Combo1_GotFocus()
AutoDropDown Combo1
End Sub

Private Sub Form_Load()
With Combo1
.AddItem "asep hibban"
.AddItem "fahmi nurul anwar"
.AddItem "mohammad galbi"
.AddItem "karim wafi"
End With
End Sub
READ MORE - VB6 Code - Procedure Auto Drop Down Pada Combobox

VB6 Code - Memperoleh Nilai Maksimal Dari Sebuah Array

Di bawah ini merupakan fungsi VB6 untuk memperoleh nilai maksimal dari sebuah array.
Option Explicit

Public Function MAX(ByRef Number() As Double) As Double
Dim iMaxNum As Double
Dim i As Integer
iMaxNum = Number(LBound(Number))
For i = LBound(Number) To UBound(Number)
If Number(i) > iMaxNum Then
iMaxNum = Number(i)
Else
iMaxNum = iMaxNum
End If
Next i
MAX = iMaxNum
End Function
Contoh penggunaan fungsi untuk memperoleh nilai maksimal dari sebuah array
Private Sub Command1_Click()
Dim iArray(3) As Double
iArray(0) = 588
iArray(1) = 67
iArray(2) = 66
iArray(3) = 4
MsgBox "The max number is: " & MAX(iArray)
End Sub
READ MORE - VB6 Code - Memperoleh Nilai Maksimal Dari Sebuah Array

VB6 Code - Memperoleh Nilai Minimal Dari Sebuah Array

Di bawah ini merupakan fungsi VB6 untuk mencari nilai minimal dari sebuah array.
Option Explicit

Public Function MIN(ByRef Number() As Double) As Double
Dim iMaxNum As Double
iMaxNum = Number(LBound(Number))
Dim i As Integer
For i = LBound(Number) To UBound(Number)
If Number(i) < iMaxNum Then
iMaxNum = Number(i)
Else
iMaxNum = iMaxNum
End If
Next i
MIN = iMaxNum
End Function
Contoh fungsi untuk memperoleh nilai minimal dari sebuah array
Private Sub Command1_Click()
Dim iArray(3) As Double
iArray(0) = 588
iArray(1) = 67
iArray(2) = 66
iArray(3) = 4
MsgBox "The min number is: " & MIN(iArray)
End Sub
READ MORE - VB6 Code - Memperoleh Nilai Minimal Dari Sebuah Array

VB6 Code - Memeriksa Apakah Screen Saver Enable

Di bawah ini merupakan fungsi VB6 untuk memeriksa apakah screen saver enable atau disable? enable return true dan jika disable, apalagi jika bukan return false.
Option Explicit

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_GETSCREENSAVEACTIVE = 16

Private Function IsScreenSaverEnable() As Boolean
Dim bReturn As Boolean
Dim bActive As Boolean
Call SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, vbNull, bReturn, 0)
IsScreenSaverEnable = bReturn
End Function
Contoh penggunaan fungsi untuk memeriksa apakah screen saver enable
Private Sub Command1_Click()
MsgBox IsScreenSaverEnable
End Sub
READ MORE - VB6 Code - Memeriksa Apakah Screen Saver Enable

VB6 Code - Memperoleh Nilai Rata-rata Dari Sebuah Array

Di bawah ini merupakan fungsi VB6 untuk memperoleh nilai rata-rata dari sebuah array.
Option Explicit

Function AVERAGE(ByRef Number() As Double) As Double
Dim iMaxNum As Double, i As Integer
For i = LBound(Number) To UBound(Number)
iMaxNum = iMaxNum + Number(i)
Next i
AVERAGE = iMaxNum / (UBound(Number) + 1)
End Function
Contoh penggunaan fungsi untuk memperoleh nilai rata-rata dari sebuah array
Private Sub Command1_Click()
Dim iArray(3) As Double
iArray(0) = 588
iArray(1) = 67
iArray(2) = 66
iArray(3) = 4
MsgBox "The Average is: " & AVERAGE(iArray)
End Sub
READ MORE - VB6 Code - Memperoleh Nilai Rata-rata Dari Sebuah Array

VB6 Code - Mencari Dengan Cepat Pada Listbox (Fungsi Api)

Di bawah ini merupakan fungsi VB6 yang digunakan untuk mencari sebuah item yang terdapat dalam objek ListBox dengan cepat.
Option Explicit

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Private Const LB_FINDSTRING = &H18F

Public Function SearchInList(sText As String, lst As ListBox)
On Error Resume Next
lst.ListIndex = SendMessage(lst.hWnd, LB_FINDSTRING, -1, ByVal sText)
lst.TopIndex = List1.ListIndex - 1
End Function
Contoh penggunaan mencari dengan cepat menggunakan fungsi API
Private Sub Form_Load()
With List1
.AddItem "Bandung"
.AddItem "Jakarta"
.AddItem "Garut"
.AddItem "Surabaya"
.AddItem "New York"
.AddItem "Khoiriyyah"
End With
End Sub

Private Sub Text1_Change()
SearchInList Text1.Text, List1
End Sub
READ MORE - VB6 Code - Mencari Dengan Cepat Pada Listbox (Fungsi Api)

VB6 Code - Menjalankan Screen Saver

Di bawah ini merupakan fungsi uVB6 ntuk menjalankan screen saver melalui pemrograman.
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_SYSCOMMAND = &H112&
Private Const SC_SCREENSAVER = &HF140&

Public Sub RunScreenSaver()
Call SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVER, 0&)
End Sub
Contoh penggunaan menjalankan screen saver
Private Sub Command1_Click()
RunScreenSaver
End Sub
READ MORE - VB6 Code - Menjalankan Screen Saver

VB6 Code - Memperoleh Waktu Double Klik Pada Mouse

Source code VB6 di bawah ini berguna untuk memperoleh waktu double klik pada mouse dengan menggunakan fungsi API GetDoubleClick.
Option Explicit

Private Declare Function GetDoubleClickTime Lib "user32" () As Long

Private Sub Command1_Click()
Dim ret As Long
ret = GetDoubleClickTime
Text1.Text = ret & " milliseconds"
End Sub
READ MORE - VB6 Code - Memperoleh Waktu Double Klik Pada Mouse

VB6 Code - Menjalankan Aplikasi Pada Start Up

Di bawah ini merupakan cara yang mudah untuk menjalankan aplikasi pada saat startup menggunakan kode VB6. Pada dasarnya fungsi startup, hanyalah fungsi baca dan tulis ke dalam registy. Kodenya pendek, karena ia meminjam ActiveX Windows Script Host Object Model atau yang lebih dikenal dengan nama WSHOM.OCX.
Option Explicit

Dim oWSHShell As New WshShell

Private Function RegWrite(sKey As String, sFilepath As String)
oWSHShell.RegWrite sKey, sFilepath
End Function

Private Function RegDelete(sKey As String)
oWSHShell.RegDelete sKey
End Function
Contoh penggunaan fungsi di atas yang digunakan untuk menulis ke dalam registry
Private Sub Command1_Click()
RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & _
App.EXEName, App.Path & "\" & App.EXEName & ".exe"
End Sub
Contoh penggunaan fungsi di atas yang digunakan untuk menghapus entry yang terdapat dalam registry
Private Sub Command2_Click()
RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName
End Sub
READ MORE - VB6 Code - Menjalankan Aplikasi Pada Start Up

VB6 Code - Animasi Ketikan Tanpa Flicker

Fungsi VB6 di bawah ini digunakan untuk animasi yang menyerupai text yang sedang di ketik. Animasinya sangat halus nyaris tanpa kedipan.
Option Explicit

Dim sAnimation As String

Private Sub Form_Load()
sAnimation = "Asep Hibban : http://4basic-vb.blogspot.com"
End Sub

Private Sub Timer1_Timer()
Dim sToAnimate As String
Static iAnimation As Integer
Dim c As Integer
iAnimation = iAnimation + 1

sToAnimate = Mid(sAnimation, 1, iAnimation)
With Picture1
.Cls
.CurrentX = 25
.CurrentY = 100
Picture1.Print sToAnimate
End With
If iAnimation >= Len(sAnimation) Then
iAnimation = 0
End If
End Sub
READ MORE - VB6 Code - Animasi Ketikan Tanpa Flicker

VB6 Code - Menjalankan File .mp3

Di bawah ini merupakan contoh menggunakan Microsoft Multimedia Control yang digunakan untuk menjalankan file .mp3 menggunakan VB6.
Option Explicit

Private Sub Command1_Click()
MMC.FileName = OpenFile
Me.Caption = MMC.FileName
MMC.Command = "open"
MMC.Command = "play"
End Sub

Private Function OpenFile() As String
With CommonDialog1
.FileName = ""
.DialogTitle = "Open Files"
.InitDir = "C:\My Documents"
.Filter = "MP3 File (*.MP3)|*.MP3"
.ShowOpen
If .FileName = "" Then Exit Function
MMC.Command = "stop"
OpenFile = .FileName
End With
End Function

Private Sub Command2_Click()
MMC.Command = "stop"
End Sub
READ MORE - VB6 Code - Menjalankan File .mp3

VB6 Code - Menghapus Spasi Rangkap

Di bawah ini merupakan fungsi VB6 untuk menghapus/menghilangkan spasi yang tidak diperlukan (spasi rangkap).
Option Explicit

Private Function DelJunkSpace(str As String) As String
Do While (InStr(str, " ") > 0)
str = Replace(str, " ", " ")
Loop
DelJunkSpace = str
End Function
Contoh penggunaan fungsi di atas
Private Sub Form_Load()
Dim str As String
str = "Asep Hibban http://4basic-vb.blogspot.com"
'menjadi = "Asep Hibban http://4basic-vb.blogspot.com"
Text1.Text = str
End Sub
READ MORE - VB6 Code - Menghapus Spasi Rangkap

VB6 Code - Menjadikan Input Textbox Kapital

Di bawah ini merupakan kode VB6 untuk menjadikan text yang terdapat pada textbox menjadi kapital. Kode yang ditrigger pada saat penekanan tombol.
Option Explicit

'This one line code makes the contents of text box in capital. As you keep in typing it. Just copy this code keypress
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
READ MORE - VB6 Code - Menjadikan Input Textbox Kapital

VB6 Code - Memperoleh Jumlah Baris TextBox

Di bawah ini merupakan fungsi VB6 untuk memperoleh/mengetahui jumlah jajaran dalam sebuah textboxt. Fungsi tersebut menggunakan fungsi API SendMessageLong.
Option Explicit

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const EM_GETLINECOUNT = &HBA

Public Function GetLineCount(Txt As TextBox)
Dim lngLineCount As Long
On Error Resume Next
lngLineCount = SendMessageLong(Txt.hwnd, EM_GETLINECOUNT, 0&, 0&)
GetLineCount = Format$(lngLineCount, "##,###")
End Function
Contoh penggunaan fungsi VB6 di atas:
Private Sub Command1_Click()
MsgBox GetLineCount(Text1)
End Sub
READ MORE - VB6 Code - Memperoleh Jumlah Baris TextBox

VB6 Code - Menghapus Isi Textbox Dengan Cepat

Di bawah ini merupakan procedure VB6 untuk menghapus isi/text yang terdapat dalam textbox dengan cepat. Kami buat menjadi procedure agar mudah dalam penggunaan dan memiliki sifat mudah digunakan kembali (reusability)
Option Explicit

Public Sub ClearAllTextBoxes(frmClearMe As Form)
Dim txt As Control
For Each txt In frmClearMe
If TypeOf txt Is TextBox Then txt.Text = ""
Next
End Sub
Contoh penggunaan/pemanggilan procedure di atas
Private Sub Command1_Click()
ClearAllTextBoxes Me
End Sub
READ MORE - VB6 Code - Menghapus Isi Textbox Dengan Cepat