Friday, December 6, 2013

Setting Arabic Tanpa Menggunakan CD Windows XP

Artikel ini merupakan permohonan maaf, karena ada beberapa SMS & email yang tidak sempat terjawab. Pertanyaan yang terdapat dalam email dan SMS tersebut senada, (1) Mengapa tulisan arab pada Software Kamus Bahasa Arab tidak bisa terbaca (2). Bagaimana cara setting arabic tanpa menggunakan CD Windows XP? (pertanyaan dalam beberapa email & SMS). Baiklah sekarang kita akan membahas bagaimana cara setting arabic tanpa menggunakan CD Windows XP (mengenai tata cara setting arabic dengan menggunakan CD Windows XP telah kami bahas pada link disamping Tata Cara Setting Arabic Pada Windows XP)

Mengapa dengan setting arabic tanpa menggunakan CD windows XP? sementara Anda memiliki CD-nya. Kalau ada pertanyaan demikian, mungkin ini sebuah pertanyaan yang menarik. Mengenai hal tersebut, terdapat beberapa keuntungan, diantaranya:
  1. Mobile, maksudnya jika Anda ingin mendownload file-file bertuliskan arab dan terpaksa harus mengetik arab pada mesin pencari, sementara Anda tidak memiliki koneksi internet sendiri di rumah atau alasan lainnya, maka Anda dapat menggunakan warnet tanpa harus bertanya "Mas, Apakah komputernya support arabic?" yang hampir dipastikan 90% dari jawabannya adalah: "Tidak".
  2. Dengan cara setting arabic seperti ini, Anda tidak akan direpotkan oleh Laptop/komputer yang tidak memiliki CD-ROM drive, gunakan saja flashdisk.
  3. Tidak disyaratkan memiliki CD Windows XP. Misalnya jika kita bermuqim di luar. Tentu saja di luar sana tidak semudah mendapatkan CD-nya seperti di dalam sini (baca: dalam negeri).
  4. dan seterusnya.
Cara setting arabic tanpa menggunakan CD Windows XP:
  1. Download terlebih dahulu link disamping [Setting Arabic Tanpa Menggunakan CD Windows XP]
  2. Extract seluruh filenya.
  3. Lakukan setting arabic seperti biasa, seperti kita melakukannya dengan menggunakan CD XP hanya sekarang sumbernya berasal dari file-file yang didownload tadi.

Jika kurang memahami langkah yang ke-3, perhatikan video youtube di bawah ini:

Keywords: cara, menulis, arab, di, windows, xp, instal, install, bahasa, setting, arabic, mengetik, huruf, tanpa, cd, download, untuk, font, for, install, fonts, menggunakan, menambah, menginstal, menginstall

READ MORE - Setting Arabic Tanpa Menggunakan CD Windows XP

Tuesday, November 26, 2013

Mengimport Database MySQL ke Hosting - Bagian-02

Setelah sukses dengan pendaftaran yang diposting disini, mari kita lanjutkan latihan pembuatan website dengan memanfaatkan script PHP serta database MySQL yang sudah ada (kunjungi sumber).

Pertama yang harus kita lakukan adalah mendownload seluruh file di bawah ini:

selanjutnya ekstraklah file database.zip, kemudian masuk ke control panel dengan mengklik icon Go to CPanel seperti yang terdapat pada gambar di bawah ini:

icon cPanel 000WebHost
Gambar: Icon cPanel 000webhost.com
selanjutnya Anda akan dibawa ke halaman kontrol panel. Klik icon menu yang bertuliskan phpMyAdmin seperti pada gambar di bawah ini:

000WebHost phpMyAdmin
Gambar: Icon menu phpMyAdmin

tahap berikutnya adalah membuat database, klik terlebih dahulu tautan yang bertuliskan MySQLManagement seperti yang terdapat pada gambar di bawah ini:

000WebHost phpMyAdmin MySQLManagement
Gambar: Tautan MySQLManagement

isi form yang terdapat pada gambar di bawah ini dengan nama user, nama database, dan password database. Harap diingat bahwa seluruh data situs e-Learning yang akan Anda buat akan disimpan disini.

000WebHost create database
Gambar: Form pengisian untuk pembuatan database

setelah seluruh textbox pada form di atas diisi maka klik tombol Create database, dan hasilnya tampak seperti gambar di bawah ini:

000webhost database
Gambar: nama database, nama user, dan nama hosting

kemudian kita kembali ke phpMyAdmin dan klik icon menu phpMyAdmin:

000WebHost phpMyAdmin
Gambar: phpMyAdmin

dilanjutkan dengan mengklik tautan Enter phpMyAdmin seperti pada gambar di bawah ini:

000WebHost enter phpMyAdmin
Gambar: Tautan Enter phpMyAdmin

000WebHost phpMyAdmin
Gambar: Halaman phpMyAdmin

tampak pada gambar di atas, kita telah memiliki database tetapi tidak memiliki tabel satupun alias tabelnya masih kosong, maka klik tab Import, dan lakukan pengimporan database dengan mengklik tombol Choose File dan pilihlah file database (dbmuhdela.sql) yang telah diekstrak tadi. Klik tombol Go, maka hasilnya tampaknya seperti pada gambar di bawah ini:

tabel-tabel database  yang diperlukan situs elearning
Gambar: Tabel-tabel database yang diperlukan oleh situs

Selamat! sampai disini kita telah menyelesaikan dua tahap (seluruhnya ada 3 tahap):

  1. Pendaftaran
  2. Import database
  3. Konfigurasi untuk menghubungkan situs dengan database
  4. Selesai, situs sudah bisa digunakan

Mengenai tahap ke-3 (konfigurasi untuk menghubungkan situs dengan database), maka akan dibahas pada posting selanjutnya (Insya Allah), sedangkan tahap ke-4 (selesai, situs sudah bisa digunakan) tidak akan dibahas lebih lanjut, karena memang sudah selesai. Semoga bermanfaat.

 

READ MORE - Mengimport Database MySQL ke Hosting - Bagian-02

Membuat WebSite/Situs di 000WebHost - Bagian-01


Mengenai cara membuat website atau situs di 000WebHost - Pertama yang harus kita lakukan adalah mendaftar di 000WebHost. Adapun langkah-langkah untuk mendaftar adalah sebagai berikut:
  • Buka 000WebHost klik disini
  • Selanjutnya kita akan bertemu dengan halaman ini. Klik tombol Sign-Up.

000webhost signup
Gambar: 000WebHost Sign-Up

  • Setelah meng-klik tombol Sign-Up, maka kita akan bertemu dengan halaman ini:
Form Isian 000WebHost
Gambar: Form yang harus diisi pada saat pendaftaran

Penjelasan cara pengisian:
  • Pada gambar di atas ada dua pilihan pengisian nama domain, seperti gambar di bawah ini:
000WebHost gratis atau berbayar
Gambar: 000WebHost, pilihan domain berbayar atau gratis

  • Isi pada baris pertama (I want to host my own domain) jika Anda sudah memiliki domain berbayar/terdaptar
  • Isi baris kedua (or, I will choose your free subdomain (recommended)) jika Anda belum memiliki domain (gratis, disarankan)
  • Your name = di isi dengan nama Anda
  • Your email (account details will be sent there) = diisi dengan alamat email Anda.
  • Password (at least 6 symbols, both letters and numbers) = diisi dengan password Anda yang digunakan untuk login ke 000WebHost. Password merupakan campuran angka dan huruf minimal 6 karakter.
  • Type password again = diisi dengan cara mengetik ulang password yang tadi telah ditulis
  • Beri centang pada tulisan I agree to Terms Of Service
  • Terakhir adalah klik tombol Create My Account
  • Jika pada pengisian di atas tidak ada yang salah maka Anda akan di bawa ke halaman seperti gambar di bawah ini:
000WebHost, Email belum dikonfirmasi
Gambar: 000WebHost, email belum dikonfirmasi

Perhatikan gambar di atas, pada kolom status terdapat tulisan Waiting for email confirmation. artinya Anda belum mengkonfirmasi lewat email, konfirmasilah dengan cara membuka email yang digunakan pada form pengisian di atas, seperti pada gambar di bawah ini:
000WebHost, Konformasi lewat email
Gambar: 000WebHost, email konfirmasi

000WebHost, tautan link konfirmasi
Gambar: 000WebHost, tautan link konfirmasi lewat email

Sekarang buka lagi situs 000WebHost, dan lihat status domain Anda, dan selamat domain Anda sudah aktif, seperti gambar di bawah ini:
000WebHost, domain telah aktif
Gambar: 000WebHost, domain telah aktif

Selanjutnya buka alamat situs gratisan Anda pada browser (Mozilla Firefox, Internet Explorer, Google Chrome, atau apa saja) dengan cara mengetikan alamat situs Anda pada AddressBar, seharusnya jika sudah aktif gambarnya adalah seperti di bawah ini:
000WebHost, tampilan situs awal setalah aktif
Gambar: 000WebHost, tampilan situs awal setetah aktif

Selanjutnya, apa yang bisa kita perbuat dengan domain gratisan (percobaan) yang sudah aktif tersebut? oh, banyak tentu saja banyak, posting kali ini dicukupkan sekian dulu, semoga bermanfaat. bersambung pada bagian-02
READ MORE - Membuat WebSite/Situs di 000WebHost - Bagian-01

Saturday, November 23, 2013

VB6 DataGrid: Mouse Wheel Scroll Horizontal ScrollBar +SHIFT

Jika kita mencari source code untuk men-scroll DataGrid dari atas ke bawah (vertikal) tentu tidak akan kesulitan, tetapi bagaimana jika scroll-nya menyamping dari kiri ke kanan (horizontal) yang disertai dengan menekan tombol SHIFT? Nah, di bawah ini merupakan salah satu contoh source codenya, dengan mengimplentasikan SubClassing menggunakan komponen SSubTmr6.dll seperti yang telah diposting sebelumnya. 

Form:

Option Explicit 

Dim WithEvents cMouse As cDataGridScroll

'--------------------------------------------------------------------------
' http://khoiriyyah.blogspot.com
' menggunakan component VBAccelerator SSubTmr6.dll Steve McMahon
'--------------------------------------------------------------------------

Private Sub Form_Activate()
If DataGrid1.hWndEditor <> 0 Then cMouse.AttacthHWNDEditor
End Sub

Private Sub Form_Load()
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh
Set cMouse = New cDataGridScroll
With cMouse
.DataGrid = DataGrid1
End With
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set cMouse = Nothing
End Sub

Class (cDataGridScroll.cls):

Option Explicit 

Implements ISubclass

'--------------------------------------------------------------------------
' http://khoiriyyah.blogspot.com
' menggunakan component VBAccelerator SSubTmr6.dll Steve McMahon
'--------------------------------------------------------------------------

Private Const WM_MOUSEWHEEL = &H20A
Private Const WHEEL_DELTA = 120
Private Const MK_SHIFT = &H4

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal cbSrc As Long)

Public Event MouseScroll(Shift As Integer)
Private WithEvents dtGrid As DataGrid
Dim GSubclass As New GSubclass

Public Sub AttacthHWNDEditor()
GSubclass.AttachMessage Me, dtGrid.hWndEditor, WM_MOUSEWHEEL
End Sub

