It is currently Sat Nov 28, 2020 12:13 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: ShowDatabaseItems (Update)
PostPosted: Fri Apr 10, 2020 8:21 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2730
Location: Germany
Update v1.02.0
- Add FitColumnWidth
Code:
;-TOP

; Comment : ShowDatabaseItems
; Author  : mk-soft
; Version : v1.02.0
; Create  : 12.02.2017
; Update  : 10.04.2020

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, 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

; ***************************************************************************************

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, #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

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 33 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye