- Add FitColumnWidth
Update v1.02.1
- Bugfix FitColumnWidth
Update v1.03.2
- Format Numbers
Code: Select all
;-TOP
; Comment : ShowDatabaseItems
; Author : mk-soft
; Version : v1.03.2
; Create : 12.02.2017
; Update : 15.04.2024
EnableExplicit
; ***************************************************************************************
Procedure.s ColumnTypeString(Type)
Protected r1.s
Select Type
Case #PB_Database_Long
r1 = "Long"
Case #PB_Database_Quad
r1 = "Quad"
Case #PB_Database_Float
r1 = "Float"
Case #PB_Database_Double
r1 = "Double"
Case #PB_Database_String
r1 = "String"
Case #PB_Database_Blob
r1 = "Blob"
EndSelect
ProcedureReturn r1
EndProcedure
; ---------------------------------------------------------------------------------------
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 FitColumnWidth(Gadget, Column = #PB_All)
Protected columns, rows, col, row, width, max, dx
Static help_gadget
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
If Column = #PB_All
columns = CountGadgetColumns(Gadget) - 1
For col = 0 To columns
SendMessage_(GadgetID(Gadget), #LVM_SETCOLUMNWIDTH, col, #LVSCW_AUTOSIZE_USEHEADER)
Next
Else
SendMessage_(GadgetID(Gadget), #LVM_SETCOLUMNWIDTH, Column, #LVSCW_AUTOSIZE_USEHEADER)
EndIf
CompilerElse
rows = CountGadgetItems(Gadget) - 1
dx = GetTextWidth("X", GetGadgetFont(Gadget))
If Column = #PB_All
columns = CountGadgetColumns(Gadget) - 1
For col = 0 To columns
For row = -1 To rows
width = Len(GetGadgetItemText(Gadget, row, col))
If width > max
max = width
EndIf
Next
max + 1
width = max * dx + 4
SetGadgetItemAttribute(Gadget, 0, #PB_ListIcon_ColumnWidth, width, col)
width = 0
max = 0
Next
Else
For row = -1 To rows
width = Len(GetGadgetItemText(Gadget, row, Column))
If width > max
max = width
EndIf
Next
max + 1
width = max * dx + 4
SetGadgetItemAttribute(Gadget, 0, #PB_ListIcon_ColumnWidth, width, Column)
EndIf
CompilerEndIf
EndProcedure
Procedure ShowDatabaseRows(Gadget, DBase, NbDecimals = 0, Hide = #False)
Protected result.i, columns.i, index.i, size.i, text.s, fltVal.f, dblVal.d
Repeat ; Do
If GadgetType(Gadget) <> #PB_GadgetType_ListIcon
Break
EndIf
If Not IsDatabase(DBase)
Break
EndIf
HideGadget(Gadget, Hide)
ClearGadgetItems(Gadget)
ClearGadgetColumns(Gadget)
columns = DatabaseColumns(DBase) - 1
Dim ColumnType(columns)
For index = 0 To columns
ColumnType(index) = DatabaseColumnType(DBase, index)
text = DatabaseColumnName(DBase, index)
size = GetTextWidth(text) + 12
AddGadgetColumn(Gadget, index, text, size)
Next
While NextDatabaseRow(DBase)
text = ""
For index = 0 To columns
Select ColumnType(index)
Case #PB_Database_Float
fltVal = GetDatabaseFloat(DBase, index)
text + FormatNumber(fltVal, NbDecimals) + #LF$
Case #PB_Database_Double
dblVal = GetDatabaseDouble(DBase, index) ; <- Bug Linux
text + FormatNumber(dblVal, NbDecimals) + #LF$
Default
text + GetDatabaseString(DBase, index) + #LF$
EndSelect
Next
AddGadgetItem(Gadget, -1, text)
Wend
FinishDatabaseQuery(DBase)
HideGadget(Gadget, #False)
result = CountGadgetItems(Gadget)
Until #True
ProcedureReturn result
EndProcedure
; ***************************************************************************************
CompilerIf #PB_Compiler_IsMainFile
; Constant
Enumeration ;Window
#Main
EndEnumeration
Enumeration ; Menu
#Menu
EndEnumeration
Enumeration ; MenuItems
#MenuExitApplication
EndEnumeration
Enumeration ; Gadgets
#List
#Edit
EndEnumeration
Enumeration ; Statusbar
#Status
EndEnumeration
; Global Variable
Global ExitApplication
; Functions
UseSQLiteDatabase()
Procedure CheckDatabaseUpdate(Database, Query$)
Protected Result = DatabaseUpdate(Database, Query$)
If Result = 0
Debug DatabaseError()
EndIf
ProcedureReturn Result
EndProcedure
Procedure CreateDummyDatabase(DBase)
Protected dbName.s
If 0
dbName = GetUserDirectory(#PB_Directory_Downloads) + "dbTest.db"
CreateFile(0, dbName)
CloseFile(0)
Else
dbName = ":memory:"
EndIf
If OpenDatabase(DBase, dbName, "", "")
CheckDatabaseUpdate(DBase, "CREATE TABLE food (recid INTEGER PRIMARY KEY ASC, name CHAR(50), weight REAL, date DATETIME)")
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight, date) VALUES ('apple', '10.005', current_timestamp)")
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight, date) VALUES ('pear', '5.9', '1900-01-01 12:00:00')")
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight, date) VALUES ('banana', '20.35', '2400-12-31 12:00:00')")
; DateTime as quad
SetDatabaseQuad(DBase, 0, Date())
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight, date) VALUES ('cherry', '10.00', datetime(?, 'unixepoch', 'localtime'))")
Else
Debug "Can't open database !"
EndIf
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(#Main)
dy = WindowHeight(#Main) - menu - status
ResizeGadget(#List, x, y, dx, dy)
EndProcedure
; Main
Procedure Main()
Protected event, style, dx, dy, count
style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
dx = 800
dy = 600
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "Main", style)
; Menu
CreateMenu(#Menu, WindowID(#Main))
MenuTitle("Ablage")
MenuItem(#MenuExitApplication, "Be&enden")
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
; Mac default menu
If Not IsMenu(#Menu)
CreateMenu(#Menu, WindowID(#Main))
EndIf
MenuItem(#PB_Menu_About, "")
MenuItem(#PB_Menu_Preferences, "")
CompilerEndIf
; Gadgets
#ListIconFlags = #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines
ListIconGadget(#List, 0, 0, dx, dy, "recid", 100, #ListIconFlags)
; Statusbar
CreateStatusBar(#Status, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
UpdateWindow()
;-Test database
CreateDummyDatabase(0)
If DatabaseQuery(0, "SELECT * FROM food")
;If DatabaseQuery(0, "SELECT * FROM sqlite_master")
count = ShowDatabaseRows(#List, 0, 3)
StatusBarText(#Status, 0, "Items: " + count)
EndIf
FitColumnWidth(#List)
; Main Loop
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Menu
Select EventMenu()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Case #PB_Menu_About
Case #PB_Menu_Preferences
Case #PB_Menu_Quit
ExitApplication = #True
CompilerEndIf
Case #MenuExitApplication
ExitApplication = #True
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #List
EndSelect
Case #PB_Event_SizeWindow
Select EventWindow()
Case #Main
UpdateWindow()
EndSelect
Case #PB_Event_CloseWindow
Select EventWindow()
Case #Main
ExitApplication = #True
EndSelect
EndSelect
Until ExitApplication
EndIf
EndProcedure : Main()
End
CompilerEndIf