You will need the GridEX module available here viewtopic.php?f=12&t=69596&hilit=GridExModule
Once you have it here is the code:-
Code: Select all
UseSQLiteDatabase()
IncludeFile "GridExModule.pbi"
Global winMain
Global DBGrid.i,DBTree.i,DataRows.i,DisplayedRows.i,CurrentVOffset.i,CurrentHOffset.i
Global CurrentDBName.s,CurrentDB.i,CurrentTableName.s
Global MyVSCroll.i,MyHSCroll.i
Structure FldDat
Name.s
FType.s
NotNull.i
PK.i
EndStructure
Structure TblDat
Name.s
TType.s
SQL.s
List Field.FldDat()
EndStructure
Global NewList TableData.TblDat()
Enumeration FormMenu
#mnuOpen
#mnuClose
#mnuSep
#mnuExit
#mnuTools
#mnuVacuum
EndEnumeration
Procedure GetDatabasePragma()
DatabaseQuery(CurrentDB, "SELECT * FROM sqlite_master;")
ClearList(TableData())
;Load The Table Names etc
While NextDatabaseRow(CurrentDB)
;Miss Out SQLite Tables
If FindString(GetDatabaseString(CurrentDB, DatabaseColumnIndex(CurrentDB, "tbl_name")),"sqlite") = 0
AddElement(TableData())
TableData()\TType = GetDatabaseString(CurrentDB, DatabaseColumnIndex(CurrentDB, "type"))
TableData()\Name = GetDatabaseString(CurrentDB, DatabaseColumnIndex(CurrentDB, "tbl_name"))
TableData()\SQL = GetDatabaseString(CurrentDB, DatabaseColumnIndex(CurrentDB, "sql"))
EndIf
Wend
FinishDatabaseQuery(CurrentDB)
;Load Field data
ForEach TableData()
ClearList (TableData()\Field())
DatabaseQuery(CurrentDB, "PRAGMA table_info(" + TableData()\Name + ");")
While NextDatabaseRow(CurrentDB)
AddElement(TableData()\Field())
TableData()\Field()\Name = GetDatabaseString(CurrentDB,DatabaseColumnIndex(CurrentDB,"name"))
TableData()\Field()\FType = GetDatabaseString(CurrentDB,DatabaseColumnIndex(CurrentDB,"type"))
TableData()\Field()\NotNull = GetDatabaseLong(CurrentDB,DatabaseColumnIndex(CurrentDB,"notnull"))
TableData()\Field()\PK = GetDatabaseLong(CurrentDB,DatabaseColumnIndex(CurrentDB,"pk"))
Wend
FinishDatabaseQuery(CurrentDB)
Next
EndProcedure
Procedure LoadTree()
ClearGadgetItems(DBTree)
While WindowEvent():Wend
AddGadgetItem (DBTree, -1, CurrentDBName,0,0)
;Only Table names
ForEach TableData()
If TableData()\TType = "table" Or TableData()\TType = "view"
AddGadgetItem(DBTree, -1, TableData()\Name,0,1)
EndIf
Next
SetGadgetItemState(DBTree, 0, #PB_Tree_Expanded)
EndProcedure
Procedure GetData(TableName.s,Offset.i)
Protected Criteria.s,RowString.s,ClearString.s
;Now get The Data
Criteria = "SELECT * FROM " + TableName + " LIMIT 20 OFFSET " + Str(Offset) + ";"
DatabaseQuery(CurrentDB,Criteria)
RowNumber = 1
While NextDatabaseRow(CurrentDB)
RowString = ""
ClearString = ""
ColumnNumber = 0
ForEach TableData()\Field()
Select DatabaseColumnType(CurrentDB, ColumnNumber)
Case #PB_Database_Blob
ClearString = ClearString + "" + Chr(10)
RowString = RowString + "Blob Size " + Str(DatabaseColumnSize(CurrentDB,DatabaseColumnIndex(CurrentDB,TableData()\Field()\Name))) + Chr(10)
Case #PB_Database_String
ClearString = ClearString + "" + Chr(10)
RowString = RowString + GetDatabaseString(CurrentDB,DatabaseColumnIndex(CurrentDB,TableData()\Field()\Name)) + Chr(10)
Case #PB_Database_Long
ClearString = ClearString + "" + Chr(10)
RowString = RowString + Str(GetDatabaseLong(CurrentDB,DatabaseColumnIndex(CurrentDB,TableData()\Field()\Name))) + Chr(10)
Case #PB_Database_Float
ClearString = ClearString + "" + Chr(10)
RowString = RowString + StrF(GetDatabaseFloat(CurrentDB,DatabaseColumnIndex(CurrentDB,TableData()\Field()\Name))) + Chr(10)
Case #PB_Database_Double
ClearString = ClearString + "" + Chr(10)
RowString = RowString + StrD(GetDatabaseDouble(CurrentDB,DatabaseColumnIndex(CurrentDB,TableData()\Field()\Name))) + Chr(10)
Case #PB_Database_Quad
ClearString = ClearString + "" + Chr(10)
RowString = RowString + Str(GetDatabaseQuad(CurrentDB,DatabaseColumnIndex(CurrentDB,TableData()\Field()\Name))) + Chr(10)
EndSelect
ColumnNumber + 1
Next
ClearString = Left(ClearString,Len(ClearString)-1)
RowString = Left(RowString,Len(RowString)-1)
GridEx::SetRowText(DBGrid, RowNumber, RowString)
RowNumber + 1
Wend
;Clear Last Row or Rows
For iLoop = RowNumber To 20
Gridex::SetRowText(DBGrid, iLoop,ClearString)
Next
Gridex::Refresh(DBGrid)
EndProcedure
Procedure SetRowsColumns(TableName.s)
Define Rows.i,Columns.i
Define Criteria.s,RowString.s
;Get Columns Required
ForEach TableData()
If TableData()\Name = TableName
Break
EndIf
Next
Columns = ListSize(TableData()\Field())
;Get Rows required
Criteria = "SELECT count(1) FROM " + TableName + ";"
DatabaseQuery(CurrentDB,Criteria)
FirstDatabaseRow(CurrentDB)
DataRows = GetDatabaseLong(CurrentDB,0)
FinishDatabaseQuery(CurrentDB)
If DataRows > 20
DisplayedRows = 20
Else
DisplayedRows = DataRows
EndIf
;Resize Grid For Table data (Max 20 Rows at a time)
GridEx::ReDefine(DBGrid,DisplayedRows,Columns)
;Hide Row Header
GridEx::HideColumn(DBGrid, 0, #True)
;Set To Allow All Cells To Be Edited
For iLoop = 1 To Columns
GridEx::SetCellFlags(DBGrid, GridEx::#AnyRow,iLoop,GridEx::#Edit)
Next iLoop
;Show The Changes
Gridex::Refresh(DBGrid)
;Set Headers
RowString = ""
ForEach TableData()\Field()
RowString = RowString + TableData()\Field()\Name + Chr(10)
Next
RowString = Left(RowString,Len(RowString)-1)
GridEx::SetRowText(DBGrid, 0, RowString)
Gridex::Refresh(DBGrid)
SetGadgetAttribute(MyVSCroll,#PB_ScrollBar_Maximum ,DataRows)
SetGadgetAttribute(MyHSCroll,#PB_ScrollBar_Maximum ,Columns)
SetGadgetState(MyHSCroll,1)
;Now Get Data
CurrentVOffset = 0
CurrentHOffset = 0
GetData(TableName,CurrentVOffset)
EndProcedure
Procedure Open_Database()
Define DBHnd.l,FileName.s
FileName = OpenFileRequester("Choose Database To Load","","Database (*.db)|*.db;*.db|All files (*.*)|*.*",0)
If FileName
;Open Database
CurrentDB = OpenDatabase(#PB_Any, FileName, #Empty$, #Empty$)
If CurrentDB = 0
MessageRequester("Database Error","Failed to open database!")
Else
CurrentDBName = GetFilePart(FileName,#PB_FileSystem_NoExtension)
GetDatabasePragma()
LoadTree()
EndIf
EndIf
EndProcedure
Procedure ScrollH()
If IsDatabase(CurrentDB)
If CurrentHOffset <> GetGadgetState(MyHSCroll)
CurrentHOffset = GetGadgetState(MyHSCroll)
GridEx::SetTopColumn(DBGrid,CurrentHOffset)
EndIf
EndIf
EndProcedure
Procedure ScrollV()
If IsDatabase(CurrentDB)
If CurrentVOffset <> GetGadgetState(MyVSCroll)
CurrentVOffset = GetGadgetState(MyVSCroll)
GetData(CurrentTableName,CurrentVOffset)
EndIf
EndIf
EndProcedure
winMain = OpenWindow(#PB_Any, 0, 0, 990, 470, "SQLite Viewer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateMenu(#PB_Any, WindowID(winMain))
MenuTitle("Database")
MenuItem(#mnuOpen, "Open")
MenuItem(#mnuClose, "Close")
MenuBar()
MenuItem(#mnuExit, "Exit")
MenuTitle("Tools")
MenuItem(#mnuVacuum, "Vacuum")
DBTree = TreeGadget(#PB_Any, 5, 5, 200, 410)
DBGrid = GridEx::Gadget(winMain, #PB_Any, 210, 5, 745, 410, 20,20,GridEx::#DrawGrid|GridEx::#Border_Single)
MyVSCroll = ScrollBarGadget(#PB_Any,955,5,20,410,0,100,20,#PB_ScrollBar_Vertical)
MyHSCroll = ScrollBarGadget(#PB_Any,210,414,745,20,1,100,1)
;Hide Row Header
GridEx::HideColumn(DBGrid, 0, #True)
;Dynamic Scrolling
BindGadgetEvent(MyVSCroll,@ScrollV(),#PB_All)
BindGadgetEvent(MyHSCroll,@ScrollH(),#PB_All)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
GridEx::Free(DBGrid)
End
Case #PB_Event_Menu
Select EventMenu()
Case #mnuOpen
Open_Database()
Case #mnuClose
CloseDatabase(CurrentDB)
ClearGadgetItems(DBTree)
GridEx::ClearRows(DBGrid)
Case #mnuVacuum
DatabaseUpdate(CurrentDB,"VACUUM")
MessageRequester("SQLite Viewer","VACUUM Completed Successfully",#PB_MessageRequester_Ok|#PB_MessageRequester_Info)
Case #mnuExit
GridEx::Free(DBGrid)
End
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case DBTree
If EventType() = #PB_EventType_Change
If GetGadgetItemAttribute(DBTree, GetGadgetState(DBTree), #PB_Tree_SubLevel) = 1
CurrentTableName = GetGadgetItemText(DBTree, GetGadgetState(DBTree))
SetRowsColumns(CurrentTableName)
EndIf
EndIf
Case MyVSCroll
If IsDatabase(CurrentDB)
If CurrentVOffset <> GetGadgetState(MyVSCroll)
CurrentVOffset = GetGadgetState(MyVSCroll)
GetData(CurrentTableName,CurrentVOffset)
EndIf
EndIf
Case MyHSCroll
EndSelect
EndSelect
ForEver
CD
PS Code updated for ClearRows() and Horizontal scroll bar