Dans ce exemple je vous montre comment créer une jolie table (simple 247 lignes)
Vous devez sauver le code, car une fichier de base de données sera créé
Première partie: (affichage simple ci-dessous)
Deuxième partie: (ajout de la sélection) ICI
Troisième et dernière partie : (gestion de colonnes plus grandes que la table) ICI
Code : Tout sélectionner
; ***************************************************************************************************************
; AUTHEUR : MicrodevWeb
; Version PB : 5.60
; Comment faire de belle table ?
; ***************************************************************************************************************
Enumeration
#MainForm
#MainCanvas
#BtFiltersName
#Scroll
#Filters
EndEnumeration
Global DbName.s="DbTeste.sqlite"
Global FontTitle=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality|#PB_Font_Bold)
Global FontLine=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
Global ScrollOn.b=#False,FiltersOn.b=#False
UseSQLiteDatabase()
Procedure Exit()
CloseWindow(#MainForm)
End
EndProcedure
Procedure DbUpdate(query.s)
Protected Db
Db=OpenDatabase(#PB_Any,DbName,"","")
If Not DB
MessageRequester("Database Error","Can't open database",#PB_MessageRequester_Error)
ProcedureReturn 0
EndIf
If Not DatabaseUpdate(Db,query)
MessageRequester("Database Error",DatabaseError(),#PB_MessageRequester_Error)
CloseDatabase(DB)
ProcedureReturn 0
EndIf
CloseDatabase(DB)
ProcedureReturn DB
EndProcedure
Procedure DbQuery(query.s)
Protected Db
Db=OpenDatabase(#PB_Any,DbName,"","")
If Not DB
MessageRequester("Database Error","Can't open database",#PB_MessageRequester_Error)
ProcedureReturn 0
EndIf
If Not DatabaseQuery(DB,query)
MessageRequester("Database Error",DatabaseError(),#PB_MessageRequester_Error)
CloseDatabase(DB)
ProcedureReturn 0
EndIf
ProcedureReturn DB
EndProcedure
Procedure.s GetRdmTxt()
Protected i,n,txt.s
Protected Car.s="a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,v,w,x,y,z"
n=Random(20,5)
For i=0 To n
txt+StringField(Car,Random(26,1),",")
Next
ProcedureReturn txt
EndProcedure
Procedure ManageDb()
Protected query.s,idDb,i
; Création du fichier si il n'existe pas
If FileSize(DbName)=-1
CreateFile(0,DbName)
CloseFile(0)
; Création du fichier client
query="CREATE TABLE client ("
query+"id INTEGER PRIMARY KEY AUTOINCREMENT,"
query+"nom TEXT,"
query+"localite TEXT)"
If Not DbUpdate(query)
Exit()
EndIf
; On va créer quelques enregistrements pour le teste :)
For i=0 To 100
query="INSERT INTO client (nom,localite) VALUES ("
query+Chr(34)+GetRdmTxt()+Chr(34)+","
query+Chr(34)+GetRdmTxt()+Chr(34)+")"
If Not DbUpdate(query)
Exit()
EndIf
Next
EndIf
EndProcedure
Procedure DrawColumnTitles()
Protected w=400,x,y,h=30
VectorSourceColor($FFFFFFFF)
VectorFont(FontID(FontTitle))
x=(w/2)-(VectorTextWidth("Nom")/2)
Y=(H/2)-(VectorTextHeight("Nom")/2)
MovePathCursor(x,y)
DrawVectorText("Nom")
x=w+((w/2)-(VectorTextWidth("Localité")/2))
MovePathCursor(x,y)
DrawVectorText("Localité")
EndProcedure
Procedure DrawColoredLines()
Protected y=30,n=20,w=800,h=660/n,i,k,start
If ScrollOn
start=GetGadgetState(#Scroll)
EndIf
k=n+start
For i=start+1 To k
; Détermine si lgn pair ou impair
If i%2=0
VectorSourceColor($FFFFFFFF)
Else
VectorSourceColor($FF008CFF)
EndIf
AddPathBox(0,y,800,30)
FillPath()
y+30
Next
EndProcedure
Procedure ManageScroll()
Protected query.s,idDb,max
Protected Filters.s=GetGadgetText(#Filters)
; Compte le nbr de record dans la table
query="SELECT COUNT(*) FROM client"
If Filters<>""
query+" WHERE nom LIKE "+Chr(34)+Filters+"%"+Chr(34)
EndIf
idDb=DbQuery(query)
If Not idDb
Exit()
EndIf
FirstDatabaseRow(idDb)
; si plus de record que de lignes
If GetDatabaseLong(idDb,0)>20
max=GetDatabaseLong(idDb,0)-20
HideGadget(#Scroll,#False)
SetGadgetAttribute(#Scroll,#PB_ScrollBar_Maximum,max)
ScrollOn=#True
Else
HideGadget(#Scroll,#True)
ScrollOn=#False
EndIf
CloseDatabase(idDb)
EndProcedure
Procedure DrawDataLines()
Protected idDb,query.s,x=5,y=30,w=390,lmtEnd,Txt.s,yt
Protected Filters.s=GetGadgetText(#Filters)
VectorFont(FontID(FontLine))
VectorSourceColor($FF000000)
If ScrollOn
lmtEnd=GetGadgetState(#Scroll)
EndIf
query="SELECT id,nom,localite FROM client"
If Filters<>""
query+" WHERE nom LIKE "+Chr(34)+Filters+"%"+Chr(34)
EndIf
query+" ORDER BY nom"
query+" LIMIT 20 OFFSET "+Str(lmtEnd)
idDb=DbQuery(query)
If Not idDb
Exit()
EndIf
While NextDatabaseRow(idDb)
Txt=GetDatabaseString(idDb,1)
; Concaténation du texte si nécessaire
While VectorTextWidth(Txt)>w
Txt=Left(Txt,Len(Txt)-4)
Txt+"..."
Wend
x=5
yt=y+15-(VectorTextHeight(Txt)/2)
MovePathCursor(x,yt)
DrawVectorText(Txt)
x+w+10
Txt=GetDatabaseString(idDb,2)
; Concaténation du texte si nécessaire
While VectorTextWidth(Txt)>w
Txt=Left(Txt,Len(Txt)-4)
Txt+"..."
Wend
MovePathCursor(x,yt)
DrawVectorText(Txt)
y+30
Wend
CloseDatabase(idDb)
EndProcedure
Procedure DrawZone()
Protected x,w
VectorSourceColor($FF000000)
AddPathBox(0,0,800,600)
MovePathCursor(0,30)
AddPathLine(800,30)
MovePathCursor(400,0)
AddPathLine(400,600)
StrokePath(1.5)
EndProcedure
Procedure DrawTable()
ManageScroll()
StartVectorDrawing(CanvasVectorOutput(#MainCanvas))
; On efface
VectorSourceColor($FF808080)
FillVectorOutput()
DrawColumnTitles()
DrawColoredLines()
DrawDataLines()
DrawZone()
StopVectorDrawing()
EndProcedure
Procedure EventFilters()
If EventType()=#PB_EventType_Change
DrawTable()
EndIf
EndProcedure
Procedure EventBtFilter()
If FiltersOn
FiltersOn=#False
HideGadget(#Filters,#True)
SetGadgetText(#Filters,"")
DrawTable()
Else
FiltersOn=#True
HideGadget(#Filters,#False)
SetActiveGadget(#Filters)
EndIf
EndProcedure
Procedure EventScroll()
DrawTable()
EndProcedure
Procedure OpenMainForm()
OpenWindow(#MainForm,0,0,800,600,"Crée de belles tables",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(#MainCanvas,0,0,800,600,#PB_Canvas_Container|#PB_Canvas_Keyboard)
ScrollBarGadget(#Scroll,775,0,25,600,0,1,10,#PB_ScrollBar_Vertical)
HideGadget(#Scroll,#True)
BindGadgetEvent(#Scroll,@EventScroll())
StringGadget(#Filters,0,0,370,30,"")
HideGadget(#Filters,#True)
BindGadgetEvent(#Filters,@EventFilters())
ButtonGadget(#BtFiltersName,370,0,30,30,"...")
BindGadgetEvent(#BtFiltersName,@EventBtFilter())
CloseGadgetList()
DrawTable()
BindEvent(#PB_Event_CloseWindow,@Exit())
EndProcedure
ManageDb()
OpenMainForm()
Repeat
WaitWindowEvent()
ForEver