XProfan

 $H Messages.ph

proc Zeige_Kugeln

    declare ly% , gueltig%
    alle Buttons durchgehen

    whileloop 0,9

        ly% = &loop

        whileloop 0,9

            if xor(not(&loop mod 9),not(ly% mod 9)) or (not(&loop) and (ly% = 9))

                Rand deaktivieren
                EnableWindow But&[&loop,ly%],0

            elseif (&loop mod 9) and (ly% mod 9)

                Mittelfeld aufdecken
                ShowWindow(But&[&loop,ly%],0)

            endif

            Die Kullern anzeigen

            if between(&loop,1,8,ly%,1,8)

                SetTimer 0 : waitinput : KillTimer

                if feld%[&loop - 1,ly% - 1]

                    DrawPic PTrue&,&loop * 48,ly% * 48;-1

                endif

            endif

        EndWhile

    EndWhile

    Das gemalte ans Hintergrundbild klatschen
    PLsg& = Create("hPic",0,"&SCRBMP")
    SendMessage(hBack&,~STM_SETIMAGE,0,PLsg&)
    SavePic "D:\Dat1.bmp",PLsg&
    SavePic "D:\Dat2.bmp",SendMessage(hBack&,~STM_GETIMAGE,0,0)
    Zu guter Letzt den deaktivierten Rand wegmachen

    whileloop 0,9

        ly% = &loop

        whileloop 0,9

            case xor(not(&loop mod 9),not(ly% mod 9)) : ShowWindow(But&[&loop,ly%],0)

        EndWhile

    EndWhile

endproc

proc Button

    parameters px% , py%
    Rand: Bilder, Mitte: normal

    ifnot (px% mod 9) and (py% mod 9)

        But&[px%,py%] = Create("PicButton",%hWnd,PTrue&,px% * 48,py% * 48,48,48)

    else

        But&[px%,py%] = Create("Button",%hWnd,"",px% * 48,py% * 48,48,48)

    endif

endproc

proc Button_2

    parameters px% , py%
    nur ein Button am Rande ist kein Bild

    if (px% = 0) and (py% = 9)

        But&[px%,py%] = Create("Button",%hWnd,"",px% * 48,py% * 48,48,48)

    elseif not((px% mod 9) and (py% mod 9))

        But&[px%,py%] = Create("PicButton",%hWnd,PTrue&,px% * 48,py% * 48,48,48)

    else

        But&[px%,py%] = Create("Button",%hWnd,"",px% * 48,py% * 48,48,48)

    endif

endproc

proc Bereite_Bilder

    Hintergrundbild
    PBack& = Create("hNewPic",481,481,$FFFFFF)
    StartPaint PBack&
    UsePen 0,1,0

    whileloop 2,8

        Rectangle (48*&loop-1),0 - (48*&loop+1),480

    EndWhile

    whileloop 2,8

        Rectangle 0,(48*&loop-1) - 480,(48*&loop+1)

    EndWhile

    EndPaint
    Bild für die Kullern
    PTrue& = Create("hNewPic",48,48,$FFFFFF)
    StartPaint PTrue&
    UsePen 0,1,0
    UseBrush 1,0
    Ellipse 2,2,45,45
    EndPaint

endproc

proc BuildUp

    declare y%
    WindowStyle 26
    Window 100,50 - 500,520
    Hintergrund
    hBack& = Create("Bitmap",%hWnd,PBack&,0,0)
    alle Buttons

    whileloop 0,9

        y% = &loop

        whileloop 0,9

            Button(&loop,y%)
            Button_2(&loop,y%)

        EndWhile

    EndWhile

endproc

proc Platziere_Kugeln

    declare rx% , ry%
    clear feld%[]

    whileloop 4

        repeat

            rx% = Rnd(8)
            ry% = Rnd(8)

        until not(feld%[rx%,ry%])

        feld%[rx%,ry%] = 1

    EndWhile

endproc

declare But&[9,9], feld%[7,7]
declare hBack&,PBack&,PLsg& , PTrue&
Randomize
Bereite_Bilder
BuildUp
Platziere_Kugeln
var e% = 0

whilenot e%

    waitinput

    if Clicked(But&[9,9])

        e% = 1

    elseif Clicked(But&[0,9])

        Zeige_Kugeln

    endif

wend

DeleteObject PBack&
DeleteObject PLsg&
DeleteObject PTrue&
end

cls 16777215
P& ist das Bild des Buttons
var P& = Create("hNewPic",48,48,$22DD22)
Die Buttons sind h& und g&. Jeder kann ein Text- oder ein Bildbutton sein.
var h& = Create("Button",%hWnd,"Text",0,0,48,48)
var h& = Create("PicButton",%hWnd,p&,0,0,48,48)
var g& = Create("PicButton",%hWnd,p&,48,0,48,48)
var g& = Create("Button",%hWnd,"Text",48,0,48,48)
Der Fensterinhalt wird fotografiert und nach unten versetzt angezeigt.
var Q& = Create("hPic",0,"&SCRBMP")
cls 0 Damit man Bild und Bildschirm unterscheiden kann.
Create("Bitmap",%hWnd,Q&,0,48)
Rest

whilenot IsKey(27)

    waitinput

wend

DeleteObject P&
DeleteObject Q&
end