Italia
Fonte/ Codesnippets

Bildschirmschoner Blöcke Fallende

 

Nico
Madysa
Das kommt raus, wenn ich Langeweile hab :
KompilierenMarkierenSeparieren
proc Boxan

    parameters x% , y%
    Rectangle (x% + 1) , (y% - ueber% + 1) - (x% + Box%) , (y% - ueber% + Box%)

endproc

proc Boxaus

    parameters x% , y%
    MCopyBMP x% , (y% - ueber%) - Box% , Box% > x% , (y% - ueber%) ; 0

endproc

declare Box% , Anzx% , Anzy% , ueber%
declare posx% , posy% , gis% , AnzBox% , Stapel%[15]
WindowStyle 1024 + 240
Window 0 , 0 - %MaxX , %MaxY
WindowTitle Bildschirmschoner
ShowCursor 0
Randomize
UsePen 0 , 2 , 0
MCls %MaxX , %MaxY
clear gis% , AnzBox%

while gis% < 10

    ifnot AnzBox%

        Anzx% = Rnd(11) + 5
        Box% = %MaxX  Anzx%
        Anzy% = Int(Anzx% * %MaxY / %MaxX) + 1
        ueber% = (Box% * Anzy%) - %MaxY
        MAT Stapel%[] = Anzy%
        CopyBMPToMem 0 , 0 - %MaxX , %MaxY > 0 , 0
        UseBrush 1 , RGB(Rnd(256),Rnd(256),Rnd(256))
        AnzBox% = Anzx% * Anzy%

    endif

    repeat

        posx% = Rnd(Anzx%)

    until Stapel%[posx%]

    Stapel%[posx%] = Stapel%[posx%] - 1

    whileloop 0 , Stapel%[posx%]

        case &loop : BoxAus (posx% * Box%) , ((&loop - 1) * Box%)
        BoxAn (posx% * Box%) , (&loop * Box%)
        Sleep 50
        case %GetInputState : inc gis%

    EndWhile

    Sleep 50
    dec AnzBox%
    case %GetInputState : inc gis%

wend

ShowCursor 1
=s4 href='./../../function-references/xprofan/end/'>end

2 kB
Kurzbeschreibung: Screensaver - Quelltext
Hochgeladen:18.02.2008
Downloadcounter302
Download
 
Nico Madysa
18.02.2008  
 



@Nico
Hab die Klötze ein bischen farbig gewechselt - bist mir aber nicht böse ;)
KompilierenMarkierenSeparieren
PROC COLOR_WECHSEL neue Procedur

    UseBrush 1 , RGB(Rnd(255-20),Rnd(255-20),Rnd(255-20))

ENDPROC

#####################################################

proc Boxan

    parameters x% , y%
    COLOR_WECHSEL Hier werden die Farben geändert
    Rectangle (x% + 1) , (y% - ueber% + 1) - (x% + Box%) , (y% - ueber% + Box%)

endproc

proc Boxaus

    parameters x% , y%
    MCopyBMP x% , (y% - ueber%) - Box% , Box% > x% , (y% - ueber%) ; 0

endproc

declare Box% , Anzx% , Anzy% , ueber%
declare posx% , posy% , gis% , AnzBox% , Stapel%[15]
WindowStyle 1024 + 240
Window 0 , 0 - %MaxX , %MaxY
WindowTitle Bildschirmschoner
ShowCursor 0
Randomize
UsePen 0 , 2 , 0
MCls %MaxX , %MaxY
clear gis% , AnzBox%

while gis% < 10

    ifnot AnzBox%

        Anzx% = Rnd(11) + 5
        Box% = %MaxX  Anzx%
        Anzy% = Int(Anzx% * %MaxY / %MaxX) + 1
        ueber% = (Box% * Anzy%) - %MaxY
        MAT Stapel%[] = Anzy%
        CopyBMPToMem 0 , 0 - %MaxX , %MaxY > 0 , 0
        UseBrush 1 , RGB(Rnd(256),Rnd(256),Rnd(256)) das hab ich deaktiviert
        AnzBox% = Anzx% * Anzy%

    endif

    repeat

        posx% = Rnd(Anzx%)

    until Stapel%[posx%]

    Stapel%[posx%] = Stapel%[posx%] - 1

    whileloop 0 , Stapel%[posx%]

        case &loop : BoxAus (posx% * Box%) , ((&loop - 1) * Box%)
        BoxAn (posx% * Box%) , (&loop * Box%)
        Sleep 50
        case %GetInputState : inc gis%

    EndWhile

    Sleep 50
    dec AnzBox%
    case %GetInputState : inc gis%

