XProfan

English

Christof
Neuß

Hi,

I try frantic, in a Richedit at Reinschreiben of Text whom mode Big on/from and some others To chid. somehow wants to but not functions.

set up does the whole on one code from the Babybox.

Perhaps help me someone? the would class.

here are the two relevanten Procs. on functions. Only the switch off not any more. The thought in MSenden is, The Parameter To take, whom Text To Send and subsequently again on the status before To chid (i.d.R. hold normal black Font).
Compile Mark Separation

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