I'd like to add a 'ShowQuery()' command to the database commands wish list.
I hunted through the forum and eventually found mk-soft's 'ShowDatabaseItems' code.
I modified it for my purposes, but it should show how the command could work.
Code: Select all
;==================================================================
;
; Author: blueb
; Date: August 22, 2018
; Explain: All credit goes to mk-soft's ShowDatabaseItems.pb
; Use it to show Database Results in a ListIconGadget
;==================================================================
; ShowDatabaseItems by mk-soft from 12.02.2017
UseSQLiteDatabase()
;- Constants
Enumeration ; Window
#ShowQuery
EndEnumeration
Enumeration ; Gadgets
#List
#Edit
EndEnumeration
Enumeration ; Statusbar
#Status
EndEnumeration
; --------------------------------------------------------------------------------------
Procedure GetTextWidth(Text.s, FontID.i = 0)
Static image
Protected result
If Not image
image = CreateImage(#PB_Any, 1, 1)
EndIf
If image And StartDrawing(ImageOutput(image))
If FontID
DrawingFont(FontID)
EndIf
result = TextWidth(Text)
StopDrawing()
EndIf
ProcedureReturn result
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure ClearGadgetColumns(Gadget)
CompilerIf #PB_Compiler_Version <= 551
ClearGadgetItems(Gadget)
While GetGadgetItemText(Gadget, -1, 0)
RemoveGadgetColumn(Gadget, 0)
Wend
CompilerElse
RemoveGadgetColumn(Gadget, #PB_All)
CompilerEndIf
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure CountGadgetColumns(Gadget)
Protected result
CompilerIf #PB_Compiler_Version <= 551
While GetGadgetItemText(Gadget, -1, result)
result + 1
Wend
CompilerElse
result = GetGadgetAttribute(Gadget, #PB_ListIcon_ColumnCount)
CompilerEndIf
ProcedureReturn result
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure ShowDatabaseRows(Gadget, DBase, Hide = #False)
Protected result.i, columns.i, index.i, size.i, text.s
Repeat
If GadgetType(Gadget) <> #PB_GadgetType_ListIcon
Break
EndIf
If Not IsDatabase(DBase)
Break
EndIf
HideGadget(Gadget, Hide)
ClearGadgetColumns(Gadget)
columns = DatabaseColumns(DBase)
For index = 0 To columns - 1
text = DatabaseColumnName(DBase, index)
size = GetTextWidth(text) + 12
AddGadgetColumn(Gadget, index, text, size)
Next
While NextDatabaseRow(DBase)
text = ""
For index = 0 To columns - 1
text + GetDatabaseString(DBase, index) + #LF$
Next
AddGadgetItem(Gadget, -1, text)
Wend
FinishDatabaseQuery(DBase)
HideGadget(Gadget, #False)
result = CountGadgetItems(Gadget)
Until #True
ProcedureReturn result
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure UpdateWindow()
Protected x, y, dx, dy, menu, status
menu = MenuHeight()
If IsStatusBar(#Status)
status = StatusBarHeight(#Status)
Else
status = 0
EndIf
x = 0
y = 0
dx = WindowWidth(#ShowQuery)
dy = WindowHeight(#ShowQuery) - menu - status
ResizeGadget(#List, x, y, dx, dy)
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure WaitForUser()
Protected iEvent.i = 0
Repeat
iEvent = WaitWindowEvent(1)
Until iEvent = #PB_Event_CloseWindow
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure ShowQuery(DB, SQL.s)
Protected event, style, dx, dy
style = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
dx = 600
dy = 300
If OpenWindow(#ShowQuery, #PB_Ignore, #PB_Ignore, dx, dy, SQL.s, style)
; Gadgets
ListIconGadget(#List, 0, 0, dx, dy, "RecID", 100)
; Statusbar
CreateStatusBar(#Status, WindowID(#ShowQuery))
AddStatusBarField(#PB_Ignore)
UpdateWindow()
If DatabaseQuery(DB, SQL)
count = ShowDatabaseRows(#List, DB, #True)
StatusBarText(#Status, 0, "Items: " + count)
FinishDatabaseQuery(DB)
EndIf
EndIf
WaitForUser() ; Kills the table when user presses 'X'
EndProcedure
; ---------------------------------------------------------------------------------------
; Done
;==================================================================
;------- Test Area -------
;==================================================================
CompilerIf #PB_Compiler_IsMainFile
UseSQLiteDatabase()
Procedure CheckDatabaseUpdate(Database, Query$)
Result = DatabaseUpdate(Database, Query$)
If Result = 0
Debug DatabaseError()
EndIf
ProcedureReturn Result
EndProcedure
DatabaseFile$ = GetTemporaryDirectory() + "bluebTest.db"
If CreateFile(0, DatabaseFile$)
CloseFile(0)
If OpenDatabase(0, DatabaseFile$, "", "")
CheckDatabaseUpdate(0, "CREATE TABLE food (name CHAR(50), weight INT)")
CheckDatabaseUpdate(0, "INSERT INTO food (name, weight) VALUES ('apple', '10')")
CheckDatabaseUpdate(0, "INSERT INTO food (name, weight) VALUES ('pear', '5')")
CheckDatabaseUpdate(0, "INSERT INTO food (name, weight) VALUES ('banana', '20')")
CheckDatabaseUpdate(0, "INSERT INTO food (name, weight) VALUES ('grapes', '1')")
CheckDatabaseUpdate(0, "INSERT INTO food (name, weight) VALUES ('oranges', '20')")
CheckDatabaseUpdate(0, "INSERT INTO food (name, weight) VALUES ('grapefruit', '40')")
;Query Selected items...
SQL.s = "SELECT * FROM food WHERE weight > 7"
ShowQuery(0, SQL.s)
; Show all items in table ... note ShowQuery displays the Row Count.
SQL.s = "SELECT * FROM food;"
ShowQuery(0, SQL.s)
CloseDatabase(0)
Else
Debug "Can't open database !"
EndIf
Else
Debug "Can't create the database file !"
EndIf
CompilerEndIf