Aber ich habe mir ein neues Tool ausgedacht und werde erstmal die Arbeit an Diesem beenden.
Es ist noch immer Beta und wird es wohl bleiben.
Dennoch für alle zum ausprobieren und als Anregung. Und wer mag zur freien Verwendung.
Code: Alles auswählen
DeclareModule ITextGadget
;HJBremer Windows 10 - ab PB 5.41 x86 + 5.70 x64, Font Consolas - 07.2019 V.3.03 Beta
Declare.i ITextGetIcon(icondat$, iconnr, large=32)
Declare.i ITextAddIcon(idx, imagenr)
Declare.i ITextAddFont(idx, fontnr, name$="", hh=0, flag=0)
Declare.i ITextSetColor(pbnr, typ, color)
Declare.i ITextSetText(pbnr, text$)
Declare.i ITextSetInfo(idx, info$)
Declare.i ITextGetState(pbnr)
Declare.i ITextGadget(pbnr, x, y, br, hh, text$, flag=0, state=0)
;Hinweis: da es mir zu aufwendig ist, mit PB Befehlen auf das Zerstören eines Gadgets zu reagieren
; nehme ich den kleinen Memoryleak in Kauf. Unter Windows wäre es einfach, aber mir egal.
; Fenster zerstöre ich in der Regel nicht, sondern lasse sie via Hide verschwinden.
;eigene Konstanten
#PB_Text_Option = 512 ;Option
#PB_Text_Button = 256 ;Button gleicher Wert wie #SS_Notify
#PB_Text_Toggle = 256 + 32 ;ist inclusive #PB_Text_Button
#PB_Text_Gradient = 64
#PB_Text_EnumColor = #PB_Gadget_GrayTextColor
#PB_Gradient_BackColor = #PB_Gadget_TitleBackColor
#PB_Gradient_FrontColor = #PB_Gadget_TitleFrontColor
;- Info Modul Befehle
;--- ITextGadget(pbnr, x, y, br, hh, text$, flag=0, state=0)
; Aufruf wie ein PB TextGadget auch die ersten 3 Flags sind gleich.
;
; #PB_Text_Border ($20000) = einfacher Rahmen
; #PB_Text_Center (1) = funktioniert nur bei einer Zeile korrekt.
; #PB_Text_Right (2) = funktioniert nur bei einer Zeile korrekt.
; #PB_Text_Button (256) = TextGadget wird zum Button
; #PB_Text_Toggle (256+32) = TextGadget wird zum ToggleButton
; #PB_Text_Option = 512 = TextGadget wird zum OptionGadget
; #PB_Text_Gradient (64) = mit Farbverlauf und bekommt #PB_Text_Border
; #PB_Text_Center + #PB_Text_Right mit {$=xxx} funktioniert nicht korrekt.
; weil der Anfang der Zeile kann in dieser Version nicht berechnet werden.
; wenn #PB_Text_Button wird #PB_Text_Border + #PB_Text_Center gesetzt + der Befehl {z} hinzugefügt.
; wenn #PB_Text_Button dann wird die Textfarbe nur rot, wenn keine Colorbefehle im Text sind !
; Buttons sind optisch größer bei gleichen Gadgetwerten. Bei mir unter Windows 10.
; state ist für #PB_Text_Toggle um den Button beim Start einzuschalten. Gilt nicht für Optiongadgets.
; state wird mit ITextGetState(pbnr) gelesen.
; --------------------------------------------------------
;--- ITextGetIcon(icondat$, iconnr, large=32)
; icondat$ = ICO, DLL oder Exe, large ist 32 oder 16
; iconnr = Nummer des Icons in der Datei, falsche Nr = kein Icon, bei .ICO muß nr=0 sein
; Icons werden in der Proc zerstört. Es wird ein PB Image zurückgegeben.
;--- ITextAddFont(idx, fontnr, name$="", hh=0, flag=0)
; Fonts werden in einem Array verwaltet und mit einem Index versehen
; fontr ist keine ID ! sondern eine PBnr. Fontnr kann Zahl, Variable oder Konstante sein.
; die Fonts werden vorher mit LoadFont geladen.
;
; Wird ein Name angegeben, so wird Font intern geladen, und die PB-Fontnr zurückgegeben.
; Der Font kann anderweitig genutzt werden. Der Parameter fontnr wird dabei ignoriert.
;
; ITextAddFont(1, 1) ;die größte Indexnr bestimmt die Anzahl der akzeptierten Fonts
; ITextAddFont(2, 2) ; in diesem Beispiel sind die Nummern 3-8 unbelegt und für die
; ITextAddFont(9, 4) ; wird der aktuelle Default Font vom Canvasgadget genommen.
;--- ITextAddIcon(idx, imagenr)
; Images (Icons, Bitmaps) werden in einem Array verwaltet und mit einem Index versehen
; wie AddFont nur mit Images, imagenr ist keine ID ! sondern eine PBnr.
; ITextAddIcon(1, imagenr)
; ITextAddIcon(2, imagenr)
; ITextAddIcon(3, imagenr) etc
;--- ITextSetColor(pbnr, typ, color)
; Farbe für 1 Gadget zuweisen oder wenn pbnr = #PB_Default für alle folgenden Gadgets
; $F0F0F0 ist Vorgabe für Background Window/Container, Panel kann andere Farbe haben (White)
; Flags
; #PB_Default ;anstatt pbnr
; #PB_Gadget_BackColor, #PB_Gadget_FrontColor ;Background + Textfarbe
; #PB_Gadget_LineColor ;Rahmen - auch mit {b=1,255}
; #PB_Text_EnumColor ;Enumfarbe
; #PB_Gradient_BackColor, #PB_Gradient_FrontColor ;Gradientfarben
; Wird ITextGadget mit #PB_Text_Button als Button genutzt sind die Gradientfarben für
; #PB_EventType_MouseEnter fix. siehe Global defaultBackGradient2 + defaultFrontGradient2
;--- ITextSetText(pbnr, text$)
; text$ ist ein neuer Text incl. Befehle. Bestehende Befehle werden überschrieben.
; Soll nur ein kleiner Teil des Textes verändert werden soll, kann ITextSetInfo verwendet werden.
; Wird Text eines Button geändert, wird automatisch {b}{z} am Anfang hinzugefügt.
;--- ITextSetInfo(pbnr, info$)
; info$ ist ein neuer Text der einen anderen Text überschreibt und erhalten bleibt (Structurfeld)
; Der zugehörige DrawBefehl ist {$=}. Beim Programmstart schreibt man als Starttext z.B. {$=2018}
; Mit ITextSetInfo(pbnr, "2019") wird der Text geändert sofern das Gadget existiert.
; Jedes Gadget hat einen Infotext in der Structure stehen. Könnte man erweitern mit einem Array.
; Der Befehl ähnelt SetText. Ändert aber nur eine bestimmte Zeichenkette und nicht den Rest.
;Bei allen Set Befehlen gibt es keine Prüfung ob Gadget existiert. Dies ist so gewollt.
; --------------------
;- Info Befehle im Text
; jeder Befehl wird in Klammern gesetzt {...} und gilt ab seiner Position im Text
; ein Befehl besteht aus einem Buchstaben und maximal 3 Werten z.B. x=10 oder i=1,22,24
; kein Wert wird als Null angesehen. Negative Werte teilweise möglich.
; die Reihenfolge der Befehle ist meist egal, aber nicht immer, muß man ausprobieren.
; zu Testzwecken kann auch eine leere {} Klammer stehen bleiben.
; das Zeichen für den Befehl kann Groß/Klein geschrieben werden.
;--- $=Info
; {$} kennzeichnet einen Infotext. {$=Otto} ist z.B. der Starttext.
; Kann geändert werden mit ITextSetInfo(pbnr, info$)
;--- Origin, x + y, Move, Posi
;
; {o=15,12} Origin nach x,y verschieben. Hier von Links 15 und von oben 12 Pixel
; !! Ist ein Wert null wird der bisherige Wert genommen !! Nur x = {o=15}
; {o=0} und {o=0,0} tut nix, da ein ev. vorhandener Rahmen mindestens 1 ist
; Origin in Verbindung mit #PB_Text_Center + #PB_Text_Right ergibt Müll.
; die Vorgabe ist 9,9 und wenn dies gerade bei kleineren Gadgets zu groß
; erscheint dann am Anfang z.B. {o=3,3} setzen.
;
; {x=10} Textposition waagerecht setzen, hier 10 Pixel. Minuswerte erlaubt.
; {y=10} Textposition senkrecht setzen
; Bezugspunkt ist links oben welcher mit SetOrigin auf 9 gesetzt wurde.
; will man nur um ein paar Pixel verschieben geschieht dies mit Move
; man kann auch Origin verschieben, aber das gilt dann für alle folgenden Posis
;
; Move
; {m=5,3} verschiebt aktuelle Drawposition um 5 nach rechts und 3 nach unten.
; Minuswerte erlaubt.
;
; Posi
; {p} speichert aktuelle Drawposition x + y
; {p=1} setzt gespeicherte Drawposition x + y, wenn vorher nicht gespeichert, dann null
; {p=2} setzt gespeicherte Drawposition x + y + Vorschub, spart ein {r}
;--- Return, Spacing
;
; Return
; {r}{r=1} wert = Anzahl Zeilen Vorschub, Minus
; das Zeichen chr(124) = | im Text wird als einfacher Return angesehen.
; das Zeichen #LF$ chr(10) im Text wird als einfacher Return angesehen.
;
; Spacing
; {s=1} zusätzlicher Abstand zwischen den Buchstaben, {s} oder {s=0} beendet dies. Minus erlaubt
;
;--- TAB, Zentrieren vertikal
;
; TAB
; {t}{t=2} ein Tab ist 10 Pixel. {t} oder {t=1} gilt als 1 Tab und springt zum nächsten 10er Wert
; also wenn x=241 ist dann springt {t=1} nach 250 und {t=2} nach 260.
; dieser Befehl kann nicht zu absoluten Posis springen, dafür gibt es {y=}
;
; Zentrieren
; {z} setzt das nächste Zeichen vertikal zentriert. nur sinnvoll bei einzeiligem Text.
; {z=2} korrigiert 2 Pixel nach unten, {z=-2} nach oben
; Hinweis: sollte möglichst immer direkt hinter dem Fontbefehl kommen.
; Beim Button + OptionGadget wird {z} automatisch eingesetzt.
; Probleme: Leerzeichen davor oder danach bei manchen Fonts ergeben Verschiebungen.
;--- Ascii, Enum
;
; Ascii
; {a=22} wert = AsciiNr. dieses Zeichen wird z.B. mit Chr(22) direkt mit DrawText geschrieben.
; damit kann man Sonderzeichen aus verschiedenen Fonts in den Text einfügen.
; Die Fonts sollten gleich groß sein. Mit {g} oder z.B. {g=2} kann man diese auf Linie bringen.
; z.B. "{f=9}{a=223}{f=1}{g}dies ist ein Text"
; {a}{a=0} geht nicht. Minus auch nicht.
;
; Enum
; wert = Typ, jede Aufzählung benötigt den Befehl {e=?}. {e=0} setzt Zähler zurück bei {e=2}bis{e=10}.
; Farbe ist Grau. Ändern mit ITextSetColor(#PB_Default, #PB_Text_EnumColor, color)
; ein guter Unicode Font für Enum und Text ist: "Segoe UI Symbol", 12
;
; {e=1} = » x86
; {e=2} = 1. x86
; {e=3} = nur Unicode
; bis
; {e=10} = nur Unicode
; {e=11} = unbekannter Wert ergibt 3 Punkte ...
;--- Border, Color
;
; Border
; {b}{b=1} wert = Anzahl Linien, erlaubt 1-5, ab 2 wird jede Linie etwas heller
; wenn kein wert, dann Border 1, ebenso wenn beim Erstellen Borderflag angegeben.
; {b=5} sollte nur mit einer dunkleren Farbe benutzt werden, aber nicht zu dunkel.
; Border können von Text überschrieben werden. Zur Sicherheit Border ans Ende vom Text setzen
;
; {b=x,255} man kann zusätzlich eine BorderFarbe angeben hier 255 = rot. {b=x,0} ergibt schwarz
; diese Angabe hat Vorrang vor dem ITextSetColor() Befehl und gilt nur für dieses Gadget.
; nur Zahlen erlaubt. Dezimal + Hex, Konstanten geht nicht.
;
; Color
; {c}{c=#Blue} {c=255} {c=$F0F0F0} wert = Textfarbe, nur PB Konstanten oder Zahlen oder Hexwerte
; kein Wert wie {c} = Schwarz
;--- Font, Ground, Draw-Vertikal
;
; Font
; {f=1} wert = Index der Fontliste, siehe ITextAddFont(idx, fontnr)
; wenn {f} oder {f=0} wird aktueller Defaultfont vom Canvas genommen
;
; Ground
; {g}{g=2}{g=-2} verschiebt den Text zur Basis des linken Zeichens direkt davor.
; ein mit {a=223} eingefügtes Ascii Zeichen zählt nicht !
; das geht auch mit y oder move aber dies ist einfacher.
; Sinn von {g=} ist das Angleichen der Grundline von verschiedenen Fonts.
; manche Fonts machen Probleme. Oft hilft ein Leerzeichen vor {g}
;
; Vertikal
; {v} schreibt die nächsten Zeichen vertikal bis wieder {v} im Text kommt
; kann mit Spacing kombiniert werden. {s=3}{v}Auto{v}{s=0}bahn
;--- Image, Kasten, Line
;
; Image
; {i=1} wert = Index der Imageliste, siehe ITextAddIcon(idx, imagenr)
; Image Position ist an den aktuellen x + y Werten (Drawposition)
; vor dem Image 1 Pixel Abstand, danach 3 Pixel. Leerzeichen im Text auch gut.
;
; {i=1,22} erstellt Kopie vom Image und Resize auf 22 x 22
; {i=1,22,24} erstellt Kopie vom Image und Resize auf angegebene Breite, Höhe.
; wird -1 für Breite angegeben, so ergibt dies Resize auf Gadgetmaße.
;
; Zu große Images können die Wordbreak Schleife ins Endlose schicken, besonders im Fließtext.
; Darum gibt es dort die 'Notbremse'. Warum ? hat Moses auch gefragt.
;
; Kasten
; {k=60,20} zeichnet ab aktuelle Drawposition einen Kasten. z.B. 60 breit 20 hoch.
;
; Line
; {l=50,0} Linie waagerecht hier 50 Pixel ab aktuelle Drawposition
; {l=0,20} Linie senkrecht hier 20 Pixel
; {l=20,20} Linie schräg
; {l=20,20,3} Strichstärke ist immer 1, optional Strichstärke angeben hier 3fach
; {l=20,20,3,255} optional Farbe angeben hier rot, nur Zahlen (Dez+Hex)
;
;--- OptionGadget
;
; {op=1} Das Flag #PB_Text_Option muß gesetzt sein. Der Befehl ordnet ein Gadget einer Gruppe zu.
; Die Gruppen beginnen bei 1 !!! Wieviele Gruppen und wieviele Gadgets pro Gruppe ist egal.
; ITextGetState(pbnr) fragt Status ab 1 oder 0.
; Die Kreise werden aus dem gewählten Font genommen. Die gängigen Fonts wie Arial Courier und Times
; kennen leider bei mir diese Zeichen so nicht. Gut sind Cambria Consolas und Segoe UI Symbol und
; sicher viele andere.
; PS: ist mehr eine Spielerei bis jetzt.
;Hinweise
; Vorsicht Falle: Bei Origin {o=0,0} tut sich nix !!!
; Vorsicht Falle: Bei Zentrieren {z} muß man bei kleineren TextGadgets Origin auf {o=0,1} stellen
;
; !!! Bei Buttons muß mit If EventType() = #PB_EventType_LeftClick gearbeitet werden !!! ist halt ein Canvas.
; sonst gibt es massenweise Events.
EndDeclareModule
;-
Module ITextGadget
Declare.i ITextDraw(pbnr, drawflag = 1)
;- Modul Start
Structure iText
br.i ;Breite Canvas
hh.i ;Höhe
text.s ;Text incl Befehle
info.s ;
flag.i ;Textgadget Flags
state.i
toggle.i
backcolor.i ; Farben
textcolor.i ;
linecolor.i ; Border
enumcolor.i
backgradient.i ;Gradientfarben normal
frontgradient.i
backcolor2.i ;MouseEnter wenn Button
textcolor2.i
backgradient2.i ;Gradientfarben MouseEnter wenn Button
frontgradient2.i
EndStructure
Global Dim fontliste(0)
Global Dim iconliste(0)
Global Dim grpliste$(0)
Global defaultBackColor = $F0F0F0 ;für Windows 10 + Container, Panel ist weiß
Global defaultTextColor = #Black
Global defaultLineColor = $666666 ;Border = grau
Global defaultEnumColor = #Gray
Global defaultBackGradient = #White
Global defaultFrontGradient = #Gray
Global defaultBackColor2 = $FDE6BE ;Windows 10 wenn MouseEnter
Global defaulttextcolor2 = #Red
Global defaultBackGradient2 = $FDE6BE
Global defaultFrontGradient2 = $FDE6BE-$505050
;Global symbolfont = LoadFont(#PB_Any, "Segoe UI Symbol", 11) ;wird nicht gebraucht
#opAus = Chr($25ce) ;$25ce 9743
#opEin = Chr($25c9) ;$25c9 9742
EnableExplicit
Procedure.i ITextGetIcon(icondat$, iconnr, large=32)
;lädt Icons aus einer Datei, gibt PB Image zurück
Protected icon, imgnr, br=32, hh=32
If large = 32
ExtractIconEx_(icondat$, iconnr, @icon, #Null, 1) ;Icon laden 32x32
Else
br=16: hh=16
ExtractIconEx_(icondat$, iconnr, #Null, @icon, 1) ;Icon laden 16x16
EndIf
If icon ;Bitmap erstellen
imgnr = CreateImage(#PB_Any, br, hh, 32, #PB_Image_Transparent)
StartDrawing(ImageOutput(imgnr))
DrawImage(icon, 0, 0)
StopDrawing()
DestroyIcon_(icon)
EndIf
ProcedureReturn imgnr ;dies ist KEINE ID !!!
EndProcedure
Procedure.i ITextAddIcon(idx, imagenr)
If idx > ArraySize(iconliste())
ReDim iconliste(idx)
EndIf
iconliste(idx) = imagenr
EndProcedure
Procedure.i ITextAddFont(idx, fontnr, name$="", hh=0, flag=0)
If idx > ArraySize(fontliste())
ReDim fontliste(idx)
EndIf
If name$ <> ""
fontnr = LoadFont(#PB_Any, name$, hh, flag)
EndIf
fontliste(idx) = fontnr
ProcedureReturn fontnr
EndProcedure
Procedure.i ITextSetColor(pbnr, typ, color)
If pbnr = #PB_Default
If typ = #PB_Gadget_BackColor ;2
defaultBackColor = color
ElseIf typ = #PB_Gadget_FrontColor ;1
defaultTextColor = color
ElseIf typ = #PB_Gadget_LineColor ;3
defaultLineColor = color
ElseIf typ = #PB_Text_EnumColor ;6 Enum Color
defaultEnumColor = color
ElseIf typ = #PB_Gradient_BackColor ;5 nur wenn #PB_Text_Gradient gesetzt
defaultBackGradient = color
ElseIf typ = #PB_Gradient_FrontColor ;4 nur wenn #PB_Text_Gradient gesetzt
defaultFrontGradient = color
EndIf
Else
Protected *ib.iText = GetGadgetData(pbnr)
If typ = #PB_Gadget_BackColor
*ib\backcolor = color
ElseIf typ = #PB_Gadget_FrontColor
*ib\textcolor = color
ElseIf typ = #PB_Gadget_LineColor
*ib\linecolor = color
ElseIf typ = #PB_Text_EnumColor
*ib\enumcolor = color
ElseIf typ = #PB_Gradient_BackColor
*ib\backgradient = color
ElseIf typ = #PB_Gradient_FrontColor
*ib\frontgradient = color
EndIf
ITextDraw(pbnr)
EndIf
EndProcedure
Procedure.i ITextSetText(pbnr, text$)
Protected *ib.iText = GetGadgetData(pbnr)
If *ib\flag & #PB_Text_Button = #PB_Text_Button
text$ = "{b}{z}" + text$
EndIf
*ib\text = text$ ;:Debug text$
ITextDraw(pbnr, 0)
ITextDraw(pbnr, 1)
EndProcedure
Procedure.i ITextSetInfo(pbnr, info$)
Protected *ib.iText = GetGadgetData(pbnr)
*ib\info = info$
ITextDraw(pbnr, 1)
EndProcedure
Procedure.i ITextGetState(pbnr)
Protected *ib.iText = GetGadgetData(pbnr)
ProcedureReturn *ib\state
EndProcedure
;- intern
Procedure.i ITextEvent()
; diese Proc wird nur aufgerufen wenn ITextGadget ein Button / Optiongadget ist
Protected pbnr = EventGadget(), *ib.iText = GetGadgetData(pbnr)
Protected j, k, nr, *o.iText
Static color
Select EventType()
Case #PB_EventType_MouseEnter
color = *ib\linecolor ;Rahmen merken für Leave
*ib\linecolor = $AA6666 ;Rahmen
Swap *ib\textcolor, *ib\textcolor2 ;normal
Swap *ib\backcolor, *ib\backcolor2 ;normal
Swap *ib\backgradient, *ib\backgradient2 ;wenn #PB_Text_Gradient
Swap *ib\frontgradient, *ib\frontgradient2 ;werden 2 Farben gebraucht
ITextDraw(pbnr)
Case #PB_EventType_MouseLeave ;MouseEnter rückgängig
*ib\linecolor = color
Swap *ib\textcolor, *ib\textcolor2 ;normal
Swap *ib\backcolor, *ib\backcolor2 ;normal
Swap *ib\backgradient, *ib\backgradient2 ;wenn #PB_Text_Gradient
Swap *ib\frontgradient, *ib\frontgradient2 ;werden 2 Farben gebraucht
ITextDraw(pbnr)
Case #PB_EventType_LeftButtonDown
*ib\linecolor = $AA6666 ! #White ;wie MouseEnter mit Xor #White
ITextDraw(pbnr)
Case #PB_EventType_LeftButtonUp
*ib\linecolor = $AA6666 ;wie MouseEnter
If *ib\toggle: *ib\state ! 1: EndIf
If *ib\flag & #PB_Text_Option
For j = 1 To ArraySize(grpliste$())
If FindString(grpliste$(j), Str(pbnr)) ;Gadget in Liste gefunden, j ist die Gruppe
;zurücksetzen
For k = 1 To CountString(grpliste$(j), ",") ;in Liste steht z.B. 8,9,10,
nr = Val(StringField(grpliste$(j), k, ",")) ;jede Nr steht für ein Gadget
*o = GetGadgetData(nr) ;Structure holen
If *o\state ;wenn gedrückt
*o\state = 0 ; EIN wird AUS
ReplaceString(*o\text, #opEin, #opAus, #PB_String_InPlace)
ITextDraw(nr)
EndIf
Next
;setzen
*o = GetGadgetData(pbnr)
*o\state = 1
ReplaceString(*o\text, #opAus, #opEin, #PB_String_InPlace)
EndIf
Next
EndIf
ITextDraw(pbnr)
Case #PB_EventType_LeftClick
; kommt nach #PB_EventType_LeftButtonDown + UP
; das aufteilen in Down + Up finde ich schöner
EndSelect
EndProcedure
Procedure.i ITextColor(color)
;Color heller machen
Protected add = 60, max = 255
Protected r = Red(color) + add
Protected g = Green(color) + add
Protected b = Blue(color) + add
If r > max: r = max: EndIf
If g > max: g = max: EndIf
If b > max: b = max: EndIf
ProcedureReturn RGB(r,g,b)
EndProcedure
Procedure.i ITextDraw(pbnr, drawflag = 1)
Protected *ib.iText = GetGadgetData(pbnr)
Protected i, j, x, y, z, x1, y1, x2, y2, px, py, br, hh, nr
Protected char, start, ende, wert, spacing, image, newimg
Protected befehl$, ischar$, iswert$, enumchar$, enum, color, color1, color2
Protected origin_x = 9, origin_y = 9, tabpixel = 10, nextcharwidth, lastbase, lineanz
Protected vflag
Protected fontidnr = GetGadgetFont(#PB_Default)
Protected klammerL = CountString(*ib\text, "{")
Protected klammerR = CountString(*ib\text, "}")
Protected *c.Character = @*ib\text
With *ib
If \flag & #PB_Text_Button
origin_x = 0 : origin_y = 0
EndIf
If \flag & #PB_Text_Option = #PB_Text_Option
origin_x = 9 : origin_y = 0
EndIf
StartDrawing(CanvasOutput(pbnr))
If \flag & #PB_Text_Gradient And \flag & #PB_Text_Border
color1 = \backgradient
color2 = \frontgradient
If \toggle And *ib\state: color1 = #Yellow: color2 = $00A5FF: EndIf ;gelb + orange
DrawingMode(#PB_Text_Gradient)
BackColor(color1) ;colorOben
FrontColor(color2) ;colorUnten
LinearGradient(0, 5, 0, \hh)
Box(1, 1, \br-2, \hh-2)
Else
color1 = \backcolor
If \toggle And *ib\state: color1 = #Yellow: EndIf
Box(0, 0, \br, \hh, color1)
EndIf
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(fontidnr)
FrontColor(\textcolor)
SetOrigin(origin_x, origin_y)
If klammerL = klammerR
While *c\c
char + 1
If *c\c = 10 ; #LF$ wie "r" Return aber nur einmaliger Vorschub
x1 = 0: y1 + TextHeight(Chr(*c\c))
ElseIf *c\c = 124 ; | wie #LF$ Return
x1 = 0: y1 + TextHeight(Chr(*c\c))
ElseIf *c\c = 123 ; {
start = char
ElseIf *c\c = 125 ; }
ende = char
befehl$ = Mid(\text, start+1, ende-start-1) ;Befehl in den Klammern
isChar$ = StringField(befehl$, 1, "=") ;: Debug isChar$
isWert$ = StringField(befehl$, 2, "=")
start = 0 ;wenn null dann Draw nächsten Buchstaben siehe unten im else Teil
Select LCase(isChar$)
;---- x y
Case "x": x1 = Val(isWert$) ;Text waagerecht verschieben
Case "y": y1 = Val(isWert$) ;Text senkrecht verschieben
;---- g - Ground
Case "g"
wert = Val(isWert$)
y1 = lastbase - TextHeight(Chr(*c\c)) + wert
;---- o - Origin
Case "o"
x2 = Val(StringField(isWert$, 1, ","))
y2 = Val(StringField(isWert$, 2, ","))
If x2: origin_x = x2: x1 = 0: EndIf
If y2: origin_y = y2: y1 = 0: EndIf
SetOrigin(origin_x, origin_y)
;---- p - Posi
Case "p"
wert = Val(isWert$)
If wert = 0: px = x1: py = y1: EndIf
If wert = 1: x1 = px: y1 = py: EndIf
If wert = 2: x1 = px: y1 = py: y1 + TextHeight(" "): EndIf
;---- r - Return
Case "r" ;entspricht CrLf
wert = Val(isWert$) ;
If wert = 0: wert = 1: EndIf
x1 = 0: y1 + (TextHeight(Chr(*c\c)) * wert) ;wert = Anzahl Zeilen
;---- s - Spacing
Case "s"
wert = Val(isWert$)
spacing = wert ;zusätzlicher Abstand zwischen den Buchstaben in Pixel
;---- t - Tab
Case "t"
wert = Val(isWert$)
x1 = (x1/tabpixel+1)*tabpixel
If wert > 1
x1 + (tabpixel*(wert-1))
EndIf
;---- v - Draw-Vertikal
Case "v"
If vflag = 0
vflag = 1
Else
vflag = 0
EndIf
;---- z - Zentrieren Vertikal
Case "z"
wert = Val(isWert$)
;y1 = (\hh - TextHeight(Chr(*c\c))) / 2
y1 = (\hh - TextHeight(" ")) / 2 ;geht auch ?!
y1 - origin_y + wert -0
;DrawText(x1, y1, Str(\hh) + " " + Str(TextHeight(Chr(*c\c))), #Black)
;---- e - Enumeration
Case "e"
wert = Val(StringField(isWert$, 1, ","))
enum = Val(StringField(isWert$, 2, ","))
Select wert
Case 0: i = 0
Case 1: enumchar$ = "» "
Case 2: enumchar$ = Str(i+1) + ". " : i+1 ;1. 2. 3. usw.
Case 3: enumchar$ = Chr(enum) + " " ;nur mit Unicode
Case 4: enumchar$ = Chr($2460+i) + " " : i+1 ;nur mit Unicode
Case 5: enumchar$ = Chr($2474+i) + " " : i+1 ;nur mit Unicode
Case 6: enumchar$ = Chr($2488+i) + " " : i+1 ;nur mit Unicode
Case 7: enumchar$ = Chr($249c+i) + " " : i+1 ;nur mit Unicode
Case 8: enumchar$ = Chr($24b6+i) + " " : i+1 ;nur mit Unicode
Case 9: enumchar$ = Chr($24b6+i) + " " : i+1 ;nur mit Unicode
Case 10: enumchar$ = Chr($03b1+i) + " ": i+1 ;nur mit Unicode
Default: enumchar$ = "... "
EndSelect
x1 = 0 : y1 + TextHeight(Chr(*c\c)) ;nach links + 1 Zeile
If wert
DrawText(x1, y1, enumchar$, \enumcolor)
x1 + TextWidth(enumchar$)
EndIf
;---- a - Ascii
Case "a"
wert = Val(isWert$)
If wert > 0
DrawText(x1, y1, Chr(wert))
x1 + TextWidth(Chr(wert))
lastbase = y1 + TextHeight(Chr(*c\c))
EndIf
;---- $ - Info
Case "$"
If \info = ""
DrawText(x1, y1, isWert$)
x1 + TextWidth(isWert$)
Else
DrawText(x1, y1, \info)
x1 + TextWidth(\info)
EndIf
;---- b - Border
Case "b"
SetOrigin(0, 0)
wert = Val(isWert$)
If wert > 5: wert = 5: EndIf
If wert = 0: wert = 1: EndIf
color = *ib\linecolor
If StringField(isWert$, 2, ",")
color = Val(StringField(isWert$, 2, ","))
EndIf
For j = 1 To wert
If wert > 1
If j=2: color = ITextColor(color): EndIf
If j=3: color = ITextColor(color): EndIf
If j=4: color = ITextColor(color): EndIf
If j=5: color = $909090: EndIf
EndIf
z = j-1
LineXY(z, z, \br-z, z, color) ;ol - or
LineXY(z, z, z, \hh-z-1, color) ;ol - ul
LineXY(z, \hh-z-1, \br-z-1, \hh-z-1, color) ;ul - ur
LineXY(\br-z-1, z, \br-z-1, \hh-z-1, color) ;or - ur
Next
SetOrigin(origin_x, origin_y)
;---- k - Kasten
Case "k"
x2 = Val(StringField(isWert$, 1, ","))
y2 = Val(StringField(isWert$, 2, ","))
Line(x1, y1, x2, 1) ;waagerecht oben
Line(x1, y1, 1, y2) ;senkrecht links
Line(x1+x2-1, y1, 1, y2) ;senkrecht rechts
Line(x1, y1+y2, x2, 1) ;waagerecht unten
;---- l - Line
Case "l"
x2 = x1 + Val(StringField(isWert$, 1, ","))
y2 = y1 + Val(StringField(isWert$, 2, ","))
lineanz = Val(StringField(isWert$, 3, ","))
color = Val(StringField(isWert$, 4, ","))
If lineanz = 0: lineanz = 1 : EndIf
For j = 1 To lineanz
LineXY(x1, y1+j, x2, y2+j, color)
Next
;---- m - Move
Case "m"
x1 + Val(StringField(isWert$, 1, ","))
y1 + Val(StringField(isWert$, 2, ","))
;---- i - Image
Case "i"
wert = Val(StringField(isWert$, 1, ","))
If wert
If wert > ArraySize(iconliste()): wert = 0: EndIf
image = iconliste(wert)
If IsImage(image)
br = Val(StringField(isWert$, 2, ",")) ;: Debug br
hh = Val(StringField(isWert$, 3, ",")) ;: Debug hh
If br
If hh = 0 : hh = br : EndIf
If br = -1: br = \br - 2: EndIf
If hh = -1: hh = \hh - 2: EndIf
newimg = CopyImage(image, #PB_Any)
ResizeImage(newimg, br, hh)
image = newimg
EndIf
DrawAlphaImage(ImageID(image), x1, y1)
x1 + 1 + ImageWidth(image) + 3
If newimg: FreeImage(newimg): EndIf
EndIf
EndIf
;---- f - Font
Case "f"
wert = Val(isWert$)
If wert > ArraySize(fontliste()): wert = 0: EndIf
If IsFont(fontliste(wert))
fontidnr = FontID(fontliste(wert))
Else
fontidnr = GetGadgetFont(#PB_Default)
If wert = 0
;Debug "Hinweis: Font 0 wurde angegeben in Gadget " + pbnr
Else
;Debug "Hinweis: Font wurde nicht geladen Nr." + wert
EndIf
EndIf
DrawingFont(fontidnr)
;---- c - Color
Case "c"
Select LCase(isWert$)
Case "#red": wert = #Red
Case "#blue": wert = #Blue
Case "#gray": wert = #Gray
Case "#green": wert = #Green
Case "#black": wert = #Black
Case "#white": wert = #White
Case "#yellow": wert = #Yellow
Case "#magenta": wert = #Magenta
Default: wert = Val(isWert$)
EndSelect
FrontColor(wert)
;---- op - OptionGadget
Case "op"
If *ib\flag & #PB_Text_Option = #PB_Text_Option ;wenn OptionGadget
wert = Val(iswert$) ;op=1 ist die Gruppe
If wert > ArraySize(grpliste$()) ;wenn noch nicht gibt
ReDim grpliste$(wert) ;Liste vergrößern
EndIf
If FindString(grpliste$(wert), Str(pbnr) + ",") = 0 ;wenn Gadget nicht
grpliste$(wert) + Str(pbnr) + "," ;in Liste, dann add
EndIf
EndIf
EndSelect
Else
If start = 0
nextcharwidth = TextWidth(Chr(*c\c)) + spacing
If drawflag
DrawText(x1, y1, Chr(*c\c))
lastbase = y1 + TextHeight(Chr(*c\c))
Else ;Wordbreak berechnen und chr(124) als Return einsetzen ohne Draw
If x1 + nextcharwidth + origin_x > \br - 3
;Debug "wird zu groß " + Chr(*c\c): Debug x1: Debug nextcharwidth: Debug \br
Repeat
*c - SizeOf(character) : char - 1
If char < 0 : Break 2 : EndIf ;Notbremse ev. nötig bei zu breiten Images
If *c\c = 0 : Break : EndIf
If *c\c = 32 ;Leer wird
*c\c = 124 ;durch | ersetzt, dies wird als Return ausgewertet
x1 = 0
Break
EndIf
Until *c\c = 32 Or *c\c = 0
EndIf
EndIf
If vflag = 0
x1 + nextcharwidth
Else
y1 + TextHeight(Chr(*c\c)) + spacing
EndIf
EndIf
EndIf
*c + SizeOf(character)
Wend
Else
DrawText(0, 0, "Fehler: Anzahl Klammern ungleich")
EndIf
StopDrawing()
EndWith
;TextgadgetFlags
If drawflag = 0 And *ib\flag & #PB_Text_Right
*ib\text = "{x=" + Str(*ib\br - x1 - origin_x - 5) + "}" + *ib\text
EndIf
If drawflag = 0 And *ib\flag & #PB_Text_Center
*ib\text = "{x=" + Str((*ib\br - x1 - origin_x - origin_x)/2) + "}" + *ib\text
EndIf
EndProcedure
;-
Procedure.i ITextGadget(pbnr, x, y, br, hh, text$, flag=0, state=0)
Protected p, rg, *ib.iText = AllocateMemory(SizeOf(IText))
With *ib
\br = br
\hh = hh
\text = text$
\flag = flag
\state = state
\backcolor = defaultBackColor
\textcolor = defaultTextColor
\linecolor = defaultLineColor
\enumcolor = defaultEnumColor
\backcolor2 = defaultBackColor2 ;nur wenn Button
\textcolor2 = defaulttextcolor2 ;
\backgradient = defaultBackGradient
\frontgradient = defaultFrontGradient
\backgradient2 = defaultBackGradient2
\frontgradient2 = defaultFrontGradient2
rg = CanvasGadget(pbnr, x, y, br, hh)
If pbnr = #PB_Any : pbnr = rg : EndIf
If \flag & #PB_Text_Toggle = #PB_Text_Toggle ;beinhaltet #PB_Text_Button
\toggle = 1
EndIf
If \flag & #PB_Text_Button = #PB_Text_Button
\flag | #PB_Text_Border ;Border setzen
\flag | #PB_Text_Center ;Center setzen
\text = "{z}" + \text ;Vertikal zentrieren
\backcolor = $DADADA ;Farbe Button Windows 10 normal
SetGadgetAttribute(pbnr, #PB_Canvas_Cursor, #PB_Cursor_Hand)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_MouseEnter)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_MouseLeave)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_LeftButtonUp)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_LeftButtonDown)
;BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_LeftClick)
EndIf
If \flag & #PB_Text_Option = #PB_Text_Option
\backcolor = defaultBackColor
SetGadgetAttribute(pbnr, #PB_Canvas_Cursor, #PB_Cursor_Hand)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_MouseEnter)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_MouseLeave)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_LeftButtonUp)
BindGadgetEvent(pbnr, @ITextEvent(), #PB_EventType_LeftButtonDown)
p = FindString(\text, "{op") ;Befehl suchen
p = FindString(\text, "}", p) ;und zwischen Befehl und Text Char einfügen
\text = InsertString(\text, "{c=#blue}{z}" + #opAus + " {c}", p+1)
EndIf
If \flag & #PB_Text_Gradient = #PB_Text_Gradient
\flag | #PB_Text_Border ;Border setzen
EndIf
If \flag & #PB_Text_Border = #PB_Text_Border
\text = "{b}" + \text
EndIf
SetGadgetData(pbnr, *ib)
ITextDraw(pbnr, 0) ;nix Draw
ITextDraw(pbnr, 1) ;:Debug \text
;Debug \text : Debug "-----------"
EndWith
ProcedureReturn rg
EndProcedure
EndModule
UseModule ITextGadget
;-Demo
arial_xx = LoadFont(#PB_Any, "arial", 11)
arial_18 = LoadFont(#PB_Any, "arial", 18)
arial_18b = LoadFont(#PB_Any, "arial", 18, #PB_Font_Bold)
courier_xx = LoadFont(#PB_Any, "Cambria", 14)
symbol_enum = LoadFont(#PB_Any, "Segoe UI Symbol", 10)
LoadFont(6, "Consolas", 12)
ITextAddFont(1, arial_xx) ;die höchste Indexnr bestimmt die Anzahl der akzeptierten Fonts
ITextAddFont(2, arial_18) ;nicht benutzte Nummern, hier 7+8, ergeben DefaultFont
ITextAddFont(3, arial_18b)
ITextAddFont(4, courier_xx)
ITextAddFont(5, symbol_enum)
ITextAddFont(6, 6)
fnr = ITextAddFont(9, 0, "Wingdings", 14) ;gibt es einen Namen, so wird Font intern geladen. Fontnr wird ignoriert
icon001 = ITextGetIcon("shell32.dll", 201)
icon002 = ITextGetIcon("shell32.dll", 221)
LoadImage(33, #PB_Compiler_Home + "Examples\Sources\Data\background.bmp")
ITextAddIcon(1, icon001)
ITextAddIcon(2, icon002)
ITextAddIcon(3, 33)
Enumeration
#window
#it_demo1
#it_demo2
#it_demo3
#it_demo4
#it_demo5
#it_demo6
#it_demo7
#it_demo_Op1
#it_demo_Op2
#it_demo_Op3
#it_demo_Op4
#it_demo_Op5
#it_demo_Op6
#pb_but_demo2
#it_but_demo2
#it_inf_demo2
#test = 1000
EndEnumeration
OpenWindow(#window, 0, 0, 950, 670, "ITextGadget Beispiel", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
;SetWindowColor(#window, #Red)
demo1$ = "{f=1}{s=1}{c=#blue}Dies ist eine Aufzählung {c=#black}(diese Zeile mit Spacing){s=0}"
demo1$ + "{c=#Red}{r=1}{e=2}Ottofant{x=140}{c=#gray}mit x verschoben{c=#Red}{e=2}Haus{e=2}Putzen{x=140}buh{e=0}{r=1}{c=#Blue}usw."
demo1$ + "{r=1}{i=1}{o=100}Oh Gott{r=1}oh Gott ach Gott - {c=#yellow}hier{c=#blue} Origin X verschoben"
demo1$ + "{r=1}{f=3}{c=#white}Border ist b5{b=5} fast als xxxx vvvvv letzter Befehl"
demo1$ + "{x=300}{y=30}{f=6}{c=#magenta}{s=-5}{v}Auto{v}{s=0}bahn"
For j = 1 To 7
demo2$ + "Hallo, dies ist ein Text und der wird nun wiederholt. "
Next
demo2$ + "{r=2}{x=11}{f=2}Es {m=0,-3}{i=1}{m=0,3}{f=1}{s=4}{g=-2}si{s}tzt {c=255}{$=eine Maus}"
demo2$ + "{f=2}{g=3} im {c=#blue}St{c=#black}a{c=#Red}ll {r=2}{c=#magenta}{k=200,30}{c=#blue}{f=5}{m=13,3}dies ist ein Kasten"
demo2$ + "{b=1}"
ITextSetColor(#PB_Default, #PB_Gadget_LineColor, $1A7716) ;Rahmenfarbe für alle folgenden Gadgets hier grünlich
ITextGadget(#it_demo1, 10, 10, 500, 250, demo1$, #PB_Text_Border|#PB_Text_Gradient)
ITextGadget(#it_demo2, 520, 10, 400, 200, demo2$)
ITextGadget(#it_but_demo2, 520, 230, 100, 24, "Katze", #PB_Text_Button)
ButtonGadget(#pb_but_demo2, 620, 230, 100, 24, "Hase")
ITextGadget(#it_inf_demo2, 750, 230, 180, 24, "{o=1,1}{f=9}{c=#blue}{z}{a=223}{c=0}{f=1} {g=1}Buttons fast gleich")
demo3$ = "{b=1}{f=1}{s=1}Hallo{s=0}{c=#blue} Right nur bei einer Zeile,{c} es steht eine Kuh im Stall"
ITextGadget(#it_demo3, 10, 270, 500, 40, demo3$, #PB_Text_Right)
demo4$ = "{b=5}{f=5}{z}{c=#blue}#PB_Text_Center{c=#black} funktioniert {i=2,24,24}nur bei {a=$e170} einer Zeile !"
ITextGadget(#it_demo4, 10, 330, 500, 44, demo4$, #PB_Text_Button|#PB_Text_Gradient)
demo5$ = "{b}{f=1}{s=1}Hallo {m=-40,8}{c=#Red}{l=30,0,2}{m=40,-8}{c=#black}es steht eine {t}Kuh im St{c=#blue}a{c=#Red}ll{c=#black}"
demo5$ + "{f=5}{e=7}pinkelt{e=7}frisst{e=3,$263a}trinkt{e=0}{c=#magenta}{f=1}{r}Der Wahnsinn, {c=#Red}Button drücken über diesen Text"
demo5$ + "{r=2}Test #it_demo5"
ITextGadget(#it_demo5, 10, 400, 500, 180, demo5$)
ITextSetColor(#it_demo5, #PB_Text_EnumColor, #Blue)
ITextSetColor(#PB_Default, #PB_Gadget_LineColor, $1877BF) ;andere Farbe: etwas grün = $1A7716, etwas blau $dd4444
ITextGadget(#it_demo7, 10, 600, 300, 40, "{b}#it_demo7 - {f=9}{a=223}{f=1}{g-1}dieser Text mit g-1 verschoben")
b1 = ITextGadget(#PB_Any, 550, 270, 44, 44, "{o=6,6}{i=2}", #PB_Text_Button)
b2 = ITextGadget(#PB_Any, 600, 270, 44, 44, "{b=2}{f=1}b2", #PB_Text_Toggle)
b3 = ITextGadget(#PB_Any, 650, 270, 44, 44, "{b=3}{f=1}b3", #PB_Text_Button)
b4 = ITextGadget(#PB_Any, 700, 270, 44, 44, "{b=4}{f=1}{$=b4}", #PB_Text_Button)
b5 = ITextGadget(#PB_Any, 750, 270, 44, 44, "{b=5}{f=1}b5", #PB_Text_Button)
ITextSetColor(#PB_Default, #PB_Gadget_LineColor, $1A7716)
ITextGadget(#PB_Any, 800, 270, 44, 44, "{b=5}{x=3}{y=4}{i=2,20}")
ITextGadget(#PB_Any, 850, 270, 88, 44, "{o=1,1}{i=3,-1}{x=6}{c=#yellow}{f=1}{z}Hallo")
ITextGadget(#it_demo6, 540, 330, 400, 150, "{o=1,1}{i=3,-1}{f=2}{o=20,20}{c=#yellow}Hallo Image mit Resize - #it_demo6{b=4,$dd4444}")
ITextSetColor(#it_demo6, #PB_Gadget_LineColor, #Blue) ;hier sinnlos da Farbe bei {b=4,$dd4444} Vorrang hat
ITextGadget(#it_demo_Op1, 540, 500, 150, 22, "{f=5}{op=1}{c=#red}Option Nr 11", #PB_Text_Option)
ITextGadget(#it_demo_Op2, 540, 540, 150, 22, "{f=5}{op=1}{c=#red}Option Nr 12", #PB_Text_Option)
ITextGadget(#it_demo_Op3, 540, 580, 150, 32, "{f=4}{op=12}Option Nr 23", #PB_Text_Option)
ITextGadget(#it_demo_Op4, 540, 620, 150, 32, "{f=4}{op=12}Option Nr 24", #PB_Text_Option)
ITextGadget(#it_demo_Op5, 700, 580, 150, 32, "{f=4}{op=12}Option Nr 25", #PB_Text_Option)
ITextGadget(#it_demo_Op6, 700, 620, 150, 32, "{f=4}{op=12}Option Nr 26", #PB_Text_Option)
HideWindow(#window, 0)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case #it_but_demo2
If EventType() = #PB_EventType_LeftClick
ITextSetInfo(#it_demo2, "eine Katze")
ITextSetInfo(#it_demo3, "eine Maus")
EndIf
Case #it_demo4
If EventType() = #PB_EventType_LeftClick
new$ = "{b=4}{c=#Red}Hallo {k=90,20}{m=3,3}{c=#blue}Kasten "
new$ + "{p}{m=90,-3}{l=300,0,2,$00aaaa}{l=20,20}{p1}60,20{r=2}{f=2}mieses {c}Beispiel"
ITextSetText(#it_demo5, new$)
EndIf
Case b1
If EventType() = #PB_EventType_LeftClick
RunProgram("charmap.exe")
EndIf
Case b2
If EventType() = #PB_EventType_LeftClick
ITextSetText(b2, "{b=2}{f=1}B2")
If ITextGetState(b2)
ITextSetInfo(#it_demo2, "ein Auto")
Else
ITextSetInfo(#it_demo2, "ein Huhn")
EndIf
EndIf
Case b3
If EventType() = #PB_EventType_LeftClick
ITextSetText(b3, "B3")
ITextSetInfo(#it_demo2, "eine Pferdekutsche")
EndIf
Case b4
If EventType() = #PB_EventType_LeftClick
ITextSetInfo(b4, "B4")
EndIf
Case b5
If EventType() = #PB_EventType_LeftClick
ITextSetText(b5, "{b=5}{f=2}{z2}B5") ;änder von {z2} zu {z9} zwecks Demo
EndIf
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow