Download Game PC indonesia RIP

Home » Archives for Agustus 2011

Selasa, 02 Agustus 2011

Compact And Repair Databse Access Dengan DBEngine VB6

Berikut ini adalah cara meng-compact and repair database microsoft access di visual basic 6, hal ini penting dilakukan agar ukuran file database tidak membengkak (besar) dan dapat membetulkan jika ada error di file ms.access-nya. untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form, 1 Module, 2 Commandbutton, dan 1 Label.
2. Tambahkan component "Microsoft Common Dialog Control 6.0 (SP3)" dari menu Project->Components...
3. Copy-kan coding berikut ke dalam editor form dan module ybt.

          'Coding ini di Module...
          Public Declare Function GetTempPath Lib "kernel32" Alias _

              "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer _
              As String) As Long
          Public Const MAX_PATH = 260

          Public Sub CompactJetDatabase(Location As String, _

                     Optional BackupOriginal As Boolean = True)
           On Error GoTo CompactErr
           Dim strBackupFile As String
           Dim strTempFile As String

           'Periksa apakah database ada...
           If Len(Dir(Location)) Then
              'Jika diperlukan utk membackup, lakukan!

              If BackupOriginal = True Then
                  strBackupFile = GetTemporaryPath & "backup.mdb"
                  If Len(Dir(strBackupFile)) Then Kill strBackupFile
                  FileCopy Location, strBackupFile
              End If

              'Buat nama file temporal (sementara)
              strTempFile = GetTemporaryPath & "temp.mdb"
              If Len(Dir(strTempFile)) Then Kill strTempFile

              'Lakukan compact database menggunakan DBEngine
              DBEngine.CompactDatabase Location, strTempFile

              'Untuk repair database, Anda menggunakan cara berikut:

              'Sesuaikan kebutuhan lainnya di prosedur ini...
              'DBEngine.RepairDatabase "NamaDatabaseAnda.mdb"

              'Jika database Anda dipassword, gunakan cari berikut:
              'DBEngine.CompactDatabase Location, strTempFile, , , ";pwd=passwordanda;"

              'Hapus file database yang asli
              Kill Location
              'Copy yang file sementara dan telah dicompact

              'menjadi file database yang asli kembali...
              FileCopy strTempFile, Location
              'Hapus file database temporal (sementara)
              Kill strTempFile

              MsgBox "Sukses meng-compact database!", vbInformation, "Sukses"
           End If
           Exit Sub
          CompactErr:   'Jika terjadi error, tampilkan pesan
                        'kemungkinan berikut ini...

            Select Case Err.Number
                   Case 70 'Sedang digunakan

                       MsgBox "Database sedang digunakan!" & vbCrLf & _
                              "Tutup dulu file tersebut!", vbCritical, _

                              "Sedang Digunakan"
                   Case 75 'Path/file belum ada
                       MsgBox "Database belum dipilih." & vbCrLf & _
                              "Pilih dulu databasenya!", vbCritical, _
                              "Database Belum Ada"

                   Case 3031 'Diprotect password
                       MsgBox "Database dipassword. Untuk yang ini," & vbCrLf & _
                              "lakukan langsung dari filenya...!", vbCritical, _
                              "File Terprotect Password"

                   Case 3343 'Database tidak dikenali
                       MsgBox "Databaes bukan Access 97" & vbCrLf & _
                              "atau file bukan database!", vbCritical, _
                              "Database Tidak Dikenali"

                   Case Else
                       MsgBox Err.Number & " - " & Err.Description
               Exit Sub
            End Select

          End Sub

          'Fungsi ini untuk mengambil nama direktori tempat file
          'database temporal (sementara) dicopy...

          Public Function GetTemporaryPath()
            Dim strFolder As String
            Dim lngResult As Long
            strFolder = String(MAX_PATH, 0)

            lngResult = GetTempPath(MAX_PATH, strFolder)
            If lngResult <> 0 Then
              GetTemporaryPath = Left(strFolder, InStr(strFolder, _
                                 Chr(0)) - 1)
            Else

              GetTemporaryPath = ""
            End If
          End Function
          '--- Akhir coding di Module...

          '--- Coding ini di Form Anda...
          Private Sub Command1_Click()
            With CommonDialog1

               .Filter = "*.mdb"
               .ShowOpen
               Label1.Caption = .FileName
            End With
          End Sub

          Private Sub Command2_Click()
              Call CompactJetDatabase(Label1.Caption)
          End Sub

          '--- Akhir coding di Form...

Tags:

contoh program vb6, contoh fungsi di vb6, cara penggunaan fungsi vb, tutorial vb6, download tutorial vb6, vb6 tutorial download, dasar dasar vb6, belajar vb6, cara mudah belajar vb6, vb6 artikel download, vb6 blog, contoh program vb6, artikel vb6, semua tentang vb6, vb6 api, cara menggunakan module, cara menggunakan class module

Cara Membuat Caption/Text StatusBar Berjalan (Marquee) VB6

Berikut ini adalah cara menampilkan tulisan berjalan (effect Marquee) di StatusBar di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form dan 1 StatusBar.
2. Copy-kan coding berikut ke dalam editor form yang bertalian.

          Dim Counter As Integer

          Private Sub Form_Load()
            Counter = 0
            Timer1.Interval = 50 '<-- Atur kecepatannya di sini
            With StatusBar1
              .Panels(1).Width = 4000
              .Panels(1).Alignment = sbrRight
            End With
          End Sub

          Private Sub Timer1_Timer()
            Dim Kalimat As String
            Dim pnlX1 As Panel

            Set pnlX1 = StatusBar1.Panels(1)
                Kalimat = "Testing tulisan berjalan"
                Counter = Counter + 1
                DoEvents
                pnlX1.Text = TulisJalan(Counter, Kalimat, 150)

          End Sub

          Public Function TulisJalan(Hitung As Integer, _
                                     strKalimat As String, _
                                     Panjang As Integer)
            If Hitung = Len(strKalimat) + Panjang Then
               Hitung = 0
            ElseIf Hitung > Len(strKalimat) Then

               TulisJalan = strKalimat & Space(Hitung - Len(strKalimat))
            Else
               TulisJalan = Mid(strKalimat, 1, Hitung)
            End If
          End Function

Tags:

Cara Memformat Sebagian Text/Kalimat Pada RichTextBox VB6

Berikut ini adalah cara memformat sebagian kalimat/text/tulisan/sekumpulan karakter/kata di dalam RichTextBox, mengubah warnanya, mengganti jenis huruf, an menebalkannya di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form dan 1 RichTextBox.
2. Copy-kan coding berikut ke dalam editor form yang bertalian.

          Function FormatTulisan(strJudul As String)
          'Mohon mencantumkan nama saya di about aplikasi Anda
          'jika menggunakan fungsi ini. Terima kasih.
          'Fungsi oleh Masino Sinaga, 22 Juli 2002.

          Dim i As Integer
          Dim PosAwal() As Long, PosAkhir() As Long
          Dim PosIsiAwal() As Long, PosIsiAkhir() As Long
          Dim RecPerHal As Integer

            RecPerHal = 5
            ReDim PosAwal(RecPerHal)
            ReDim PosAkhir(RecPerHal)
            ReDim PosIsiAwal(RecPerHal)
            ReDim PosIsiAkhir(RecPerHal)

            PosAwal(RecPerHal) = InStr(1, rtf1.Text, strJudul)
            PosAkhir(RecPerHal) = InStr(PosAwal(RecPerHal), rtf1.Text, ":")
            PosIsiAwal(RecPerHal) = PosAkhir(RecPerHal) + 1
            PosIsiAkhir(RecPerHal) = InStr(PosIsiAwal(RecPerHal), _

                                     rtf1.Text, Chr(13))
            For i = 1 To RecPerHal
               DoEvents
               If PosAwal(RecPerHal) > 0 Then

                  With rtf1
                    PosAkhir(RecPerHal) = InStr(PosAwal(RecPerHal) + i, _
                                          rtf1, ":")
                    'Ini untuk data sebelum titik dua
                    .SelStart = (PosAwal(RecPerHal) - 1)

                    .SelLength = PosAkhir(RecPerHal) - PosAwal(RecPerHal)
                    .SelLength = Len(strJudul)
                    .SelFontName = "Verdana"
                    .SelFontSize = 8

                    .SelColor = vbBlue
                    .SelText = UCase(.SelText)
                    'Ini untuk data setelah titik dua
                    .SelStart = (PosIsiAwal(RecPerHal) - 1)

                    .SelLength = PosIsiAkhir(RecPerHal) - _
                                 PosIsiAwal(RecPerHal)
                    .SelFontName = "Arial"
                    .SelFontSize = 9
                    .SelBold = True

                  End With
               End If
               PosAwal(RecPerHal) = InStr(PosAwal(RecPerHal) + i, _
                                    rtf1.Text, strJudul)

               PosAkhir(RecPerHal) = InStr(PosAwal(RecPerHal) + i, _
                                     rtf1.Text, ":")
               PosIsiAwal(RecPerHal) = PosAkhir(RecPerHal) + 1
               PosIsiAkhir(RecPerHal) = InStr(PosIsiAwal(RecPerHal) + i, _
                                        rtf1.Text, Chr(13))
            Next i
          End Function

          Private Sub Form_Load()
            With rtf1
              .Width = 5000

              .Font.Name = "Courier New"
              .Font.Size = 9
              .RightMargin = .Width + 500
              .Text = "Nama: Masino Sinaga" & vbCrLf & _

                   "Alamat: Jalan Terusan Sari Asih 54" & vbCrLf & _
                   "Tempat Lahir: Jakarta" & vbCrLf & _
                   "Tanggal Lahir: 22 Januari 1973" & vbCrLf & _
                   "" & vbCrLf & _
                   "Nama: Elvis Presley" & vbCrLf & _

                   "Alamat: Graceland, Memphis, Tennessee" & vbCrLf & _
                   "Tempat Lahir: Tupello" & vbCrLf & _
                   "Tanggal Lahir: 8 Januari 1935" & vbCrLf & _
                   "" & vbCrLf & _

                   "Nama: Pat Boone" & vbCrLf & _
                   "Alamat: 1st Avenue Hollywood" & vbCrLf & _
                   "Tempat Lahir: New York" & vbCrLf & _
                   "Tanggal Lahir: 5 Desember 1940" & vbCrLf & _

                   ""
            End With
            Call FormatTulisan("Nama")
            Call FormatTulisan("Alamat")
            Call FormatTulisan("Tempat Lahir")

            Call FormatTulisan("Tanggal Lahir")

          End Sub

          Private Sub Form_Resize()
            rtf1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
          End Sub

Tags:

Cara Menambahkan Scrollbar Horizontal Pada RichTextBox VB6

Berikut ini adalah cara menambahkan Scrollbar Horizontal ke RichTextBox di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form dan 1 RichTextBox
2. Set properti Scrollbars ke 1 (horizontal) atau ke 3 (horizontal dan vertical).
3. Copy-kan coding berikut ke dalam editor form yang bertalian.

          Private Sub Form_Load()
          'Ukuran 'RichTextBox1.RightMargin' menandakan ukuran sroll horizontal-nya
          'Tambahkan/kurangi dengan '500' di bawah untuk mengurangi atau memperbesar ukuran

          'scroll-horizonalnya. Jika 'RichTextBox1.RightMargin' sama dengan 'RichTextBox1.Width'
          'maka tidak akan ada muncul horizonal scroll bar.
            RichTextBox1.Text = "Halo, selamat datang di Puslatpos yang indah ini.. heheheheheh...."
            RichTextBox1.RightMargin = RichTextBox1.Width + 500
          End Sub

Tags:

Contoh Cara Penggunaan Fungsi ZOrder VB6

Berikut ini adalah cara menggunakan fungsi ZOrder di visual basic 6, yaitu untuk membuat tampilan controls atau form tampil lebih atas atau tidak, jika di vb.net ini sama dengan bringtofront, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 3 Form.
2. Pada Form1, tambahkan 1 Commandbutton.
3. Copy-kan coding berikut ke dalam editor Form1 saja.

          Private Sub Command1_Click()

            If Command1.Caption = "Form2" Then
               Command1.Caption = "Form3"
               Form2.ZOrder 0 'Form2 di atas
               Form3.ZOrder 1 'Form3 di bawah

            Else
               Command1.Caption = "Form2"
               Form3.ZOrder 0 'Form3 di atas
               Form2.ZOrder 1 'Form2 di bawah

            End If
          End Sub

          Private Sub Form_Load()
            Form2.Show

            Form3.Show
            Me.Move 6000, 5000
            Command1.Caption = "Form2"
          End Sub

          Private Sub Form_QueryUnload(Cancel As Integer, _
                                       UnloadMode As Integer)
            End
          End Sub

Tags:

Cara Menambahkan File Ke Recent Files Windows VB6

Berikut ini adalah cara menambahkan suatu file ke dalam daftar Recent Files Windows di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form dan 1 Commandbutton.
2. Copy-kan coding berikut ke editor form yang bertalian.

          'Private, karena hanya digunakan satu form dengan pemanggilannya
          Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags _
                     As Long, ByVal pv As String)

          Private Sub Command1_Click()
            'Ganti "C:\My Documents\Test.txt" dengan nama file yang
            'ingin Anda tambahkan ke Recent Files (Documents menu).
            'Agar file ini bisa dipanggil nantinya dari Documents

            'menu tersebut, sebaiknya file ini harus ada di dalam
            'C:\My Documents. Jika tidak, file ini tetap ditambahkan
            'ke dalam Documents menu, tetapi tidak dapat dibuka.
            Call SHAddToRecentDocs(2, "C:\My Documents\Test.txt")
            MsgBox "Lihat hasilnya dari menu Start->Documents", _
                   vbInformation, "Sukses Tambah Recent Files"
          End Sub

Tags:

Cara Mengubah Name dan Company Di Komputer VB6