Public Property Let DataGrid(New_DataGrid As DataGrid)
Set dtGrid = New_DataGrid
GSubclass.AttachMessage Me, dtGrid.hwnd, WM_MOUSEWHEEL
End Property

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer6.EMsgResponse)
'
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer6.EMsgResponse
'
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fwKeys As Integer, zDelta As Integer
Static intHScroll As Integer
Select Case iMsg
Case WM_MOUSEWHEEL
fwKeys = LoWord(wParam)
zDelta = HiWord(wParam) / WHEEL_DELTA
'Debug.Print "fwKeys: " & fwKeys
'Debug.Print "zDelta: " & zDelta
If fwKeys = 4 Then '+SHIFT
intHScroll = intHScroll + 1
If intHScroll > 5 Then 'memperlambat horizontal scroll
If zDelta > 0 Then
dtGrid.Scroll -1, 0
Else
dtGrid.Scroll 1, 0
End If
intHScroll = 0
End If
ElseIf fwKeys = 0 Then
If zDelta > 0 Then
dtGrid.Scroll 0, -1
Else
dtGrid.Scroll 0, 1
End If
ElseIf fwKeys = 8 Then '+CTRL 'ZOOM
If zDelta > 0 Then
dtGrid.Font.Size = dtGrid.Font.Size + 1
Else
If dtGrid.Font.Size > 2 Then
dtGrid.Font.Size = dtGrid.Font.Size - 1
End If
End If
End If
End Select
End Function

Private Sub Class_Terminate()
GSubclass.DetachMessage Me, dtGrid.hwnd, WM_MOUSEWHEEL
Set GSubclass = Nothing
Set dtGrid = Nothing
End Sub

Function LoWord(ByVal dwDoubleWord As Long) As Integer
Call CopyMemory(LoWord, dwDoubleWord, 2)
End Function

Function HiWord(ByVal dwDoubleWord As Long) As Integer
Call CopyMemory(HiWord, ByVal VarPtr(dwDoubleWord) + 2, 2)
End Function
READ MORE - VB6 DataGrid: Mouse Wheel Scroll Horizontal ScrollBar +SHIFT

Friday, November 22, 2013

Cara Menggunakan Komponen SubClassing SSubTmr6.dll

SSubTmr6.dll merupakan komponen yang dibuat oleh Steve McMahon. Tujuan utamanya adalah untuk mengimplementasikan subclassing dengan mudah, stabil, dan aman. Selengkapnya bisa Anda baca disini.

Di bawah ini merupakan langkah mudah cara menggunakan komponen subclassing SSubTmr6.dll. Setelah menambahkan referensi dll SSubTmr6.dll (vbAccelerator VB6 Subclassing And Timer Assistant...) selanjutnya, buatlah kerangkan kodenya seperti di bawah ini:

Option Explicit  

'--------------------------------------------------------------------------
' http://khoiriyyah.blogspot.com
' kerangka kode Subclassing SSubTmr6.dll Steve McMahon
'--------------------------------------------------------------------------
Dim GSubclass As New GSubclass
Implements ISubclass

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer6.EMsgResponse)
'Kode ini boleh dikosongkan tetapi tidak boleh dihapus
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer6.EMsgResponse
'Kode ini boleh dikosongkan tetapi tidak boleh dihapus
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case Message1
Case Message2
Case Etc
End Select
End Function

Di bawah ini merupakan contoh paling sederhana subclassing menggunakan komponen SSubTmr6.dll. Kode di bawah, digunakan untuk mengganti menu yang ditampilkan pada saat mengklik kanan komponen TextBox standar:

Option Explicit 

'--------------------------------------------------------------------------
' http://khoiriyyah.blogspot.com
' kerangka kode Subclassing SSubTmr6.dll Steve McMahon
'--------------------------------------------------------------------------
Dim GSubclass As New GSubclass
Implements ISubclass

'message windows yang akan dilampirkan (klik kanan)
Private Const WM_RBUTTONUP = &H205

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer6.EMsgResponse)
'Kode ini boleh dikosongkan tetapi tidak boleh dihapus
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer6.EMsgResponse
'Kode ini boleh dikosongkan tetapi tidak boleh dihapus
End Property

Private Sub Form_Load()
'melampirkan message WM_RBUTTONUP-nya Text1 pada komponen
    GSubclass.AttachMessage Me, Text1.hwnd, WM_RBUTTONUP
End Sub

Private Sub Form_Unload(Cancel As Integer)
'menghilangkan message WM_RBUTTONUP-nya Text1 dari komponen
    GSubclass.DetachMessage Me, Text1.hwnd, WM_RBUTTONUP
Set GSubclass = Nothing 'bersihkan memory
End Sub

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_RBUTTONUP
'tampilkan menu mnuTest pada saat klik kanan di Text1
        PopupMenu mnuTest
End Select
End Function

Maka sekarang, pada saat kita mengklik kanan TextBox diganti menjadi seperti gambar di bawah ini:

mengganti menu klik kanan pada textbox
Gambar: Menu klik kanan default yang terdapat pada TextBox kita ganti dengan menu buatan kita sendiri

READ MORE - Cara Menggunakan Komponen SubClassing SSubTmr6.dll

Tuesday, November 19, 2013

Install Arabic di Windows 7

Mengenai cara install arabic di Windows 7 - Sebelumnya saya pernah memposting mengenai cara setting arabic pada pada Windows XP, maka pada kesempatan kali ini, kita akan membahas mengenai cara install/setting arabic language pada Windows 7.

Cara menginstall/setting arabic pada Windows 7 jauh lebih mudah dibandingkan dengan setting arabic pada Windows XP, mengapa demikian? karena menginstall arabic pada Windows 7 tidak memerlukan CD installer. Jadi, kemungkinan tidak akan ada judul posting yang seperti ini: Cara Install/Setting Arabic Pada Window 7 Tanpa CD Installer, karena memang tidak membutuhkannya.

