XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Textausgabe farbig gestalten
Lauffähig ab Profan-Version 5.0
Einen Ersatz für Createtext schaffen.
Createtext hat den Nachteil, daß man keine Textfarbe darstellen kann
und daß der Hintergrund nicht immer transparent ist.
(c) by Rolf Koch - Rokosoft - Koblenz - Februar 2003
Parameter Setnewtext: Posx,Posy,Neuer Text,Alter Text,Neue Farbe(RGB),Anzahl erlaubte Zeichen
Hinweis: Letzter Parameter ist nur für die Einschränkung der Textausgabe, der String ansich
geht nicht verloren - Also genauso wie bei Createtext, nur nicht sichtbar!

PROC SETNEWTEXT

    PARAMETERS tx%,ty%,txt$,alt$,fb%,len%

    if neq(len%,0)

        ifnot gt(len(txt$),len%)

            TextColor getpixel(1,1),-1
            UseFont MS Sans Serif,13,0,0,0,0
            Drawtext tx%,ty%,alt$ 			anstatt das Handle bei Createtext...
            Noch der alte Text!
            TextColor fb%,-1
            UseFont MS Sans Serif,13,0,0,0,0
            Drawtext tx%,ty%,txt$

        endif

    endif

    Return txt$

ENDPROC

declare edit&,edit2&,text1$,text2$,box&,boxtext$,1%,2%,3%
declare font%
Def SysColor(1) !USER32, GetSysColor
SetTrueColor 1
WINDOW 10,10-500,530
Windowtitle Text in Farbe
Cls SysColor(15)
UseFont MS Sans Serif,13,0,0,0,0
font%=createfont(MS Sans Serif,13,0,0,0,0)
SetDialogFont 1
edit&=createedit(%hwnd,,300,6,150,20)
edit2&=createedit(%hwnd,,300,26,150,20)
setfont edit&,font%
setfont edit2&,font%
boxtext$=Dies ist eine Box -Text3D-  		Man kann hiermit auch einen 3D Text erstellen
box&=creategroupbox(%hwnd,boxtext$,10,100,200,200)
Setnewtext 20,100,boxtext$,boxtext$,RGB(255,0,0),36
text1$=Hier ein Ersatz für Createtext
Setnewtext 10,10,text1$,text1$,RGB(255,0,0),36
text1$=@$(0)
text2$=.... und noch einer
Setnewtext 10,30,text2$,text2$,RGB(0,0,255),36
text2$=@$(0)

while 1

    waitinput

    If getfocus(edit&)

        Setnewtext 10,10,gettext$(edit&),text1$,RGB(255,0,0),36
        text1$=@$(0)

    elseif getfocus(edit2&)

        Setnewtext 10,30,gettext$(edit2&),text2$,RGB(0,0,255),36
        text2$=@$(0)

    endif

wend

Deleteobject font%