Berikut ini adalah cara mengganti nama pemilik Windows yang terdaftar di komputer Anda beserta perusahaan/organisasinya. di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form, 1 Module, 2 Textbox dan 1 Commandbutton
2. Copy-kan coding berikut ke dalam editor form & module ybt.

          'Masukkan nama pemilik Windows yang baru di Text1, masukkan nama perusahaan
          'pemilik tersebut di Text2, lalu klik tombol Command1. Jika Anda mengosongkan
          'kedua texbox tsb lalu mengklik Command1, maka tidak ada perubahan yg terjadi.

          'Lihat perubahannya dari menu Start | Settings | Control Panel | System
          '(tab General), atau klik kanan icon "My Computer" di desktop lalu pilih
          '"Properties".

          'Coding ini di Module...
          Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
            (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
          Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
            (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As _

            Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
          Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
          Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

          Public Const HKEY_LOCAL_MACHINE = &H80000002
          '--- Akhir coding di Module...

          '--- Coding ini di Form...

          Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As _
              String, NewVal As String)
          Dim lResult As Long, lKeyValue As Long
          Dim InLen As Long
          On Error Resume Next

            lResult = RegOpenKey(Group, Section, lKeyValue)
            InLen = Len(NewVal)
            lResult = RegSetValueEx(lKeyValue, Key, 0&, 1&, NewVal, InLen)
            lResult = RegFlushKey(lKeyValue)

            lResult = RegCloseKey(lKeyValue)
          End Sub

          Private Sub Command1_Click()

            WriteRegistry HKEY_LOCAL_MACHINE, _
            "SOFTWARE\Microsoft\Windows\CurrentVersion", "RegisteredOwner", Text1
            WriteRegistry HKEY_LOCAL_MACHINE, _
            "SOFTWARE\Microsoft\Windows\CurrentVersion", "RegisteredOrganization", Text2
            MsgBox "Registered Name = " & Text1.Text & "" & Chr(13) & _

                   "Registered Organization = " & Text2.Text & "", vbInformation, _
                   "Berhasil Diganti!"
          End Sub
          '--- Akhir coding di Form...

Tags:

Cara Membuat AutoRun/AutoStart Program Saat Windows Start VB6

Berikut ini adalah cara membuat aplikasi/program kita autostart saat windows pertama kali dinyalakan, menggunakan visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form, 1 Module, dan 2 Commandbutton.
2. Copy-kan coding berikut ke dalam editor form & module yang bertalian

          'Tombol pertama untuk menjalankan program saat startup, sedangkan
          'tombol kedua untuk menghapusnya dari daftar startup program.

          '--- Coding ini di Module...
          Public Type SECURITY_ATTRIBUTES
            nLength As Long
            lpSecurityDescriptor As Long

            bInheritHandle As Long
          End Type

          Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
            (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
            ByVal samDesired As Long, phkResult As Long) As Long
          Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
          Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
            (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As _

            Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
          Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal _
            hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal _
            dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

          Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
            (ByVal hKey As Long, ByVal lpValueName As String) As Long

          Public Enum T_KeyClasses
            HKEY_CLASSES_ROOT = &H80000000

            HKEY_CURRENT_CONFIG = &H80000005
            HKEY_CURRENT_USER = &H80000001
            HKEY_LOCAL_MACHINE = &H80000002
            HKEY_USERS = &H80000003

          End Enum

          Private Const SYNCHRONIZE = &H100000
          Private Const STANDARD_RIGHTS_ALL = &H1F0000

          Private Const KEY_QUERY_VALUE = &H1
          Private Const KEY_SET_VALUE = &H2
          Private Const KEY_CREATE_LINK = &H20
          Private Const KEY_CREATE_SUB_KEY = &H4
          Private Const KEY_ENUMERATE_SUB_KEYS = &H8

          Private Const KEY_EVENT = &H1
          Private Const KEY_NOTIFY = &H10
          Private Const READ_CONTROL = &H20000
          Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)

          Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
          Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
            KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
            Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _
            And (Not SYNCHRONIZE))

          Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
            KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
            And (Not SYNCHRONIZE))
          Private Const KEY_EXECUTE = (KEY_READ)
          Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
            KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
          Private Const REG_BINARY = 3

          Private Const REG_CREATED_NEW_KEY = &H1
          Private Const REG_DWORD = 4
          Private Const REG_DWORD_BIG_ENDIAN = 5
          Private Const REG_DWORD_LITTLE_ENDIAN = 4

          Private Const REG_EXPAND_SZ = 2
          Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
          Private Const REG_LINK = 6
          Private Const REG_MULTI_SZ = 7

          Private Const REG_NONE = 0
          Private Const REG_SZ = 1
          Private Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
          Private Const REG_NOTIFY_CHANGE_LAST_SET = &H4
          Private Const REG_NOTIFY_CHANGE_NAME = &H1

          Private Const REG_NOTIFY_CHANGE_SECURITY = &H8
          Private Const REG_OPTION_BACKUP_RESTORE = 4
          Private Const REG_OPTION_CREATE_LINK = 2
          Private Const REG_OPTION_NON_VOLATILE = 0

          Private Const REG_OPTION_RESERVED = 0
          Private Const REG_OPTION_VOLATILE = 1
          Private Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME _
            Or REG_NOTIFY_CHANGE_ATTRIBUTES Or _

            REG_NOTIFY_CHANGE_LAST_SET Or _
            REG_NOTIFY_CHANGE_SECURITY)
          Private Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or _
            REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or _
            REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)

          Public Sub DeleteValue(rClass As T_KeyClasses, Path As String, sKey As String)
          Dim hKey As Long
          Dim res As Long

            res = RegOpenKeyEx(rClass, Path, 0, KEY_ALL_ACCESS, hKey)
            res = RegDeleteValue(hKey, sKey)
            RegCloseKey hKey
          End Sub

          Public Function SetRegValue(KeyRoot As T_KeyClasses, Path As String, sKey As _
          String, NewValue As String) As Boolean
          Dim hKey As Long
          Dim KeyValType As Long

          Dim KeyValSize As Long
          Dim KeyVal As String
          Dim tmpVal As String
          Dim res As Long

          Dim i As Integer
          Dim x As Long
            res = RegOpenKeyEx(KeyRoot, Path, 0, KEY_ALL_ACCESS, hKey)
            If res <> 0 Then GoTo Errore

            tmpVal = String(1024, 0)
            KeyValSize = 1024
            res = RegQueryValueEx(hKey, sKey, 0, KeyValType, tmpVal, KeyValSize)
            Select Case res
                   Case 2
                        KeyValType = REG_SZ
                   Case Is <> 0
                        GoTo Errore

            End Select
            Select Case KeyValType
                   Case REG_SZ
                        tmpVal = NewValue
                   Case REG_DWORD

                        x = Val(NewValue)
                        tmpVal = ""
                        For i = 0 To 3
                            tmpVal = tmpVal & Chr(x Mod 256)

                            x = x \ 256
                        Next
            End Select
            KeyValSize = Len(tmpVal)

            res = RegSetValueEx(hKey, sKey, 0, KeyValType, tmpVal, KeyValSize)
            If res <> 0 Then GoTo Errore
            SetRegValue = True
            RegCloseKey hKey
            Exit Function

          Errore:
            SetRegValue = False
            RegCloseKey hKey
          End Function
          '--- Akhir coding di Module...

          '--- Coding ini di Form...
          Private Sub Command1_Click()

            'Ganti kedua kata 'NotePad' di bawah dengan nama aplikasi Anda, dan
            'c:\windows\notepad.exe' di bawah dengan file aplikasi Anda...
            SetRegValue HKEY_LOCAL_MACHINE, _
                  "Software\Microsoft\Windows\CurrentVersion\Run", "NotePad", "c:\windows\notepad.exe"
          End Sub

          Private Sub Command2_Click()
            DeleteValue HKEY_LOCAL_MACHINE, _
                 "Software\Microsoft\Windows\CurrentVersion\Run", "NotePad"

          End Sub
          '--- Akhir coding di Form...

Tags:

Cara Click Start Menu Button Windows Dengan Coding VB6

Berikut ini adalah cara mengklik menu Start button Windows dengan menggunakan coding di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form, 1 Module, dan 1 Commandbutton.
2. Copy-kan coding berikut ke dalam editor form & module ybt.

         '--- Coding ini di Module...
          Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" _
                      (ByVal wCode As Long, ByVal wMapType As Long) As Long

          Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan _
                      As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
          Public Const KEYEVENTF_KEYUP = &H2
          '--- Akhir coding di Module...

          '--- Coding ini di Form...
          Private Sub Command1_Click()
            Const MENU_KEYCODE = 91
            keybd_event MENU_KEYCODE, 0, 0, 0

            keybd_event MENU_KEYCODE, 0, KEYEVENTF_KEYUP, 0
          End Sub
          '--- Akhir coding di Form...

Tags:

Open Windows Explorer To ListBox VB6

Berikut ini adalah cara menampilkan Windows Explorer dalam satu ListBox, Anda dapat berpindah antar drive, direktori, dan memilih file melalui ListBox ini saja di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form, 1 ListBox, 1 DriveListBox, 1 DirListBox, 1 FileListBox, dan 1 Label.
2. Copy-kan coding berikut ke dalam editor form yang bertalian.

          Function StripPath(T$) As String
          Dim x%, ct%

            StripPath$ = T$
            x% = InStr(T$, "\")
            Do While x%
              ct% = x%

              x% = InStr(ct% + 1, T$, "\")
            Loop
            If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
          End Function

          Sub UpdatePath()
          Dim I, D, J, K As Integer
            For D = 0 To List1.ListCount - 1
               List1.RemoveItem "0"

            Next D
            If Not Right(Dir1.List(-1), 1) = "\" Then
               List1.AddItem "[^] .."
            End If

            For I = 0 To Dir1.ListCount - 1
               List1.AddItem "[\] " & StripPath(Dir1.List(I))
            Next I
            For J = 0 To File1.ListCount - 1
               List1.AddItem "[*] " & File1.List(J)

            Next J
            For K = 0 To Drive1.ListCount - 1
               List1.AddItem "[o] " & Drive1.List(K)
            Next K

            Label1.Caption = Dir1.Path
          End Sub

          Private Sub Drive1_Change()

            Dir1.Path = Drive1.Drive
          End Sub

          Private Sub Dir1_Change()
            File1.Path = Dir1.Path

            UpdatePath
          End Sub

          Private Sub Form_Load()
            Drive1.Visible = False
            File1.Visible = False
            Dir1.Visible = False
            UpdatePath

            Me.Move (Screen.Width - Me.Width) / 2, _
                    (Screen.Height - Me.Height) / 2
          End Sub

          Private Sub List1_DblClick()
          On Error GoTo ErrHdlr
            If Right(List1.Text, 2) = ".." Then
               Dir1.Path = Dir1.Path & "\.."

            ElseIf Left(List1.Text, 3) = "[\]" Then
               If Right(Dir1.List(-1), 1) = "\" Then
                  Dir1.Path = Dir1.Path & _
                              Right(List1.Text, Len(List1.Text) - 4)
               Else

                  Dir1.Path = Dir1.Path & _
                              "\" & Right(List1.Text, _
                                          Len(List1.Text) - 4)
               End If

            ElseIf Left(List1.Text, 3) = "[o]" Then
               Drive1.Drive = Right(Left(List1.Text, 6), 2)
            Else
               MsgBox "File " & Chr(34) & _

                      Right(List1.Text, Len(List1.Text) - 4) & _
                      Chr(34) & " dipilih.", _
                      vbInformation, "File Terpilih"
            End If
            Exit Sub

          ErrHdlr:
             MsgBox "Drive tidak siap!", vbCritical, "Tidak Siap"
             Exit Sub
          End Sub

Tags:

Contoh Penggunaan Fungsi SaveSetting, GetSetting, dan GetAllSettings Registry VB6

Berikut ini adalah cara menyimpan/mengambil data ke/dari Registry dengan memakai fungsi SaveSetting, GetSetting, dan GetAllSettings.GetAllSettings, merupakan fungsi untuk mengambil semua data di "bawah" suatu Section tertentu, jadi tanpa harus mengambil satu per satu item/setting dengan GetSetting. di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form.
2. Tambahkan 3 TextBox, masing-masing beri nama dengan Text1, Text2, dan Text3.
3. Tambahkan 1 ComboBox, beri nama dengan Combo1.
4. Tambahkan 2 CheckBox, masing-masing beri nama dengan Check1 dan Check2.
5. Tambahkan 4 OptionButton, masing-masing beri nama dengan Option1(0), Option1(1), Option2, dan Option3.
6. Tambahkan 1 ListBox, beri nama dengan List1.
7. Tambahkan 4 Commandbutton, masing-masing beri nama dengan
- cmdSaveSetting
- cmdGetSetting
- cmdDeleteSetting
- cmdSaveQuit
8. Copy-kan coding berikut ke dalam editor form yang bertalian.

          'Penggunaan setiap fungsi:

          'SaveSetting(AppName As String, _
                       Section As String, _
                       Setting As String)

          'GetSetting(AppName As String, _
                      Section As String, _
                      Key As String, _
                      Default As String)

          'GetAllSettings(AppName As String, _
                          Section As String)

          'Untuk melihat hasil dari contoh ini, jalankan Registry dari menu
          'Start->Run ketikkan: Regedit lalu tekan Enter. Buka folder/direktori
          'di explorer Regedit yaitu:
          'HKEY_CURRENT_USER\Software\VB and VBA Program Settings\prjRegedit

          'kemudian periksa subfolder "Form" dan "TestRegedit".
          'Khusus untuk Section "TestRegedit", seluruh nilai yang diambil dapat
          'Anda lihat di List1.
          '--------------------------------------------------------------------------

          Private Sub cmdDeleteSetting_Click()
          On Error Resume Next
             DeleteSetting App.Title, "TestRegedit"
             MsgBox "Berhasil dihapus!", vbInformation, "Hapus OK"
          End Sub

          Private Sub cmdGetSetting_Click()
             Form_Load
          End Sub

          Private Sub cmdSaveQuit_Click()
             SimpanForm1
             SimpanLetakForm

             End
          End Sub

          Private Sub cmdSaveSetting_Click()

             SimpanForm1
             SimpanLetakForm
             MsgBox "Berhasil disimpan!", vbInformation, "Simpan OK"
          End Sub

          Private Sub Form_Load()
          Dim AtasForm, KiriForm As Integer
          On Error Resume Next
             AtasForm = Screen.Height / 2 - Me.Height / 2

             KiriForm = Screen.Width / 2 - Me.Width / 2
             Me.Left = GetSetting(App.Title, "Form", "Kiri", KiriForm)
             Me.Top = GetSetting(App.Title, "Form", "Atas", AtasForm)
             Me.Width = GetSetting(App.Title, "Form", "Lebar", 5000)

             Me.Height = GetSetting(App.Title, "Form", "Tinggi", 5000)

             Dim avntSettings As Variant
             Dim intX As Integer
             avntSettings = GetAllSettings(App.Title, "TestRegedit")

             List1.Clear
             For intX = 0 To UBound(avntSettings, 1)
                List1.AddItem avntSettings(intX, 1)
             Next intX
             Text1 = List1.List(0)
             Text2 = List1.List(1)
             Text3 = List1.List(2)

             Check1 = List1.List(3)
             Check2 = List1.List(4)
             Option1(0) = List1.List(5)
             Option1(1) = List1.List(6)
             Option2 = List1.List(7)

             Option3 = List1.List(8)

             Combo1.List(0) = GetSetting(App.Title, "TestRegedit", "Combo1(0)", "")
             Combo1.List(1) = GetSetting(App.Title, "TestRegedit", "Combo1(1)", "")

             Combo1.List(2) = GetSetting(App.Title, "TestRegedit", "Combo1(2)", "")
             Combo1.Text = Text3.Text
          End Sub

          Sub SimpanForm1()

             SaveSetting App.Title, "TestRegedit", "Text1", Text1
             SaveSetting App.Title, "TestRegedit", "Text2", Text2
             SaveSetting App.Title, "TestRegedit", "Text3", Combo1.Text

             SaveSetting App.Title, "TestRegedit", "Check1", Check1.Value
             SaveSetting App.Title, "TestRegedit", "Check2", Check2.Value
             SaveSetting App.Title, "TestRegedit", "Option1(0)", Option1(0).Value
             SaveSetting App.Title, "TestRegedit", "Option1(1)", Option1(1).Value

             SaveSetting App.Title, "TestRegedit", "Option2", Option2.Value
             SaveSetting App.Title, "TestRegedit", "Option3", Option3.Value

             If Combo1.List(0) = "" Then

                SaveSetting App.Title, "TestRegedit", "Combo1(0)", Combo1.Text
             ElseIf Combo1.List(0) = Combo1.Text Or _
                    Combo1.List(1) = Combo1.Text Or _
                    Combo1.List(2) = Combo1.Text Then
                SaveSetting App.Title, "TestRegedit", "Combo1(0)", Combo1.List(0)

                SaveSetting App.Title, "TestRegedit", "Combo1(1)", Combo1.List(1)
                SaveSetting App.Title, "TestRegedit", "Combo1(2)", Combo1.List(2)
             Else
                SaveSetting App.Title, "TestRegedit", "Combo1(2)", Combo1.List(1)

                SaveSetting App.Title, "TestRegedit", "Combo1(1)", Combo1.List(0)
                SaveSetting App.Title, "TestRegedit", "Combo1(0)", Combo1.Text
             End If

          End Sub

          Sub SimpanLetakForm()
            If Me.WindowState <> vbMinimized Then
               SaveSetting App.Title, "Form", "Kiri", Me.Left

               SaveSetting App.Title, "Form", "Atas", Me.Top
               SaveSetting App.Title, "Form", "Lebar", Me.Width
               SaveSetting App.Title, "Form", "Tinggi", Me.Height
            End If

          End Sub

