TextGadget erstellen, Position berechnen, Größe, ev. Farbe usw
Dieses Modul vereinfacht dies, indem es mit 5 Flags den Infotext positioniert.
Als WriteText.pbi speichern und mit XIncludeFile "WriteText.pbi" einbinden oder solo ausprobieren
Update: #goLeft + #goRight ohne Align Parameter, jetzt automatisch #goCenter
Update: mehrzeilig
Update: Font auf Default zurücksetzen
Code: Alles auswählen
;- Gadgets beschriften by HJBremer V.1.31 Nov 2022 - Windows 10 - PB ab 5.70 all
;Text kann rund um ein Gadget positioniert werden, auch mehrzeilig ausgerichtet
;
;WriteText(text$, parent, position=#goTop, align=#goLeft, gap=2, flag=0)
; parent = pbnr des Gadgets welches beschriftet wird
; position = flag bestimmt wo der Text hin soll, flags gelten auch für align, siehe DeclareModule
; align = flag bestimmt wo Text an welcher Stelle der Position steht
; gap = Abstand zum Parentgadget, Vorgabe ist 2 Pixel Abstand zum Gadget
; flag = Ausrichtung für mehrzeiligen Text, #PB_Text_Right ..Center, Left ist Standard
; unter Windows kann man #WS_BORDER als flag für Testzwecke angeben
; Standarvorgabe ist #goTop, #goLeft, Abstand 2 Pixel zum Gadget
; wenn Position #goLeft oder #goRight, Vorgabe align=#goLeft wird intern zu #goCenter
;Beispiele
; WriteText("Bananen", pbnr) ;über dem Gadget links
; WriteText("Eingabe", pbnr, #goLeft) ;links vom Gadget mittig
; WriteText("Eingabe", pbnr, #goRight, #goTop) ;rechts vom Gadget oben
; WriteText("Eingabe", pbnr, #goRight, #goBottom, 3) ;rechts vom Gadget unten Abstand 3
; WriteText("Eingabe", pbnr, #goRight, #goBottom, 3) ;rechts vom Gadget unten Abstand 3
; WriteText("Eingabe", pbnr, #goBottom, #goCenter, 3) ;unter dem Gadget mittig Abstand 3
; WriteText("Eingabe"+#LF$+"Euro"+#LF$+"Cola", pbnr) ;mehrzeilig oben links
;
; WriteText(~"Stücke\ngelb\ngelblich\ngelb", pbnr) ;~ + \n als Escapezeichen für #LF$
; WriteText(~"Stücke\ngelb\ngelblich\ngelb", pbnr, #goLeft, #goCenter, 2, #PB_Text_Right)
;WriteTextColor(flag, value) ;ändert für ALLE folgenden WriteText() den Font oder Farben
;
; WriteTextColor(#PB_All, fontid) ;#PB_Any kann auch benutzt werden
; WriteTextColor(#PB_All, #PB_Default) ;Font zurück auf internen DefaultFont
; WriteTextColor(#PB_Gadget_BackColor, color) ;Color ändern
; WriteTextColor(#PB_Gadget_FrontColor, color) ;Color ändern
DeclareModule WriteText
#goTop = 16
#goLeft = 1
#goRight = 2
#goBottom = 128
#goCenter = $100000
Declare.i WriteTextColor(flag, value) ;für WriteText, Font oder Color ändert sich ab Aufruf
Declare.i WriteText(text$, parent, position=#goTop, align=#goLeft, gap=2, flag=0) ;gap = Abstand
EndDeclareModule
;-
Module WriteText
EnableExplicit
Global backcolor = 0
Global frontcolor = #Blue
Global sizeimage = CreateImage(#PB_Any, 1, 1) ;für GadgetSize, FreeImage durch PB bei Progende
Global textfontid = FontID(LoadFont(#PB_Any, "Arial", 9)) ;oder GetGadgetFont(#PB_Default) ist kleiner
Global defaultfont = textfontid ;um Font auf Default zurück zusetzen
;- intern
Procedure.i SetGadgetSize(pbnr, txt$)
Protected j, k, w, h, z = CountString(txt$, #LF$) ;z = Anzahl LF, wenn > 0 dann mehrzeilig
StartDrawing(ImageOutput(sizeimage))
DrawingFont(textfontid)
w = TextWidth(StringField(txt$, 1, #LF$)) ;Breite vom 1.String, auch wenn LF nicht vorhanden
For j = 1 To z ;wenn z = 0 wird For Next nicht ausgeführt
k = TextWidth(StringField(txt$, j+1, #LF$)) ;wenn For Next dann k = breite vom nächsten String
If k > w : w = k: EndIf ;wenn k > w wird w geändert
Next ;usw
h = TextHeight(txt$): h + (h * z) ;h + Anzahl Zeilen
StopDrawing()
ResizeGadget(pbnr, #PB_Ignore, #PB_Ignore, w+2, h+1) ;+2 bzw. + 1 wegen Schönheit oder so
EndProcedure
; Procedure.i oldSetGadgetSize(pbnr, txt$) ;alte Proc für einzeilig
; StartDrawing(ImageOutput(sizeimage))
; DrawingFont(textfontid)
; Protected w = TextWidth(txt$)
; Protected h = TextHeight(txt$)
; StopDrawing()
; ResizeGadget(pbnr, #PB_Ignore, #PB_Ignore, w+2, h+0)
; EndProcedure
;-extern
Procedure.i WriteTextColor(flag, value)
Select flag
Case #PB_All: textfontid = value ;value = FontID übergeben
If value = #PB_Default: textfontid = defaultfont: EndIf
Case #PB_Gadget_BackColor: backcolor = value
Case #PB_Gadget_FrontColor: frontcolor = value
EndSelect
EndProcedure
Procedure.i WriteText(text$, parent, position=#goTop, align=#goLeft, gap=2, flag=0)
If IsGadget(parent) = 0: Debug "kein Gadget": ProcedureReturn 0: EndIf
Protected pbnr = TextGadget(#PB_Any, 0, 0, 0, 0, text$, flag)
SetGadgetFont(pbnr, textfontid) ;textfontid + colors sind global
SetGadgetSize(pbnr, text$)
SetGadgetColor(pbnr, #PB_Gadget_FrontColor, frontcolor)
If backcolor: SetGadgetColor(pbnr, #PB_Gadget_BackColor, backcolor): EndIf
Protected x, y, w = GadgetWidth(pbnr), h = GadgetHeight(pbnr) ;TextGadget Werte
Protected px = GadgetX(parent), py = GadgetY(parent) ;Parent Werte
Protected pw = GadgetWidth(parent), ph = GadgetHeight(parent)
Select position ;wohin soll der Text ?
Case #goTop: y = py - h - gap ;y über dem Parent
Case #goLeft: x = px - w - gap ;x links vom Parent
Case #goRight: x = px + pw + gap ;x rechts vom Parent
Case #goBottom: y = py + ph + gap ;y unter dem Parent
Case #goCenter: Debug "#goCenter für posi verboten"
Default: Debug "unbekanntes Flag für position"
EndSelect
;Vorgabe align anpassen an position
If position = #goLeft And align = #goLeft: align = #goCenter: EndIf
If position = #goRight And align = #goLeft: align = #goCenter: EndIf
Select align ;Ausrichtung
Case #goTop
Select position
Case #goLeft, #goRight: y = py
Default: Debug "Kombination posi/align falsch"
EndSelect
Case #goLeft
Select position
Case #goTop, #goBottom: x = px
Default: Debug "Kombination posi/align falsch"
EndSelect
Case #goRight
Select position
Case #goTop, #goBottom: x = px + pw - w
Default: Debug "Kombination posi/align falsch"
EndSelect
Case #goBottom:
Select position
Case #goLeft, #goRight: y = py + ph - h
Default: Debug "Kombination posi/align falsch"
EndSelect
Case #goCenter:
Select position
Case #goTop, #goBottom: x = px + ((pw - w)/2)
Case #goLeft, #goRight: y = py + ((ph - h)/2)
Case #goCenter: Debug "Kombination posi/align falsch"
EndSelect
Default: Debug "unbekanntes Flag für align"
EndSelect
ResizeGadget(pbnr, x, y, w, h)
ProcedureReturn pbnr
EndProcedure
EndModule
UseModule WriteText
;===================
CompilerIf #PB_Compiler_IsMainFile
LoadFont(12, "Calibri", 22)
OpenWindow(0, 0, 0, 650, 360, "TextGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TextGadget(4, 100, 100, 400, 50, "Gadget Beschriftung", #PB_Text_Center | #PB_Text_Border)
SetGadgetFont(4, FontID(12))
WriteText("Mayonese", 4) ;#goTop + #goLeft sind Vorgabe
WriteText("Bremer", 4, #goTop, #goRight)
WriteText("ganz ganz viel Kirschen", 4, #goTop, #goCenter, 20)
WriteText("sehr große Kartoffeln", 4, #goTop, #goCenter)
WriteText("Äpfel", 4, #goLeft, #goTop)
WriteText("Kohl", 4, #goLeft, #goCenter)
WriteText("Bananen", 4, #goLeft, #goBottom)
WriteTextColor(#PB_Gadget_FrontColor, #Red) ;ab hier andere Farbe
WriteText("Erdbeeren", 4, #goRight, #goTop)
WriteText("Euro", 4, #goRight, #goCenter)
WriteText("Kartoffeln", 4, #goRight, #goBottom)
WriteTextColor(#PB_Gadget_FrontColor, #Gray) ;ab hier andere Farbe
WriteTextColor(#PB_All, FontID(12)) ;ab hier anderen Font
WriteText("Kartoffeln", 4, #goBottom, #goCenter)
WriteTextColor(#PB_All, #PB_Default) ;ab hier anderen Font
WriteText("kleine Kartoffeln", 4, #goBottom, #goLeft)
WriteText("sehr riesige Kartoffeln", 4, #goBottom, #goRight)
WriteTextColor(#PB_Gadget_FrontColor, #Black) ;ab hier andere Farbe
StringGadget(5, 100, 250, 60, 20, "10")
WriteText("Eingabe"+#LF$+"Euro"+#LF$+"Cola", 5, #goLeft, #goCenter, 4, #PB_Text_Right)
WriteText(~"Knöpfe\n schwarz \n rot ", 5, #goTop, #goRight, 2, #PB_Text_Center|#WS_BORDER)
WriteText(~"Bananen\ngelb\ngrün", 5, #goRight )
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
CompilerEndIf
