XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Icon-Editor programmieren
==============================================================================
ICONEDITOR mit Profan    32 Bit                       (P)Fairware, Freeware...
Version 2.0
(c) 1998 Richard Maurukas
bearbeitet und korrigiert von Dietmar Horn
==============================================================================
KURZE ERKLÄRUNG
----------------
**Datei Neu**
Setzt das aktuelle Bild ins UNDO Feld, löscht das aktuelle Icon und stellt
ein leeres Icon zur Bearbeitung bereit.
**Datei Öffnen**
Durchsucht das gewählte Verzeichnis nach EXE, DLL oder ICO Dateien und
zeigt diese in einer Vorschau an. Das in der Vorschau gewählte Icon kann
mit OK geladen werden. Ein bereits vorhandenes Icon wird ins UNDO-Feld
gesetzt und das geladene wird angezeigt.
**Datei Speichern**
Das Angezeigte Original wird als ICOn gespeichert. Das Oberste linke Pixel
als transparente Farbe angenommen.
**Datei Beenden**
Der Iconeditor wird beendet.
**Bearbeiten Rückgängig**
Das im UNDO-Feld sichtbare Bild wird zum aktuellen ICON
**Bearbeiten Farbe ändern**
Die ausgewählte Farbe im Bildpunkt wird im gesamten Icon durch die
angezeigte gewählte Zeichenfarbe ersetzt.
**Bearbeiten Füllen**
Es wird der ausgewählte Bereich mit der Farbe x durch die angezeigte ge-
wählte Zeichenfarbe bis zu einer angrenzenden anderen Farbe ersetzt.
**Optionen Raster einblenden**
Zeigt das RAster mit der gewälten Rasterfarbe
**Optionen Raster ausblenden**
Blendet das Raster aus
**Effekte Spiegel Horizontal**
Spiegel das Icon horizontal
**Effekte Spiegel vertikal**
Spiegelt das Icon vertikal
**Effekte Drehe links**
Dreht das Icon Pixel für Pixel nach links
**Effekte Drehe nach rechts**
Dreht das Icon Pixel für Pixel nach rechts
**Info Über**
Zeigt eine MessageBox
**Info Hilfe**
Nicht belegt
===============================================================================
DEF ExtFloodFill(5) !GDI32,ExtFloodFill
declare Dirname#
dim Dirname#,255
declare linex%,liney%,e%,ende%
declare icox%,Icoy%
declare IPunktFarbe&[16]          RGB Farben
declare fcolor&,rcolor&           Zeichnfarbe, Rasterfarbe
declare Raster%                   Raster ein oder ausgeschaltet

PROC ICONFARBEN

    let IPunktFarbe&[0] =rgb(000,000,000)   black
    let IPunktFarbe&[1] =rgb(128,128,128)   gray
    let IPunktFarbe&[2] =rgb(192,192,192)   silver
    let IPunktFarbe&[3] =rgb(128,128,000)   olive
    let IPunktFarbe&[4] =rgb(000,128,000)   hgreen
    let IPunktFarbe&[5] =rgb(000,000,128)   navy
    let IPunktFarbe&[6] =rgb(128,000,000)   maroon
    let IPunktFarbe&[7] =rgb(000,128,128)   Teal
    let IPunktFarbe&[8] =rgb(255,000,000)   red
    let IPunktFarbe&[9] =rgb(000,255,000)   lime
    let IPunktFarbe&[10]=rgb(000,000,255)   blue
    let IPunktFarbe&[11]=RGB(000,255,255)   aqua
    let IPunktFarbe&[12]=rgb(128,000,128)   Purple
    let IPunktFarbe&[13]=rgb(255,000,255)   fuchsia
    let IPunktFarbe&[14]=rgb(255,255,000)   yellow
    let IPunktFarbe&[15]=rgb(255,255,255)   white

ENDPROC