Langkah-langkah installasi:

  • Klik Tombol Start >> Control Panel >> Clock, Language and Region >> Change keyboards or other input methods
  • Pada Dialog window Text Services and Input Languages, klik tombol Add
  • Pada window Add Input Language, pilih Arabic (Saudi Arabia) Klik tanda + pada Arabic (Saudi Arabia)  >>  tanda + Keyboard >> pilih Arabic (101)  >> OK.
  • Sampai disini, proses intallasi belum selesai, selanjutnya klik tombol Key Settings >> Change Key Sequence... >> Switch input languages >> CTRL + SHIFT, point yang terakhir ini maksudnya: apabila Anda ingin berpindah dari latin ke arab maka tekan CTRL + SHIFT (kanan) dan apabila Anda ingin berpindah dari Arab ke Latin tekan CTRL + SHIFT (kiri). Tentu saja ini akan sangat memudahkan sekali pada saat kita mengetik tulisan campuran antara Latin dan Arab.
Untuk lebih jelasnya, Anda bisa melihat video cara install arabic pada Windows 7:



Demikian mengenai cara install arabic pada Windows 7, Semoga bermanfaat.
READ MORE - Install Arabic di Windows 7

Friday, November 1, 2013

VB6 Trik - Mengukur Dimensi String Tanpa Fungsi API

Menjelaskan mengenai cara mengukur dimensi string yang menggunakan objek font tertentu tanpa menggunakan fungsi API.

Untuk berbagai keperluan, terkadang kita membutuhkan sebuah prosedure untuk mengukur dimensi sebuah string. Di samping dengan menggunakan fungsi API GetTextExtentPoint32, kitapun dapat mengukurnya dengan sebuah trik yang sederhana, di bawah ini adalah contohnya:

Option Explicit

Private Type hwFONT
Height As Integer
Width As Integer
End Type

Private Function GetWidthHeight(LabelCaption As String) As hwFONT
Dim lbl As Label, hwF As hwFONT
Set lbl = Controls.Add("VB.Label", "lblTestWidthHeight")
With lbl
.Caption = LabelCaption
.AutoSize = True
.Refresh
End With
hwF.Width = lbl.Width
hwF.Height = lbl.Height
GetWidthHeight = hwF
Controls.Remove "lblTestWidthHeight"
End Function

Private Function GetFontWidthHeight(LabelCaption As String, _
Optional FontName As String = "MS Sans Serif", _
Optional FontSize As String = 8) As hwFONT
Dim lbl As Label, hwF As hwFONT
Set lbl = Controls.Add("VB.Label", "lblTestWidthHeight")
With lbl
.FontName = FontName
.FontSize = FontSize
.Caption = LabelCaption
.AutoSize = True
.Refresh
End With
hwF.Width = lbl.Width
hwF.Height = lbl.Height
GetFontWidthHeight = hwF
Controls.Remove "lblTestWidthHeight"
End Function

Private Function GetFontObjectWH(LabelCaption As String, fntAny As StdFont) As hwFONT
Dim lbl As Label, hwF As hwFONT
Set lbl = Controls.Add("VB.Label", "lblTestWidthHeight")
With lbl
.Caption = LabelCaption
.AutoSize = True
Set .Font = fntAny
.Refresh
End With
hwF.Width = lbl.Width
hwF.Height = lbl.Height
GetFontObjectWH = hwF
Controls.Remove "lblTestWidthHeight"
End Function

Private Sub cmdTest1_Click()
Dim hwF As hwFONT
hwF = GetWidthHeight("Test")
List1.AddItem "Test"
Shape1.Width = hwF.Width
Picture1.Cls
Picture1.Print "Height: " & hwF.Height & vbCrLf & "Widht: " & hwF.Width
End Sub

Private Sub cmdTest3_Click()
Dim fntList As StdFont
Dim hwF As hwFONT
Set fntList = List1.Font
Dim strString As String
strString = "Test Font object"
List1.AddItem strString
hwF = GetFontObjectWH(strString, fntList)
Shape1.Width = hwF.Width
Picture1.Cls
Picture1.Print "Height: " & hwF.Height & vbCrLf & "Widht: " & hwF.Width
End Sub

Private Sub cmdTest2_Click()
Dim hwF As hwFONT
hwF = GetFontWidthHeight("Just Test")
List1.AddItem "Just Test"
Shape1.Width = hwF.Width
Picture1.Cls
Picture1.Print "Height: " & hwF.Height & vbCrLf & "Widht: " & hwF.Width
End Sub
Selanjutnya, dari contoh-contoh di atas yang akan kita gunakan untuk berbagai keperluan adalah:
Private Type hwFONT
Height As Integer
Width As Integer
End Type

Private Function GetFontObjectWH(LabelCaption As String, fntAny As StdFont) As hwFONT
Dim lbl As Label, hwF As hwFONT
Set lbl = Controls.Add("VB.Label", "lblTestWidthHeight")
With lbl
.Caption = LabelCaption
.AutoSize = True
Set .Font = fntAny
.Refresh
End With
hwF.Width = lbl.Width
hwF.Height = lbl.Height
GetFontObjectWH = hwF
Controls.Remove "lblTestWidthHeight"
End Function

Download project: String dimension (font height and width)

READ MORE - VB6 Trik - Mengukur Dimensi String Tanpa Fungsi API

Tuesday, October 1, 2013

Menghapus Virus Shortcut - Cara Termudah

Mengenai cara termudah menghapus virus shortcut/copy of shortcut/ramnit/recycler - Sebelumnya saya pernah memposting bagaimana cara menghapus virus copy of shortcut secara manual klik di sini. Pada saat itu, cara tersebut terbukti efektif, yakni sebelum virus copy of shortcut dapat menginfeksi file *.exe, *.dll, .html seperti sekarang ini. Lalu sekarang bagaimana?

Langkah-langkah menghapus virus ramnit

  • Download ramnit killer (PCMAV Express for Ramnit) klik di sini
  • Tutup seluruh aplikasi yang sedang berjalan
  • Putuskan koneksi internet (tidak boleh ada koneksi internet)
  • Jalankan dialog run dengan menekan Win + R atau klik Start >> Run
  • Ketik 'msconfig' (tanpa menggunakan tanda petik)
  • Pilih tab Startup >> Disable All >> OK seperti gambar di bawah:
