XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Editor programmieren (Mini-Editor)

proc editor

    declare _ende%
    declare _dlg%
    declare SCHRIFT%
    declare Groesse%
    declare Fett%
    declare kursiv%
    declare unterstrichen%
    declare CUT%
    declare COPY%
    declare INS%
    declare Text%
    declare anz!, f%, u%, k%, font$, g!, x%, datei$, text$, edit#
    def @buttonstate(1) @sendmessage(@%(1),$402,0,0)
    def @changed(1) @sendmessage(@%(1),$408,0,0)

    proc zeigeschrift

        let font$ = @GetText$(schrift%)
        let g! = @Mul(@Val(@GetText$(groesse%)),anz!)
        UseFont font$,g!,0,f%,k%,u%
        @sendmessage(text%,$30,%font,1)   wm_SetFont

    endproc

    proc Datei_Laden

        let datei$ = @LoadFile$(Datei laden:,*.txt)

        ifnot @equ$(datei$,)

            usecursor 2

            If @Gt(@FileSize(Datei$),32000)

                @MessageBox(Datei ist zu groß für den Editor!,Hinweis:,48)

            Else

                Dim Edit#,@Add(@FileSize(Datei$),2000)
                ReadText Edit#,Datei$

                If @SendMessage(text%,$000C,0,Edit#)

                    WindowTitle @Add$(Mini-Ed 1.0 [,
                    @Add$(Datei$,]))

                Else

                    @MessageBox(Datei ist zu groß für den Editor!,Hinweis:,48)

                EndIf

                Dispose Edit#

            EndIf

            usecursor 0

        endif

    EndProc

    Proc Speichere

        Parameters dname$
        Declare Nr%, Max%
        assign #1,dname$
        rewrite #1
        Let Nr% = 0
        Let Max% = @GetLineCount(Text%)

        WhileNot @Gt(Nr%,Max%)

            Print #1,@GetLine$(Text%,Nr%)
            Inc Nr%

        Wend

        close #1

    EndProc

    Proc Datei_SpeichernAls

        let datei$ = @SaveFile$(Datei speichern:,Datei$)

        ifnot @equ$(Datei$,)

            Speichere Datei$
            WindowTitle @Add$(Mini-Ed 1.0 [,
            @Add$(Datei$,]))

        endif

    EndProc

    Proc Datei_Speichern

        IfNot @Equ$(Datei$,)

            Speichere Datei$

        Else

            Datei_SpeichernAls

        EndIf

    EndProc

    Proc Geändert

        If @Changed(Text%)

            If @Equ(@MessageBox(Die Datei wurde geändert.

                Soll sie gespeichert werden?,
                Datei$,36),6)
                Datei_Speichern

            EndIf

        EndIf

    EndProc

    let _dlg% = %Hwnd
    let SCHRIFT%=@createchoicebox(_dlg%,,0,0,136,120)
    let Groesse%=@createchoicebox(_dlg%,,136,0,40,120)
    let Fett%=@createbutton(_dlg%,f,176,0,24,24)
    let kursiv%=@createbutton(_dlg%,k,200,0,24,24)
    let unterstrichen%=@createbutton(_dlg%,u,224,0,24,24)
    let Text%=@createmultiedit(_dlg%,,0,24,548,364)
    let f% = 0
    let k% = 0
    let u% = 0
    let anz! = 1.5
    let Datei$ =
    clearlist
    addfonts
    @movelisttochoice(schrift%)
    @sendmessage(schrift%,1038,2,0)
    @addchoice(groesse%,10)
    @addchoice(groesse%,12)
    @addchoice(groesse%,14)
    @addchoice(groesse%,16)
    @addchoice(groesse%,18)
    @addchoice(groesse%,22)
    @addchoice(groesse%,26)
    @sendmessage(groesse%,1038,2,0)
    zeigeschrift
    @SetFocus(Text%)
    let _ende% = 0

    whilenot _ende%

        waitinput

        if @equ(%key,2)

            geändert
            let _ende% = 1

        elseif @equ(%key,4)

            If @and ( @Gt(@Sub(%WinRight,%WinLeft),220),

                @Gt(@Sub(%WinBottom,%WinTop),120) )
                SetWindowPos Text% = 0,24
                - @Sub(@Sub(%WinRight,%WinLeft),6),
                @Sub(@Sub(%WinBottom,%WinTop),88)

            endif

        elseif @menuitem(100)

            geändert
            SetText text%,
            Let Datei$=
            WindowTitle Mini-Ed 1.0
            @SetFocus(Text%)

        elseif @menuitem(101)

            geändert
            Datei_Laden
            @SetFocus(Text%)

        elseif @menuitem(102)

            Datei_Speichern
            @SetFocus(Text%)

        elseif @menuitem(103)

            Datei_SpeichernAls
            @SetFocus(Text%)

        elseif @menuitem(104)

            @WinExec(CONTROL Drucker,0)

        elseif @menuitem(-3808)

            shownormal
            SetWindowPos Text% = 0,24
            - @Sub(@Sub(%WinRight,%WinLeft),6),
            @Sub(@Sub(%WinBottom,%WinTop),88)

        elseif @menuitem(-4064)

            showmin

        elseif @menuitem(-4048)

            showmax
            SetWindowPos Text% = 0,24
            - @Sub(@Sub(%WinRight,%WinLeft),6),
            @Sub(@Sub(%WinBottom,%WinTop),88)

        elseif @or ( @menuitem(109),@menuitem(-4000) )

            Geändert
            Let _ende% = 1

        elseif @menuitem(130)

            @messagebox(programmiert mit RGH-Profan² 4.0,RGH-MINITEXT,0)

        elseif @menuitem(110)

            @sendmessage(text%,$304,0,0)   wm_Undo

        elseif @menuitem(111)

            @sendmessage(text%,$300,0,0)   wm_Cut

        elseif @menuitem(112)

            @sendmessage(text%,$301,0,0)   wm_Copy

        elseif @menuitem(113)

            @sendmessage(text%,$302,0,0)   wm_Insert

        elseif @menuitem(114)

            @sendmessage(text%,$303,0,0)   wm_Clear

        Elseif @Menuitem(200)

            let anz! = 1
            checkmenu 200,1
            checkmenu 201,0
            checkmenu 202,0
            zeigeschrift

        Elseif @Menuitem(201)

            let anz! = 1.5
            checkmenu 200,0
            checkmenu 201,1
            checkmenu 202,0
            zeigeschrift

        Elseif @Menuitem(202)

            let anz! = 2
            checkmenu 200,0
            checkmenu 201,0
            checkmenu 202,1
            zeigeschrift

        elseif @getfocus(schrift%)

            zeigeschrift

        elseif @getfocus(groesse%)

            zeigeschrift

        elseif @getfocus(fett%)

            if @equ(@buttonstate(%getfocus),108)

                let f% = @sub(1,f%)

                if f%

                    settext %getfocus,F

                else

                    settext %getfocus,f

                endif

                zeigeschrift

            endif

        elseif @getfocus(kursiv%)

            if @equ(@buttonstate(%getfocus),108)

                let k% = @sub(1,k%)

                if k%

                    settext %getfocus,K

                else

                    settext %getfocus,k

                endif

                zeigeschrift

            endif

        elseif @getfocus(unterstrichen%)

            if @equ(@buttonstate(%getfocus),108)

                let u% = @sub(1,u%)

                if u%

                    settext %getfocus,U

                else

                    settext %getfocus,u

                endif

                zeigeschrift

            endif

        endif

    wend

    @destroywindow(_dlg%)

endproc

HAUPTPROGRAMM
=============
windowstyle $11F
windowtitle Mini-Ed 1.0
window 20,20-555,452
cls @rgb(23,23,23)
PopUp &Datei
AppendMenu 100,&Neu
AppendMenu 101,&Laden
AppendMenu 102,&Speichern
AppendMenu 103,Speichern &als
Separator
AppendMenu 104, D&rucker einrichten
Separator
AppendMenu 109,&Ende
PopUp &Bearbeiten
AppendMenu 110,&Rückgänging 	Alt+BS
Separator
AppendMenu 111,&Ausschneiden 	Shift+Entf
AppendMenu 112,&Kopieren 	Strg+Einfg
AppendMenu 113,&Einfügen 	Shift+Einfg
AppendMenu 114,&Löschen 	Strg+Entf
PopUp &Anzeige
AppendMenu 200,&100 %
AppendMenu 201,1&50 %
AppendMenu 202,&200 %
AppendMenuBar 130,a&Info
CheckMenu 201,1
editor
end