XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
profaninterne Icons zeichnen
Lauffähig ab Profan-Version 6.6
Erklärung:
----------
Dieses Beispiel demonstriert, wie Icons auf dem Hauptfenster
positioniert werden können und verwendet alle profaninternen Icons.
Es bedeuten:
------------
Titel$     der Text der Titelzeile des Hauptfensters
x%         die vertikale Ausdehnung des Hauptfensters
y%         die horizontale Ausdehnung des Hauptfensters
exit%      Handle des Beenden-Buttons
b%         Breite des Beenden-Buttons
h%         Höhe des Beenden-Buttons
bild$      Dateiname des Bitmaps
icon$      Name des profaninternen Icons
declare Titel$,x%,y%,e%
declare i%,j%
declare icon$
declare b%,h%
declare bild$

PROC INIT

    x% = 325
    y% = 235
    b% = 100
    h% = 25
    let bild$ = WOLKEN.BMP
    let icon$ = A
    Titel$=Ich bin ein kleines Profan²-Programm
    WindowStyle 48
    WindowTitle Titel$
    SetTrueColor 1

ENDPROC

PROC MENU

    PopUp Icon
    AppendMenu 101,A
    AppendMenu 102,DOS
    AppendMenu 103,EIMER
    AppendMenu 104,GESICHT
    AppendMenu 105,SAND
    AppendMenu 106,WASSER
    AppendMenu 107,MUELL
    AppendMenu 108,BAUM
    AppendMenu 109,DRUCKER
    AppendMenu 110,EIS
    AppendMenu 111,KNOPF1
    AppendMenu 112,MUENZE
    AppendMenu 113,STEIN
    AppendMenu 114,WEG
    AppendMenu 115,COMPUTER
    AppendMenu 116,EDITOR
    AppendMenu 117,FILEICON
    AppendMenu 118,KNOPF2
    AppendMenu 119,PROFAN
    AppendMenu 120,TEXT
    AppendMenu 121,WINDOWS
    AppendMenuBar 99,Be&enden

ENDPROC

PROC HAUPTFENSTER

    Window (%MaxX - x%) / 2,(%MaxY - y%) / 2 - x%,y%
    MENU
    cls rgb(255,255,255)
    UseFont Arial,16,0,0,0,0
    SetDialogfont 1

ENDPROC

PROC ICONS

    clear i%
    clear j%

    while lt(j%,Height(%HWnd))

        while lt(i%,Width(%HWnd))

            DrawIcon icon$,i%,j%
            i% = i% +32

        wend

        i% = 0
        j% = j% +32

    wend

ENDPROC

#####################################################
INIT
HAUPTFENSTER
ICONS
clear e%

whilenot e%

    Waitinput

    If MenuItem(99)

        e%=1

    elseif MenuItem(101)

        let icon$=A
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(102)

        let icon$=DOS
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(103)

        let icon$=EIMER
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(104)

        let icon$=GESICHT
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(105)

        let icon$=SAND
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(106)

        let icon$=WASSER
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(107)

        let icon$=MUELL
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(108)

        let icon$=BAUM
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(109)

        let icon$=DRUCKER
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(110)

        let icon$=EIS
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(111)

        let icon$=KNOPF1
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(112)

        let icon$=MUENZE
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(113)

        let icon$=STEIN
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(114)

        let icon$=WEG
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(115)

        let icon$=COMPUTER
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(116)

        let icon$=EDITOR
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(117)

        let icon$=FILEICON
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(118)

        let icon$=KNOPF2
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(119)

        let icon$=PROFAN
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(120)

        let icon$=TEXT
        cls rgb(255,255,255)
        ICONS

    elseif MenuItem(121)

        let icon$=WINDOWS
        cls rgb(255,255,255)
        ICONS

    endif

wend

end