PureBasic Forums - English

Code: Select all

DataSection
  CLSID_ACLMulti:
  Data.l $00BB2765
  Data.w $6A77, $11D0
  Data.b $A5, $35, $00, $C0, $4F, $D7, $D0, $62
EndDataSection

Code: Select all

;==================================================================
;
; Library:           AutoComplete v. 0.3 alpha
; Author:            Lloyd Gallant (netmaestro)
; Date:              July 21, 2010
; Target OS:         Microsoft Windows All
; Target Compiler:   PureBasic 4.50 and later
; license:           Free, unrestricted, no warranty whatsoever
;                    credit appreciated but not required
;
;==================================================================

UseSQLiteDatabase()

#DATABASE_OK = ""

Structure AutoCompleteObject
  *vTable
  database.i
  subclass_oldproc.i
  gadget.i
  dynamic.b
EndStructure

Interface iAutoCompleteObject
  Attach    ( gadget, *strings, size )
  AddString ( gadget, *string )
  Release   ()
EndInterface

Procedure AddString(*this.AutoCompleteObject, gadget, *string )
  text$ = PeekS(*string)
  sql$ =  "SELECT promptstring FROM Autocomplete where (promptstring = '"+text$+"' and gadget = '" + Str(gadget) + "')"
  DatabaseQuery(*this\database, sql$)
  recordcount = 0
  While NextDatabaseRow(*this\database)
    recordcount+1
  Wend
  FinishDatabaseQuery(*this\database)
  If recordcount = 0
    sql$ = "insert into Autocomplete (gadget, promptstring) values(" + Str(gadget) + "," + "'"+ PeekS(*string) + "')"
    DatabaseUpdate(*this\database, sql$)
  EndIf
  ProcedureReturn 1
EndProcedure

