Get Any Gadget Parent

Share your advanced PureBasic knowledge/code with the community.
Post Reply
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Get Any Gadget Parent

Post 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
Last edited by RASHAD on Tue Oct 15, 2013 9:28 am, edited 2 times in total.
Egypt my love
Top
User avatar
Danilo
Addict
Addict
Posts: 3036
Joined: Sat Apr 26, 2003 8:26 am
Location: Planet Earth

Re: Get Any Gadget Parent

Post 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.
Last edited by Danilo on Tue Oct 15, 2013 3:25 pm, edited 1 time in total.
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Get Any Gadget Parent

Post 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
Last edited by RASHAD on Tue Oct 15, 2013 7:56 am, edited 1 time in total.
Egypt my love
Top
User avatar
STARGÅTE
Addict
Addict
Posts: 2235
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:
Contact STARGÅTE

Re: Get Any Gadget Parent

Post 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
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and more ― Typeface - Sprite-based font include/module
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Get Any Gadget Parent

Post 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
Egypt my love
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Get Any Gadget Parent

Post 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
Last edited by RASHAD on Sat Oct 19, 2013 3:46 am, edited 1 time in total.
Egypt my love
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Get Any Gadget Parent

Post by Kwai chang caine »

This code and the first works good on XP Pro
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: Get Any Gadget Parent

Post by IdeasVacuum »

...now all we need are the Grand Parents and Great Grand Parents....... :mrgreen:
Edit: (not serious!)
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Get Any Gadget Parent

Post 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
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Get Any Gadget Parent

Post by RASHAD »

Previous post updated
Egypt my love
Top
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Get Any Gadget Parent

Post by mestnyi »

in Linux does not work this condition, who knows why?

Code: Select all

If X1 <> X2
                    Obj$ = "Gadget"
                    Parent = ig
                    Break         
                 EndIf
Top
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Get Any Gadget Parent

Post 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)
Top
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Get Any Gadget Parent

Post by mestnyi »

RASHAD What should you do to your code to work in Linux?
Top
Post Reply

Return to “Tricks 'n' Tips”