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