Procedure _nmAC_StringProc(hwnd, msg, wparam, lparam)
  *this.AutoCompleteObject = GetProp_(hwnd, "acdata")
  oldproc = *this\subclass_oldproc
  gadget = *this\gadget
  
  Select msg
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      
    Case #WM_KEYUP
      If GetFocus_() = hwnd
        ClearDebugOutput()
        text$ = GetGadgetText(*this\gadget)
        If text$ <> ""
          sql$ =  "SELECT promptstring FROM Autocomplete where (promptstring like '"+text$+"%' and gadget = '" + Str(gadget) + "')"
          DatabaseQuery(*this\database, sql$)
          While NextDatabaseRow(*this\database)
            Debug GetDatabaseString(*this\database,0)
          Wend
          FinishDatabaseQuery(*this\database)
        EndIf
      EndIf
      
    Case #WM_KILLFOCUS
      If *this\dynamic
        text$ = GetGadgetText(gadget)
        Addstring(*this, gadget, @text$)
      EndIf
      
    Case #WM_SETFOCUS
      SendMessage_(hwnd, #EM_SETSEL, 0, -1)
    
  EndSelect   
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure

Procedure Attach(*this.AutoCompleteObject, gadget, *strings, size )
  Protected fail_status = #False
  *ptr = *strings
  For i=1 To size
    sql$ = "insert into Autocomplete (gadget, promptstring) values(" + Str(gadget) + "," + "'"+ PeekS(PeekL(*ptr)) + "')"
    If DatabaseUpdate(*this\database, sql$)
      *ptr+SizeOf(integer)
    Else
      fail_status = #True
      Break
    EndIf
  Next
  If IsGadget(gadget) And GadgetType(gadget) = #PB_GadgetType_String And fail_status = #False
    *this\gadget = gadget
    *this\subclass_oldproc = SetWindowLongPtr_(GadgetID(gadget), #GWL_WNDPROC, @_nmAC_StringProc())
    SetProp_(GadgetID(gadget), "acdata", *this )
  Else
    fail_status = #True
  EndIf
  
  If fail_status = #False 
    ProcedureReturn #True
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure NewObject_Autocomplete(dynamic=0)
  *newobject.AutoCompleteObject = AllocateMemory(SizeOf(AutoCompleteObject))
  With *newobject
    \vTable = ?AutoComplete_Methods
    \dynamic = dynamic
  EndWith
  dbOpenResult = OpenDatabase(#PB_Any, ":memory:", "", "")
  If dbOpenResult
    DatabaseUpdate(dbOpenResult, "CREATE TABLE AutoComplete (gadget VARCHAR, promptstring VARCHAR(255));")       
    If DatabaseError() = #DATABASE_OK
      *newobject\database = dbOpenResult
      ProcedureReturn *newobject
    Else
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure Release(*this.AutoCompleteObject)
  If *this\subclass_oldproc
    SetWindowLongPtr_(GadgetID(*this\gadget),#GWL_WNDPROC, *this\subclass_oldproc)
  EndIf
  If IsDatabase(*this\database)
    CloseDatabase(*this\database)
  EndIf
  FreeMemory(*this)
EndProcedure

DataSection
  AutoComplete_Methods:
  Data.l @Attach(), @AddString(), @Release()
EndDataSection

;=================================================================
;                    END OF INCLUDE CODESECTION
;=================================================================

; Test prog

Dim Strings.s(17)
Strings(0)  = "Else"
Strings(1)  = "ElseIf"
Strings(2)  = "EnableDebugger"
Strings(3)  = "EnableExplicit"
Strings(4)  = "End"
Strings(5)  = "EndDataSection"
Strings(6)  = "EndEnumeration"
Strings(7)  = "EndIf"
Strings(8)  = "EndImport"
Strings(9)  = "EndInterface"
Strings(10) = "EndMacro"
Strings(11) = "EndProcedure"
Strings(12) = "EndSelect"
Strings(13) = "EndStructure"
Strings(14) = "EndStructureUnion"
Strings(15) = "EndWith"
Strings(16) = "Enumeration"


OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
StringGadget(6, 10,10, 300,20,"")
StringGadget(7, 10,50, 300,20,"")
SetActiveGadget(6)


prompts1.iAutoCompleteObject = NewObject_Autocomplete(1) ; Dynamic additions on
prompts1\Attach(6, @strings(), 17 )

prompts2.iAutoCompleteObject = NewObject_Autocomplete() ; Dynamic additions off - list doesn't change
prompts2\Attach(7, @strings(), 17 )

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

prompts1\Release()
prompts2\Release()

Code: Select all

;
;  Generic Implementation of an IEnumString Interface.
;  New_EnumString(StringArray(), ItemCount) will create a new IEnumString instance
;  with a referencecount of 1. (this means you must call IEnumString\Release()
;  to release this reference once you do not need it anymore.)
;
;
;
EnableExplicit

; To allow for the ::Clone() method without dublicating the buffer,
; the string buffer is kept separate, with its own reference count.
Structure EnumStringBuffer
  RefCount.l
  Strings.l[0]
  ; following is the literal string data
EndStructure

; IEnumString data
Structure EnumString
 *Vtbl
  RefCount.l
  StringCount.l
  Enumerator.l
 *Buffer.EnumStringBuffer
EndStructure


Procedure IEnumString_QueryInterface(*THIS.EnumString, *IID.IID, *Object.Integer)
  If *Object = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf CompareMemory(*IID, ?IID_IUnknown, SizeOf(IID)) Or  CompareMemory(*IID, ?IID_IEnumString, SizeOf(IID))
    *Object\i = *THIS
    *THIS\RefCount + 1
    ProcedureReturn #S_OK
  Else
    *Object\i = 0
    ProcedureReturn #E_NOINTERFACE
  EndIf
EndProcedure


Procedure IEnumString_AddRef(*THIS.EnumString)
  *THIS\RefCount + 1
  ProcedureReturn *THIS\RefCount
EndProcedure


Procedure IEnumString_Release(*THIS.EnumString)
  *THIS\RefCount - 1
 
  If *THIS\RefCount = 0
    *THIS\Buffer\RefCount - 1
    If *THIS\Buffer\RefCount = 0
      FreeMemory(*THIS\Buffer)
    EndIf
   
    FreeMemory(*THIS)
    ProcedureReturn 0
  Else
    ProcedureReturn *THIS\RefCount
  EndIf
EndProcedure


Procedure IEnumString_Next(*THIS.EnumString, celt, *rgelt.Integer, *pceltFetched.Integer)
  Protected count.i, i.i
  
  If *THIS\Enumerator + celt <= *THIS\StringCount
    count = celt
  Else
    count = *THIS\StringCount - *THIS\Enumerator
  EndIf
 
  For i = 0 To count-1
    *rgelt\i = *THIS\Buffer\Strings[*THIS\Enumerator + i]
    *rgelt + 4
  Next i
 
  *THIS\Enumerator + count
 
  If *pceltFetched
    *pceltFetched\i = count
  EndIf
 
  If count = celt
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure


Procedure IEnumString_Skip(*THIS.EnumString, celt)
  *THIS\Enumerator + celt
  If *THIS\Enumerator <= *THIS\StringCount
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure


Procedure IEnumString_Reset(*THIS.EnumString)
  *THIS\Enumerator = 0
  ProcedureReturn #S_OK
EndProcedure


Procedure IEnumString_Clone(*THIS.EnumString, *ppenum.Integer)
  Protected *Clone.EnumString
  
  If *ppenum = 0
    ProcedureReturn #E_INVALIDARG
  Else   
    *Clone = AllocateMemory(SizeOf(EnumString))
    If *Clone
      CopyMemory(*THIS, *Clone, SizeOf(EnumString))
      *Clone\RefCount = 1
      *Clone\Buffer\RefCount + 1
      *ppenum\i = *Clone
      ProcedureReturn #S_OK
    Else
      *ppenum\i = 0
      ProcedureReturn #E_OUTOFMEMORY
    EndIf 
  EndIf
EndProcedure


Procedure New_EnumString(Array StringArray.s(1))
  Protected *THIS.EnumString = 0, *StringBuffer.EnumStringBuffer
  Protected StringCount.i, Size.i, i.i
  Protected *Pointer
  
  StringCount = ArraySize(StringArray())

  Size = 4 + StringCount * 4
  For i = 0 To StringCount - 1
    Size + Len(StringArray(i)) * 2 + 2
  Next i

  *StringBuffer = AllocateMemory(Size)
  If *StringBuffer
    *StringBuffer\RefCount = 1
    *Pointer = *StringBuffer + 4 + StringCount * 4
   
    For i = 0 To StringCount - 1
      *StringBuffer\Strings[i] = *Pointer 
      PokeS(*Pointer, StringArray(i), -1, #PB_Unicode)
      *Pointer + Len(StringArray(i)) * 2 + 2
    Next i
   
    *THIS = AllocateMemory(SizeOf(EnumString))
    If *THIS
      *THIS\Vtbl        = ?IEnumStringVtbl
      *THIS\RefCount    = 1
      *THIS\StringCount = StringCount
      *THIS\Enumerator  = 0
      *THIS\Buffer      = *StringBuffer
    Else
      FreeMemory(*StringBuffer)
    EndIf
  EndIf   

  ProcedureReturn *THIS
EndProcedure


DataSection
  IEnumStringVtbl:
    Data.i @IEnumString_QueryInterface()
    Data.i @IEnumString_AddRef()
    Data.i @IEnumString_Release()
    Data.i @IEnumString_Next()
    Data.i @IEnumString_Skip()
    Data.i @IEnumString_Reset()
    Data.i @IEnumString_Clone()
   
  IID_IUnknown:       ; {00000000-0000-0000-C000-000000000046}
    Data.l $00000000
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
   
  IID_IEnumString:    ; {00000101-0000-0000-C000-000000000046}
    Data.l $00000101
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    
  CLSID_AutoComplete: ; {00BB2763-6A77-11D0-A535-00C04FD7D062}
    Data.l $00BB2763
    Data.w $6A77, $11D0
    Data.b $A5, $35, $00, $C0, $4F, $D7, $D0, $62

  IID_IAutoComplete:  ; {00BB2762-6A77-11D0-A535-00C04FD7D062}
    Data.l $00BB2762
    Data.w $6A77, $11D0
    Data.b $A5, $35, $00, $C0, $4F, $D7, $D0, $62

  IID_IAutoComplete2: ; {EAC04BC0-3791-11D2-BB95-0060977B464C}
    Data.l $EAC04BC0
    Data.w $3791, $11D2
    Data.b $BB, $95, $00, $60, $97, $7B, $46, $4C
EndDataSection


#CLSCTX_INPROC_SERVER     = $1
#ACO_NONE                 = 0   ; No autocompletion.
#ACO_AUTOSUGGEST          = $1  ; Enable the autosuggest drop-down list.
#ACO_AUTOAPPEND           = $2  ; Enable autoappend.
#ACO_SEARCH               = $4  ; Add a search item to the dropdown list of completed strings. If this is item is selected, you should launch a search engine to assist the user.
#ACO_FILTERPREFIXES       = $8  ; Don't match common prefixes, such as "www.", "http://", and so on.
#ACO_USETAB               = $10 ; Use the TAB key to select an item from the drop-down list. This flag is disabled by default.
#ACO_UPDOWNKEYDROPSLIST   = $20 ; Use the UP ARROW and DOWN ARROW keys to display the autosuggest drop-down list.
#ACO_RTLREADING           = $40 ; If ACO_RTLREADING is set, the text is read in the opposite direction from the text in the parent window.

Code: Select all

IncludeFile "AutoComplete.pbi"

; -----------------------------------------------

#Window_0 = 0
#String_0 = 0

Dim Strings.s(17)
Strings(0)  = "Else"
Strings(1)  = "ElseIf"
Strings(2)  = "EnableDebugger"
Strings(3)  = "EnableExplicit"
Strings(4)  = "End"
Strings(5)  = "EndDataSection"
Strings(6)  = "EndEnumeration"
Strings(7)  = "EndIf"
Strings(8)  = "EndImport"
Strings(9)  = "EndInterface"
Strings(10) = "EndMacro"
Strings(11) = "EndProcedure"
Strings(12) = "EndSelect"
Strings(13) = "EndStructure"
Strings(14) = "EndStructureUnion"
Strings(15) = "EndWith"
Strings(16) = "Enumeration"

; Initialize the COM environment
CoInitialize_(0)

Define *AutoComplete.IAutoComplete2, *Enum.IEnumString

If OpenWindow(#Window_0, 323, 219, 600, 300, "AutoComplete",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    StringGadget(#String_0, 40, 40, 320, 20, "")
    SetActiveGadget(#String_0)
   
    ; This creates the autocomplete object:
    ;
    If CoCreateInstance_(?CLSID_AutoComplete, #Null, 1, ?IID_IAutoComplete2, @*AutoComplete) = #S_OK
   
      ; Lets change the options for autocomplete a bit:
      ; See the constant definitions above for the available options.
      ; There is a dropdown or in-place suggestion mode.
      ;
      *AutoComplete\SetOptions(#ACO_AUTOSUGGEST|#ACO_USETAB)
   
      ; This creates the IEnumString interface from our string array:
      ;
      *Enum = New_EnumString(Strings())
     
      ; This sets the autocomplet with our Enum object.
      ; If you want more info on the last 2 parameters, read here:
      ; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iautocomplete/Init.asp
      ; Note that these must be unicode strings if present!
      ;
      ; This also works for Comboboxes, you just need to get the handle to the edit
      ; control that is contained inside with the GetComboBoxInfo_() function.     
      ;
      *AutoComplete\Init(GadgetID(#String_0), *Enum, 0, 0)
     
      Repeat
      Until WaitWindowEvent() = #PB_Event_CloseWindow
     
      ; Release our own references to the objects to avoid a memory leak
      ;
      *Enum\Release()       
      *AutoComplete\Release()     
    EndIf
EndIf