XProfan

Español

Christof
Neuß

¡Hola,

Yo versuche verzweifelt, en un Richedit beim Reinschreiben de Texto el Modus Fett a/de y algunos otro a schalten. Irgendwie voluntad pero no la trabajo.

Aufbauen tut el Ganze en una Code de el Babybox.

Tal vez hilft me alguien? Das wäre klasse.

Hier son el beiden relevanten Procs. Einschalten funktioniert. Nur el Ausschalten no mehr. Der Gedanke en MSenden es, el Parámetro a tomar, el Texto a senden y anschließend otra vez en el Zustand vorher a schalten (i.d.R. sólo normale schwarze Schrift).
Kompilieren Marca Separación

Schaltet den Fettdruck etc. in einem Richedit ein/aus
' 0=Fett
' 1=kursiv
' 2=unterstrichen
' 3=rot
' 4=grün
' 5=blau
' 6=schwarz

PROC RTF_SetFormat

    parameters Edit&,d%,Schrift$

    if d%=3:d%=rgb(255,  0,  0):endif'rot

        if d%=4:d%=rgb(  0,255,  0):endif'grün

            if d%=5:d%=rgb(  0,  0,255):endif'blau

                if d%=6:d%=rgb(  0,  0,  0):endif'schwarz

                    Declare a%,rtf#
                    dim rtf#,60

                    If Schrift$="Courier"

                        declare a&,b&
                        '--Charset des Fonts ermitteln (ANSI,ASCII,Symbol usw.)
                        clear rtf#
                        byte rtf#,23=1
                        STRING rtf#,28="Courier"
                        b&=CreateFontIndirect(rtf#)
                        SelectObject(%hdc,b&)
                        a&=GetTextCharset(%hdc)
                        deleteobject b&
                        '--Font zuordnen
                        long rtf#,0=60
                        long rtf#,4=$28000000'--dwMask > CFM_FACE
                        byte rtf#,24=a&'--------CharSet des Fonts
                        string rtf#,26="Courier"
                        sendmessage(Edit&,1092,1,rtf#)'-EM_SETCHARFORMAT

                    EndIf

                    Clear rtf#
                    long rtf#,0=60

                    if d%<3

                        long rtf#,4=31

                    else

                        long rtf#,4=$40000000
                        long rtf#,20=d%

                    endif

                    if d%<3

                        sendmessage(Edit&,$043A,1,rtf#)'-EM_GETCHARFORMAT
                        a%=byte(rtf#,8)

                        if testbit(a%,d%)

                            byte rtf#,8=setbit(a%,d%,0)
                            long rtf#,4=setbit(a%,d%,1)

                        else

                            byte rtf#,8=setbit(a%,d%,1)
                            long rtf#,4=setbit(a%,d%,1)

                        EndIf

                    endif

                    sendmessage(Edit&,1092,1,rtf#)'-EM_SETCHARFORMAT
                    '  If Schrift$="Courier"
                    '   Clear rtf#
                    '   long rtf#,0=60
                    '   long rtf#,4=$28000000'--dwMask > CFM_FACE
                    '   byte rtf#,24=a&'--------CharSet des Fonts
                    '   string rtf#,26="Arial"
                    '   sendmessage(Edit&,1092,1,rtf#)'-EM_SETCHARFORMAT
                    '  EndIf
                    '
                    dispose rtf#
                    setfocus(Edit&)

                endproc

                PROC MSenden

                    Parameters fett&,kursiv&,unterstrichen&,farbig&,Schrift$
                    SendMessage(Re_MBENCH_01&, 177, $FFFF, $FFFF)' EM_SETSEL

                    If Schrift$="Courier":RTF_SetFormat Re_MBENCH_01&,0,Schrift$:endif'Unproportionale Schriftart

                        if fett&=1         :RTF_SetFormat Re_MBENCH_01&,0," ":endif

                            if kursiv&=1       :RTF_SetFormat Re_MBENCH_01&,1," ":endif

                                if unterstrichen&=1:RTF_SetFormat Re_MBENCH_01&,2," ":endif

                                    if farbig&<>0      :RTF_SetFormat Re_MBENCH_01&,farbig&:endif

                                        SendMessage(Re_MBENCH_01&, 194, 0, Addr(Re_Text$))' EM_REPLACESEL

                                        if fett&=1         :RTF_SetFormat Re_MBENCH_01&,0," ":endif

                                            if kursiv&=1       :RTF_SetFormat Re_MBENCH_01&,1," ":endif

                                                if unterstrichen&=1:RTF_SetFormat Re_MBENCH_01&,2," ":endif

                                                    if farbig&<>0      :RTF_SetFormat Re_MBENCH_01&,6," ":endif'schwarz

                                                        If NichtNeuZeichnen&<>1'Ist public definiert

                                                            Repaint 1

                                                        EndIf