PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

[MODULE] Gadgets beschriften Version 2

https://www.purebasic.fr/german/viewtopic.php?t=32820

Seite 1 von 1

[MODULE] Gadgets beschriften Version 2

Verfasst: 08.11.2022 22:56
von PureUser1966
Hab meinen Sourcecode nochmals aufgegriffen und um vertikale Gadgetbeschriftungen (siehe Beispiel) erweitert und ein Modul draus gemacht.
LG aus Köln

Danke an hjbremer für das in Erinnerung bringen. Hatte meinen alten Source fast wieder vergessen...

Code: Alles auswählen

; GadgetLabel.pb - WB 2021/2022


DeclareModule GadgetLabel
	
	EnableExplicit					; the magic one
	
	Enumeration
		#GC_TOPLEFT = 1
		#GC_TOPRIGHT
		#GC_TOPCENTER
		#GC_BOTTOMLEFT
		#GC_BOTTOMRIGHT
		#GC_BOTTOMCENTER
		#GC_RIGHTTOP
		#GC_RIGHTBOTTOM
		#GC_RIGHTCENTER
		#GC_LEFTTOP
		#GC_LEFTBOTTOM
		#GC_LEFTCENTER
		#GC_LEFTVERTICALUP			; new 07.11.2022
		#GC_LEFTVERTICALDOWN			; new 07.11.2022
		#GC_RIGHTVERTICALUP			; new 07.11.2022
		#GC_RIGHTVERTICALDOWN			; new 07.11.2022
		#GC_END
	EndEnumeration

	Declare.i SetGadgetLabel(iParentGadget.i, sText.s, iFColor.i, iBColor.i, iXAdd.i, iYAdd.i, iMode.i = #GC_TOPLEFT, sFontName.s = "Consolas", iFontSize.i = 14)
	Declare FreeGadgetLabel(iCanvasID.i)

	Global.i iErrCode = 0

EndDeclareModule

Module GadgetLabel

	; -------------------------------------------------------------------------------------------------
	; GadgetLabel - WB - 14.08.2021
	; last bits: 21.08.2021
	; last bits: 07.11.2022
	;
	; -------------------------------------------------------------------------------------------------
	; Parameter:
	;  iParentgadget	- parent gadget to create comment for
	;  sText:		- text
	;  iFColor		- textcolor
	;  iBColor		- background color (pixel based)
	;  iXAdd		- xpos alignment (pixel based)
	;  iYAdd		- ypos alignement
	;  iMode		- position of comment text
	;  sFontname		- fontname
	;  iFontSize		- fontsize
	;
	; -------------------------------------------------------------------------------------------------
	; returns:		Gibt bei Erfolg einen Wert ungleich Null zurück (gadget nummer des generierten gadgets),
	;			oder Null bei einem Fehler.
	; -------------------------------------------------------------------------------------------------

	Procedure.i SetGadgetLabel(iParentGadget.i, sText.s, iFColor.i, iBColor.i, iXAdd.i, iYAdd.i, iMode.i = #GC_TOPLEFT, sFontName.s = "Consolas", iFontSize.i = 14)

		Protected.i iResult = 0
		Protected.i iFontID = 0
		Protected.i iCanvasID = 0
		Protected.i iTextWidth = 0
		Protected.i iTextHeight = 0
		Protected.i iXPos = 0
		Protected.i iYPos = 0

		; Simple Error checking -------------------------------------------------------------------
		If IsGadget(iParentGadget) = 0
			iErrCode = 1 ; no proper initialized parent gadget
		EndIf
		If Trim(sText) = ""
			iErrCode = 2 ; no text found
		EndIf
		ifontID = LoadFont(#PB_Any, sFontName, iFontSize, #PB_Font_HighQuality)
		If ifontID = 0
			iErrCode = 3
		EndIf
		If iMode >= #GC_END Or iMode < #GC_TOPLEFT
			iErrCode = 4 ; illegal position value (iPos)
		EndIf

		If iErrCode <> 0
			Debug "GadgetLabel error code: " + Str(iErrCode)
			ProcedureReturn 0
		EndIf
		; -----------------------------------------------------------------------------------------

		iCanvasID = CanvasGadget(#PB_Any, 1, 1, 1, 1)
		If iCanvasID = 0
			iErrCode = 5
			Debug "GadgetLabel error code: " + Str(iErrCode)
			ProcedureReturn 0
		EndIf

		; create dummy vector canvas gadget to get proper width & height of text
		If StartVectorDrawing(CanvasVectorOutput(iCanvasID))
			VectorFont(FontID(iFontID), iFontSize)
			Select iMode
				; vertical text
				Case #GC_LEFTVERTICALUP, #GC_LEFTVERTICALDOWN, #GC_RIGHTVERTICALUP, #GC_RIGHTVERTICALDOWN
					iTextWidth = VectorTextHeight(sText)	; width = height
					iTextHeight = VectorTextWidth(sText)	; hight = width
				; normal text	
				Default
					iTextWidth = VectorTextWidth(sText)
					iTextHeight = VectorTextHeight(sText)
			EndSelect
			StopVectorDrawing()
			FreeGadget(iCanvasID)
		EndIf

		iCanvasID = CanvasGadget(#PB_Any, 10, 10, iTextWidth, iTextHeight)
		If iCanvasID = 0
			iErrCode = 6
			Debug "GadgetLabel error code: " + Str(iErrCode)
			ProcedureReturn 0
		EndIf

		HideGadget(iCanvasID, 1)
		If StartVectorDrawing(CanvasVectorOutput(iCanvasID))
			VectorFont(FontID(iFontID), iFontSize)
			AddPathBox(0, 0, iTextWidth, iTextHeight)
			VectorSourceColor($ff << 24 + iBColor)
			FillPath()
			ResetPath()	; sets cursor also to 0,0
			VectorSourceColor($ff << 24 + iFColor)
			Select iMode
				Case #GC_LEFTVERTICALUP, #GC_RIGHTVERTICALUP
					MovePathCursor(0, iTextHeight)
			 		RotateCoordinates(0, iTextHeight, -90)
				Case #GC_LEFTVERTICALDOWN, #GC_RIGHTVERTICALDOWN
					MovePathCursor(iTextWidth, 0)
			 		RotateCoordinates(iTextWidth, iTextHeight, 90)
			EndSelect
			DrawVectorText(sText)
			StopVectorDrawing()
		Else
			iErrCode = 7
			Debug "GadgetLabel error code: " + Str(iErrCode)
			ProcedureReturn 0
		EndIf

		; Set canvas gadget positions
		Select iMode
			Case #GC_TOPLEFT
				iXPos = GadgetX(iParentGadget)
				iYPos = GadgetY(iParentGadget) - GadgetHeight(iCanvasID)
			Case #GC_TOPRIGHT
				iXPos = GadgetX(iParentGadget) + GadgetWidth(iParentGadget) - GadgetWidth(iCanvasID)
				iYPos = GadgetY(iParentGadget) - GadgetHeight(iCanvasID)
			Case #GC_TOPCENTER
				iXPos = GadgetX(iParentGadget) + (GadgetWidth(iParentGadget) / 2) - (GadgetWidth(iCanvasID) / 2)
				iYPos = GadgetY(iParentGadget) - GadgetHeight(iCanvasID)
			Case #GC_BOTTOMLEFT
				iXPos = GadgetX(iParentGadget)
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget)
			Case #GC_BOTTOMRIGHT
				iXPos = GadgetX(iParentGadget) + GadgetWidth(iParentGadget) - GadgetWidth(iCanvasID)
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget)
			Case #GC_BOTTOMCENTER
				iXPos = GadgetX(iParentGadget) + (GadgetWidth(iParentGadget) / 2) - (GadgetWidth(iCanvasID) / 2)
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget)
			Case #GC_RIGHTTOP
				iXPos = GadgetX(iParentGadget) + (GadgetWidth(iParentGadget))
				iYPos = GadgetY(iParentGadget)
			Case #GC_RIGHTBOTTOM
				iXPos = GadgetX(iParentGadget) + (GadgetWidth(iParentGadget))
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget) - GadgetHeight(iCanvasID)
			Case #GC_RIGHTCENTER
				iXPos = GadgetX(iParentGadget) + GadgetWidth(iParentGadget)
				iYPos = GadgetY(iParentGadget) + (GadgetHeight(iParentGadget) / 2) - (GadgetHeight(iCanvasID) / 2)
			Case #GC_LEFTTOP
				iXPos = GadgetX(iParentGadget) - (GadgetWidth(iCanvasID))
				iYPos = GadgetY(iParentGadget)
			Case #GC_LEFTBOTTOM
				iXPos = GadgetX(iParentGadget) - (GadgetWidth(iCanvasID))
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget) - GadgetHeight(iCanvasID)
			Case #GC_LEFTCENTER
				iXPos = GadgetX(iParentGadget) - (GadgetWidth(iCanvasID))
				iYPos = GadgetY(iParentGadget) + (GadgetHeight(iParentGadget) / 2) - (GadgetHeight(iCanvasID) / 2)
			Case	#GC_LEFTVERTICALUP
				iXPos = GadgetX(iParentGadget) - GadgetWidth(iCanvasID) 
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget) - GadgetHeight(iCanvasID)
			Case	#GC_LEFTVERTICALDOWN
				iXPos = GadgetX(iParentGadget) - GadgetWidth(iCanvasID) 
				iYPos = GadgetY(iParentGadget)
			Case	#GC_RIGHTVERTICALUP
				iXPos = GadgetX(iParentGadget) + GadgetWidth(iParentGadget) 
				iYPos = GadgetY(iParentGadget) + GadgetHeight(iParentGadget) - GadgetHeight(iCanvasID)
			Case	#GC_RIGHTVERTICALDOWN
				iXPos = GadgetX(iParentGadget) + GadgetWidth(iParentGadget) 
				iYPos = GadgetY(iParentGadget)
		EndSelect

		; -----------------------------------------------------------------------------------------
		; x&y user corrections if set
		iXPos + iXAdd
		iYPos + iYAdd
		; set new x & y position of gadget
		ResizeGadget(iCanvasID, iXPos, iYPos, #PB_Ignore, #PB_Ignore) ; set new gadget to its position
		FreeFont(iFontID) ; free font
		HideGadget(iCanvasID, 0)
		ProcedureReturn iCanvasID

	EndProcedure


	Procedure FreeGadgetLabel(iCanvasID.i)

		If IsGadget(iCanvasID)
			FreeGadget(iCanvasID)
		EndIf

	EndProcedure

EndModule


; -----------------------------------------------------------------------------------------
; Sandbox
EnableExplicit


Global.i iMW_Event = 0
Global.i iMW_Quit = 0

Global.i iMyFontID1 = 0
Global.i iMyGadget = 0
Global.i iMyGadget2 = 0

UseModule GadgetLabel

If OpenWindow(1, 100, 200, 1024, 768, "GadgetLabel test", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
	SetWindowColor(1, #Gray)

	; Create Default Font
	iMyFontID1 = LoadFont(#PB_Any, "Consolas", 14)
	If IsFont(iMyFontID1)
		SetGadgetFont(#PB_Default, FontID(iMyFontID1))
	EndIf
	; Create Demo Gadgets

	iMyGadget = 10
	TextGadget(iMyGadget, 200, 100, 600, 150, "Textgadget")
	SetGadgetLabel(iMyGadget, "TopLeft", #Yellow, GetWindowColor(1), 0, 0, #GC_TOPLEFT, "Consolas", 8)
	SetGadgetLabel(iMyGadget, "TopRight", #Yellow, GetWindowColor(1), 0, 0, #GC_TOPRIGHT, "Consolas", 24)
	SetGadgetLabel(iMyGadget, "TopCenter", #Yellow, GetWindowColor(1), 0, 0, #GC_TOPCENTER)
	SetGadgetLabel(iMyGadget, "BottomLeft", #Blue, GetWindowColor(1), 0, 0, #GC_BOTTOMLEFT)
	SetGadgetLabel(iMyGadget, "BottomRight", #Blue, GetWindowColor(1), 0, 0, #GC_BOTTOMRIGHT)
	SetGadgetLabel(iMyGadget, "BottomCenter", #Blue, GetWindowColor(1), 0, 0, #GC_BOTTOMCENTER, "Arial", 18)
	SetGadgetLabel(iMyGadget, "RightTop", #White, GetWindowColor(1), 2, 0, #GC_RIGHTTOP)
	SetGadgetLabel(iMyGadget, "RightBottom", #White, GetWindowColor(1), 2, 0, #GC_RIGHTBOTTOM)
	SetGadgetLabel(iMyGadget, "RightCenter", #Black, #Red, 2, 0, #GC_RIGHTCENTER)
	SetGadgetLabel(iMyGadget, "LeftTop", #Black, GetWindowColor(1), -2, 0, #GC_LEFTTOP, "Consolas", 12)
	SetGadgetLabel(iMyGadget, "LeftBottom", #Black, GetWindowColor(1), -2, 0, #GC_LEFTBOTTOM)
	SetGadgetLabel(iMyGadget, "LeftCenter", #Black, #Green, -2, 0, #GC_LEFTCENTER)

	iMyGadget = 11
	EditorGadget(iMyGadget, 100, 300, 800, 200)
	SetGadgetText(iMyGadget, "The quick brown fox jumps over the lazy dog!")
	SetGadgetLabel(iMyGadget, "Editorgadget", #Blue, GetWindowColor(1), 0, 0, #GC_TOPLEFT)
	SetGadgetLabel(iMyGadget, "  SizeOf: " + Len(GetGadgetText(11)), #Black, GetWindowColor(1), 0, 0, #GC_BOTTOMRIGHT)
	SetGadgetLabel(iMyGadget, "LeftuP", #Black, GetWindowColor(1), -1, 0, #GC_LEFTVERTICALUP, "Consolas", 18)
	SetGadgetLabel(iMyGadget, "LeftDown", #Blue, GetWindowColor(1), 0, 0, #GC_LEFTVERTICALDOWN, "Consolas", 20)
	SetGadgetLabel(iMyGadget, "RightUp", #Black, GetWindowColor(1), 0, 0, #GC_RIGHTVERTICALUP, "Consolas", 44)
	SetGadgetLabel(iMyGadget, "RightDown", #Blue, GetWindowColor(1), 0, 0, #GC_RIGHTVERTICALDOWN, "Consolas", 14)

	Repeat
		iMW_Event = WaitWindowEvent()
		Select iMW_Event
			Case #PB_Event_Gadget
				Select EventGadget()
					Case 11
						Select EventType()
							Case #PB_EventType_Change
								SetGadgetLabel(iMyGadget, "  SizeOf: " + Len(GetGadgetText(11)), #Black, GetWindowColor(1), 0, 0, #GC_BOTTOMRIGHT)
						EndSelect
				EndSelect
			Case #PB_Event_CloseWindow ; If the user has pressed on the close button
				iMW_Quit = 1
		EndSelect
	Until iMW_Quit = 1
	End
EndIf

Bild
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de