Tags:

Remove Loaded Form From Memory VB6

Berikut ini adalah cara menghapus form (yang sudah diload) dari memory di visual basic 6, hal ini penting agar memory komputer anda akan tetap stabil. jadi aplikasi anda tidak terkesan berat, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 3 Form.
2. Pada Form1 buat 2 Commanbutton. Form lainnya tidak perlu.
3. Copy-kan coding berikut ke dalam editor Form1.

          Private Sub Command1_Click() 'Buka form lainnya
             Form2.Show
             Form3.Show
          End Sub

          Private Sub Command2_Click()   'Tutup semua form yang ada, termasuk Form1
          Dim Form As Form               '(Sebenarnya, hal ini sama dengan 'End')
             For Each Form In Forms
                 Unload Form

                 Set Form = Nothing      'Bersihkan memori yang digunakan sebelumnya
             Next Form
          End Sub

Tags:

Cara Menghapus Recent Document VB6

Berikut ini adalah cara menghapus daftar dokumen yang terakhir pernah diakses (recent document) / biasanya dapat dilihat dari menu Start->Documents menggunakan visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form, 1 Module dan 1 Commandbutton
2. Copy-kan coding berikut ke editor form yang bertalian.

          '--- Coding ini di Module...
          Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, _
          ByVal pv As String)
          '--- Akhir coding di Module...

          '--- Coding ini di Form...
          Private Sub Command1_Click()

            Call SHAddToRecentDocs(2, vbNullString)
            'Untuk melihat efek dari tips ini, silahkan lihat dari menu
            'Start->Documents, maka daftar dokumen yang terakhir pernah
            'diakses sekarang telah menjadi kosong (Empty).
          End Sub

