XProfan

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

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),$0F2,0,0)
    def @changed(1) @sendmessage(@%(1),$0B8,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)

        if (datei$ <> )

            usecursor 2

            If (@FileSize(Datei$) > 32000)

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

            Else

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

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

                    WindowTitle Mini-Ed 1.0 [ + 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%)

        While Nr% <= Max%

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

        EndWhile

        close #1

    EndProc

    Proc Datei_SpeichernAls

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

        if (Datei$ <> )

            Speichere Datei$
            WindowTitle Mini-Ed 1.0 [ + Datei$ + ]

        endif

    EndProc

    Proc Datei_Speichern

        If (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%=@create(choicebox,_dlg%,,0,0,136,120)
    let Groesse%=@create(choicebox,_dlg%,,136,0,40,120)
    let Fett%=@create(button,_dlg%,f,176,0,24,24)
    let kursiv%=@create(button,_dlg%,k,200,0,24,24)
    let unterstrichen%=@create(button,_dlg%,u,224,0,24,24)
    let Text%=@create(multiedit,_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%,$14E,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%,$14E,2,0)
    zeigeschrift
    @SetFocus(Text%)
    let _ende% = 0

    whilenot _ende%

        waitinput

        if %key = 2

            geändert
            let _ende% = 1

        elseif %key = 4

            If ((%WinRight - %WinLeft) > 220) and ((%WinBottom - %WinTop) >120)

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

            endif

        elseif @menuitem(100)

            geändert
            SetText text%,
            Let Datei$=
            WindowTitle Mini-Ed 1.5
            @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(-3808)

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

        elseif @menuitem(-4064)

            showmin

        elseif @menuitem(-4048)

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

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

            Geändert
            Let _ende% = 1

        elseif @menuitem(130)

            @messagebox(programmiert mit XProfan,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 @buttonstate(%getfocus) <> 108

                let f% = 1 - f%

                if f%

                    settext %getfocus,F

                else

                    settext %getfocus,f

                endif

                zeigeschrift

            endif

        elseif @getfocus(kursiv%)

            if @buttonstate(%getfocus) <> 108

                let k% = 1 - k%

                if k%

                    settext %getfocus,K

                else

                    settext %getfocus,k

                endif

                zeigeschrift

            endif

        elseif @getfocus(unterstrichen%)

            if @buttonstate(%getfocus) <> 108

                let u% = 1 - u%

                if u%

                    settext %getfocus,U

                else

                    settext %getfocus,u

                endif

                zeigeschrift

            endif

        endif

    endwhile

    @destroywindow(_dlg%)

endproc

HAUPTPROGRAMM
=============
set(TrueColor,0)
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 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