Hypnoseprogramm

Übersicht

BlitzBasic

Allgemein

	das wurgel Betreff: Hypnoseprogramm	Fr, Dez 28, 2007 6:28 Antworten mit Zitat
Hab mit Winkelberechnung experimentiert und dabei ein Hypnoseprogramm gemacht. Es muss die Frames am Anfang erstellen, das dauert ein bisschen, aber nur beim ersten Mal starten, weil es die Frames dann nämlich abspeichert und sie dann nurnoch geladen werden müssen. sry wenns n bisschen unordentlich is. Code: [AUSKLAPPEN] [EINKLAPPEN] Const GGX = 1024 Const GGY = 768 umge=1 If FileType("asse1.bong")=1 Then umge = 0 sp=umge Global CX,CY Graphics GGX,GGY,16,1 SetBuffer BackBuffer () SeedRnd MilliSecs () AppTitle "","" ShowPointer ClsColor 0,0,0 font = LoadFont("Arial",32) SetFont font timer = CreateTimer(60) frames=20 -1 fab=4 abst#=2.2 rich=-1 hyper = CreateImage(GGX,GGY,frames +1) If umge Then For i = 0 To frames AppTitle i + " Frames von " + (frames+1) + " erzeugt." Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " erzeugt.",1,1 Flip Cls LockBuffer ImageBuffer(hyper,i) For x = 0 To GGX-1 For y = 0 To GGY-1 win# = ATan2(x-GGX/2,y-GGY/2) ab = Floor( (win#+irich((720.0/fab)/frames)+abstand(x,y,GGX/2,GGY/2)abst#)/(360.0/fab)) If (ab Mod 2 = 0) Then WritePixelFast x,y, $FFFFFF, ImageBuffer(hyper,i) ;WritePixelFast x,y, $FFFFFF, ImageBuffer(hyper,i) Next Next UnlockBuffer ImageBuffer(hyper,i) Next If sp Then For i = 0 To frames AppTitle i + " Frames von " + (frames+1) + " gespeichert." Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " gespeichert.",1,1 Flip Cls SaveImage hyper,"hyper1_"+i+".bmp",i Next EndIf Else For i = 0 To frames AppTitle i + " Frames von " + (frames+1) + " geladen." Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " geladen.",1,1 Flip Cls fram = LoadImage("hyper1_"+i+".bmp") CopyRect 0,0,GGX,GGY,0,0,ImageBuffer(fram), ImageBuffer(hyper,i) Next EndIf If umge=1 Then b = WriteFile("asse1.bong") Repeat CX = MouseX() CY = MouseY() Chit = MouseHit(1) oft = WaitTimer(timer) If oft > 5 Then oft = 5 For i = 1 To oft fra=fra+1 If fra=frames+1 Then fra=0 Next DrawBlock hyper, 0,0,fra Flip Cls Until KeyDown(1) End Function Abstand(X#,Y#,X2#,Y2#) If x=x2 And y=y2 Then Return 0 Return Sqr#(Abs(X#-X2#)^2.0 + Abs(Y#-Y2#)^2.0) End Function und es gibt auch noch ne zweite Version, die 3d ist obwohl ich keine 3D Befehle gebraucht habe. Code:* [AUSKLAPPEN] [EINKLAPPEN] Const GGX = 1024 Const GGY = 768 umge=1 If FileType("asse2.bong")=1 Then umge = 0 If umge=1 Then b = WriteFile("asse2.bong") sp=umge Global CX,CY Graphics GGX,GGY,16,1 SetBuffer BackBuffer () SeedRnd MilliSecs () AppTitle "","" ShowPointer ClsColor 0,0,0 font = LoadFont("Arial",32) SetFont font timer = CreateTimer(40) frames=20 -1 fab=8 abst#=125 rich=-1 hyper = CreateImage(GGX,GGY,frames +1) If umge Then For i = 0 To frames AppTitle i + " Frames von " + (frames+1) + " erzeugt." Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " erzeugt.",1,1 Flip Cls LockBuffer ImageBuffer(hyper,i) For x = 0 To GGX-1 For y = 0 To GGY-1 win# = ATan2(x-GGX/2,y-GGY/2) ab = Floor( (win#+irich((720.0/fab)/frames)+ 360.0/abstand(x,y,GGX/2,GGY/2)abst#)/(360.0/fab) ) If (ab Mod 2 = 0) Then WritePixelFast x,y, $10101 Int(abstand(x,y,GGX/2,GGY/2)^2255/abstand(0,0,GGX/2,GGY/2)^2), ImageBuffer(hyper,i) ;If (ab Mod 2 = 0) Then WritePixelFast x,y, $10101 Int(1.0/(abstand(0,0,GGX/2,GGY/2)-abstand(x,y,GGX/2,GGY/2)+1)*255), ImageBuffer(hyper,i) Next Next UnlockBuffer ImageBuffer(hyper,i) Next If sp Then For i = 0 To frames AppTitle i + " Frames von " + (frames+1) + " gespeichert." Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " gespeichert.",1,1 Flip Cls SaveImage hyper,"hyper2_"+i+".bmp",i Next EndIf Else For i = 0 To frames AppTitle i + " Frames von " + (frames+1) + " geladen." Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " geladen.",1,1 Flip Cls fram = LoadImage("hyper2_"+i+".bmp") CopyRect 0,0,GGX,GGY,0,0,ImageBuffer(fram), ImageBuffer(hyper,i) Next EndIf Repeat CX = MouseX() CY = MouseY() Chit = MouseHit(1) oft = WaitTimer(timer) If oft > 5 Then oft = 5 For i = 1 To oft fra=fra+1 If fra=frames+1 Then fra=0 Next DrawBlock hyper, 0,0,fra Flip Cls Until KeyDown(1) End Function Abstand(X#,Y#,X2#,Y2#) If x=x2 And y=y2 Then Return 0 Return Sqr#(Abs(X#-X2#)^2.0 + Abs(Y#-Y2#)^2.0) End Function
1 ist ungefähr 3