Windows MSConfig
Gambar: Mendisable seluruh program pada startup

  • Restart komputer
  • Jalankan PCMAV Express for Ramnit
  • Biarkan ia bekerja hingga selesai.
  • Setelah selesai, Anda dapat meng-enable-kan kembali aplikasi-aplikasi yang berjalan pada startup yang sebelumnya Anda disablekan.
Win + R
Gambar: Menekan tombol Win + R


PCMAV Express untuk menghapus virus Ramnit - Copy Of Shortcut - Recycler
Gambar: PCMAV Express untuk menghapus virus Ramnit - Copy Of Shortcut - Recycler


Demikian mengenai cara menghapus virus copy of shortcut dengan mudah. Semoga bermanfaat.

Keywords: cara, menghilangkan, virus, copy, of, shortcut, menghapus, +, recycler, (ramnit), mudah, mengatasi, ramnit, manual, dan, secara, bagaimana, shorcut, pcmav, express, for, ramnit.shortcut, membasmi, membersihkan, uninstall, software, hapus, killer, aplikasi, untuk, ramnit,shortcut,recycler, hilangkan, pada, windows, 7, basmi, file, to, membuang, membunuh, download, 1, 2, 3, 4, di, bersihkan, penghapus.

READ MORE - Menghapus Virus Shortcut - Cara Termudah

Kamus Bahasa Arab v3.0 | Download

Alhamdulillah Kamus Bahasa Arab v3.0 telah selesai. Kamus Bahasa Arab v3.0 merupakan kelanjutan Kamus Bahasa Arab v2.0.1

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.

Download: Kamus Bahasa Arab v3.0

Perhatian:
Untuk kenyamanan Anda, scan terlebih dahulu menggunakan Anti Virus sebelum melakukan proses instalasi.

Mengenai hal-hal yang berhubungan dengan kamus bisa Anda klik disini.
 Keywords: download, kamus, bahasa, arab, indonesia, untuk, windows, 7, xp, 8, v3.0, free, offline, software, v3, online, aplikasi
READ MORE - Kamus Bahasa Arab v3.0 | Download

VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512

VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512
Option Explicit

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
(ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _
ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _
ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" _
(ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" _
(ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" _
(ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _
ByVal dwFlags As Long) As Long

Private Const PROV_RSA_FULL As Long = 1
Private Const PROV_RSA_AES As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000

Private Const HP_HASHVAL As Long = 2
Private Const HP_HASHSIZE As Long = 4

Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768

Private Const ALG_SID_MD2 As Long = 1
Private Const ALG_SID_MD4 As Long = 2
Private Const ALG_SID_MD5 As Long = 3
Private Const ALG_SID_SHA As Long = 4
Private Const ALG_SID_SHA_256 As Long = 12
Private Const ALG_SID_SHA_384 As Long = 13
Private Const ALG_SID_SHA_512 As Long = 14

Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)

' Create Hash
Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String
Dim hProv As Long, hHash As Long
Dim abytHash(0 To 63) As Byte
Dim lngLength As Long
Dim lngResult As Long
Dim strHash As String
Dim i As Long
strHash = ""
If CryptAcquireContext(hProv, vbNullString, vbNullString, _
IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _
CRYPT_VERIFYCONTEXT) <> 0& Then
If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then
lngLength = UBound(abytData()) - LBound(abytData()) + 1
If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) _
Else lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&)
If lngResult <> 0& Then
lngLength = UBound(abytHash()) - LBound(abytHash()) + 1
If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) <> 0& Then
For i = 0 To lngLength - 1
strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2)
Next
End If
End If
CryptDestroyHash hHash
End If
CryptReleaseContext hProv, 0&
End If
CreateHash = LCase$(strHash)
End Function

' Create Hash From String(Shift_JIS)
Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String
CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID)
End Function

' Create Hash From File
Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Long) As String
Dim abytData() As Byte
Dim intFile As Integer
Dim lngError As Long
On Error Resume Next
If Len(Dir(strFileName)) > 0 Then
intFile = FreeFile
Open strFileName For Binary Access Read Shared As #intFile
abytData() = InputB(LOF(intFile), #intFile)
Close #intFile
End If
lngError = Err.Number
On Error GoTo 0
If lngError = 0 Then CreateHashFile = CreateHash(abytData(), lngAlgID) _
Else CreateHashFile = ""
End Function

' MD5
Public Function CreateMD5Hash(abytData() As Byte) As String
CreateMD5Hash = CreateHash(abytData(), CALG_MD5)
End Function
Public Function CreateMD5HashString(ByVal strData As String) As String
CreateMD5HashString = CreateHashString(strData, CALG_MD5)
End Function
Public Function CreateMD5HashFile(ByVal strFileName As String) As String
CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5)
End Function

' SHA-1
Public Function CreateSHA1Hash(abytData() As Byte) As String
CreateSHA1Hash = CreateHash(abytData(), CALG_SHA)
End Function
Public Function CreateSHA1HashString(ByVal strData As String) As String
CreateSHA1HashString = CreateHashString(strData, CALG_SHA)
End Function
Public Function CreateSHA1HashFile(ByVal strFileName As String) As String
CreateSHA1HashFile = CreateHashFile(strFileName, CALG_SHA)
End Function

' SHA-256
Public Function CreateSHA256Hash(abytData() As Byte) As String
CreateSHA256Hash = CreateHash(abytData(), CALG_SHA_256)
End Function
Public Function CreateSHA256HashString(ByVal strData As String) As String
CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256)
End Function
Public Function CreateSHA256HashFile(ByVal strFileName As String) As String
CreateSHA256HashFile = CreateHashFile(strFileName, CALG_SHA_256)
End Function

