mdlautocompletesuggestion.bas

Autocomplete sugestion textbox from Google, yahoo, youtube, wikipedia. in visual basic

Attribute VB_Name = "MdlAutocompleteSuggestion"
Option Explicit

'----------------------------------------------------------------
'Autor:         Leandro Ascierto
'Mail:          leandroascierto @hotmail.com
'Date:          22/03/2009
'Description:   Autocomplete suggestion google in EditBox
'Use:           SubClassEdit Text1.hwnd
'----------------------------------------------------------------

'=========User32 Api========
Private Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Private Declare Function IsWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub 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)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'=========GDI32 Api========
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetTextColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long


'=========Wininet Api========
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

'=========Oleaut32 Api========
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long

'=========Kernel32 Api========
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

'=========Constantes========
Private Const HWND_TOPMOST              As Long = -1
Private Const HWND_NOTOPMOST            As Long = -2
Private Const SWP_NOSIZE                As Long = &H1
Private Const SWP_NOMOVE                As Long = &H2
Private Const SWP_NOACTIVATE            As Long = &H10
Private Const SWP_SHOWWINDOW            As Long = &H40

Private Const WS_BORDER                 As Long = &H800000
Private Const WS_CLIPSIBLINGS           As Long = &H4000000
Private Const WS_POPUP                  As Long = &H80000000
Private Const WS_DISABLED               As Long = &H8000000
Private Const WS_CHILD                  As Long = &H40000000

Private Const WS_EX_NOPARENTNOTIFY      As Long = &H4&
Private Const WS_EX_TOOLWINDOW          As Long = &H80&
Private Const WS_EX_TOPMOST             As Long = &H8&
Private Const WS_EX_WINDOWEDGE          As Long = &H100&

Private Const WM_LBUTTONDOWN            As Long = &H201
Private Const WM_PAINT                  As Long = &HF&
Private Const WM_SETCURSOR              As Long = &H20
Private Const WM_KILLFOCUS              As Long = &H8
Private Const WM_DESTROY                As Long = &H2
Private Const WM_GETFONT                As Long = &H31
Private Const WM_KEYDOWN                As Long = &H100
Private Const WM_LBUTTONUP              As Long = &H202
Private Const WM_SETFOCUS               As Long = &H7
Private Const WM_KEYUP                  As Long = &H101

Private Const COLOR_HIGHLIGHTTEXT       As Long = 14
Private Const COLOR_MENUTEXT            As Long = 7
Private Const COLOR_HIGHLIGHT           As Long = 13

Private Const EM_GETSEL                 As Long = &HB0
Private Const EM_SETSEL                 As Long = &HB1

Private Const DT_CALCRECT               As Long = &H400

Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_OPEN_TYPE_PROXY  As Long = 3
Private Const INTERNET_FLAG_RELOAD      As Long = &H80000000

Private Const GWL_WNDPROC               As Long = (-4)
Private Const GWL_STYLE                 As Long = -16

Private Const CP_UTF8                   As Long = 65001

Private Const LOCALE_SISO639LANGNAME As Long = &H59
Private Const LOCALE_USER_DEFAULT As Long = &H400



'=========Estructuras========
Private Type UcsRgbQuad
    R                       As Byte
    G                       As Byte
    B                       As Byte
    a                       As Byte
End Type

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

Private Type POINTAPI
    x                       As Long
    y                       As Long
End Type

Private Type PAINTSTRUCT
    hdc                     As Long
    fErase                  As Long
    rcPaint                 As RECT
    fRestore                As Long
    fIncUpdate              As Long
    rgbReserved(1 To 32)    As Byte
End Type

Private Type tItems
    Caption                 As String
    NumberReslut            As String
    Rec                     As RECT
End Type



Private Handle              As Long
Private ControlPrevProc     As Long
Private PrevProc            As Long
Private Item()              As tItems
Private mDC                 As Long
Private mCurrIndex          As Long
Private hEdit               As Long
Private mText               As String


Public mSearcherOfSuggestions           As String
Public mLangName                        As String 'Maybe not so,you can modify



Public Sub SubClassEdit(hwnd As Long)

    Dim winStyle As Long
    Dim winStyleEX As Long

    mLangName = GetSystemLocaleInfo(LOCALE_SISO639LANGNAME) 'Maybe not so, you can modify

    hEdit = hwnd

    winStyle = WS_POPUP Or WS_BORDER Or WS_CLIPSIBLINGS Or WS_CHILD Or WS_DISABLED
    winStyleEX = WS_EX_TOOLWINDOW Or WS_EX_TOPMOST Or WS_EX_WINDOWEDGE

    Handle = CreateWindowEx(winStyleEX, "#32768", "Google Suggestion", winStyle, 0, 0, 0, 0, hwnd, ByVal 0&, App.hInstance, ByVal 0&)
 
    ControlPrevProc = SetWindowLong(hEdit, GWL_WNDPROC, AddressOf ControlProc)
    
    PrevProc = SetWindowLong(Handle, GWL_WNDPROC, AddressOf WindowProc)
End Sub


Public Sub StopSubClass()
    SetWindowLong Handle, GWL_WNDPROC, PrevProc
    SetWindowLong hEdit, GWL_WNDPROC, ControlPrevProc
    KillTimer Handle, 0
    DestroyWindow Handle
End Sub


Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
   Dim PT As POINTAPI
   Dim WfP As Long

    If GetKeyState(1) < 0 Then
        GetCursorPos PT
        WfP = WindowFromPoint(PT.x, PT.y)
        If WfP <> hwnd And WfP <> hEdit Then
            ShowWindow Handle, 0
        End If
    End If
End Sub


Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim CapRec As RECT
    Dim PT As POINTAPI
    Dim PS As PAINTSTRUCT
    Dim hBrush As Long
    Dim hPen As Long
    Dim i As Integer
    

    If uMsg = WM_SETCURSOR Then

        GetCursorPos PT
        ScreenToClient hwnd, PT
        
        For i = 0 To UBound(Item)
            If PtInRect(Item(i).Rec, PT.x, PT.y) And mCurrIndex <> i Then
                mCurrIndex = i
                RedrawWindow hwnd, ByVal 0&, ByVal 0&, &H1
                Exit For
            End If
        Next
        
        Select Case HiWord(lParam)
        
            Case WM_LBUTTONUP
                If mCurrIndex > -1 Then
                    Call SetEditText(hEdit, Item(mCurrIndex).Caption)
                    keybd_event vbKeyReturn, 0, 0, 0
                    keybd_event vbKeyReturn, 0, &H2, 0
                End If
                ShowWindow Handle, 0
                
            Case WM_LBUTTONDOWN
                'Cancel beep
                Exit Function
                
        End Select

    End If


    If uMsg = WM_PAINT Then

        
        BeginPaint hwnd, PS

        mDC = PS.hdc

        DeleteObject SelectObject(mDC, SendMessage(hEdit, WM_GETFONT, 0, ByVal 0&))
        
        hBrush = CreateSolidBrush(GetPixel(GetDC(hEdit), 0, 0))
        FillRect mDC, PS.rcPaint, hBrush
        DeleteObject hBrush
        
        SetBkMode mDC, 0

        SetTextColor mDC, GetSysColor(COLOR_MENUTEXT)
        
        For i = 0 To UBound(Item)
            With Item(i)
                SetRect CapRec, 5, .Rec.Top, .Rec.Right - 5, .Rec.Bottom
                If i = mCurrIndex Then
                    hPen = CreatePen(0, 1, GetSysColor(COLOR_HIGHLIGHT))
                    hBrush = CreateSolidBrush(pvAlphaBlend(vbHighlight, vbWindowBackground, 120))
                    SelectObject mDC, hBrush
                    SelectObject mDC, hPen
                    SetTextColor mDC, GetSysColor(COLOR_HIGHLIGHTTEXT)
                    Rectangle mDC, 0, .Rec.Top, .Rec.Right - .Rec.Left, .Rec.Top + (.Rec.Bottom - .Rec.Top)
                    DrawText mDC, .Caption, Len(.Caption), CapRec, 0