das wurgel

Betreff: Hypnoseprogramm

Fr, Dez 28, 2007 6:28
Antworten mit Zitat

Hab mit Winkelberechnung experimentiert und dabei ein Hypnoseprogramm gemacht. Es muss die Frames am Anfang erstellen, das dauert ein bisschen, aber nur beim ersten Mal starten, weil es die Frames dann nämlich abspeichert und sie dann nurnoch geladen werden müssen. Smile

sry wenns n bisschen unordentlich is. Embarassed

Code: [AUSKLAPPEN]

Const GGX = 1024
Const GGY = 768

umge=1
If FileType("asse1.bong")=1 Then umge = 0
sp=umge

Global CX,CY
Graphics GGX,GGY,16,1
SetBuffer BackBuffer ()
SeedRnd MilliSecs ()
AppTitle "",""
ShowPointer
ClsColor 0,0,0
font = LoadFont("Arial",32)
SetFont font
timer = CreateTimer(60)
frames=20 -1
fab=4
abst#=2.2
rich=-1
hyper = CreateImage(GGX,GGY,frames +1)
If umge Then
For i = 0 To frames
   AppTitle i + " Frames von " + (frames+1) + " erzeugt."
   Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " erzeugt.",1,1
   Flip
   Cls
   LockBuffer ImageBuffer(hyper,i)
   For x = 0 To GGX-1
      For y = 0 To GGY-1
         win# = ATan2(x-GGX/2,y-GGY/2)
         ab = Floor( (win#+i*rich*((720.0/fab)/frames)+abstand(x,y,GGX/2,GGY/2)*abst#)/(360.0/fab))
         If (ab Mod 2 = 0) Then WritePixelFast x,y, $FFFFFF, ImageBuffer(hyper,i)
         ;WritePixelFast x,y, $FFFFFF, ImageBuffer(hyper,i)
      Next
   Next
   UnlockBuffer ImageBuffer(hyper,i)
Next
If sp Then
   For i = 0 To frames
      AppTitle i + " Frames von " + (frames+1) + " gespeichert."
      Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " gespeichert.",1,1
      Flip
      Cls
      SaveImage hyper,"hyper1_"+i+".bmp",i
   Next
EndIf
Else
For i = 0 To frames
   AppTitle i + " Frames von " + (frames+1) + " geladen."
   Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " geladen.",1,1
   Flip
   Cls
   fram = LoadImage("hyper1_"+i+".bmp")
   CopyRect 0,0,GGX,GGY,0,0,ImageBuffer(fram), ImageBuffer(hyper,i)
Next
EndIf
If umge=1 Then b = WriteFile("asse1.bong")
Repeat
CX = MouseX()
CY = MouseY()
Chit = MouseHit(1)
oft = WaitTimer(timer)
If oft > 5 Then oft = 5
For i = 1 To oft
   fra=fra+1
   If fra=frames+1 Then fra=0
Next
DrawBlock hyper, 0,0,fra
Flip
Cls
Until KeyDown(1)

End

Function Abstand(X#,Y#,X2#,Y2#)
If x=x2 And y=y2 Then Return 0
Return Sqr#(Abs(X#-X2#)^2.0 + Abs(Y#-Y2#)^2.0)
End Function

und es gibt auch noch ne zweite Version, die 3d ist obwohl ich keine 3D Befehle gebraucht habe. Very Happy

Code: [AUSKLAPPEN]

Const GGX = 1024
Const GGY = 768

umge=1
If FileType("asse2.bong")=1 Then umge = 0
If umge=1 Then b = WriteFile("asse2.bong")
sp=umge

Global CX,CY
Graphics GGX,GGY,16,1
SetBuffer BackBuffer ()
SeedRnd MilliSecs ()
AppTitle "",""
ShowPointer
ClsColor 0,0,0
font = LoadFont("Arial",32)
SetFont font
timer = CreateTimer(40)
frames=20 -1
fab=8
abst#=125
rich=-1
hyper = CreateImage(GGX,GGY,frames +1)
If umge Then
For i = 0 To frames
   AppTitle i + " Frames von " + (frames+1) + " erzeugt."
   Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " erzeugt.",1,1
   Flip
   Cls
   LockBuffer ImageBuffer(hyper,i)
   For x = 0 To GGX-1
      For y = 0 To GGY-1
         win# = ATan2(x-GGX/2,y-GGY/2)
         ab = Floor( (win#+i*rich*((720.0/fab)/frames)+ 360.0/abstand(x,y,GGX/2,GGY/2)*abst#)/(360.0/fab) )
         If (ab Mod 2 = 0) Then WritePixelFast x,y, $10101 * Int(abstand(x,y,GGX/2,GGY/2)^2*255/abstand(0,0,GGX/2,GGY/2)^2), ImageBuffer(hyper,i)
         ;If (ab Mod 2 = 0) Then WritePixelFast x,y, $10101 * Int(1.0/(abstand(0,0,GGX/2,GGY/2)-abstand(x,y,GGX/2,GGY/2)+1)*255), ImageBuffer(hyper,i)
      Next
   Next
   UnlockBuffer ImageBuffer(hyper,i)
Next
If sp Then
   For i = 0 To frames
      AppTitle i + " Frames von " + (frames+1) + " gespeichert."
      Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " gespeichert.",1,1
      Flip
      Cls
      SaveImage hyper,"hyper2_"+i+".bmp",i
   Next
EndIf
Else
For i = 0 To frames
   AppTitle i + " Frames von " + (frames+1) + " geladen."
   Text GGX/2, GGY/2, i + " Frames von " + (frames+1) + " geladen.",1,1
   Flip
   Cls
   fram = LoadImage("hyper2_"+i+".bmp")
   CopyRect 0,0,GGX,GGY,0,0,ImageBuffer(fram), ImageBuffer(hyper,i)
Next
EndIf

Repeat
CX = MouseX()
CY = MouseY()
Chit = MouseHit(1)
oft = WaitTimer(timer)
If oft > 5 Then oft = 5
For i = 1 To oft
   fra=fra+1
   If fra=frames+1 Then fra=0
Next
DrawBlock hyper, 0,0,fra
Flip
Cls
Until KeyDown(1)
End
Function Abstand(X#,Y#,X2#,Y2#)
If x=x2 And y=y2 Then Return 0
Return Sqr#(Abs(X#-X2#)^2.0 + Abs(Y#-Y2#)^2.0)
End Function

1 ist ungefähr 3

	BladeRunner Moderator	Fr, Dez 28, 2007 12:15 Antworten mit Zitat
~VERSCHOBEN~ Dieser Thread passte nicht in das Forum, in dem er ursprünglich gepostet wurde. Warum? Es ist nett, aber sicher nichts fürs Codearchiv. Noch dazu mag ich es nicht wenn Massen an Daten auf die Festplatte gehämmtert werden. Btw. wäre, wo Du doch B3D besitzt (mir stellt sich eh die Frage warum 2 Versionen) das Ganze mit Sprites ohne probleme in realtime realisierbar.
Zu Diensten, Bürger. Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3 Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64 B3D BMax MaxGUI Stolzer Gewinner des BAC#48, #52 & #92

BladeRunner

Moderator

Fr, Dez 28, 2007 12:15
Antworten mit Zitat

~VERSCHOBEN~
Dieser Thread passte nicht in das Forum, in dem er ursprünglich gepostet wurde.

Warum? Es ist nett, aber sicher nichts fürs Codearchiv. Noch dazu mag ich es nicht wenn Massen an Daten auf die Festplatte gehämmtert werden. Btw. wäre, wo Du doch B3D besitzt (mir stellt sich eh die Frage warum 2 Versionen) das Ganze mit Sprites ohne probleme in realtime realisierbar.

Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3
Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64
B3D BMax MaxGUI
Stolzer Gewinner des BAC#48, #52 & #92