' SHA-384
Public Function CreateSHA384Hash(abytData() As Byte) As String
CreateSHA384Hash = CreateHash(abytData(), CALG_SHA_384)
End Function
Public Function CreateSHA384HashString(ByVal strData As String) As String
CreateSHA384HashString = CreateHashString(strData, CALG_SHA_384)
End Function
Public Function CreateSHA384HashFile(ByVal strFileName As String) As String
CreateSHA384HashFile = CreateHashFile(strFileName, CALG_SHA_384)
End Function

' SHA-512
Public Function CreateSHA512Hash(abytData() As Byte) As String
CreateSHA512Hash = CreateHash(abytData(), CALG_SHA_512)
End Function
Public Function CreateSHA512HashString(ByVal strData As String) As String
CreateSHA512HashString = CreateHashString(strData, CALG_SHA_512)
End Function
Public Function CreateSHA512HashFile(ByVal strFileName As String) As String
CreateSHA512HashFile = CreateHashFile(strFileName, CALG_SHA_512)
End Function

Keywords: vb6, md5, hash, function, sha256, hashing, in, vb, sha512, generator, sha1, sha, vba, algorithm, sha512.dll

READ MORE - VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512

Thursday, August 15, 2013

Contoh VB6 Kode Cek Stok SEV Indosat (STK)

Di bawah ini merupakan contoh kode yang digunakan untuk mengecek stok SEV Indosat.

Peralatan yang dibutuhkan:

  1. Modem GSM
  2. Kartu chip Indosat

Adapun kodenya adalah sebagai berikut:

Option Explicit 

'-----------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-----------------------------------------------------------------------------

Dim strBuffer As String

Private Sub cmdSend_Click()
txtResult.Text = ""
txtProcess.Text = ""
strBuffer = ""
If UCase$(Left$(txtATCommand.Text, 2)) <> "AT" Then
MSComm1.Output = txtATCommand.Text & Chr(26)
Else
MSComm1.Output = txtATCommand.Text & vbCrLf
End If
End Sub

Private Sub Form_Load()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.CommPort = 3 'Port disesuaikan
.Settings = "115200,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub

Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
strBuffer = strBuffer & MSComm1.Input
End Select
txtProcess.Text = strBuffer
txtProcess.SelStart = Len(txtProcess.Text)
Do
strBuffer = strBuffer & MSComm1.Input
Loop While MSComm1.InBufferCount

If InStr(1, strBuffer, "+STIN: 99" & vbCrLf) Then
MSComm1.Output = "AT+STGI=99" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 9" & vbCrLf) Then
MSComm1.Output = "AT+STGI=9" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 6" & vbCrLf) Then
MSComm1.Output = "AT+STGI=6" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 3" & vbCrLf) Then
MSComm1.Output = "AT+STGI=3" & vbCrLf
strBuffer = ""
ElseIf InStr(1, strBuffer, "+STIN: 1" & vbCrLf) Then
MSComm1.Output = "AT+STGI=1" & vbCrLf
strBuffer = ""
End If

If InStr(1, strBuffer, "+STGI") Then
If InStr(1, strBuffer, "SEV Menu") Then
MSComm1.Output = "AT+STGR=0,1,3" & vbCrLf
strBuffer = ""
End If

If InStr(1, strBuffer, "Inventory") Then
MSComm1.Output = "AT+STGR=6,1,1" & vbCr
strBuffer = ""
End If
If InStr(1, strBuffer, "Optional") Then
MSComm1.Output = "AT+STGR=6,1,1" & vbCr
strBuffer = ""
End If
If InStr(1, strBuffer, "Enter MPIN") Then
MSComm1.Output = "AT+STGR=3,1" & vbCr
MSComm1.Output = "313131" & Chr(26) 'PIN disesuaikan, hati-hati 3x salah PIN kartu akan diblokir
strBuffer = ""
End If
End If

End Sub

Catatan penting:

  1. Sebelumnya kita harus mengaktifkan terlebih dahulu menu STK-nya seperti yang telah dijelaskan dalam posting disini.
  2. Setelah seluruhnya selesai, yang harus kita lakukan adalah mengetikan AT+STGI=0 dan klik tombol Send seperti yang terlihat pada gambar di bawah:

Cek STOK SEV Indosat
Gambar - Cek STOK SEV Indosat

Download: Contoh kode VB6 cek stok SEV Indosat

Keywords: contoh, cek, gambar, vb6, code, visual, basic, 6.0, contok, chek, kode, html, contohcek, stk, output, instr, indosat, contoh-contoh, coding, source, mscomm1.output

READ MORE - Contoh VB6 Kode Cek Stok SEV Indosat (STK)

Monday, July 29, 2013

VB6 Database: Listview Code Generator Source Code

Tools VB6 Add-Ins yang satu ini digunakan untuk mengenerate source code listview untuk berinteraksi dengan database. Cara menggunakan:

  • Registrasikan terlebih dahulu komponen VB6 Listview Generator.dll yang terdapat dalam folder bin.
  • Buka project VB6
  • Klik menu Add-Ins >> VB6 Listview Generator, maka akan muncul form seperti di bawah ini:

VB6 Listview Generator
Gambar - VB6 Listview Generator

  • Pilih database apa saja (terserah), seperti gambar di bawah ini :

VB6 Listview Generator - Memilih database
Gambar: VB6 Listview Generator - Memilih database

  • Pilih tabel apa saja (terserah), seperti gambar di bawah ini:

VB6 Listview Generator - Memilih Tabel
VB6 Listview Generator - Memilih Tabel

Pilih ID (sebaiknya AUTO INCREMENT), seperti gambar di bawah ini:

VB6 Listview Generator - Memilih ID
VB6 Listview Generator - Memilih ID

  • Klik tombol Generate Code.
  • Ulangi seluruh langkah di atas sejumlah form listview yang Anda butuhkan.
  • Terakhir, edit manual jika ada kode yang kurang sesuai.
  • Selesai.

Download: VB6 Listview Generator Source Code. 

