Terror of Colors

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Olaf
Beiträge: 117
Registriert: 20.04.2006 14:51
Wohnort: 66606 St.Wendel (Niederlinxweiler, Dr.Albert-Schweitzer-Str.9)
Kontaktdaten:

Terror of Colors

Beitrag von Olaf »

Hab mal ein Programm geschrieben, was den direkten Desktopoutput zum Zeichnen benutzt.
Dabei wird über den gesamten Desktop ein Rechteck im XOr - Modus gezeichnet (Effekt: Farben umkehren).
Da der Effekt nach 100 ms wieder rückgängig gemacht wird und nach weiteren 100ms wieder erscheint, führt das zu einem sehr bunten Resultat (kann User aber auch ganz schön nerven, daher der Name).
Sieht eigentlich ganz witzig aus.
Andere Programme können jedoch gleichzeitig laufen und sind weiterhin nutzbar.
Zudem ist der Code sehr kurz:

Code: Alles auswählen

Global *mem=AllocateMemory(1024)
Procedure.l DesktopOutput()  ;ermittelt den Output des Desktop
	mem=PokeL(*mem,1)
	ProcedureReturn mem
EndProcedure

ExamineDesktops()
w=DesktopWidth(0)  ;ermittelt Breite des Desktops
h=DesktopHeight(0)  ;ermittelt Höhe des Desktops

Repeat
Delay(100)
StartDrawing(Desktopoutput())
	DrawingMode(2)  ;XOr - Modus einschalten
	Box(0,0,w,h)       ;Rechteck zeichnen
