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