Tags:

Print Test Page Using VB6

Berikut ini adalah cara melakukan test printer (print test page) di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form.
2. Copy-kan coding berikut ke dalam editor form yang bertalian.

          'Panggil fungsi print-test-page milik Windows.
          Private Sub Form_Load()
              Shell "rundll32 msprint2.dll,RUNDLL_PrintTestPage"
          End Sub

Tags:

Cara Mengganti Resolusi Layar Monitor VB6

Berikut ini adalah cara mengganti resolusi layar monitor Anda menggunakan visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Module dan 1 Form.
2. Copy-kan coding berikut ke dalam editor Module dan form ybt.

         'Program akan mengkonfirmasikan ke Anda jika komputer harus di-restart
          'untuk menyimpan perubahan.
          '--- Coding ini di Module Anda...
          Public Const CCDEVICENAME = 32
          Public Const CCFORMNAME = 32

          Public Const DISP_CHANGE_SUCCESSFUL = 0
          Public Const DISP_CHANGE_RESTART = 1
          Public Const DISP_CHANGE_FAILED = -1
          Public Const DISP_CHANGE_BADMODE = -2

          Public Const DISP_CHANGE_NOTUPDATED = -3
          Public Const DISP_CHANGE_BADFLAGS = -4
          Public Const DISP_CHANGE_BADPARAM = -5
          Public Const CDS_UPDATEREGISTRY = &H1
          Public Const CDS_TEST = &H2

          Public Const DM_BITSPERPEL = &H40000
          Public Const DM_PELSWIDTH = &H80000
          Public Const DM_PELSHEIGHT = &H100000
          Public Type DEVMODE

          dmDeviceName As String * CCDEVICENAME
          dmSpecVersion As Integer
          dmDriverVersion As Integer
          dmSize As Integer

          dmDriverExtra As Integer
          dmFields As Long
          dmOrientation As Integer
          dmPaperSize As Integer
          dmPaperLength As Integer

          dmPaperWidth As Integer
          dmScale As Integer
          dmCopies As Integer
          dmDefaultSource As Integer

          dmPrintQuality As Integer
          dmColor As Integer
          dmDuplex As Integer
          dmYResolution As Integer

          dmTTOption As Integer
          dmCollate As Integer
          dmFormName As String * CCFORMNAME
          dmUnusedPadding As Integer
          dmBitsPerPel As Integer

          dmPelsWidth As Long
          dmPelsHeight As Long
          dmDisplayFlags As Long
          dmDisplayFrequency As Long

          End Type
          Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
          (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
          lpDevMode As Any) As Boolean

          Declare Function ChangeDisplaySettings Lib "user32" Alias _

          "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
          '--- Akhir coding di Module...

          '--- Coding ini di Form Anda...
          Private Sub Form_Load()
            'Ganti '800,600' dengan resolusi yang Anda inginkan.
            'Anda dapat mengganti "color pallete" ke 32 - Bit dengan mengganti '16' di bawah dengan '32'

            'ChangeScreenSettings 640, 480, 16 - Bit 'Contoh apabila menggunakan 640x480, 16 Bit
            ChangeScreenSettings 800, 600, 16 - Bit 'Contoh yang diaplikasikan saat ini.
          End Sub

          Public Sub ChangeScreenSettings(lWidth As Integer, _
          lHeight As Integer, lColors As Integer)
          Dim tDevMode As DEVMODE, lTemp As Long, lIndex As Long
          lIndex = 0

          Do
          lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
          If lTemp = 0 Then Exit Do
          lIndex = lIndex + 1
          With tDevMode

          If .dmPelsWidth = lWidth And .dmPelsHeight = lHeight _
          And .dmBitsPerPel = lColors Then
          lTemp = ChangeDisplaySettings(tDevMode, CDS_UPDATEREGISTRY)
          Exit Do

          End If
          End With
          Loop
          Select Case lTemp

          Case DISP_CHANGE_SUCCESSFUL
               MsgBox "Setting tampilan baru telah berhasil", _
                      vbInformation
          Case DISP_CHANGE_RESTART
               MsgBox "Komputer harus di-restart agar mode grafik dapat berfungsi!", vbQuestion

          Case DISP_CHANGE_FAILED
               MsgBox "Driver dari tampilan gagal memilih mode grafik!", vbCritical
          Case DISP_CHANGE_BADMODE
               MsgBox "Mode grafik tidak mendukung!", vbCritical

          Case DISP_CHANGE_NOTUPDATED
               MsgBox "Tidak dapat menulis setting ke dalam registry", vbCritical
          Case DISP_CHANGE_BADFLAGS
               MsgBox "Anda memasukkan data yang tidak valid!", vbCritical

          End Select
          End Sub
          '--- Akhir Coding di Form...

Tags:

Contoh Membuat Press AnyKey To Stop And Continue VB6

Berikut ini adalah cara sederhana membuat stop dan continue saat form ditekan oleh sembarang tombol di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form.
2. Tambahkan 1 control Timer dan 2 Label.
3. Copy-kan coding berikut ke dalam editor form yang bertalian.

          Dim StatusLanjut As Boolean

          Private Sub Form_KeyPress(KeyAscii As Integer)
            If StatusLanjut = False Then

               Timer1.Enabled = True
               StatusLanjut = True
               Label1.Caption = "Press any key to stop..."
            ElseIf StatusLanjut = True Then

               Timer1.Enabled = False
               StatusLanjut = False
               Label1.Caption = "Press any key to continue.."
            End If
          End Sub

          Private Sub Form_Load()
            Label1.Caption = "Press any key to continue..."
            Label2.Caption = Time

            Timer1.Interval = 500
            Timer1.Enabled = False
            StatusLanjut = False
          End Sub

          Private Sub Timer1_Timer()
            Label2.Caption = Time
          End Sub

Tags:

Cara Mengubah Font Sebelum Data Di Print/Cetak VB6

Berikut ini adalah cara mengubah font sebelum data dicetak/print di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form dan 1 Commandbutton.
2. Copy-kan coding berikut ke dalam editor form yang bertalian.

          Private Sub Command1_Click()
              Printer.FontName = "Arial"

              Printer.FontUnderline = False
              Printer.FontBold = False
              Printer.FontItalic = True
              Printer.FontSize = "30"

              Printer.Print "hello"
              'Gunakan perintah EndDoc jika teks ini adalah yang
              'terakhir yang dicetak ke dalam kertas.
              Printer.EndDoc

          End Sub

Tags: