property Grid

Vous avez une idée pour améliorer ou modifier PureBasic ? N'hésitez pas à la proposer.
Mesa
Messages : 1097
Inscription : mer. 14/sept./2011 16:59

property Grid

Message par Mesa »

Un gadget Property Grid serait le bien venu, c'est trop compliqué à coder avec un canvas ou un listicon.

Ça existe sous windows et je crois que ça existe aussi avec gtk et pour osx.

Image

Mesa.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: property Grid

Message par Backup »

on peu le faire de façon legerement détourné, avec le RTF
et l'editeurgadget ...

Code : Tout sélectionner

Procedure.s Tableau_vide_RTF(nbcol,nbligne,largeur,cellfontsize=20) ; 20 = taille par défaut, donc paramètre optionnel
	result.s = "{\rtf1\trowd"
	Result +"\fs"+Str(cellfontsize)+" " ; Font Size
	For i=1 To nbcol
		result + "\cellx"+Str(i*largeur)
	Next
	For j=1 To nbligne
		result + "\intbl"
		For i=1 To nbcol
			result + "\cell"
		Next
		result + "\row"
	Next
	result + "}"
	ProcedureReturn result
EndProcedure

Procedure.s   TableauRTF(nbcol,nbligne,largeur)
	
	Result.s = "{\rtf1 \trowd"
	
	Result +"\fs32 " ; Font Size 32
	
	For i=1 To nbcol
		Result + "\cellx" + Str (i*largeur) ; defini la largeur de nos cellules
	Next ; la hauteur est definie par la taille de la police de caractère
	
	Result + " \intbl " ; on signale qu'on écrit dans le tableau
	
	For j=1 To nbligne       
		If j=1   
			Result +Space(3)+"ligne "+Str(j)  ; on ecrit directement sans ajouter de ligne puisqu'elle existe déjà!
			For i=2 To nbcol ; on commence à 2 puisqu'on a commencé à écrire dans la première colonne le mot ligne
				Result + " \cell " ; on va remplir une colonne du tableau
				Result +"\fs20 "   ; on modifie la taille de police
				Result +Space(5)+"Colonne "+Str(i) ; on ecrit dans la cellule avec un espace de 5 char en tête
			Next i
			ElseIf j>1
			Result + "\row " ; on passe à la ligne suivante du tableau
			Result +"\fs32 " ; on revient à la taille de police de départ
			Result +Space(3)+"ligne "+Str(j)  ; on ecrit dans la cellule
			For i=2 To nbcol ; on commence à 2 puisqu'on a commencé à écrire dans la première colonne le mot ligne
				Result + " \cell " ; on va remplir une colonne du tableau
				Result +"\fs20 "  ;on modifie la taille de police
				Result +Space(5)+"Colonne "+Str(i) ; on ecrit dans la cellule
			Next i
		EndIf                
	Next j
	result + "\row" ; on referme le tableau
	
	Result + "}"
	
	ProcedureReturn Result
	
EndProcedure
hwnd = OpenWindow (0,0,0,800,600, "Tableaux" ,#PB_Window_SystemMenu | #PB_Window_ScreenCentered )

EditorGadget(1,10,10,780,580)

SetGadgetText(1,TableauRTF(5,10,2000))

;Ajout d'un tableau vide avec taille des cellules par défaut
AddGadgetItem(1,-1,Tableau_vide_RTF(3,5,1000)) ; avec paramètre par défaut
;Ajout d'un autre tableau vide en changeant la taille des cellules
AddGadgetItem(1,-1,Tableau_vide_RTF(3,3,2000,40)) ; avec paramètre modifié

Repeat
	EventID = WaitWindowEvent ()
	Select EventID
		Case #PB_Event_CloseWindow
		Quit = #True
	EndSelect
Until Quit   ; EPB
Avatar de l’utilisateur
blendman
Messages : 2017
Inscription : sam. 19/févr./2011 12:46

Re: property Grid

Message par blendman »

Mesa : ce serait un chouette ajout, c'est clair :). Mais je pense que c'est un gros boulot.

Sinon, pour le moment, y'a quelques codeurs qui ont fait ça sur le forum Anglais :
http://www.purebasic.fr/english/viewtop ... operty+box
http://www.purebasic.fr/english/viewtop ... operty+box
http://www.purebasic.fr/english/viewtop ... operty+box



Et puis, comme je suis hyper sympa, je mets des infos pour Fred, au cas où il aurait envie de coder ce type de gadget ^^ :
http://www.codeproject.com/Articles/189 ... opertyGrid
http://www.codeproject.com/Articles/779 ... ItemData18

Je ne suis pas certain que ces codes soient tiptop, mais bon ^^.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: property Grid

Message par Backup »

un autre Grid , que je viens de passer en v5.11

Code : Tout sélectionner

; Grid - PB 3.81
; by Einander
; conversion v5.11 by Dobro
enumeration
	#win
	#im
EndEnumeration

#LightGray = $BDBDBD : #SAND = $BBFFFF

global Dim Selected.l(1)
Global Grid, Colum, Rows, _X, _Y, WCell, HCell, XGrid, YGrid, NColumns, NRows, NCells, WGrid, HGrid,SmallFont
SmallFont=LoadFont(0, "Tahoma ", 8)

Procedure inmous(x, y, x1, y1, mx, my)
	
	ProcedureReturn bool(mx >= x And my >= y And mx <= x1 And my <= y1)
EndProcedure

Procedure CleanCell(COLU, ROW)
	Box(XGrid + 1 + (COLU - 1) * WCell, YGrid + 1 + (ROW - 1) * HCell, WCell - 1, HCell - 1, #SAND)
	Selected(0) = 0
EndProcedure

Procedure DrawCell(Ev)
	MX = WindowMouseX(#win) - GetSystemMetrics_(#SM_CYSIZEFRAME)
	MY = WindowMouseY(#win) - GetSystemMetrics_(#SM_CYCAPTION) - GetSystemMetrics_(#SM_CYSIZEFRAME)
	If inmous(xGrid + 1, yGrid + 1, xGrid + wGrid - 2, yGrid + hGrid - 2, MX, MY)
		COLU = (MX - XGrid) / WCell + 1 : ROW = (MY - YGrid) / HCell + 1
		SEL = (ROW - 1) * NColumns + COLU
		If Ev = #WM_LBUTTONDOWN  : ProcedureReturn SEL : EndIf
		If Selected(0) <> COLU Or Selected(1) <> ROW
			If Selected(0) : CleanCell(SELECTED(0), Selected(1)) : EndIf
			x = XGrid + (COLU - 1) * WCell + 1 : y = YGrid + ((ROW - 1) * HCell) + 1
			Box(x, y, WCell - 1, HCell - 1, #GREEN)
			DrawingMode(1)
			FrontColor(rgb(0, 0, 0))
			DrawingFont(SmallFont) 
			DrawText(x,y,Str(SEL))
			DrawingMode(0)
			Selected(0) = COLU : Selected(1) = ROW
		EndIf
		ElseIf selected(0)
		CleanCell(Selected(0), Selected(1))
		ProcedureReturn 0
	EndIf
EndProcedure

Procedure DrawGrid()
	Grid = CreateImage(#im, wGrid , hGrid )
	StartDrawing(ImageOutput(#im))
		Box(0,0, wGrid, hGrid, #SAND)
		Pos = HCell * NRows
		x1 = 0 : y1 = 0
		For i = 0 To NColumns
			LineXY(x1, 0, x1, Pos, #LightGray)
			x1 + WCell
		Next i
		Pos = WCell * NColumns
		For i = 0 To NRows
			LineXY(0, y1, Pos, y1)
			y1 + HCell
		Next i
	StopDrawing()
EndProcedure


_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68
hWnd = OpenWindow(#win, 0, 0, _X, _Y,"Grid", #WS_OVERLAPPEDWINDOW)

XGrid = 100 : YGrid = 120        ;grid position
NColumns = 10 : NRows = 20   ;number of rows & columns
WCell = 60 : HCell = 16           ;cell sizes
NCells = NColumns * NRows
WGrid = WCell * NColumns+1 : HGrid = HCell * NRows+1

; CreateGadgetList(hWnd)
TextGadget(2, _x / 2, yGrid + hGrid + 10, 100, 20, "", #PB_Text_Center | #PB_Text_Border )

DrawGrid()
StartDrawing(WindowOutput(#win))
	
	Repeat
		Ev = WindowEvent()
		SEL = DrawCell(Ev)
		If SEL : SetGadgetText(2, "Selected " + Str(SEL)) : selected(0) = 0 : EndIf
		If Ev=#Wm_Paint :  DrawImage(Grid, xgrid,ygrid) : EndIf
	Until Ev = #PB_Event_CloseWindow
StopDrawing()
End 
; EPB
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: property Grid

Message par Backup »

version avec edition :

Code : Tout sélectionner

; Grid with input text
; December 26 -2003- PB 3.81
; by Einander

; Convert in V5.11  by Dobro

Enumeration
	#win
	#im
	#font
	;
	#Ret
	#Txt
	#Input
EndEnumeration

#LightGray = $BDBDBD : #SAND = $BBFFFF

global Dim Selected.l(1): global Dim textcell$(0) : global Dim xcell.W(0) :global  Dim ycell.W(0)
Global Mx, My, Mk,S$
Global Grid, Colum, Rows, _X, _Y, WCell, HCell, XGrid, YGrid, NColumns, NRows, NCells, WGrid, HGrid, SmallFont
S$="  "

Procedure inmous(x, y, x1, y1)
	ProcedureReturn bool(mx >= x And my >= y And mx <= x1 And my <= y1)
EndProcedure

Procedure CleanCell(COLU, ROW)
	x = XGrid + 1 + (COLU - 1) * WCell+1
	y = YGrid + 1 + (ROW - 1) * HCell+1
	Box(X, Y-1, WCell-2, HCell-1, #SAND)
	SEL = (ROW - 1 ) * NColumns + COLU
	DrawingFont(SmallFont)
	FrontColor(rgb(0, 0, 0))
	DrawText(x,y,textcell$(SEL - 1))
	Selected(0) = 0
EndProcedure

Procedure DrawCell(Ev)
	If inmous(xGrid + 1, yGrid + 1, xGrid + wGrid - 2, yGrid + hGrid - 2)
		COLU = (MX - XGrid) / WCell + 1 : ROW = (MY - YGrid) / HCell + 1
		SEL = (ROW - 1 ) * NColumns + COLU
		If Ev = #WM_LBUTTONDOWN : ProcedureReturn SEL : EndIf
		If Selected(0) <> COLU Or Selected(1) <> ROW
			If Selected(0) : CleanCell(SELECTED(0), Selected(1)) : EndIf
			x = XGrid + (COLU - 1) * WCell + 1 : y = YGrid + ((ROW - 1) * HCell) + 1
			Box(x+1, y, WCell-2 , HCell-1 , #GREEN)
			DrawingMode(1)
			FrontColor(rgb(0, 0, 0))
			DrawingFont(SmallFont)
			DrawText(x,y,textcell$(SEL - 1))
			DrawingMode(1)
			Selected(0) = COLU : Selected(1) = ROW
		EndIf
		ElseIf selected(0)
		CleanCell(Selected(0), Selected(1))
		ProcedureReturn 0
	EndIf
EndProcedure

Procedure DrawGrid()
	Grid = CreateImage(#im, wGrid, hGrid )
	StartDrawing(ImageOutput(#im))
		DrawingMode(1)
		Box(0, 0, wGrid, hGrid, #SAND)
		Pos = HCell * NRows
		x1 = 0 : y1 = 0
		For i = 0 To NColumns
			LineXY(x1, 0, x1, Pos, #LightGray)
			x1 + WCell
		Next i
		Pos = WCell * NColumns
		For i = 0 To NRows
			LineXY(0, y1, Pos, y1)
			y1 + HCell
		Next i
		FrontColor(rgb(0, 0, 0))
		DrawingFont(SmallFont)
		For i = 0 To Ncells
			DrawText(xcell(i) + 2, ycell(i)+2,textcell$(i))
		Next
	StopDrawing()
EndProcedure

_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68
hWnd = OpenWindow(#win, 0, 0, _X, _Y,"Grid", #WS_OVERLAPPEDWINDOW)
AddKeyboardShortcut(#win, #PB_Shortcut_Return, #Ret)

XGrid = 100 : YGrid = 120 ; grid position
NColumns = 8 : NRows = 12 ; number of rows & columns
WCell = 72 : HCell = 22 ; cell sizes
SmallFont = LoadFont(#font, "Tahoma ", hcell/2)

NCells = NColumns * NRows
WGrid = WCell * NColumns + 1 : HGrid = HCell * NRows + 1
global Dim TextCell$(Ncells)
global Dim XCell.w(Ncells)
global Dim YCell.w(Ncells)

For i = 0 To ncells
	If i > 0 And i % ncolumns = 0 : x = 0 : y + hcell : EndIf
	TextCell$(i) = Str(i + 1)
	Xcell(i) = x : ycell(i) = y
	x + wcell
Next

; CreateGadgetList(hWnd)
TextGadget(#Txt, _x / 2, yGrid + hGrid + 10, 100, 40, "", #PB_Text_Center | #PB_Text_Border )
StringGadget(#Input, 0, 0, 0, 0, "")

DrawGrid()
StartDrawing(WindowOutput(#win))
	
	Repeat
		MX = WindowMouseX(#win) - GetSystemMetrics_(#SM_CYSIZEFRAME)
		MY = WindowMouseY(#win) - GetSystemMetrics_(#SM_CYCAPTION) - GetSystemMetrics_(#SM_CYSIZEFRAME)
		If #WM_LBUTTONDOWN : mk = 1 : Else : mk = 0 : EndIf
		Ev = WindowEvent()
		SEL = DrawCell(Ev)
		If SEL
			If mk
				HideGadget(#input, 0)
				ResizeGadget(#Input, mx, my, 200, 20)
				Repeat
					;ActivateGadget(#Input)
					ev = WaitWindowEvent()
					t$ = GetGadgetText(#Input)
					If StringByteLength(t$+"W")>wcell:Break:EndIf ;TextLength(t$+"W")>wcell:Break:EndIf   ; limit for text too long
					
				Until ev = #PB_Event_Menu And EventMenu() = #Ret
				If Len(t$): textcell$(sel - 1) = t$ : EndIf
			StopDrawing()
			drawgrid()
			StartDrawing(WindowOutput(#win))
				SetGadgetText(#input, "")
				ResizeGadget(#input, 0, 0, 0, 0)
			EndIf
			SetGadgetText(#Txt, "Selected " + Str(SEL)+s$+textcell$(sel-1))
			selected(0) = 0
		EndIf
		If Ev = #Wm_Paint : DrawImage(Grid, xgrid, ygrid) : EndIf
	Until Ev = #PB_Event_CloseWindow
StopDrawing()
End 
; EPB
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: property Grid

Message par falsam »

Bonjour Dobro. Le sujet n'est pas d'avoir en natif une lib pour gérer les grids mais plutot une lib pour pouvoir mettre en place un PropertyGridGadget().

Fin de la parenthèse. :) Sur tes deux derniers codes, la souris ne pointe pas sur la bonne cellule. Exemple : pointe la cellule qui contient le chiffre 9 et c'est la cellule qui contient la valeur 1 qui est mise en valeur.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: property Grid

Message par Backup »

je propose des liens et codes permettant de faire un grid , en attendant ...
pour ce qui est du pointage , vous etes programmeurs non ?
le source est donné , ya plus qu'a ;)

je prefererai aussi avoir un gadget en natif , c'est une demande qui a été faites a maintes reprise
sur le forum anglais , on va peut etre pas trop tirer sur la corde ....
Répondre