READ MORE - VB6 Database: Listview Code Generator Source Code

Friday, July 26, 2013

VB6 DataGrid: Mengatur Tinggi Listitem Dropdown

Membahas hal yang kurang penting mengenai cara mengatur tinggi Listitem pada dropdown datagrid. Seperti biasa menggunakan fungsi API SendMessage yang bisa dilihat penjelasannya disini, kemudian beberapa konstanta ListBox yang bisa Anda lihat penjelasannya disini, serta konstanta ComboBox yang bisa Anda lihat penjelasannya disini.

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
LB_SETITEMHEIGHT = &H1A0
Private Const CB_SETITEMHEIGHT = &H15

Private Sub SetListItemHeight(ctrl As Control, ByVal newHeight As Long)
Dim uMsg As Long
If TypeOf ctrl Is ListBox Then
uMsg = LB_SETITEMHEIGHT
ElseIf TypeOf ctrl Is ComboBox Then
uMsg = CB_SETITEMHEIGHT
Else
Exit Sub
End If
SendMessage ctrl.hwnd, uMsg, 0, ByVal CLng(newHeight And &HFFFF&)
ctrl.Refresh
End Sub

Contoh penggunaan:

Private Sub Command1_Click() 
SetListItemHeight List1, 25
End Sub

Private Sub Form_Load()
Dim i As Integer
For i = 1 To 10
List1.AddItem i
Next
End Sub

Sehingga hasilnya:

dropdown_normal_height
Gambar: Dropdown DataGrid dengan Tinggi Normal

Kemudian: 

dropdown_autoheight_listitem
Gambar: Dropdown DataGrid dengan Listitem yang Diperbesar (otomatis mengikuti row height datagrid).

READ MORE - VB6 DataGrid: Mengatur Tinggi Listitem Dropdown

Friday, July 19, 2013

VB6 Code: Membuat DWord dari HiWord + LoWord

Posting ini diambil dari Microsoft KB mengenai cara membuat fungsi return DWord dengan menggabungkan HiWord dan LoWord. Adapun fungsi yang dimaksud adalah sebagai berikut:
Function MakeDWord(LoWord As Integer, HiWord As Integer) As Long 
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&) 
End Function 
Sedangkan untuk memecah DWord (32 bits) menjadi LoWord (16 bits) dan HiWord (16 bits) adalah sebagai berikut:
Function LoWord(DWord As Long) As Integer 
    If DWord And &H8000& Then ' &H8000& = &H00008000 
        LoWord = DWord Or &HFFFF0000 
    Else 
        LoWord = DWord And &HFFFF& 
    End If 
End Function 
 
Function HiWord(DWord As Long) As Integer 
    HiWord = (DWord And &HFFFF0000) \ &H10000 
End Function 
Sedangkan contoh dari fungsi MakeDword (menggabungkan LoWord dan HiWord) adalah sebagai berikut:
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 MK_LBUTTON = &H1 
Private Const WM_LBUTTONDOWN = &H201 
 
Function MakeDWord(LoWord As Integer, HiWord As Integer) As Long 
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&) 
End Function 
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    Form1.Cls 
    Form1.Print "Button Click Event Fired" 
    Form1.Print "Position X:" & Str$(X / Screen.TwipsPerPixelX) 
    Form1.Print "Position Y:" & Str$(Y / Screen.TwipsPerPixelY) 
End Sub 
 
Private Sub Command1_Click() 
    Dim nMousePosition As Long 
    ' nMousePosition stores the x (hiword) and y (loword) values 
    ' of the mouse cursor as measured in pixels. 
 
    Let nMousePosition = MakeDWord(16, 18) 
    Call SendMessage(Me.hwnd, WM_LBUTTONDOWN, MK_LBUTTON, nMousePosition) 
End Sub 
 
Semoga bermanfaat.
READ MORE - VB6 Code: Membuat DWord dari HiWord + LoWord

Monday, July 15, 2013

VB6 DataGrid: Multiple Delete (Del Key)

Option Explicit 

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim DontResponseErrorTemporary As Boolean

Private Sub DeleteRows(dtGrid As DataGrid)
Dim varBmk As Variant
For Each varBmk In dtGrid.SelBookmarks
Adodc1.Recordset.Bookmark = varBmk
Adodc1.Recordset.Delete
Sleep 5 'miliseconds (as delay multiple delete animations)
dtGrid.Refresh
Next
End Sub

Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
If DontResponseErrorTemporary Then
Response = 0
DontResponseErrorTemporary = False
End If
End Sub

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
If Not DeleteConfirm Then
KeyCode = 0
Exit Sub
End If
DontResponseErrorTemporary = True
Call DeleteRows(DataGrid1)
KeyCode = 0
End If
End Sub

Private Function DeleteConfirm() As Boolean
If MsgBox("Are you sure want to delete this record?", vbQuestion + vbYesNo + vbDefaultButton2, "Delete Confirm") = vbYes Then
DeleteConfirm = True
End If
End Function
READ MORE - VB6 DataGrid: Multiple Delete (Del Key)

VB6 DataGrid: Multiple Selection (Left Mouse Down + SHIFT)

Option Explicit 

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const
VK_SHIFT = &H10
Private LastRow As Long
Private
SelectionCount As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
Call SetSelectionPlusShiftKey(DataGrid1)
End Sub

Private Sub SetSelectionPlusShiftKey(dtGrid As DataGrid)
Dim i As Integer
Dim Direction As Integer
If GetKeyState(VK_SHIFT) < 0 Then
SelectionCount = LastRow - dtGrid.Row
If SelectionCount < 0 Then
Direction = 1
Else
Direction = -1
End If
For i = 0 To SelectionCount Step -Direction
DataGrid1.SelBookmarks.Add (dtGrid.GetBookmark(i))
Next i
Else
LastRow = dtGrid.Row
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
READ MORE - VB6 DataGrid: Multiple Selection (Left Mouse Down + SHIFT)

Sunday, July 14, 2013

VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

Option Explicit 

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function
SetCapture Lib "user32.dll" (ByVal hwnd As Long) As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim BeginSelect As Boolean
Dim
CurrentRowY As Long

Private Sub DataGrid1_Click()
BeginSelect = False
ReleaseCapture
End Sub

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub RemoveAllSelected()
Dim h As Integer
Dim i As Integer
h = DataGrid1.SelBookmarks.Count
If h = 0 Then Exit Sub
For i = h - 1 To 0 Step -1
DataGrid1.SelBookmarks.Remove i
Next i
End Sub

Private Sub DataGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static t As Integer
Dim Direction As Integer
Dim i As Integer
If BeginSelect Then
SetCapture DataGrid1.hwnd
If CurrentRowY > DataGrid1.RowContaining(Y) Then
Direction = 1
Else
Direction = -1
End If
RemoveAllSelected
For i = CurrentRowY To DataGrid1.RowContaining(Y) Step -Direction
If i = -1 Then
Exit For
End If
DataGrid1.SelBookmarks.Add DataGrid1.RowBookmark(i)
Next
End If
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
If BeginSelect = False Then
Debug.Print DataGrid1.Col
CurrentRowY = DataGrid1.Row
End If
BeginSelect = True
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub ReleaseSelect()
BeginSelect = False
ReleaseCapture
End Sub
READ MORE - VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

Thursday, July 11, 2013

VB6 DataGrid - Auto Height DropDown DataGrid

Dengan mengetahui tinggi item sebuah ListBox seperti yang telah dijelaskan pada posting sebelumnya, maka ada banyak sekali variant code yang bermanfaat yang bisa dikembangkan, salah satunya adalah mengatur tinggi dropdown datagrid secara otomatis. Hal ini sebenarnya bukan masalah apabila item yang terdapat pada ListBox jumlahnya tetap Anda dapat mengatur tinggi ListBoxnya secara manual, tetapi bagaimana jika dinamis? terkadang 1 item, 2 item, 5 item, dsb.  Jangan sampai terjadi seperti gambar di bawah ini:

VB6 NO Auto Heigh Dropdown ListBox DataGrid
Gambar - DropDown DataGrid tanpa Auto Heigh

Padahal tinggi DropDown ListBox seharusnya seperti gambar di bawah ini:

VB6 Drop Down Datagrid
Gambar - DropDown DataGrid dengan Auto Height

Option Explicit 

'------------------------------------------------------------------------------------------ '
'http://khoiriyyah.blogspot.com
'------------------------------------------------------------------------------------------
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Const
LB_GETITEMRECT As Long = &H198

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

Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Private Const SM_CXBORDER = 5 'flat
Private Const SM_CYBORDER = 6 'flat
Private Const SM_CXEDGE = 45 '3D
Private Const SM_CYEDGE = 46 '3D

Private Function ListBoxItemHeight(lst As ListBox) As Integer
Dim rc As RECT, I As Long, dy As Long
If lst.ListCount = 0 Then Exit Function
SendMessage lst.hWnd, LB_GETITEMRECT, ByVal 0&, rc
dy = rc.Bottom - rc.Top
ListBoxItemHeight = (dy * Screen.TwipsPerPixelY)
End Function

Private Sub cmdTest_Click()
List1.Visible = False
List1.AddItem "A"
Dim BorderHeight As Integer
If List1.ListCount > 8 Then
List1.Visible = True
Exit Sub
End If
If List1.Appearance = 0 Then 'flat
        BorderHeight = (GetSystemMetrics(SM_CXBORDER) * Screen.TwipsPerPixelX) + (GetSystemMetrics(SM_CYBORDER) * Screen.TwipsPerPixelY)
ElseIf List1.Appearance = 1 Then '3D
        BorderHeight = (GetSystemMetrics(SM_CXEDGE) * Screen.TwipsPerPixelX) + (GetSystemMetrics(SM_CYEDGE) * Screen.TwipsPerPixelY)
End If
List1.Height = (ListBoxItemHeight(List1) * List1.ListCount) + BorderHeight
Debug.Print ListBoxItemHeight(List1)
Debug.Print List1.Height
List1.Visible = True
End Sub
READ MORE - VB6 DataGrid - Auto Height DropDown DataGrid

VB6 PictureBox - Print Left Center Right Align - PictureBox

Di bawah ini merupakan contoh print left - center - right pada PictureBox, seperti pada gambar di bawah ini:

VB6 Print Left Center Right Align PictureBox
Gambar - VB6 Print Left Center Right Align PictureBox

Option Explicit

'-------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------
'Print right align pada objek PictureBox
Private Sub PrintRightAlign(ByVal Teks As String, pic As PictureBox)
With pic
.CurrentX = pic.ScaleWidth - pic.TextWidth(Teks)
pic.Print Teks
End With
End Sub

'Print center pada objek PictureBox
Private Sub PrintCenter(ByVal Teks As String, pic As PictureBox)
With pic
.CurrentX = (pic.ScaleWidth - pic.TextWidth(Teks)) / 2
pic.Print Teks
End With
End Sub

'Print left pada objek PictureBox
Private Sub PrintLeft(ByVal Teks As String, pic As PictureBox)
With pic
pic.Print Teks
End With
End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = True
End Sub

'Contoh print left align
Private Sub cmdLeft_Click()
Static i As Long
i = i + 1
Call PrintLeft(i, Picture1)
End Sub

'Contoh print center
Private Sub cmdCenter_Click()
Static i As Long
i = i + 1
Call PrintCenter(i, Picture1)
End Sub

'Contoh print right
Private Sub cmdRight_Click()
Static i As Long
i = i + 1
Call PrintRightAlign(i, Picture1)
End Sub

Download: vb6_print_center_right_left.zip

READ MORE - VB6 PictureBox - Print Left Center Right Align - PictureBox