Regentropfen auf dem Desktop

[STARGÅTE]

Tachchen,

hat jemand Interesse an Regentropfen,
dann soll er sich die (Link veraltet) saugen.

Einfach die EXE starten (am besten
auf dem Desktop) und kurz warten.
Beenden mit jeder Taste.
Danach müsste man nur kurz den Desktop "trocknen",
weil er danach "durchnässt" ist.

Ich kann die Teile leider (zur Zeit) für nix gebrauchen,
aber vllt hat ein von euch eine Idee,
für was man sie Brauchen kann.

Code: Alles auswählen

InitKeyboard()

Global DesktopOutput_Memory.l 
DesktopOutput_Memory = AllocateMemory(1024, 1024)
Procedure.l DesktopOutput() 
 PokeL(DesktopOutput_Memory, 1)
 ProcedureReturn DesktopOutput_Memory
EndProcedure 

Procedure DesktopX()
 ProcedureReturn GetSystemMetrics_(0)
EndProcedure
Procedure DesktopY()
 ProcedureReturn GetSystemMetrics_(1)
EndProcedure

#b = 0.01745329
xP = DesktopX()
yP = DesktopY()

Dim Punkt(xP, yP)

Procedure DisplayTropfen(x,y,r)
 rr = r*r
 Ar.f = 1/rr 
 For yy = -r To r
  sr = Sqr(rr-yy*yy)
  For xx = -sr To sr
   d = xx*xx+yy*yy
   Px = Int(x+xx*d*Ar)
   Py = Int(y+yy*d*Ar)
   Plot(xx+x,yy+y,Punkt(Px,Py))
  Next xx
 Next yy
EndProcedure

Procedure Desktop()
 xx = DesktopX() : yy = DesktopY()
 For y = 0 To yy
  For x = 0 To xx
   Punkt(x,y) = Point(x,y)
  Next x
 Next y
EndProcedure

Structure T
 x.l
 y.l
 r.l
EndStructure
NewList T.T()
Procedure NeuerTropfen()
 AddElement(T())
 T()\x = Random(DesktopX()-100)+50
 T()\y = Random(DesktopY()/2)+50
 T()\r = Random(25)+15
EndProcedure

For n = 1 To 10 : NeuerTropfen() : Next n

StartDrawing(DesktopOutput())
 Desktop()
 Repeat
  ExamineKeyboard() : If KeyboardPushed(#PB_Key_All) : End : EndIf
  ResetList(T())
  While NextElement(T())
   T()\y + 3
   DisplayTropfen(T()\x,T()\y,T()\r)
   If T()\y-T()\r > yP
    DeleteElement(T())
    NeuerTropfen()
   EndIf
  Wend
 ForEver
StopDrawing()

[Kevin]

cool das script
mach doch ein bildschirmschoner draus
das hab ich gemacht

[dige]

@Stargate: uiii, gar nicht mal so schlecht

Ich habe den Code bischen aufgeräumt und nach PB4 portiert:

Code: Alles auswählen

Structure T
  x.l
  y.l
  r.l
EndStructure

Global xP.l, yP.l, DesktopOutput_Memory.l
Global NewList T.T()

Procedure.l DesktopOutput()
  PokeL(DesktopOutput_Memory, 1)
  ProcedureReturn DesktopOutput_Memory
EndProcedure
Procedure DesktopX()
  ProcedureReturn GetSystemMetrics_(0)
EndProcedure
Procedure DesktopY()
  ProcedureReturn GetSystemMetrics_(1)
EndProcedure

DesktopOutput_Memory = AllocateMemory(1024)

#b = 0.01745329
xP = DesktopX()
yP = DesktopY()

Global Dim Punkt(xP, yP)

Procedure DisplayTropfen(x,y,r)
  rr = r*r
  Ar.f = 1/rr
  For yy = -r To r
    sr = Sqr(rr-yy*yy)
    For xx = -sr To sr
      d = xx*xx+yy*yy
      pX = Int(x+xx*d*Ar)
      pY = Int(y+yy*d*Ar)
      Plot(xx+x,yy+y,Punkt(pX,pY))
    Next xx
  Next yy
EndProcedure

Procedure Desktop()
  xx = DesktopX() : yy = DesktopY()
  For y = 0 To yy
    For x = 0 To xx
      Punkt(x,y) = Point(x,y)
    Next x
  Next y
EndProcedure

Procedure NeuerTropfen()
  AddElement(T())
  T()\x = Random(DesktopX()-100)+50
  T()\y = Random(DesktopY()/2)+50
  T()\r = Random(25)+15
EndProcedure

For n = 1 To 10 : NeuerTropfen() : Next n

If StartDrawing(DesktopOutput())
  Desktop()
  
  Repeat
    If GetAsyncKeyState_ (#VK_ESCAPE) : Break : EndIf
    ResetList(T())
    While NextElement(T())
      T()\y + 3
      DisplayTropfen(T()\x,T()\y,T()\r)
      If T()\y-T()\r > yP
        DeleteElement(T())
        NeuerTropfen()
      EndIf
    Wend
  ForEver
  StopDrawing() 
EndIf
End

Ist allerdings noch ein Bug drin. Plot zeichnet wohl über den Bildschirm-
rand hinaus ....

[STARGÅTE]

jo, naja, was unter dem Bildschirmrand passiert war mir eigentlich egal

aber wenn der Tropfen drunter läutf, dann kommts indirekt zum BUG, weil er ja ein Farbwert lesen will den es garnicht gibt

PS: danke für's Übersetzen

[D@nte]

@Stargåte
Für die exe sollteste ggf noch sowas wie

Code: Alles auswählen

Sleep_(5000)
InvalidateRect_(#False,#False,#False)

(mir fallen grad die äquivalenten PB-Befehle ein) einfügen um den Screen auch wieder aufzuräumen damit man nicht "trocken wischen" muss

Zur Verwendung:
Kannst es ja an M$ mailen die VISTA User scheinen ja auf so Effektchen zu stehen

[HeX0R]

[...]
(mir fallen grad die äquivalenten PB-Befehle ein)
[...]

Wenn sie dir einfallen, wieso verwendest du sie dann nicht ?

[Tafkadasom2k5]

Zur Verwendung:
Kannst es ja an M$ mailen die VISTA User scheinen ja auf so Effektchen zu stehen

...das Programm funktioniert aber unter Vista so garnicht

[Knight_Rider_2000]

@dige
Dein Code hat noch den fehler das du plot benutzt und deswegen wenn ein tropfen aus den bildschirm kommt der compiler meckert. Könntest du den fehler vielleicht mit einer If Endif abfrage verbessern?