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)