Automatisches füllen von ListIconGadget mit Datenbankabfrage
Code: Alles auswählen
;-TOP
; Comment : ShowDatabaseItems
; Author : mk-soft
; Version : v1.02.0
; Create : 12.02.2017
; Update : 27.05.2022
; Added: NbDecimals
EnableExplicit
; ***************************************************************************************
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
width = max * dx + 4
SetGadgetItemAttribute(Gadget, 0, #PB_ListIcon_ColumnWidth, width, col)
width = 0
Next
Else
For row = -1 To rows
width = Len(GetGadgetItemText(Gadget, row, Column))
If width > max
max = width
EndIf
Next
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
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
If NbDecimals
Select DatabaseColumnType(DBase, index)
Case #PB_Database_Float
text + StrF(GetDatabaseFloat(DBase, index), NbDecimals) + #LF$
Case #PB_Database_Double
text + StrF(GetDatabaseFloat(DBase, index), NbDecimals) + #LF$
Default
text + GetDatabaseString(DBase, index) + #LF$
EndSelect
Else
text + GetDatabaseString(DBase, index) + #LF$
EndIf
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)
If OpenDatabase(DBase, ":memory:", "", "")
CheckDatabaseUpdate(DBase, "CREATE TABLE food (recid INTEGER PRIMARY KEY ASC, name CHAR(50), weight FLOAT)")
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight) VALUES ('apple', '10.005')")
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight) VALUES ('pear', '5.9')")
CheckDatabaseUpdate(DBase, "INSERT INTO food (name, weight) VALUES ('banana', '20.35')")
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
ListIconGadget(#List, 0, 0, dx, dy, "recid", 100)
; Statusbar
CreateStatusBar(#Status, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
UpdateWindow()
;-Test database
CreateDummyDatabase(0)
If DatabaseQuery(0, "SELECT * FROM food WHERE weight > 0")
;If DatabaseQuery(0, "SELECT * FROM sqlite_master")
count = ShowDatabaseRows(#List, 0, 3, #True)
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