StopDrawing()
Delay(100)
InvalidateRect_(0,0,0)  ;Auf den Desktop Gezeichnetes löschen
Until GetAsyncKeyState_(#VK_END) ;bis ENDE-Taste gedrückt wird
InvalidateRect_(0,0,0)
PB 4.xx (Windows & Linux & Mac OS X)
Treffen sich 2 Kurven in der Unendlichkeit. Sagt die eine zur anderen: "Hau ab aus meinem Definitionsbereich oder ich leite dich ab!"
Darauf die andere: "Mach nur! Ich bin die e-Funktion." :lol:
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

hübsche sinnlose Spielerei :lol:

hier mal ohne Extra Procedure:

Code: Alles auswählen

*mem.Long = AllocateMemory(1024)
*mem\l = 1

ExamineDesktops()
w=DesktopWidth(0)  ;ermittelt Breite des Desktops
h=DesktopHeight(0)  ;ermittelt Höhe des Desktops

Repeat
Delay(100)
StartDrawing(*mem)
   DrawingMode(2)  ;XOr - Modus einschalten
   Box(0,0,w,h)       ;Rechteck zeichnen
StopDrawing()
Delay(100)
InvalidateRect_(0,0,0)  ;Auf den Desktop Gezeichnetes löschen
Until GetAsyncKeyState_(#VK_END) ;bis ENDE-Taste gedrückt wird
InvalidateRect_(0,0,0)
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

autsch...

nerven is gut... dein proggi braucht ne epilepsiewarnung in riesengroßer schrift.. ;)
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Benutzeravatar
Alves
Beiträge: 1208
Registriert: 19.04.2006 18:24
Kontaktdaten:

Beitrag von Alves »

Also ich finds gut! :allright:
Benutzeravatar
Mr.X
Beiträge: 66
Registriert: 10.08.2005 22:46
Wohnort: im schönen OWL

Beitrag von Mr.X »

Wer so einen Blödsin programmiert und noch veröffentlicht gehört m.E. in die Klapse :mrgreen: -- oder kommt er von dort und kann einfach nicht anders. Dann habe einfach nur Mitleid. Mitleid mit dem, der die Entlassung unterschrieben hat.

:lol: :lol: :lol: :lol:
Benutzeravatar
dige
Beiträge: 1241
Registriert: 08.09.2004 08:53

Beitrag von dige »

Kann mal jemand erklären wie das funktioniert?
Ist mir vollkommen unklar das eine beliebig Speicheradresse:

Code: Alles auswählen

*mem.Long = AllocateMemory(1024) 
zum zeichnen auf den Desktop verwendet werden kann:

Code: Alles auswählen

StartDrawing(*mem) 
Ist das jetzt Zufall oder ein echtes Feature?
"Papa, ich laufe schneller - dann ist es nicht so weit."
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

Beitrag von Jilocasin »

kA, hab ich auch schon überlegt...

aber sonst -> Cooles Prog
Bild
Benutzeravatar
Quaxi
Beiträge: 66
Registriert: 11.09.2004 12:42

Beitrag von Quaxi »

Hallo,
ich hab mich damit ein wenig gespielt und bin fasziniert. Mich stört allerdings dieses flackern beim neuzeichnen. Kann man das irgendwie lösen?
lg
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Beitrag von STARGÅTE »

Sry wenn ich einfach deine Frage umgehe :lol: aber ich wollte auch noch ein Code mit reinschreiben der auch etwas mit dem Desktop spielt :

Schusslöcher im Bildschirm + Risse

Code: Alles auswählen

Global Mem.l 
Mem = AllocateMemory(1, 1024)

Procedure.l DesktopOutput() 
  PokeL(Mem, 1) 
  ProcedureReturn Mem 
EndProcedure 

b.f = 3.14159265/180

Repeat
  Delay(10)
  StartDrawing(DesktopOutput() ) 
   If Random(200) = 0
    x = Random(GetSystemMetrics_(0))
    y = Random(GetSystemMetrics_(1))
    r = Random(4)+4
    For n = 1 To r*2
     ax = x
     ay = y
     w = Random(359)
     Repeat
      bx = ax+Cos((w+Random(12)-6)*b)*(Random(40)+40)
      by = ay+Sin((w+Random(12)-6)*b)*(Random(40)+40)
      LineXY(ax-1, ay  , bx-1, by  , RGB(128,128,128))
      LineXY(ax  , ay-1, bx  , by-1, RGB(128,128,128))
      LineXY(ax-1, ay-1, bx-1, by-1, RGB(0,0,0))
      LineXY(ax  , ay  , bx  , by  , RGB(255,255,255))
      ax = bx
      ay = by
     Until bx < 0 Or bx > GetSystemMetrics_(0) Or by < 0 Or by > GetSystemMetrics_(1)    
     z = r+Random(r)
     ww = Random(359)
     For xx = -r/2 To r/2 :
      For yy = -r/2 To r/2 :
       LineXY(x+xx,y+yy,x+Cos(ww*b)*z,y+Sin(ww*b)*z, RGB(0,0,0))
      Next yy
     Next xx
    Next n
    Circle(x  ,y  ,r/2+4, RGB(128,128,128))
    Circle(x  ,y  ,r/2+3, RGB(0,0,0))
    For n = 1 To r
    Next n
   EndIf
  StopDrawing() 

Until GetAsyncKeyState_(#VK_ESCAPE)
End
und

Wasser läuft am Desktop runter

Code: Alles auswählen

Global Mem.l 
Mem = AllocateMemory(1, 1024)

Procedure.l DesktopOutput() 
  PokeL(Mem, 1) 
  ProcedureReturn Mem 
EndProcedure 

Global xx, yy
xx = GetSystemMetrics_(0)
yy = GetSystemMetrics_(1)

Procedure Weich(PosX, PosY)
  x = Random(60)-30
  y = Random(60)-30
   F0 = Point(PosX+x  ,PosY+y  )
   F1 = Point(PosX+x-1,PosY+y  )
   F2 = Point(PosX+x  ,PosY+y-1)
   F3 = Point(PosX+x+1,PosY+y  )
   F4 = Point(PosX+x  ,PosY+y+1)
   F5 = Point(PosX+x-1,PosY+y-1)
   F6 = Point(PosX+x+1,PosY+y-1)
   F7 = Point(PosX+x+1,PosY+y+1)
   F8 = Point(PosX+x-1,PosY+y+1)
   R_RGB = (Red(F0)+Red(F1)+Red(F2)+Red(F3)+Red(F4)+Red(F5)+Red(F6)+Red(F7)+Red(F8))/9
   G_RGB = (Green(F0)+Green(F1)+Green(F2)+Green(F3)+Green(F4)+Green(F5)+Green(F6)+Green(F7)+Green(F8))/9
   B_RGB = (Blue(F0)+Blue(F1)+Blue(F2)+Blue(F3)+Blue(F4)+Blue(F5)+Blue(F6)+Blue(F7)+Blue(F8))/9
   If PosX+x > -1 And PosY+y > -1 : Box(PosX+x, PosY+y, 2, 2, RGB(R_RGB, G_RGB, B_RGB)) : EndIf
EndProcedure

b.f = 3.14159265/180

Repeat

  StartDrawing(DesktopOutput())

   For y = 1 To yy-2 Step 2
    For x = 1 To xx-2 Step 2
     Weich(x, y)
    Next x
    Delay(5)
    If GetAsyncKeyState_(#VK_ESCAPE) : InvalidateRect_(0, 0, 0) : End : EndIf  
   Next y   
 
  StopDrawing() 

ForEver
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Antworten