XProfan

Français

Christof
Neuß

Salut,

je versuche verzweifelt, dans einem Richedit beim Reinschreiben de Text den Modus Fett à/aus et quelques autre trop schalten. Irgendwie veux cela mais pas marcher.

Aufbauen tut cela Ganze sur einem Code aus qui Babybox.

peut-être hilft mir quelqu'un? cela wäre super.

ici sommes qui beiden relevanten Procs. Einschalten funktioniert. seulement cela Ausschalten pas plus. qui idée dans MSenden ist, qui paramètre trop prendre, den Text trop senden et anschließend wieder sur den Zustand auparavant trop schalten (i.d.R. arrêt normale schwarze Schrift).
Kompilieren Marque Séparation

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