PROC LADEICON

    declare IconedIcon&
    Ladendialog
    declare Öffnendlg%,ÖffnenEnde%
    declare lwliste%,Dateiliste%,Verzliste%,lw$,DateiTyp$
    declare dllbutton%,exebutton%,Icobutton%,Icowahl%,IcoAnz%,IcoNr%
    declare Öffneok%,Öffneabbr%,Infofilepath%,InfoIcotxt%

    PROC ICON_ANZAHl_TEXT

        declare Infotext1$,Infotext2$,Infotext3$
        Decimals 0
        Let Infotext1$=getstring$(Dateiliste%,getcursel(Dateiliste%))
        Let Infotext1$=add$(Infotext1$,
        )
        let Infotext2$=str$(add(Getscrollpos(Icowahl%),1))
        let Infotext2$=add$(add$(Infotext2$, von ),str$(Icoanz%))
        Let Infotext3$=
        Laden mit OK
        case gt(Icoanz%,1):let Infotext3$=add$(add$(Infotext3$,
        Wähle aus ),str$(icoanz%))
        settext InfoIcotxt%,add$(add$(Infotext1$,Infotext2$),Infotext3$)

    ENDPROC

    PROC ICON_Anzahl_Anzeige

        declare Infotext1$,Infotext2$,Infotext3$
        Decimals 0

        if gt(getcount(Dateiliste%),0)

            let icoanz%=iconcount(getstring$(Dateiliste%,getcursel(Dateiliste%)))
            setscrollrange Icowahl%,0,sub(Icoanz%,1)
            setscrollpos Icowahl%,0
            ICON_ANZAHl_TEXT
            case gt(icoanz%,1):enablewindow Icowahl%,1
            case equ(icoanz%,1):enablewindow Icowahl%,0

        Else

            Let Infotext1$=add$(add$(Keine ,DateiTyp$), Dateien im
            )
            let Infotext2$=add$(Infotext1$,gewählten Verzeichnis!)
            settext InfoIcotxt%,Infotext2$
            settext InfofilePath%,getdir$(@)
            startpaint Öffnendlg%
            Usepen 0,3,rgb(255,0,0)
            line 22,230-54,262
            line 54,230-22,262
            Endpaint
            enablewindow Icowahl%,0

        ENDIF

    ENDPROC

    PROC FIND_ICON

        nur die Dateien anzeigen, die ein Icon haben
        declare Datei$
        Usecursor 2
        Settext Öffnendlg%,add$(add$(Icon aus ,DateiTyp$), laden)
        settext InfoIcotxt%,
        startpaint öffnendlg%
        usebrush 1,rgb(192,192,192)
        UsePen 1,5,rgb(192,192,192)
        rectangle 23,230-55,263
        Endpaint
        sendmessage(Dateiliste%,$0184,0,0)
        let datei$= @FindFirst$(DateiTyp$)

        if gt$(datei$,)

            Let IcoAnz% = @IconCount(Datei$)

            if gt(IcoAnz%,0)

                addstring(Dateiliste%,Datei$)

            endif

            WhileNot %IOResult

                let Datei$= @FindNext$()
                Let IcoAnz% = @IconCount(Datei$)

                if gt(IcoAnz%,0)

                    addstring(Dateiliste%,datei$)

                endif

            Wend

            if gt(Getcount(dateiliste%),0)

                sendmessage(Dateiliste%,$0186,0,0)
                ICON_Anzahl_Anzeige
                startpaint öffnendlg%
                usebrush 1,rgb(192,192,192)
                UsePen 1,5,rgb(192,192,192)
                rectangle 23,230-55,263
                drawlibIcon getstring$(Dateiliste%,getcursel(dateiliste%)),0,23,230
                Endpaint

            ELSE

                ICON_Anzahl_Anzeige

            Endif

        ELSE

            ICON_Anzahl_Anzeige

        ENDIF

        Usecursor 0

    ENDPROC

    PROC VERZEICHNISLISTE

        Declare Suchergebnis%
        startpaint öffnendlg%
        usebrush 1,rgb(192,192,192)
        UsePen 1,5,rgb(192,192,192)
        rectangle 23,230-55,263
        Endpaint
        Settext InfoIcotxt%,
        let lw$=getstring$(Verzliste%,getcursel(Verzliste%))
        let LW$=Translate$(LW$,[,)
        let LW$=Translate$(LW$,],)
        let lw$=Longname$(lw$)
        chdir LW$
        Settext InfoFilePath%,LW$
        sendmessage(Verzliste%,$0184,0,0)
        string Dirname#,0=*.*
        sendmessage(Verzliste%,$018D,$8010,Dirname#)
        sendmessage(Verzliste%,$0186,0,0)
        let Suchergebnis%=%IORESULT
        FIND_ICON

    ENDPROC

    PROC LWLISTE

        let lw$=getstring$(LWListe%,getcursel(LWliste%))
        let lw$=translate$(lw$,[-,)
        let lw$=translate$(lw$,-],:)
        chdir LW$
        sendmessage(Verzliste%,$0184,0,0)
        string Dirname#,0=*.*
        sendmessage(Verzliste%,$018D,$8010,Dirname#)
        sendmessage(Verzliste%,$0186,0,0)
        Find_icon
        settext InfoFilePath%,@GetDir$(@)

    ENDPROC

    enablewindow %Hwnd,0
    let Öffnendlg%=Createdialog(%Hwnd,Icon Laden,20,40,400,340)
    let LWliste%=createlistbox(Öffnendlg%,,20,20,60,60)
    Let VerzListe%=Createsortedlistbox(Öffnendlg%,,20,88,190,126)
    Let Dateiliste%=Createsortedlistbox(Öffnendlg%,,220,20,150,194)
    let Dllbutton%=Createbutton(Öffnendlg%,Dynamic-Link-Library,90,20,120,18)
    let EXEbutton%=Createbutton(Öffnendlg%,Programme,90,40,120,18)
    let ICObutton%=Createbutton(Öffnendlg%,Icon Datei,90,60,120,18)
    let Öffneok%=Createbutton(Öffnendlg%,&OK,224,232,142,18)
    let ÖffneAbbr%=Createbutton(Öffnendlg%,&Abbrechen,224,252,142,18)
    Let Icowahl%=CreateHscroll(Öffnendlg%,,22,267,34,18)
    Creategroupbox(Öffnendlg%,,2,285,390,29)
    Let InfoFilePath%=Createtext(Öffnendlg%,getdir$(@),6,296,384,16)
    Creategroupbox(Öffnendlg%,,20,220,38,66)
    Creategroupbox(Öffnendlg%,,60,220,150,66)
    creategroupbox(Öffnendlg%,,220,220,150,66)
    let InfoIcotxt%=Createtext(Öffnendlg%,,65,230,130,54)
    string Dirname#,0=
    sendmessage(LWListe%,$018D,$4000,Dirname#)
    let lw$=translate$($Drive,:,-])
    let lw$=add$([-,lw$)
    @SelectString(LWListe%,-1,Lw$)
    Let DateiTyp$= *.ICO
    VERZEICHNISLISTE

    Whilenot Öffnenende%

        waitinput

        IF GETFOCUS(Icowahl%)

            let Iconr%=getscrollpos(Icowahl%)
            case equ(add(Iconr%,1),Iconcount(getstring$(Dateiliste%,getcursel(dateiliste%)))):Beep
            case equ(IcoNr%,0):beep
            ICON_ANZAHl_TEXT
            startpaint öffnendlg%
            usebrush 1,rgb(192,192,192)
            UsePen 1,5,rgb(192,192,192)
            rectangle 23,230-55,263
            drawlibIcon getstring$(Dateiliste%,getcursel(dateiliste%)),Iconr%,23,230
            Endpaint
            setfocus(Öffnendlg%)

        ELSEIF Getfocus(Dllbutton%)

            Let DateiTyp$=*.DLL
            FIND_ICON
            setfocus(Öffnendlg%)

        ELSEIF Getfocus(EXEbutton%)

            Let DateiTyp$=*.EXE
            FIND_ICON
            Setfocus(Öffnendlg%)

        ELSEIF Getfocus(ICObutton%)

            Let DateiTyp$=*.ICO
            FIND_ICON
            setfocus(Öffnendlg%)

        ELSEIF Getfocus(Öffneok%)

            if gt(getcount(dateiliste%),0)

                let Icoanz%=getscrollpos(Icowahl%)
                mcls 32,32
                startpaint -1
                drawlibicon Getstring$(Dateiliste%,getcursel(dateiliste%)),Icoanz%,0,0
                endpaint

            else

                mcls 32,32

            endif

            let ÖffnenEnde%=1

        Elseif Getfocus(ÖffneAbbr%)

            let Öffnenende%=1

        ELSEIF GETFOCUS(LwListe%)

            LWLISTE

        ELSEIF GETFOCUS(VerzListe%)

            VERZEICHNISLISTE

        ELSEIF GETFOCUS(DATEILISTE%)

            ICON_Anzahl_Anzeige
            startpaint öffnendlg%
            usebrush 1,rgb(192,192,192)
            UsePen 1,5,rgb(192,192,192)
            rectangle 23,230-55,263
            drawlibIcon getstring$(Dateiliste%,getcursel(dateiliste%)),0,23,230
            endpaint

        ENDIF

    wend

    enablewindow %Hwnd,1
    destroywindow(Öffnendlg%)

ENDPROC

PROC SPEICHER_ICON

    declare SPdatei$
    let spdatei$=@SaveFile$(Icon Speichern,Profan.ICO)

    if gt$(spdatei$,)

        savebmp SPdatei$,311,310-32,32

    endif

ENDPROC

PROC ZEIGEICON

    MCopySizedBmp 0,0-32,32 > 40,40-256,256;0
    MCopyBmp 0,0-32,32 > 311,310;0

ENDPROC

PROC ZEIGERASTER

    usepen 0,1,rcolor&
    let linex%=0

    whilenot gt(linex%,256)

        line @add(linex%,40),40-@add(linex%,40),296
        line 40,@add(linex%,40)-296,@add(linex%,40)
        let linex%=@add(Linex%,8)

    wend

ENDPROC

PROC ZEICHNE_BILDPUNKT

    parameters startposx%,startposy%,IFarbe&
    declare linememx%,linememy%
    let linememx%=div&(@sub(startposx%,40),8)
    let linememy%=div&(@sub(startposy%,40),8)

    if and(and(gt(linememx%,-1),lt(linememx%,32)),and(gt(linememy%,-1),lt(linememy%,32)))

        let linex%=@add(@mul(linememx%,8),40)
        let liney%=@add(@mul(linememy%,8),40)
        usebrush 1,IFarbe&
        usepen 0,1,IFarbe&
        rectangle linex%,liney%-@add(linex%,8),@add(liney%,8)
        CopyBmpToMem linex%,liney%-1,1 > linememx%,linememy%
        MCopyBmp 0,0-32,32 > 311,310;0   Original Icon zeigen

        if equ(Raster%,1)

            usepen 0,1,rcolor&
            rectangle linex%,liney%-@add(linex%,9),@add(liney%,9)

        Endif

    Endif

ENDPROC

PROC XYPOSITION

    parameters startposx%,startposy%
    declare linememx%,linememy%
    let linememx%=div&(@sub(startposx%,40),8)
    let linememy%=div&(@sub(startposy%,40),8)

    if and(and(gt(linememx%,-1),lt(linememx%,32)),and(gt(linememy%,-1),lt(linememy%,32)))

        Usecursor 3
        decimals 0
        settext icox%,str$(@add(linememx%,1))
        settext icoy%,str$(@add(linememy%,1))

    Else

        Usecursor 0

    endif

ENDPROC

PROC FENSTERELEMENTE

    declare farbposy%
    usebrush 1,rgb(192,192,192)           Füllfarbe für den Icon-Hintergrund
    usepen 0,1,rgb(0,0,0)                 und die Rahmenfarbe
    rectangle 28,29-395,379               Rechteck für den HG zeichnen
    creategroupbox(%Hwnd,,29,22,365,355)Rahmen für den Icon-Hintergrund
    creategroupbox(%Hwnd,,38,30,263,271)Rahmen um grosses Icon
    creategroupbox(%Hwnd,,305,30,82,270)Rahmen um den Farben
    Usefont ARIAL,12,0,0,0,1
    textcolor rgb(0,0,0),-1
    drawtext 311,40,Color
    drawtext 347,40,Raster
    drawtext 311,348,Original
    drawtext 351,348,UNDO
    Usefont ARIAL,14,0,0,0,0
    setdialogfont 1
    drawtext 44,309,Farbe
    drawtext 44,328,Raster
    let e%=0
    let farbposy%=55                          Farbenauswahl Startposition y

    whilenot gt(e%,15)

        usebrush 1,IPunktFarbe&[e%]
        usepen 0,1,IPunktFarbe&[e%]
        rectangle 311,farbposy%-343,add(farbposy%,15)  Zeichenfarben Auswahl
        rectangle 349,farbposy%-379,add(farbposy%,15)  Rahmenfarben Auswahl
        let farbposy%=add(farbposy%,15)
        inc e%

    Wend

    creategroupbox(%Hwnd,,38,295,263,75)Rahmen für die Farben u.Optionen
    creategroupbox(%Hwnd,,309,44,37,254)Rahmen um die Zeichenfarbe
    creategroupbox(%Hwnd,,346,44,37,254)Rahmen um die Rahmenfarbe
    creategroupbox(%Hwnd,,305,295,82,75)Rahmen um die Icons
    creategroupbox(%Hwnd,,308,300,38,45)Rahmen um das orig. Icon
    creategroupbox(%Hwnd,,346,300,38,45)Rahmen um das orig. Icon
    createtext(%Hwnd,X:,140,310,20,18)  Text X
    let icox%=createtext(%hwnd,18,160,310,80,18)X Pos. Anzeige
    createtext(%Hwnd,Y:,140,330,20,18)  Text Y
    let icoy%=createtext(%hwnd,18,160,330,80,18)Y Anzeige
    Zeichenfarbe Schwarz beim Start als Voreinstellung
    let fcolor&=rgb(0,0,0)
    usebrush 1,fcolor&                   Füllfarbe für den Icon-Hintergrund
    usepen 0,1,rgb(0,0,0)                und die Rahmenfarbe
    rectangle 80,310-120,322             Rechteck mit aktueller Farbe zeichnen
    Rasterfarbe Grau beim Start als Voreinstellung
    let RColor&=rgb(128,128,128)
    usebrush 1,Rcolor&                   Füllfarbe für den Raster-Hintergrund
    usepen 0,1,rgb(0,0,0)                und die Rahmenfarbe
    rectangle 80,330-120,342             Rechteck mit aktueller Farbe zeichnen
    createtext(%Hwnd,,0,sub(%Winbottom,70),%Winright,24)
    creategroupbox(%Hwnd,,0,sub(%Winbottom,78),sub(%winright,7),32)Rahmen um das orig. Icon

ENDPROC

PROC SPIEGEL_HORIZONTAL

    Usecursor 2
    Undo Bitmap
    copysizedbmp 311,310-32,32 >349,310-32,32;0
    Spiegel horizontal
    mcopysizedbmp 0,0-32,32 >40,295-256,-256;0
    mcopysizedbmp 0,0-32,32 >311,341-32,-32;0
    copybmptomem 311,310-32,32 >0,0
    case equ(Raster%,1):ZEIGERASTER
    usecursor 0

ENDPROC

PROC SPIEGEL_VERTIKAL

    Usecursor 2
    Undo Bitmap
    copysizedbmp 311,310-32,32>349,310-32,32;0
    Spiegel Vertikal
    mcopysizedbmp 0,0-32,32 >295,40--256,256;0
    mcopysizedbmp 0,0-32,32 >342,310--32,32;0
    copybmptomem 311,310-32,32 >0,0
    case equ(Raster%,1):ZEIGERASTER
    usecursor 0

ENDPROC

PROC ROTIERE_LINKS

    Usecursor 2
    declare ex1%,ey1%,a%,b%,c&
    Undo Bitmap
    copysizedbmp 311,310-32,32>349,310-32,32;0
    Rotiere links
    let ex1%=0
    let ey1%=0

    whilenot equ(ey1%,32)

        let a%=add(40,mul(ey1%,8))
        let b%=sub(295,mul(ex1%,8))
        let c&=getpixel(add(349,ex1%),add(310,ey1%))
        ZEICHNE_BILDPUNKT a%,b%,c&
        inc ex1%

        if equ(ex1%,32)

            let ex1%=0
            inc ey1%

        endif

    wend

    usecursor 0

ENDPROC

PROC ROTIERE_RECHTS

    Usecursor 2
    declare ex1%,ey1%,a%,b%,c&
    Undo Bitmap
    copysizedbmp 311,310-32,32>349,310-32,32;0
    Rotiere Rechts
    let ex1%=0
    let ey1%=0

    whilenot equ(ey1%,32)

        let a%=sub(295,mul(ey1%,8))
        let b%=add(47,mul(ex1%,8))
        let c&=getpixel(add(349,ex1%),add(310,ey1%))
        ZEICHNE_BILDPUNKT a%,b%,c&
        inc ex1%

        if equ(ex1%,32)

            let ex1%=0
            inc ey1%

        endif

    wend

    Usecursor 0

ENDPROC

PROC FARBE_AENDERN

    declare ex1%,ey1%,a%,b%,c&,changecolor&,Farbändern_ende%
    Undo Bitmap
    copysizedbmp 311,310-32,32>349,310-32,32;0
    Usecursor 4

    While Menuitem(202)

        getmessage
        waitinput

        If and(equ(%Message,513),equ(&Wparam,1))

            if and(and(gt(%Mousex,39),lt(%mousex,298)),and(gt(%Mousey,39),lt(%Mousey,298)))

                Sichergehen, das nicht die Farbe des Rasters als die zu ändernde Farbe
                genommen wird, das Raster ausblenden und das richtige Pixel holen.
                case equ(Raster%,1):ZEIGEICON
                let changecolor&=getpixel(%mousex,%mousey)
                case equ(Raster%,1):ZEIGERASTER
                let ex1%=0
                let ey1%=0

                whilenot equ(ey1%,32)

                    Usecursor 2
                    let a%=add(41,mul(ex1%,8))
                    let b%=add(47,mul(ey1%,8))
                    let c&=getpixel(add(311,ex1%),add(310,ey1%))

                    if equ(c&,changecolor&)

                        let c&=Fcolor&
                        ZEICHNE_BILDPUNKT a%,b%,c&

                    ENDIF

                    inc ex1%

                    IF equ(ex1%,32)

                        let ex1%=0
                        inc ey1%

                    Endif

                WEND

            ELSE

                setmenuitem 0

            ENDIF

        ENDIF

    WEND

    Usecursor 0
    Setmenuitem 202

ENDPROC

PROC FUELLEN

    declare ex1%,ey1%,a%,b%,c&,changecolor&,newcolor&,FUELLEN_Ende%
    Undo Bitmap
    copysizedbmp 311,310-32,32>349,310-32,32;0
    Usecursor 4

    While Menuitem(203)

        waitinput

        If and(equ(%Message,513),equ(&Wparam,1))

            if and(and(gt(%Mousex,39),lt(%mousex,298)),and(gt(%Mousey,39),lt(%Mousey,298)))

                XYPOSITION %Mousex,%Mousey
                let ex1%=add(311,sub(val(gettext$(icox%)),1))
                let ey1%=add(310,sub(val(gettext$(icoy%)),1))
                let changecolor&=getpixel(ex1%,ey1%)
                ExtFloodFill(%Hdc,ex1%,ey1%,Changecolor&,1)
                CopyBmpToMem 311,310-32,32 > 0,0
                MCopySizedBmp 0,0-32,32 > 40,40-257,257;0
                case equ(Raster%,1):ZEIGERASTER

            ELSE

                setmenuitem 0

            endif

        endif

    wend

    usecursor 0
    setmenuitem 203

ENDPROC

PROC UNDO_ICON

    CopyBmpToMem 349,310-32,32 > 0,0
    copybmp 311,310-32,32 > 349,310;0
    MCopyBmp 0,0-32,32 > 311,310;0
    MCopySizedBmp 0,0-32,32 > 40,40-257,257;0
    case equ(Raster%,1):ZEIGERASTER

ENDPROC

PROC INFO

    Messagebox(ICON-EDITOR Ver 2.0
    mit und für Profan
    (c) 1998 Richard Maurukas
    Code bearbeitet und korrigiert von Dietmar Horn.,Info,64)

ENDPROC

WINDOWSTYLE 31
WINDOW 0,0-440,470
WINDOWTITLE Iconeditor mit Profan. (c) 1998 Richard Maurukas
settruecolor 1
cls rgb(0,128,128)
PopUp &Datei
Appendmenu 101,&Neu
AppendMenu 102,&Öffnen
AppendMenu 103,&Speichern
Separator
Appendmenu 199,&Beenden
PopUp &Bearbeiten
Appendmenu 201,&Rückgängig
Separator
Appendmenu 202,&Farbe ändern
Separator
Appendmenu 203,Füllen
POPUP Optionen
Appendmenu 301,Raster &einblenden
Appendmenu 302,Raster &ausblenden
POPUP Effekte
Appendmenu 401,Spiegel &horizontal
Appendmenu 402,Spiegel &vertikal
Separator
Appendmenu 403,Drehe &links
Appendmenu 404,Drehe &rechts
POPUP Info
Appendmenu 901,Über
Separator
Appendmenu 902,&Hilfe
Voreinstellung beim Start --------------------------------------
Zeichenfarbe Schwarz beim Start als Voreinstellung
let fcolor&=@RGB(0,0,0)
Rasterfarbe Grau beim Start als Voreinstellung
let RColor&=@RGB(128,128,128)
Let Raster%=1                    Raster aktivieren für Menü 301
checkmenu 301,1                  Menupunkt 301 mit Hacken
ICONFARBEN                       Zeichenfarben initialisieren
----------------------------------------------------------------
FENSTERELEMENTE                  Fenster aufbauen
mcls 32,32                       leeres Speicherbitmap erzeugen
ZEIGEICON                        und zeigen
case equ(Raster%,1):ZEIGERASTER
----------------------------------------------------------------
let ende%=0

whilenot equ(ende%,1)

    getmessage
    locate 0,0
    Print

    IF Menuitem(101)

        UNDO_ICON
        MCLS 32,32
        Zeigeicon
        case equ(Raster%,1):ZEIGERASTER

    ELSEIF Menuitem(102)

        LADEICON
        ZEIGEICON
        case equ(Raster%,1):ZEIGERASTER

    ELSEIF Menuitem(103)

        SPEICHER_ICON

    ELSEIF Menuitem(201)

        UNDO_ICON

    ELSEIF Menuitem(202)

        FARBE_AENDERN

    ELSEIF Menuitem(203)

        FUELLEN

    ELSEIF MENUITEM(301)

        checkmenu 301,1
        checkmenu 302,0
        let Raster%=1
        ZEIGERASTER

    ELSEIF MENUITEM(302)

        checkmenu 301,0
        checkmenu 302,1
        Let Raster%=0
        ZEIGEICON

    ELSEIF MENUITEM(401)

        SPIEGEL_HORIZONTAL

    ELSEIF MENUITEM(402)

        SPIEGEL_VERTIKAL

    ELSEIF MENUITEM(403)

        ROTIERE_LINKS

    ELSEIF MENUITEM(404)

        ROTIERE_RECHTS

    ELSEIF MENUITEM(901)

        INFO

    ELSEIF MENUITEM(199)

        let ENDE%=1
        Wenn der Cursor im Zeichenbereich ist

    ELSEIF and(and(gt(%Mousex,39),lt(%mousex,298)),and(gt(%Mousey,39),lt(%Mousey,298)))

        Zeichnet einzelnen Bildpunkt

        IF and(equ(%Message,513),equ(&Wparam,1))

            ZEICHNE_BILDPUNKT %Mousex,%Mousey,fcolor&
            Zeichnet Bildpunkte bei gedrückter Taste

        ELSEIF equ(%Mousepressed,1)

            ZEICHNE_BILDPUNKT %Mousex,%Mousey,fcolor&

        ENDIF

        Farbe wählen, wenn die Maus im Farbenbereich ist u. geklickt wird.

    ELSEIF and(and(gt(%Mousex,311),lt(%mousex,341)),and(gt(%Mousey,55),lt(%Mousey,295)))

        if and(equ(%Message,513),equ(&WPARAM,1))

            copybmp 311,310-32,32 > 349,310;0     ICON für das UNDO-FELD
            let fcolor&=getpixel(%Mousex,%Mousey)
            usebrush 1,fcolor&                    Füllfarbe für den Icon-Hintergrund
            usepen 0,1,rgb(0,0,0)                 und die Rahmenfarbe
            rectangle 80,310-120,322              Rechteck mit aktueller Farbe zeichnen

        endif

        Rasterfarbe setzen, wenn die Maus im Rasterfarben-Bereich ist u. geklickt wird.

    ELSEIF and(and(gt(%Mousex,348),lt(%mousex,379)),and(gt(%Mousey,55),lt(%Mousey,295)))

        if and(equ(%Message,513),equ(&WPARAM,1))

            let Rcolor&=getpixel(%Mousex,%Mousey)
            usebrush 1,Rcolor&                    Füllfarbe für den Rasterrahmen
            usepen 0,1,rgb(0,0,0)                 und die Rahmenfarbe
            rectangle 80,330-120,342              Rechteck mit aktueller Farbe zeichnen
            case equ(Raster%,1):ZEIGERASTER

        endif

        Undo Icon mit Aktuellen tauschen wenn Auf dem UNDO Icon geklickt.

    ELSEIF and(and(gt(%Mousex,349),lt(%mousex,381)),and(gt(%Mousey,310),lt(%Mousey,342)))

        if and(equ(%Message,513),equ(&WPARAM,2>1))

            UNDO_ICON

        endif

    ENDIF

    XYPOSITION %Mousex,%Mousey
    setmenuitem 0

wend

Dispose Dirname#
END