XProfan

Deutsch

Christof
Neuß

Hallo,

ich versuche verzweifelt, in einem Richedit beim Reinschreiben von Text den Modus Fett an/aus und einige andere zu schalten. Irgendwie will das aber nicht funktionieren.

Aufbauen tut das Ganze auf einem Code aus der Babybox.

Vielleicht hilft mir jemand? Das wäre klasse.

Hier sind die beiden relevanten Procs. Einschalten funktioniert. Nur das Ausschalten nicht mehr. Der Gedanke in MSenden ist, die Parameter zu übernehmen, den Text zu senden und anschließend wieder auf den Zustand vorher zu schalten (i.d.R. halt normale schwarze Schrift).
Kompilieren Markieren Separieren

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

                                                    EndProc