ShowDatabaseRows (ListIconGadget)

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

ShowDatabaseRows (ListIconGadget)

Post by mk-soft »

Update v1.02.0
- Add FitColumnWidth

Update v1.02.1
- Bugfix FitColumnWidth

Update v1.03.1
- Format Numbers

Code: Select all

;-TOP

; Comment : ShowDatabaseItems
; Author  : mk-soft
; Version : v1.03.1
; Create  : 12.02.2017
; Update  : 19.08.2022

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
        max = 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, fltVal.f, dblVal.d
  
  Repeat
    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
            dblVal = ValD(GetDatabaseString(DBase, index))
            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)
    If OpenDatabase(DBase, ":memory:", "", "")
      CheckDatabaseUpdate(DBase, "CREATE TABLE food (recid INTEGER PRIMARY KEY ASC, name CHAR(50), weight REAL)")
      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
      #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
Last edited by mk-soft on Fri Aug 19, 2022 3:06 pm, edited 4 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
jak64
Enthusiast
Enthusiast
Posts: 502
Joined: Sat Aug 15, 2020 5:02 pm
Location: Ciboure (France)

Re: ShowDatabaseRows (ListIconGadget)

Post by jak64 »

Thank you mk-soft for this example which will help me.
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: ShowDatabaseRows (ListIconGadget)

Post by idle »

thanks that's very useful, I was just thinking about how to set listicon column widths
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: ShowDatabaseRows (ListIconGadget)

Post by mk-soft »

Update v1.02.1
- Bugfix FitColumnWidth (macOS, Linux)

Thanks for the answer,
But I found a small bug and fixed it right away.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: ShowDatabaseRows (ListIconGadget)

Post by infratec »

Once I wrote a proxy for secured postgres access, I noticed that all data is send as string.
So you can simply reduce your code to:

Code: Select all

For index = 0 To columns - 1
  text + GetDatabaseString(DBase, index) + #LF$
Next
This saves you a lot of conversions :wink:

Ups... only for postgres.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: ShowDatabaseRows (ListIconGadget)

Post by mk-soft »

Update v1.03.1
- Format Numbers

I should tidy up my place. I already had a newer version with FormatNumber and Bugfix Linux.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply