XProfan

WindowStyle 512+16:Window 200,100 - 390,241:Declare ib&[35,3],im%,s%,i%,t%,b%,r%,z%,sf%,ai%,at%,ar%,wz%,qp$,fm%,fr!,kt%,wt$,ti%
wt$=" JörgG's 4k-SystemMemory -- Klick dich fit...  ":WindowTitle wt$:Def GetSysColor(1) !"USER32","GetSysColor":sf% = GetSysColor(15)

Proc tb

    s%=5:z%=5:t%=1:ib&[0,1]=Create("hIcon",Par$(0),0)

    WhileLoop 1,at%:ib&[&loop]=Create("IconButton",%hwnd,ib&[0,1],s%,z%,50,50):ib&[&loop,2]=s%+7:ib&[&loop,3]=z%+7:Inc t%:If t%>ar%:t%=1:s%=5:Inc z%,52:Else:Inc s%,52:EndIf:EndWhile

        ib&[27]=Create("Button",%hwnd,"Neu",325,170,55,40):ib&[34]=Create("text",%hwnd,"",337,145,43,25)

    EndProc

    Proc level

        var f$="$400080":Cls sf%:MAT ib&[]=1
        ib&[26]=Create("Button",%hwnd,"Ende",325,5,55,20):ib&[28]=Create("RadioButton",%hwnd,"16x",325,146,55,20):ib&[29]=Create("RadioButton",%hwnd,"20x",325,166,55,20)
        ib&[30]=Create("RadioButton",%hwnd,"24x",325,186,55,20):ib&[31]=Create("text",%hwnd,"Anzeigedauer bei ungleichen Pärchen:",50,43,265,25)
        ib&[32]=Create("choicebox",%hwnd,1,310,35,70,90):@AddString(ib&[32],"0.5 sek"):AddString(ib&[32],"1.0 sek"):AddString(ib&[32],"1.5 sek"):SelectString(ib&[32],-1,"1.0 sek")
        ib&[34]=Create("text",%hwnd,"Zeitlimit in Sekunden pro Runde setzen:",38,105,265,25)
        ib&[35]=Create("choicebox",%hwnd,0,310,105,70,110):AddString(ib&[35],"kein's"):WhileLoop 15,180,15:AddString(ib&[35],Str$(&loop)):EndWhile:SelectString(ib&[35],-1,"kein's")
        TextColor $00FF,-1:DrawText 50,145,"Mit welchem Level":DrawText 50,170,"möchtest du spielen?":SetTimer 10

        While 1

            WaitInput
            case (Clicked(ib&[28])) Or (Clicked(ib&[29])) Or (Clicked(ib&[30])):BREAK

            If Clicked(ib&[26]):KillTimer:End:EndIf

                Inc ai%,30:usepen 0,3,f$:Line ai%,80-ai%,83:If ai%>330:ai%=0:If f$="$400080":f$="$FF":Else:f$="$400080":EndIf:EndIf

            EndWhile

            If GetCheck(ib&[28])=1:ai%=8:at%=16:ar%=4:ElseIf GetCheck(ib&[29])=1:ai%=10:at%=20:ar%=5:Else:ai%=12:at%=24:ar%=6:EndIf

                wz%=GetCurSel(ib&[32]):If wz%=0:wz%=500:elseif wz%=1:wz%=1000:Else:wz%=1500:EndIf
                fm%=GetCurSel(ib&[35]):If fm%=0:fm%=301:Else:fm%=fm%*15:WindowTitle wt$+"--  Zeitlimit: "+Str$(fm%)+" Sek":EndIf:fr!=fm%
                KillTimer:DestroyWindow(ib&[31]):DestroyWindow(ib&[32]):DestroyWindow(ib&[33]):DestroyWindow(ib&[34]):DestroyWindow(ib&[35])
                ShowWindow(ib&[28],0):ShowWindow(ib&[29],0):ShowWindow(ib&[30],0)

            EndProc

            Proc neu

                Declare h%[im%]:WhileLoop 1,at%:ShowWindow(ib&[&loop],1):DeleteObject ib&[&loop,1]:ib&[&loop,1]=1:EndWhile:cls sf%:s%=0:Randomize

                While s%<ai%:t%=Rnd(im%)+1:if h%[t%]=0:h%[t%]=Create("hIcon",qp$,t%):Inc s%:z%=0:While z%<2:i%=Rnd(at%)+1:If ib&[i%,1]=1:ib&[i%,1]=h%[t%]:Inc z%:EndIf:EndWhile:EndIf:EndWhile:s%=0:t%=0:r%=0:anz:Play 75;80,16,1:If fm%<301:SetTimer 500:kt%=1:EndIf:fr!=fm%

                EndProc

                Proc ausgabe

                    Parameters ix%:ShowWindow(ib&[ix%],0):DrawIcon ib&[ix%,1],ib&[ix%,2],ib&[ix%,3]:If s%=0:i%=ix%:inc s%:Else:If ib&[ix%,1]<>ib&[i%,1]:sleep wz%:ShowWindow(ib&[ix%],1):ShowWindow(ib&[i%],1)

                    If fr!<301:fr!=fr!-wz%/1000:ti%=%wmtimer:SetTimer 500:EndIf:Else:Inc r%:EndIf:s%=0:EndIf

                        If r%=ai%:Play 19;19;19,-1,0:Play 25;27;29,0,0:If fm%<301:KillTimer:kt%=0:TextColor $400080,-1:DrawText 330,110,Str$(fm%-fr!)+ "s":EndIf:sleep 1000:Play -25;-27;-29,0,0:If (b% > t%) Or (b% = 0):MUSIC "C#2 F-8 G4.":b%=t%:anz:EndIf:EndIf

                        EndProc

                        Proc anz

                            rectangle 325,32-380,97:TextColor $00FF,-1:DrawText 335,33,Str$(b%):TextColor $8000,-1:DrawText 335,68,Str$(t%)

                        EndProc

                        qp$=$syspath+"\\shell32.dll":im%=@IconCount(qp$)-1:UseFont "courier new",30,12,1,0,0:set("NumWidth",3):set("Decimals",0):level:usepen 0,0,$FF0000:tb:neu:b%=0

                        While 1

                            WaitInput

                            If %wmtimer:fr!=fr!-.5:SetText ib&[34],Str$(fr!):If fr!<.5:Play 29;35,2,1:MessageBox("Die Zeit für die neue Runde läuft, sobald du OK drückst...","Schade - die "+Str$(fm%)+" Sek sind leider abgelaufen...",262640):SetFocus((ib&[27])):neu:EndIf

                            ElseIf Clicked(ib&[26]):WhileLoop 0,at%:DeleteObject ib&[&loop,1]:EndWhile:Case kt%=1:KillTimer:end:ElseIf Clicked(ib&[27]):neu:Endif

                                WhileLoop 1,at%:If %getfocus=ib&[&loop]:Inc t%:anz:ausgabe &loop:BREAK:EndIf:EndWhile:EndWhile