wend

ShowCursor 1<
end
 
18.02.2008  
 




Nico
Madysa
Pfui, Schäm dich, aus!
Nein im Ernst, auf sowas cooles bin ich nicht gekommen.
 
Nico Madysa
19.02.2008  
 




Paul
Glatz
Giebts das auch per XProfan 8.0
Paul
 
19.02.2008  
 




Wilfried
Friebe
Hi alle

Habe das Prog mal gestartet

und dann kam diese Fehlermeldung

was ist das per ein Befehl?

MAT ???

Fehlermeldung im Anhang.

Saluto Wilfried


53 kB
Hochgeladen:19.02.2008
Downloadcounter259
Download
 
Board MSI B450M BAZOOKA CPU AMD Ryzen 7 2700x 8 Core 3,7-4,2 GH 32 Gb Ram NVIDIA GeForce GTX 3060 12 GB Ram Window 11 Prof 64 Bit

Sun-Guru-Barebone CPU I7-9750H 16 GB Ram NVIDIA GeForce GTX1660TI 6 GB Ram Window 11 Hom 64 Bit

Profan 4.5 bis Xprofan 14
Ein frisch geschriebenes Programm hat meistens einen großen Fehler.Sollte man versuchen diesen großen Fehler zu beseitigen, hat man viele kleine Fehler "Grins"
19.02.2008  
 




Jörg
Sellmeyer
Mat wird es erst ab Profan 11 geben. Der Code ist also nur per Besitzer der Subscriptionsversion lauffähig.
Siehe hier: [...]  und dann unter Nr 3:


3. Array-Zuweisungen und Matrix-Befehle (letzte Ergänzung: 16.12.2007)
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
19.02.2008  
 




Nico
Madysa
Macht nichts anderes, als das gesamte Array mit einer einzigen Zahl zu füllen. Davor muss man eine Whileloop-Schleife dazu basteln, was naturalmente an der Rechenzeit nagt.
KompilierenMarkierenSeparieren
proc Boxan

    parameters x% , y%
    Rectangle (x% + 1) , (y% - ueber% + 1) - (x% + Box%) , (y% - ueber% + Box%)

endproc

proc Boxaus

    parameters x% , y%
    MCopyBMP x% , (y% - ueber%) - Box% , Box% > x% , (y% - ueber%) ; 0

endproc

declare Box% , Anzx% , Anzy% , ueber%
declare posx% , posy% , gis% , AnzBox% , Stapel%[15]
WindowStyle 1024 + 240
Window 0 , 0 - %MaxX , %MaxY
WindowTitle Bildschirmschoner
ShowCursor 0
Randomize
UsePen 0 , 2 , 0
MCls %MaxX , %MaxY
clear gis% , AnzBox%

while gis% < 10

    ifnot AnzBox%

        Anzx% = Rnd(11) + 5
        Box% = %MaxX  Anzx%
        Anzy% = Int(Anzx% * %MaxY / %MaxX) + 1
        ueber% = (Box% * Anzy%) - %MaxY

        whileloop 0 , 14

            Stapel%[&loop] = Anzy%

        EndWhile

        CopyBMPToMem 0 , 0 - %MaxX , %MaxY > 0 , 0
        UseBrush 1 , RGB(Rnd(256),Rnd(256),Rnd(256))
        AnzBox% = Anzx% * Anzy%

    endif

    repeat

        posx% = Rnd(Anzx%)

    until Stapel%[posx%]

    Stapel%[posx%] = Stapel%[posx%] - 1

    whileloop 0 , Stapel%[posx%]

        case &loop : BoxAus (posx% * Box%) , ((&loop - 1) * Box%)
        BoxAn (posx% * Box%) , (&loop * Box%)
        Sleep 50
        case %GetInputState : inc gis%

    EndWhile

    Sleep 50
    dec AnzBox%
    case %GetInputState : inc gis%

wend

ShowCursor 1 class=s4 href='./../../function-references/xprofan/end/'>end

@Paul: Du gemeiner Avatar-Dieb, du hättest zumindest die Zündschnur umzeichnen können, damit der Klau nicht ganz so auffällig ist.
 
Nico Madysa
20.02.2008  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

9.620 Views

Untitledvor 0 min.
Frank16.04.2021
RudiB.31.01.2016
lange-jens18.04.2012
Julian Schmidt26.07.2011
Di più...

Themeninformationen



Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie