Créer des composants (gadgets).

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

voilà g retrouvé : http://purebasic.hmt-forum.com/viewtopi ... highlight=

sinon il y a un exemple interessant vu le forum anglais pour ceux que ca interessent...

il faut une DLL telechargeable ici:
http://radasm.visualassembler.com/

et un exemple de code pour l'exploiter :

Code : Tout sélectionner

; 
; Sample from the RAGrid package: GridTest. 
; Translated to PureBasic (more or less: this one doesn't use a resource dialog) 
; 

Global menuID 

Structure COLUMN 
  colwt.l 
  lpszhdrtext.l 
  halign.l 
  calign.l 
  ctype.l 
  ctextmax.l 
  lpszformat.l 
  himl.l 
  hdrflag.l 
  colxp.l 
  edthwnd.l 
EndStructure 

Structure ROWDATA 
  lpszName.l 
  nId.l 
EndStructure 

#GM_ADDCOL = #WM_USER+1 ;wParam=0, lParam=lpCOLUMN 
#GM_ADDROW = #WM_USER+2 ;wParam=0, lParam=lpROWDATA (can be NULL) 
#GM_SETBACKCOLOR = #WM_USER+21 ;wParam=nColor, lParam=0 
#GM_SETGRIDCOLOR = #WM_USER+23 ;wParam=nColor, lParam=0 
#GM_SETTEXTCOLOR = #WM_USER+25 ;wParam=nColor, lParam=0 
#GA_ALIGN_LEFT = 0 
#GA_ALIGN_RIGHT = 2 
#TYPE_EDITTEXT = 0   ;String 
#TYPE_EDITLONG = 1   ;Long 

Global *ClassBuffer 
*ClassBuffer = AllocateMemory(64) 

Procedure CreateGrids(hwnd, lParam) 
  If *ClassBuffer 
    GetClassName_(hwnd, *ClassBuffer, 64) 
    If PeekS(*ClassBuffer, 6)="Static" 
      hGrid = CreateWindowEx_($00000200, "RAGrid", "Grid test", $5001000D, 0, 0, 195, 260, hwnd, menuID, LibraryID(0), 0) 
      If hGrid 
        SendMessage_(hGrid, #WM_SETFONT, hFont, #False) 
        SendMessage_(hGrid, #GM_SETBACKCOLOR, $0C0FFFF, 0) 
        SendMessage_(hGrid, #GM_SETGRIDCOLOR, $808080, 0) 
        SendMessage_(hGrid, #GM_SETTEXTCOLOR, $800000, 0) 
        col.COLUMN 
        col\colwt = 130 
        col\lpszhdrtext = @"Name" 
        col\halign = #GA_ALIGN_LEFT 
        col\calign = #GA_ALIGN_LEFT 
        col\ctype = #TYPE_EDITTEXT 
        col\ctextmax = 31 
        col\lpszformat = 0 
        col\himl = 0 
        col\hdrflag = 0 
        SendMessage_(hGrid, #GM_ADDCOL, 0, @col) 
        ;Number column 
        col\colwt = 42 
        col\lpszhdrtext = @"ID" 
        col\halign = #GA_ALIGN_RIGHT 
        col\calign = #GA_ALIGN_RIGHT 
        col\ctype = #TYPE_EDITLONG 
        col\ctextmax = 11 
        col\lpszformat = 0 
        col\himl = 0 
        col\hdrflag = 0 
        SendMessage_(hGrid, #GM_ADDCOL, 0, @col) 
        ;Add some rows 
        Dim rdta.ROWDATA(3) 
        For i=0 To 3 
          SendMessage_(hGrid, #GM_ADDROW, 0, @rdta(i)) 
        Next i 
        ShowWindow_(hGrid, #SW_SHOW) 
        menuID+1 
      EndIf 
    EndIf 
    ProcedureReturn #True 
  Else 
    ProcedureReturn #False 
  EndIf 
EndProcedure 

Procedure DestroyGrids(hwnd, lParam) 
  If *ClassBuffer 
    GetClassName_(hwnd, *ClassBuffer, 64) 
    If PeekS(*ClassBuffer, 6)="Static" 
      hGrid = GetWindow_(hwnd, #GW_CHILD) 
      GetClassName_(hGrid, *ClassBuffer, 64) 
      If PeekS(*ClassBuffer, 6)="RAGrid" 
        DestroyWindow_(hGrid) 
      EndIf 
    EndIf 
    ProcedureReturn #True 
  Else 
    ProcedureReturn #False 
  EndIf 
EndProcedure 

If OpenWindow(0, 100, 200, 195, 260, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget, "PureBasic Window") 
  If OpenLibrary(0, "RAGrid.DLL") 
    InitCommonControls_() 
    hFont = SendMessage_(WindowID(), #WM_GETFONT, 0, 0) 
    If CreateGadgetList(WindowID()) 
      Panel = PanelGadget(0, 0, 0, 195, 260) 
        For j=1 To 6 
          AddGadgetItem(0, -1, "Tab "+Str(j)) 
        Next j 
        EnumChildWindows_(Panel, @CreateGrids(), 0) 
      CloseGadgetList() 
      Repeat 
        EventID = WaitWindowEvent() 
        If EventID=#PB_Event_CloseWindow 
          Quit = 1 
        EndIf 
      Until Quit=1 
    EndIf 
    EnumChildWindows_(Panel, @DestroyGrids(), 0) 
  EndIf 
  CloseLibrary(0) 
EndIf 
End 
Image
petitchercheur
Messages : 17
Inscription : lun. 07/mars/2005 17:50

Message par petitchercheur »

Flype a écrit :j'ai a peine modifie le code du soldat inconnu pour mettre la grille
dans un ScrollAreaGadget ce qui est assez pratique... :roll:

sinon j'ai lu qqpart ( forum FR ou anglais je sais plus ) que Fred avait
l'intention d'intégrer assez vite un GridGadget() à Purebasic 8)
Merci!
Torp
Messages : 360
Inscription : lun. 22/nov./2004 13:05

Message par Torp »

Flype a écrit :j'ai a peine modifie le code du soldat inconnu pour mettre la grille dans un ScrollAreaGadget ce qui est assez pratique... :roll:
On veut pas savoir ce vous faites toi et le soldat... :twisted: ... :D
gansta93
Messages : 1448
Inscription : jeu. 26/févr./2004 11:17
Localisation : Le Village
Contact :

Message par gansta93 »

Je crois qu'avec TailBite, tu as possibilité de faire tes propres gadget que tuintégrerais dans une lib.
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Message par Le Soldat Inconnu »

Ah oui, exact, j'ai jamais essayé :wink:
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

gansta93 a écrit :Je crois qu'avec TailBite, tu as possibilité de faire tes propres gadget que tuintégrerais dans une lib.
Tu as un exemple ?
gansta93
Messages : 1448
Inscription : jeu. 26/févr./2004 11:17
Localisation : Le Village
Contact :

Message par gansta93 »

Denis a écrit :
gansta93 a écrit :Je crois qu'avec TailBite, tu as possibilité de faire tes propres gadget que tuintégrerais dans une lib.
Tu as un exemple ?
Non, mais il y en a un dans TailBite.
petitchercheur
Messages : 17
Inscription : lun. 07/mars/2005 17:50

Message par petitchercheur »

Le Soldat Inconnu a écrit :

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 3.92

; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 400, 200, #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget, "Test") = 0 Or CreateGadgetList(WindowID()) = 0
  End
EndIf

; on va faire un tableau de StringGadget, dimension 10 * 10

Dim Gadget(9, 9) ; on crée un tableau de 10 par 10 qui va recevoir l'identifant des gadgets crées
For x = 0 To 9
  For y = 0 To 9
    Gadget(x, y) = StringGadget(#PB_Any, 40 * x, 20 * y, 40, 20, Str(x) + ", " + Str(y))
    ; On sauvegarde l'identifiant du gadget dans le tableau pour pouvroi récupérer le texte tapé
  Next
Next

Repeat
  Event = WaitWindowEvent()
  
Until Event = #PB_EventCloseWindow ; On a fermé la fenêtre

; on affiche le contenu du tableau dans le debugger
For x = 0 To 9
  For y = 0 To 9
    Debug Str(x) + ", " + Str(y) + " = " + GetGadgetText(Gadget(x, y))
  Next
Next

End
Sous PureBasic 4.02, à la ligne 5 du code, j'ai l'erreur suivante: "Bad parameter type, number expected instead of string"

Qui peut me dire comment la corriger?

Merci.
Anonyme

Message par Anonyme »

Remplace :

Code : Tout sélectionner

OpenWindow(0, 0, 0, 400, 200, #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget, "Test")
par :

Code : Tout sélectionner

OpenWindow(0, 0, 0, 400, 200, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
@++ :wink:
petitchercheur
Messages : 17
Inscription : lun. 07/mars/2005 17:50

Message par petitchercheur »

OK, j'ai fait la correction.

J'ai constaté que la ligne 22:

Code : Tout sélectionner

Until Event = #PB_EventCloseWindow ; On a fermé la fenêtre
doit être remplacée par:

Code : Tout sélectionner

Until Event = #PB_Event_CloseWindow ; On a fermé la fenêtre


Mais alors, j'ai un problème à la ligne 14:
[ERROR] There is no current GadgetList!

Là, je ne vois pas où est l'erreur!

Je ne sais si d'autres erreurs apparaîtront après?

Ne serait-il pas préférable de remettre sur ce forum un code complet correct?

J'ai encore beaucoup de chemin à faire avec PureBasic... d'autant que je suis resté involontairement inactif dans ce domaine trop longtemps!
petitchercheur
Messages : 17
Inscription : lun. 07/mars/2005 17:50

Exemple de Flype

Message par petitchercheur »

Cet exemple de Flype cause aussi quelques problèmes sous PureBasic 4.02...

Code : Tout sélectionner

; 
; Sample from the RAGrid package: GridTest. 
; Translated to PureBasic (more or less: this one doesn't use a resource dialog) 
; 

Global menuID 

Structure COLUMN 
  colwt.l 
  lpszhdrtext.l 
  halign.l 
  calign.l 
  ctype.l 
  ctextmax.l 
  lpszformat.l 
  himl.l 
  hdrflag.l 
  colxp.l 
  edthwnd.l 
EndStructure 

Structure ROWDATA 
  lpszName.l 
  nId.l 
EndStructure 

#GM_ADDCOL = #WM_USER+1 ;wParam=0, lParam=lpCOLUMN 
#GM_ADDROW = #WM_USER+2 ;wParam=0, lParam=lpROWDATA (can be NULL) 
#GM_SETBACKCOLOR = #WM_USER+21 ;wParam=nColor, lParam=0 
#GM_SETGRIDCOLOR = #WM_USER+23 ;wParam=nColor, lParam=0 
#GM_SETTEXTCOLOR = #WM_USER+25 ;wParam=nColor, lParam=0 
#GA_ALIGN_LEFT = 0 
#GA_ALIGN_RIGHT = 2 
#TYPE_EDITTEXT = 0   ;String 
#TYPE_EDITLONG = 1   ;Long 

Global *ClassBuffer 
*ClassBuffer = AllocateMemory(64) 

Procedure CreateGrids(hwnd, lParam) 
  If *ClassBuffer 
    GetClassName_(hwnd, *ClassBuffer, 64) 
    If PeekS(*ClassBuffer, 6)="Static" 
      hGrid = CreateWindowEx_($00000200, "RAGrid", "Grid test", $5001000D, 0, 0, 195, 260, hwnd, menuID, LibraryID(0), 0) 
      If hGrid 
        SendMessage_(hGrid, #WM_SETFONT, hFont, #False) 
        SendMessage_(hGrid, #GM_SETBACKCOLOR, $0C0FFFF, 0) 
        SendMessage_(hGrid, #GM_SETGRIDCOLOR, $808080, 0) 
        SendMessage_(hGrid, #GM_SETTEXTCOLOR, $800000, 0) 
        col.COLUMN 
        col\colwt = 130 
        col\lpszhdrtext = @"Name" 
        col\halign = #GA_ALIGN_LEFT 
        col\calign = #GA_ALIGN_LEFT 
        col\ctype = #TYPE_EDITTEXT 
        col\ctextmax = 31 
        col\lpszformat = 0 
        col\himl = 0 
        col\hdrflag = 0 
        SendMessage_(hGrid, #GM_ADDCOL, 0, @col) 
        ;Number column 
        col\colwt = 42 
        col\lpszhdrtext = @"ID" 
        col\halign = #GA_ALIGN_RIGHT 
        col\calign = #GA_ALIGN_RIGHT 
        col\ctype = #TYPE_EDITLONG 
        col\ctextmax = 11 
        col\lpszformat = 0 
        col\himl = 0 
        col\hdrflag = 0 
        SendMessage_(hGrid, #GM_ADDCOL, 0, @col) 
        ;Add some rows 
        Dim rdta.ROWDATA(3) 
        For i=0 To 3 
          SendMessage_(hGrid, #GM_ADDROW, 0, @rdta(i)) 
        Next i 
        ShowWindow_(hGrid, #SW_SHOW) 
        menuID+1 
      EndIf 
    EndIf 
    ProcedureReturn #True 
  Else 
    ProcedureReturn #False 
  EndIf 
EndProcedure 

Procedure DestroyGrids(hwnd, lParam) 
  If *ClassBuffer 
    GetClassName_(hwnd, *ClassBuffer, 64) 
    If PeekS(*ClassBuffer, 6)="Static" 
      hGrid = GetWindow_(hwnd, #GW_CHILD) 
      GetClassName_(hGrid, *ClassBuffer, 64) 
      If PeekS(*ClassBuffer, 6)="RAGrid" 
        DestroyWindow_(hGrid) 
      EndIf 
    EndIf 
    ProcedureReturn #True 
  Else 
    ProcedureReturn #False 
  EndIf 
EndProcedure 

If OpenWindow(0, 100, 200, 195, 260, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget, "PureBasic Window") 
  If OpenLibrary(0, "RAGrid.DLL") 
    InitCommonControls_() 
    hFont = SendMessage_(WindowID(), #WM_GETFONT, 0, 0) 
    If CreateGadgetList(WindowID()) 
      Panel = PanelGadget(0, 0, 0, 195, 260) 
        For j=1 To 6 
          AddGadgetItem(0, -1, "Tab "+Str(j)) 
        Next j 
        EnumChildWindows_(Panel, @CreateGrids(), 0) 
      CloseGadgetList() 
      Repeat 
        EventID = WaitWindowEvent() 
        If EventID=#PB_Event_CloseWindow 
          Quit = 1 
        EndIf 
      Until Quit=1 
    EndIf 
    EnumChildWindows_(Panel, @DestroyGrids(), 0) 
  EndIf 
  CloseLibrary(0) 
EndIf 
End 
Si quelqu'un avait le temps de le corriger, ça me ferait plaisir!
Il me reste à passer du temps à étudier PureBasic...
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Ca devrait aller mais je n'ai pas la dll pour tester

Code : Tout sélectionner

;
; Sample from the RAGrid package: GridTest.
; Translated to PureBasic (more or less: this one doesn't use a resource dialog)
;

Global menuID

Structure COLUMN
  colwt.l
  lpszhdrtext.l
  halign.l
  calign.l
  ctype.l
  ctextmax.l
  lpszformat.l
  himl.l
  hdrflag.l
  colxp.l
  edthwnd.l
EndStructure

Structure ROWDATA
  lpszName.l
  nId.l
EndStructure

#GM_ADDCOL = #WM_USER+1 ;wParam=0, lParam=lpCOLUMN
#GM_ADDROW = #WM_USER+2 ;wParam=0, lParam=lpROWDATA (can be NULL)
#GM_SETBACKCOLOR = #WM_USER+21 ;wParam=nColor, lParam=0
#GM_SETGRIDCOLOR = #WM_USER+23 ;wParam=nColor, lParam=0
#GM_SETTEXTCOLOR = #WM_USER+25 ;wParam=nColor, lParam=0
#GA_ALIGN_LEFT = 0
#GA_ALIGN_RIGHT = 2
#TYPE_EDITTEXT = 0   ;String
#TYPE_EDITLONG = 1   ;Long

Global *ClassBuffer
*ClassBuffer = AllocateMemory(64)

Procedure CreateGrids(hwnd, lParam)
  If *ClassBuffer
    GetClassName_(hwnd, *ClassBuffer, 64)
    If PeekS(*ClassBuffer, 6)="Static"
      hGrid = CreateWindowEx_($00000200, "RAGrid", "Grid test", $5001000D, 0, 0, 195, 260, hwnd, menuID, LibraryID(0), 0)
      If hGrid
        SendMessage_(hGrid, #WM_SETFONT, hFont, #False)
        SendMessage_(hGrid, #GM_SETBACKCOLOR, $0C0FFFF, 0)
        SendMessage_(hGrid, #GM_SETGRIDCOLOR, $808080, 0)
        SendMessage_(hGrid, #GM_SETTEXTCOLOR, $800000, 0)
        col.COLUMN
        col\colwt = 130
        col\lpszhdrtext = @"Name"
        col\halign = #GA_ALIGN_LEFT
        col\calign = #GA_ALIGN_LEFT
        col\ctype = #TYPE_EDITTEXT
        col\ctextmax = 31
        col\lpszformat = 0
        col\himl = 0
        col\hdrflag = 0
        SendMessage_(hGrid, #GM_ADDCOL, 0, @col)
        ;Number column
        col\colwt = 42
        col\lpszhdrtext = @"ID"
        col\halign = #GA_ALIGN_RIGHT
        col\calign = #GA_ALIGN_RIGHT
        col\ctype = #TYPE_EDITLONG
        col\ctextmax = 11
        col\lpszformat = 0
        col\himl = 0
        col\hdrflag = 0
        SendMessage_(hGrid, #GM_ADDCOL, 0, @col)
        ;Add some rows
        Dim rdta.ROWDATA(3)
        For i=0 To 3
          SendMessage_(hGrid, #GM_ADDROW, 0, @rdta(i))
        Next i
        ShowWindow_(hGrid, #SW_SHOW)
        menuID+1
      EndIf
    EndIf
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure DestroyGrids(hwnd, lParam)
  If *ClassBuffer
    GetClassName_(hwnd, *ClassBuffer, 64)
    If PeekS(*ClassBuffer, 6)="Static"
      hGrid = GetWindow_(hwnd, #GW_CHILD)
      GetClassName_(hGrid, *ClassBuffer, 64)
      If PeekS(*ClassBuffer, 6)="RAGrid"
        DestroyWindow_(hGrid)
      EndIf
    EndIf
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

If OpenWindow(0, 100, 200, 195, 260, "PureBasic Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
  If OpenLibrary(0, "RAGrid.DLL")
    InitCommonControls_()
    hFont = SendMessage_(WindowID(0), #WM_GETFONT, 0, 0)
    If CreateGadgetList(WindowID(0))
      Panel = PanelGadget(0, 0, 0, 195, 260)
        For j=1 To 6
          AddGadgetItem(0, -1, "Tab "+Str(j))
        Next j
        EnumChildWindows_(Panel, @CreateGrids(), 0)
      CloseGadgetList()
      Repeat
        EventID = WaitWindowEvent()
        If EventID=#PB_Event_CloseWindow
          Quit = 1
        EndIf
      Until Quit=1
    EndIf
    EnumChildWindows_(Panel, @DestroyGrids(), 0)
  EndIf
  CloseLibrary(0)
EndIf
End
Répondre