Berikut ini adalah cara melakukan editing item listbox pada saat program sedang jalan (running) di visual basic 6, untuk mempraktekannya siapkan :
1. Buat 1 Project baru dengan 1 Form, 1 Module, 1 Listbox, 1 Textbox, dan 1 Commandbutton.2. Copy-kan coding berikut ke dalam editor form & module ybt.
'--- Coding ini di Module...
Option Explicit
DefLng A-Z
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type SIZE
cx As Long
cy As Long
End Type
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal _
cbString As Long, lpSize As SIZE) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal _
hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As _
Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) 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
Public Const WM_SETREDRAW = &HB&
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31
Public Const LB_GETITEMRECT = &H198
Public Const LB_ERR = (-1)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOOWNERZORDER = &H200
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SM_CXEDGE = 45
Public Const SM_CYEDGE = 46
Public Function Max(ByVal param1 As Long, ByVal param2 As Long) As Long
If param1 > param2 Then Max = param1 Else Max = param2
End Function
'--- Akhir coding di Module...
'--- Coding ini di Form Anda...
Option Explicit
DefLng A-Z
Private m_bEditing As Boolean
Private m_lngCurrIndex As Long
Private Sub Command1_Click()
If Not m_bEditing Then Editing = True
End Sub
Private Sub Form_Load()
Me.ScaleMode = 3
Text1.Visible = False
Text1.Appearance = 0
Command1.Caption = "Tekan F2 utk mengedit"
Dim a%
For a% = 1 To 10
List1.AddItem "Item yang ke-" & a%
Next a%
Set Text1.Font = List1.Font
End Sub
Private Sub List1_KeyUp(KeyCode As Integer, Shift As Integer)
If ((KeyCode = vbKeyF2) And (Shift = 0)) Then
If (Not m_bEditing) Then Editing = True
End If
End Sub
Private Sub Text1_LostFocus()
'Jika textbox kehilangan fokus ketika kita mengedit data, kembalikan
'data/teks semula dan batalkan proses pengeditan yg telah berlangsung.
If m_bEditing = True Then
List1.List(m_lngCurrIndex) = Text1.Tag
Editing = False
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim strText As String
If KeyAscii = 10 Or KeyAscii = 13 Then
If Len(Trim$(Text1.Text)) = 0 Then
List1.List(m_lngCurrIndex) = Text1.Tag
Else
strText = Text1.Text
'Assginment-kan teks baru ke item data di Listbox ybt
List1.List(m_lngCurrIndex) = strText
End If
Editing = False 'Kembalikan ke posisi semula
KeyAscii = 0 'Menghindari bunyi beep
ElseIf KeyAscii = 27 Then 'Jika ditekan Esc untuk membatalkan pengeditan
List1.List(m_lngCurrIndex) = Text1.Tag 'Kembalikan data semula
Editing = False
KeyAscii = 0 'Menghindari bunyi beep
End If
End Sub
Private Sub Text1_GotFocus()
'Jika Text1 mendapat fokus, sorot semua isinya.
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Text1_Change()
Dim lpSize As SIZE
Dim phDC As Long
'Atur ukuran textbox tergantung dari hasil perhitungan
'ukuran dari textbox dalam pixels
'Catatan bahwa tingkat perhitungan gagal (untuk beberapa alasan) ketika
'huruf melebihi dari 14 points, tapi jika Anda mempunyai sebuah listbox
'dengan huruf 14 point, Anda harus men-design-nya dari sana.
phDC = GetDC(Text1.hwnd)
If GetTextExtentPoint32(phDC, Text1.Text, Len(Text1.Text), lpSize) = 1 Then
Text1.Width = Max(50, lpSize.cx)
End If
Call ReleaseDC(Text1.hwnd, phDC)
End Sub
Private Property Let Editing(vData As Boolean)
Dim rcItem As RECT 'RECT of the item being edited
Dim strText As String 'text of the item beign edited
Dim lpSize As SIZE 'uset to calculate the size of the textbox
Dim phDC As Long 'hDC of the listbox
On Error Resume Next
'Ambil index dari item data
m_lngCurrIndex = List1.ListIndex
'... perlakuan khusus jika tidak ada index
If m_lngCurrIndex = -1 Then Beep: Exit Property
'Mulai mengedit data...
If vData = True Then
strText = List1.List(m_lngCurrIndex)
If Len(strText) = 0 Then Beep: Exit Property
'Coba mengambil type RECT dari item dalam list
If SendMessage(List1.hwnd, LB_GETITEMRECT, ByVal m_lngCurrIndex, rcItem) _
<> LB_ERR Then
'Atur RECT. Catatan bahwa ini adalah koordinat di layar
'Itulah mengapa RECT berhubungan dengan luas dari jendela Listbox
'Kita juga mempertimbangkan dengan batas 3-D listbox, jadi jangan memanggil
'fungsi GetSystemMetrics() jika property Appearence listbox = "Flat"
With rcItem
.Left = .Left + List1.Left + GetSystemMetrics(SM_CXEDGE)
.Top = List1.Top + .Top
'Mengapa tidak memanggil fungsi GetSysMetrics dan SM_CYEDGE?
'...karena kita ingin data berada di tengah textbox
'Ambil DC dari listbox lalu hitung tinggi dan lebarnya
'Catatan bahwa hasil perhitungan gagal (untuk beberapa alasan) ketika
'ukuran huruf melebihi dari 14 points.
phDC = GetDC(Text1.hwnd)
Call GetTextExtentPoint32(phDC, strText, Len(strText), lpSize)
Call ReleaseDC(Text1.hwnd, phDC)
'Posisikan dan tampilkan textbox, bawa ke tampilan/urutan teratas.
Call SetWindowPos(Text1.hwnd, HWND_TOP, .Left, .Top, Max(50, lpSize.cx), _
lpSize.cy + 2, SWP_SHOWWINDOW Or SWP_NOREDRAW)
End With
'Setting property Listbox menyebabkan banyak efek pemunculan, jadi
'matikan property "redrawing"
Call SendMessage(List1.hwnd, WM_SETREDRAW, 0, ByVal 0&)
List1.List(m_lngCurrIndex) = ""
'Simpan item data dan set fokus ke textbox
With Text1
.Enabled = True
.Tag = strText
.Text = strText
.SetFocus
End With
End If
Else
'Set tanda redraw sehingga listbox menyesuaikan sendiri
Call SendMessage(List1.hwnd, WM_SETREDRAW, 1, ByVal 0&)
'Bersihkan isi textbox
With Text1
.Enabled = False
.Visible = False
.Move 800, 800
.Text = ""
.Tag = ""
End With
m_lngCurrIndex = -1 'invalidate this for next time
End If
'Simpan posisi terbaru..........
m_bEditing = vData
End Property
'--- 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
0 komentar:
Posting Komentar