Code archives/BlitzPlus Gui/Xp/Normal Group Box

This code has been declared by its author to be Public Domain code.

Download source code

Xp/Normal Group Box by Helios
(Posted 22 years ago)
Well this creates a basic group box, the style parameters specifys wether its a Xp styled one or a normal one, all the colors come from the systemColors so they should look right on all themes. When using it make sure to put the update code in your main loop as this resizes the image and deletes the type if you resize or delete its parent!

You need this in a decals file;

.lib "user32.dll" 
api_GetSysColor% (nIndex%) : "GetSysColor"

;--------------------------------------------------------------------
;		THe type!!
;		(C) 2500 TIM lEOANRD
; -------------------------------------------------------------------
Type groupbox
	Field panel
	Field parent
	Field name$
	Field style
End Type


;--------------------------------------------------------------------
;		The Update Code
;		(C) 2500 TIM lEOANRD
;		NOTE: This is used when resizeing and freeing windows
;		      asccociated with it!
; -------------------------------------------------------------------
Function updategadgets()
id=PeekEvent()
ev=EventSource()

;Update Group Boxes
For g.groupbox=Each groupbox
	If id=$802
		resizeGroupbox(Handle(g.groupbox))
	EndIf
	If id=$803 And EventSource()=g\parent Then FreeGroupBox(g\panel)
Next

End Function


;--------------------------------------------------------------------
;		GROUP BOX CODE
;		(C) 2500 TIM lEOANRD
;		NOTE: The buffer parameter is used to set the 
;             current buffer back To the one you were using!
; -------------------------------------------------------------------
Function CreateGroupBox(name$, x, y, w, h, p , style=0, buffer=0) 
	g.groupbox=New groupbox
	
	;Create the panel to make the gadget out of
		g\panel=CreatePanel(x,y,w,h,p)
		g\parent=p
		g\name=name
		g\style=style
	
	;Create the image
	image=CreateImage(w,h) : SetBuffer ImageBuffer(image)
	
	;Draw gadgets with system colors
	ClsColor GetSysColorR(15),GetSysColorG(15),GetSysColorB(15) : Cls 
	
	If style=0 
	Color GetSysColorR(11),GetSysColorG(11),GetSysColorB(11) : rRect 0,4,w-1,h-5,6
	;Not used anymore, not needed just slows down...
	;Color GetSysColorR(5),GetSysColorG(5),GetSysColorB(5) : rRect 1,5,w-3,h-7,5
	EndIf
	
	If style=1
	Color GetSysColorR(16),GetSysColorG(16),GetSysColorB(16) : Rect 0,4,w,h-5,0
	EndIf
	
	font=LoadFont("MS Sans Serif",8) : SetFont(font)
	Viewport 13,0,StringWidth(name)+6,FontHeight()
	Cls
	If style=0 Then Color 0,70,213 
	If style=1 Then Color GetSysColorR(8),GetSysColorG(8),GetSysColorB(8)
	Text(16,0,name)
	
	; Save image and set it as panel image
	SaveImage(image,"tempGB.bmp")
	SetPanelImage(g\panel,"tempGB.bmp")
	DeleteFile("tempGB.bmp")
	
	;Reset the buffer
	If buffer<>0 Then SetBuffer buffer
	
Return g\panel
End Function



Function FreeGroupBox(pan) 
For g.groupbox=Each groupbox
	If g\panel=pan Then FreeGadget g\panel : Delete g.groupbox
Next
End Function



Function ResizeGroupBox(han)
g.groupbox=Object.groupbox(han)
w=GadgetWidth(g\panel)
h=GadgetHeight(g\panel)

	;Create the image
	image=CreateImage(w,h) : SetBuffer ImageBuffer(image)
	
	;Draw gadgets with system colors
	ClsColor GetSysColorR(15),GetSysColorG(15),GetSysColorB(15) : Cls 
	
	If g\style=0 
	Color GetSysColorR(11),GetSysColorG(11),GetSysColorB(11) : rRect 0,4,w-1,h-5,6
	;Not used anymore, not needed just slows down...
	;Color GetSysColorR(5),GetSysColorG(5),GetSysColorB(5) : rRect 1,5,w-3,h-7,5
	EndIf
	
	If g\style=1
	Color GetSysColorR(16),GetSysColorG(16),GetSysColorB(16) : Rect 0,4,w,h-5,0
	EndIf
	
	font=LoadFont("MS Sans Serif",8) : SetFont(font)
	Viewport 13,0,StringWidth(g\name)+6,FontHeight()
	Cls
	If g\style=0 Then Color 0,70,213 
	If g\style=1 Then Color GetSysColorR(8),GetSysColorG(8),GetSysColorB(8)
	Text(16,0,g\name)
	
	; Save image and set it as panel image
	SaveImage(image,"tempGB.bmp")
	SetPanelImage(g\panel,"tempGB.bmp")
	DeleteFile("tempGB.bmp")
	
End Function


;--------------------------------------------------------------------
;		Rounded Rectangle CODE
;	  Thanks to Stephen C. Demuth for this!
; -------------------------------------------------------------------
Function RRect(x,y,width,height,radius=5)

	If radius > width/2 Then radius = width/2
	If radius > height/2 Then radius = height/2

	;---DRAW BORDERS
	Line x+radius,y,x+width-radius,y			   ;Top
	Line x+radius,y+height,x+width-radius,y+height ;Bottom	
	Line x,y+radius,x,y+height-radius			   ;Left
	Line x+width,y+radius,x+width,y+height-radius  ;Right	


	;---DRAW CORNERS

	;Upper Left
	For deg = 90 To 180
		yp = Sin(deg) * radius * -1 + y + radius
		xp = Cos(deg) * radius + x + radius		
		Plot xp,yp
	Next

	;Lower Left
	For deg = 180 To 270
		yp = Sin(deg) * radius * -1 + y + height - radius
		xp = Cos(deg) * radius + x + radius		
		Plot xp,yp
	Next

	;Upper Right
	For deg = 0 To 90
		yp = Sin(deg) * radius * -1 + y + radius
		xp = Cos(deg) * radius + x + width - radius		
		Plot xp,yp
	Next

	;Lower Right
	For deg = 270 To 359
		yp = Sin(deg) * radius * -1 + y + height - radius
		xp = Cos(deg) * radius + x + width - radius		
		Plot xp,yp
	Next

End Function


;--------------------------------------------------------------------
;		System Colour code
;	  I cant remember who made it but credit to him anyway!
; -------------------------------------------------------------------
Function GetSysColorR(SystemColor)
        Return (api_GetSysColor(SystemColor) And $000000FF) 
End Function


Function GetSysColorG(SystemColor)
	Return (api_GetSysColor(SystemColor) And $0000FF00) Shr 8
End Function


Function GetSysColorB(SystemColor)
	Return (api_GetSysColor(SystemColor) And $00FF0000) Shr 16 
End Function

Comments

Helios
(Posted 22 years ago)
heres an example....

win=CreateWindow("Group Box test",50,50,400,300,0,2+8+1)
GB1=createGroupBox("Xp Style",5,5,380,120,win)
GB2=createGroupBox("Normal Style",5,140,380,100,win,1)
SetGadgetLayout(gb1,1,2,1,2)
SetGadgetLayout(gb2,1,2,2,2)

Repeat
id=WaitEvent()
UpdateGadgets()
Until id=$803

;--------------------------------------------------------------------
;		THe type!!
;		(C) 2500 TIM lEOANRD
; -------------------------------------------------------------------
Type groupbox
	Field panel
	Field parent
	Field name$
	Field style
End Type


;--------------------------------------------------------------------
;		The Update Code
;		(C) 2500 TIM lEOANRD
;		NOTE: This is used when resizeing and freeing windows
;		      asccociated with it!
; -------------------------------------------------------------------
Function updategadgets()
id=PeekEvent()
ev=EventSource()

;Update Group Boxes
For g.groupbox=Each groupbox
	If id=$802
		resizeGroupbox(Handle(g.groupbox))
	EndIf
	If id=$803 And EventSource()=g\parent Then FreeGroupBox(g\panel)
Next

End Function


;--------------------------------------------------------------------
;		GROUP BOX CODE
;		(C) 2500 TIM lEOANRD
;		NOTE: The buffer parameter is used to set the 
;             current buffer back To the one you were using!
; -------------------------------------------------------------------
Function CreateGroupBox(name$, x, y, w, h, p , style=0, buffer=0) 
	g.groupbox=New groupbox
	
	;Create the panel to make the gadget out of
		g\panel=CreatePanel(x,y,w,h,p)
		g\parent=p
		g\name=name
		g\style=style
	
	;Create the image
	image=CreateImage(w,h) : SetBuffer ImageBuffer(image)
	
	;Draw gadgets with system colors
	ClsColor GetSysColorR(15),GetSysColorG(15),GetSysColorB(15) : Cls 
	
	If style=0 
	Color GetSysColorR(11),GetSysColorG(11),GetSysColorB(11) : rRect 0,4,w-1,h-5,6
	;Not used anymore, not needed just slows down...
	;Color GetSysColorR(5),GetSysColorG(5),GetSysColorB(5) : rRect 1,5,w-3,h-7,5
	EndIf
	
	If style=1
	Color GetSysColorR(16),GetSysColorG(16),GetSysColorB(16) : Rect 0,4,w,h-5,0
	EndIf
	
	font=LoadFont("MS Sans Serif",8) : SetFont(font)
	Viewport 13,0,StringWidth(name)+6,FontHeight()
	Cls
	If style=0 Then Color 0,70,213 
	If style=1 Then Color GetSysColorR(8),GetSysColorG(8),GetSysColorB(8)
	Text(16,0,name)
	
	; Save image and set it as panel image
	SaveImage(image,"tempGB.bmp")
	SetPanelImage(g\panel,"tempGB.bmp")
	DeleteFile("tempGB.bmp")
	
	;Reset the buffer
	If buffer<>0 Then SetBuffer buffer
	
Return g\panel
End Function



Function FreeGroupBox(pan) 
For g.groupbox=Each groupbox
	If g\panel=pan Then FreeGadget g\panel : Delete g.groupbox
Next
End Function



Function ResizeGroupBox(han)
g.groupbox=Object.groupbox(han)
w=GadgetWidth(g\panel)
h=GadgetHeight(g\panel)

	;Create the image
	image=CreateImage(w,h) : SetBuffer ImageBuffer(image)
	
	;Draw gadgets with system colors
	ClsColor GetSysColorR(15),GetSysColorG(15),GetSysColorB(15) : Cls 
	
	If g\style=0 
	Color GetSysColorR(11),GetSysColorG(11),GetSysColorB(11) : rRect 0,4,w-1,h-5,6
	;Not used anymore, not needed just slows down...
	;Color GetSysColorR(5),GetSysColorG(5),GetSysColorB(5) : rRect 1,5,w-3,h-7,5
	EndIf
	
	If g\style=1
	Color GetSysColorR(16),GetSysColorG(16),GetSysColorB(16) : Rect 0,4,w,h-5,0
	EndIf
	
	font=LoadFont("MS Sans Serif",8) : SetFont(font)
	Viewport 13,0,StringWidth(g\name)+6,FontHeight()
	Cls
	If g\style=0 Then Color 0,70,213 
	If g\style=1 Then Color GetSysColorR(8),GetSysColorG(8),GetSysColorB(8)
	Text(16,0,g\name)
	
	; Save image and set it as panel image
	SaveImage(image,"tempGB.bmp")
	SetPanelImage(g\panel,"tempGB.bmp")
	DeleteFile("tempGB.bmp")
	
End Function


;--------------------------------------------------------------------
;		Rounded Rectangle CODE
;	  Thanks to Stephen C. Demuth for this!
; -------------------------------------------------------------------
Function RRect(x,y,width,height,radius=5)

	If radius > width/2 Then radius = width/2
	If radius > height/2 Then radius = height/2

	;---DRAW BORDERS
	Line x+radius,y,x+width-radius,y			   ;Top
	Line x+radius,y+height,x+width-radius,y+height ;Bottom	
	Line x,y+radius,x,y+height-radius			   ;Left
	Line x+width,y+radius,x+width,y+height-radius  ;Right	


	;---DRAW CORNERS

	;Upper Left
	For deg = 90 To 180
		yp = Sin(deg) * radius * -1 + y + radius
		xp = Cos(deg) * radius + x + radius		
		Plot xp,yp
	Next

	;Lower Left
	For deg = 180 To 270
		yp = Sin(deg) * radius * -1 + y + height - radius
		xp = Cos(deg) * radius + x + radius		
		Plot xp,yp
	Next

	;Upper Right
	For deg = 0 To 90
		yp = Sin(deg) * radius * -1 + y + radius
		xp = Cos(deg) * radius + x + width - radius		
		Plot xp,yp
	Next

	;Lower Right
	For deg = 270 To 359
		yp = Sin(deg) * radius * -1 + y + height - radius
		xp = Cos(deg) * radius + x + width - radius		
		Plot xp,yp
	Next

End Function


;--------------------------------------------------------------------
;		System Colour code
;	  I cant remember who made it but credit to him anyway!
; -------------------------------------------------------------------
Function GetSysColorR(SystemColor)
        Return (api_GetSysColor(SystemColor) And $000000FF) 
End Function


Function GetSysColorG(SystemColor)
	Return (api_GetSysColor(SystemColor) And $0000FF00) Shr 8
End Function


Function GetSysColorB(SystemColor)
	Return (api_GetSysColor(SystemColor) And $00FF0000) Shr 16 
End Function


Phoenix
(Posted 22 years ago)
It's veeeery slow, though it looks good.

Code Archives Forum