PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Get Any Gadget Parent

https://www.purebasic.fr/english/viewtopic.php?t=57046

Page 1 of 1

Get Any Gadget Parent

Posted: Tue Oct 15, 2013 4:54 am
by RASHAD
Need more to do
No guarantee for next PB versions :)

Code: Select all

;:==========================================
;:- GetParent(Gadget)
;:- Author          : RASHAD
;:- Date            : 10 15, 2013
;:- Compiler        : PureBasic 5.1x - 5.20 LTS
;:- Target OS       : Cross Platform (Should be)
;:==========================================

Global Dim Gad(100,1),Count,Parent,Win ,Obj$,Run

Import ""
  PB_Object_EnumerateAll(obj,cb,vData)
  PB_Gadget_Objects.i
  PB_Window_Objects.i
EndImport

Procedure WinCB(id,*obj,vdata) 
  Win = id
  ProcedureReturn 1
EndProcedure

Procedure GadCB(id,*obj,vdata)
  Gad(Count,0) = id
  Gad(Count,1) = GadgetType(id)
  Count+1 
  ProcedureReturn 1
EndProcedure

Procedure GetParent(Gadget)
  If Run = 0
     Run + 1
     PB_Object_EnumerateAll(PB_Window_Objects,@WinCB(),0)
     PB_Object_EnumerateAll(PB_Gadget_Objects,@GadCB(),0)
  EndIf
  For x = 0 To Count - 1
      If Gad(x,1) = 11 Or Gad(x,1) = 16 Or Gad(x,1) = 28
         id = Gad(x,0)
         X1 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
         ResizeGadget(id,GadgetX(id)+10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
         X2 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
         ResizeGadget(id,GadgetX(id)-10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
         If X1 <> X2
            Obj$ = "Gadget"
            Parent = id
            Break          
         EndIf
      Else
         Obj$ = "Window"
         Parent = Win
      EndIf
  Next
EndProcedure

win1 = OpenWindow(#PB_Any,0,0,400,300,"Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_SizeGadget)

PanelGadget     (0, 8, 8, 306, 203)
  AddGadgetItem (0, -1, "Panel 1")
    PanelGadget (1, 5, 5, 290, 166)
      AddGadgetItem(1, -1, "Sub-Panel 1")
      AddGadgetItem(1, -1, "Sub-Panel 2")
      AddGadgetItem(1, -1, "Sub-Panel 3")
    CloseGadgetList()
  AddGadgetItem (0, -1,"Panel 2")
    ButtonGadget(2, 10, 15, 80, 24,"Button 1")
    ButtonGadget(3, 95, 15, 80, 24,"Button 2")
CloseGadgetList()

ContainerGadget(5,10,220,62,22,#PB_Container_Flat )
    ButtonGadget(6,0,0,60,20,"Test")
CloseGadgetList()

ButtonGadget(10,10,250,60,20,"Run Test")


Repeat
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
            Quit = 1
     
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 10
                GetParent(2)
                Debug "Parent of Gadget 2  is : "+ Obj$ + " : "+ Str(Parent)
                
                GetParent(6)
                Debug "Parent of Gadget 6  is : "+ Obj$ + " : "+ Str(Parent)
                
                GetParent(10)
                Debug "Parent of Gadget 10  is : "+ Obj$ + " : "+Str(Parent)
           
          EndSelect         
             
  EndSelect

Until Quit = 1
End
Edit :Modified for better
Edit :Fixed out of bounds bug

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 7:07 am
by Danilo
Crash on Mac OS X with stack align issue:

Code: Select all

Executable started.
[WARNING] Line 31
[WARNING] The stack is no more 16 bytes aligned !
[WARNING] Line 26
[WARNING] The stack is no more 16 bytes aligned !
[ERROR] Line: 26
[ERROR] Invalid memory access.
Works with PB5.20LTS MacOSX x86 when changing "Import" to "ImportC" and
"Procedure" to "ProcedureC" for WinCB() and GadCB().

Output:

Code: Select all

Parent of Gadget 2  is : Window : 35751532
Parent of Gadget 6  is : Gadget : 5
Parent of Gadget 10  is : Window : 35751532
After changing the import:

Code: Select all

  PB_Gadget_Objects.l
  PB_Window_Objects.l
to:

Code: Select all

  PB_Gadget_Objects.i
  PB_Window_Objects.i
it works also with PB5.20LTS MacOSX x64.

Making the buttons "Run Test" and its ContainerGadget a little bit wider is required on MacOSX to see the button text.

The following code was tested with PB 5.20 LTS x86 & x64 on MacOSX:

Code: Select all

;:==========================================
;:- GetParent(Gadget)
;:- Author          : RASHAD
;:- Date            : 11 15, 2013
;:- Compiler        : PureBasic 5.1x - 5.20 LTS
;:- Target OS       : Cross Platform (Should be)
;:==========================================

Global Dim Gad(100,1),Count,Parent,Win ,Obj$

ImportC ""
  PB_Object_EnumerateAll(obj,cb,vData)
  PB_Gadget_Objects.i
  PB_Window_Objects.i
EndImport

ProcedureC WinCB(id,*obj,vdata) 
  Win = id
  ProcedureReturn 1
EndProcedure

ProcedureC GadCB(id,*obj,vdata) 
  Gad(Count,0) = id
  Gad(Count,1) = GadgetType(id)
  Count+1 
  ProcedureReturn 1
EndProcedure

Procedure GetParent(Gadget)
  PB_Object_EnumerateAll(PB_Window_Objects,@WinCB(),0)
  PB_Object_EnumerateAll(PB_Gadget_Objects,@GadCB(),0)
  For x = 0 To Count - 1
      If Gad(x,1) = 11 Or Gad(x,1) = 16 Or Gad(x,1) = 28
         id = Gad(x,0)
         X1 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
         ResizeGadget(id,GadgetX(id)+10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
         X2 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
         ResizeGadget(id,GadgetX(id)-10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
         If X1 <> X2
            Obj$ = "Gadget"
            Parent = id
            Break          
         EndIf
      Else
         Obj$ = "Window"
         Parent = Win
      EndIf
  Next
EndProcedure

win1 = OpenWindow(#PB_Any,0,0,400,300,"Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_SizeGadget)

PanelGadget     (0, 8, 8, 306, 203)
  AddGadgetItem (0, -1, "Panel 1")
    PanelGadget (1, 5, 5, 290, 166)
      AddGadgetItem(1, -1, "Sub-Panel 1")
      AddGadgetItem(1, -1, "Sub-Panel 2")
      AddGadgetItem(1, -1, "Sub-Panel 3")
    CloseGadgetList()
  AddGadgetItem (0, -1,"Panel 2")
    ButtonGadget(2, 10, 15, 80, 24,"Button 1")
    ButtonGadget(3, 95, 15, 80, 24,"Button 2")
CloseGadgetList()

ContainerGadget(5,10,220,82,22,#PB_Container_Flat )
    ButtonGadget(6,0,0,80,20,"Test")
CloseGadgetList()

ButtonGadget(10,10,250,80,20,"Run Test")


Repeat
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
            Quit = 1
     
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 10
                GetParent(2)
                Debug "Parent of Gadget 2  is : "+ Obj$ + " : "+ Str(Parent)
                
                GetParent(6)
                Debug "Parent of Gadget 6  is : "+ Obj$ + " : "+ Str(Parent)
                
                GetParent(10)
                Debug "Parent of Gadget 10  is : "+ Obj$ + " : "+Str(Parent)
           
          EndSelect         
             
  EndSelect

Until Quit = 1
End
It works sometimes. Sometimes I get:

Code: Select all

[ERROR] Line: 23
[ERROR] Array index out of bounds.
I always get this error after pressing the button "Run Test" 5 times, so this
hack seems not to be very reliable.

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 7:22 am
by RASHAD
Hi Danilo :)
I know a little about Linux
I know nothing about Mac :P

And I am not going to smash my brain (windows is more enough for me)
It is just an idea
If you see that it worth to be corrected for Mac,so please do it Danilo
Thanks mate

Fixed out of bounds bug

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 7:55 am
by STARGÅTE
doesn't work here:

Code: Select all

;:==========================================
;:- GetParent(Gadget)
;:- Author          : RASHAD
;:- Date            : 11 15, 2013
;:- Compiler        : PureBasic 5.1x - 5.20 LTS
;:- Target OS       : Cross Platform (Should be)
;:==========================================

Global Dim Gad(100,1),Count,Parent,Win ,Obj$

ImportC ""
	PB_Object_EnumerateAll(obj,cb,vData)
	PB_Gadget_Objects.i
	PB_Window_Objects.i
EndImport

ProcedureC WinCB(id,*obj,vdata) 
	Win = id
	ProcedureReturn 1
EndProcedure

ProcedureC GadCB(id,*obj,vdata) 
	Gad(Count,0) = id
	Gad(Count,1) = GadgetType(id)
	Count+1 
	ProcedureReturn 1
EndProcedure

Procedure GetParent(Gadget)
	PB_Object_EnumerateAll(PB_Window_Objects,@WinCB(),0)
	PB_Object_EnumerateAll(PB_Gadget_Objects,@GadCB(),0)
	For x = 0 To Count - 1
		If Gad(x,1) = 11 Or Gad(x,1) = 16 Or Gad(x,1) = 28
			id = Gad(x,0)
			X1 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
			ResizeGadget(id,GadgetX(id)+10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
			X2 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
			ResizeGadget(id,GadgetX(id)-10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
			If X1 <> X2
				Obj$ = "Gadget"
				Parent = id
				Break          
			EndIf
		Else
			Obj$ = "Window"
			Parent = Win
		EndIf
	Next
EndProcedure



OpenWindow(1, 200, 200, 400, 300, "Window 1", #PB_Window_SystemMenu)
ButtonGadget(1, 10, 10, 80, 20, "Button 1")

OpenWindow(2, 700, 200, 400, 300, "Window 2", #PB_Window_SystemMenu)
ButtonGadget(2, 10, 10, 80, 20, "Button 2")

UseGadgetList(WindowID(1))
ButtonGadget(3, 10, 30, 80, 20, "Button 3")


GetParent(1)
Debug Parent

GetParent(2)
Debug Parent

GetParent(3)
Debug Parent


Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			End
	EndSelect
ForEver
2
2
2
should be:
1
2
1

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 8:00 am
by RASHAD
Hi STARGÅTE
Yes you are right

Now I see you created more than one windows
I will see what I can do with your snippet
Thanks mate

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 8:44 am
by RASHAD
Modified ver for more than one opened window

Code: Select all

;:===========================================
;:- GetParent(Gadget)
;:- Author          : RASHAD
;:- Date            : 10, 15, 2013
;:- Compiler        : PureBasic 5.1x - 5.20 LTS
;:- Target OS       : Cross Platform (Should be)
;:===========================================

Global Dim Gad(1,0)
Global Dim Wind(0)
Global Countw,Countg,Parent,Win ,Obj$,Run

Import ""
  PB_Object_EnumerateAll(obj,cb,vData)
  PB_Object_Count(*obj)
  PB_Gadget_Objects.i
  PB_Window_Objects.i
EndImport

Procedure WinCB(id,*obj,vdata)
  wind(Countw) = id
  Countw+1
  ProcedureReturn 1
EndProcedure

Procedure GadCB(id,*obj,vdata)
  Gad(0,Countg) = id
  Gad(1,Countg) = GadgetType(id)
  Countg+1
  ProcedureReturn 1
EndProcedure

Procedure GetParent(Gadget)
  If Run = 0     
     Run + 1
     wc = PB_Object_Count(PB_Window_Objects)
     gc = PB_Object_Count(PB_Gadget_Objects)
     ReDim Wind(wc)
     ReDim Gad(1,gc)
     PB_Object_EnumerateAll(PB_Window_Objects,@WinCB(),0)
     PB_Object_EnumerateAll(PB_Gadget_Objects,@GadCB(),0)
  EndIf
  For w = 0 To Countw - 1
      iw = Wind(w)
      X1 = GadgetX(Gadget,#PB_Gadget_ScreenCoordinate)
      ResizeWindow(iw,WindowX(iw)+10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
      X2 = GadgetX(Gadget,#PB_Gadget_ScreenCoordinate)
      ResizeWindow(iw,WindowX(iw)-10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
      If X1 <> X2
          For g = 0 To Countg - 1
              If Gad(1,g) = 11 Or Gad(1,g) = 16 Or Gad(1,g) = 28
                 ig = Gad(0,g)
                 X1 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
                 ResizeGadget(ig,GadgetX(ig)+10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
                 X2 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
                 ResizeGadget(ig,GadgetX(ig)-10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
                 If X1 <> X2
                    Obj$ = "Gadget"
                    Parent = ig
                    Break          
                 EndIf
              Else
                  Obj$ = "Window"
                  Parent = iw
              EndIf
           Next
      EndIf
  Next
EndProcedure

win1 = OpenWindow(#PB_Any,0,0,400,300,"Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_SizeGadget)

PanelGadget     (0, 8, 8, 306, 203)
  AddGadgetItem (0, -1, "Panel 1")
    PanelGadget (1, 5, 5, 290, 166)
      AddGadgetItem(1, -1, "Sub-Panel 1")
      AddGadgetItem(1, -1, "Sub-Panel 2")
      AddGadgetItem(1, -1, "Sub-Panel 3")
    CloseGadgetList()
  AddGadgetItem (0, -1,"Panel 2")
    ButtonGadget(2, 10, 15, 80, 24,"Button 1")
    ButtonGadget(3, 95, 15, 80, 24,"Button 2")
CloseGadgetList()

ContainerGadget(5,10,220,62,22,#PB_Container_Flat )
    ButtonGadget(6,0,0,60,20,"Test")
CloseGadgetList()

ButtonGadget(8,10,250,60,20,"Run Test")

OpenWindow(1, 200, 200, 400, 300, "Window 1", #PB_Window_SystemMenu)
ButtonGadget(10, 10, 10, 80, 20, "Button 1")

OpenWindow(2, 700, 200, 400, 300, "Window 2", #PB_Window_SystemMenu)
ButtonGadget(20, 10, 10, 80, 20, "Button 2")

UseGadgetList(WindowID(1))
ButtonGadget(30, 10, 30, 80, 20, "Button 3")

GetParent(2)
Debug "Parent of Gadget 2  is : "+ Obj$ + " : "+Str(Parent)
Debug ""

GetParent(6)
Debug "Parent of Gadget 6  is : "+ Obj$ + " : "+Str(Parent)
Debug""

GetParent(8)
Debug "Parent of Gadget 8  is : "+ Obj$ + " : "+Str(Parent)
Debug""

GetParent(10)
Debug "Parent of Gadget 10  is : "+ Obj$ + " : "+Str(Parent)
Debug ""

GetParent(20)
Debug "Parent of Gadget 20  is : "+ Obj$ + " : "+Str(Parent)
Debug ""

GetParent(30)
Debug "Parent of Gadget 30  is : "+ Obj$ + " : "+Str(Parent)


Repeat
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
            Quit = 1     
            
  EndSelect

Until Quit = 1
End
Edit :Modified for better performance

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 6:42 pm
by Kwai chang caine
This code and the first works good on XP Pro
Thanks for sharing 8)

Re: Get Any Gadget Parent

Posted: Tue Oct 15, 2013 11:48 pm
by IdeasVacuum
...now all we need are the Grand Parents and Great Grand Parents....... :mrgreen:
Edit: (not serious!)

Re: Get Any Gadget Parent

Posted: Wed Oct 16, 2013 9:49 pm
by BorisTheOld
IdeasVacuum wrote:...now all we need are the Grand Parents and Great Grand Parents....... :mrgreen:
Edit: (not serious!)
Can already do that. :wink:

Code: Select all

PrivateSubroutine(ProcName) (ByVal(Me, strClassName))

  Local(oGrandParent, typObject)
  Local(iGPGadgetNumber, typInt32)
  Local(oGreatGrandParent, typObject)
  Local(iGGPGadgetNumber, typInt32)

  oGrandParent = Get(Me\exoParent, exoParent)
  iGPGadgetNumber = Get(oGrandParent, exiGadgetNumber)
  oGreatGrandParent = Get(oGrandParent, exoParent)
  iGGPGadgetNumber = Get(oGreatGrandParent, exiGadgetNumber)

  etc
  etc

EndSubroutine

Re: Get Any Gadget Parent

Posted: Sat Oct 19, 2013 3:47 am
by RASHAD
Previous post updated

Re: Get Any Gadget Parent

Posted: Sun Feb 23, 2014 7:00 am
by mestnyi
in Linux does not work this condition, who knows why?

Code: Select all

If X1 <> X2
                    Obj$ = "Gadget"
                    Parent = ig
                    Break         
                 EndIf

Re: Get Any Gadget Parent

Posted: Mon Feb 24, 2014 5:01 am
by mestnyi
Because of this does not work, why not change the variables in Linux?

Code: Select all

X1 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
                 ResizeGadget(ig,GadgetX(ig)+10,#PB_Ignore, #PB_Ignore, #PB_Ignore)
                 X2 = GadgetX(Gadget,#PB_Gadget_WindowCoordinate)
                 ResizeGadget(ig,GadgetX(ig)-10,#PB_Ignore, #PB_Ignore, #PB_Ignore)

Re: Get Any Gadget Parent

Posted: Fri Mar 28, 2014 6:06 pm
by mestnyi
RASHAD What should you do to your code to work in Linux?
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited