PureBasic Forum

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

;==================================================================
;
; 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()