Vos plus beaux stars scroll

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

Tres beau stars scroll de face : :P

Code : Tout sélectionner

InitSprite() 
InitMouse() 
InitKeyboard() 

ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

ddw2=1024
ddh2=768

ddh3.f=(ddh/ddh2)

zoomx.f=(ddw-ddw2)/2
zoomy.f=(ddh-ddh2)/2


  sph15=1
  
OpenScreen(ddw,ddh,32,"SPH Demo") 
Global Dim pp.w(8290,2500)
Global dw.w,dh.w,SPH_Z,SPH_NOMBRE

Dim points.Point(10) 

f0.f=1
f1.f=0
f2.f=3.14159265/5


For i=1 To 65
  
 points(0)\x=ddw2/2+zoomx+Cos(f1)*(i*2*f0)
 points(0)\y=ddh2/2+zoomy+Sin(f1)*(i*2*f0)
 f1+f2
 points(1)\x=ddw2/2+zoomx+Cos(f1)*(i*f0)
 points(1)\y=ddh2/2+zoomy+Sin(f1)*(i*f0)
 f1+f2

 points(2)\x=ddw2/2+zoomx+Cos(f1)*(i*2*f0)
 points(2)\y=ddh2/2+zoomy+Sin(f1)*(i*2*f0)
 f1+f2
 points(3)\x=ddw2/2+zoomx+Cos(f1)*(i*f0)
 points(3)\y=ddh2/2+zoomy+Sin(f1)*(i*f0)
 f1+f2
 
 points(4)\x=ddw2/2+zoomx+Cos(f1)*(i*2*f0)
 points(4)\y=ddh2/2+zoomy+Sin(f1)*(i*2*f0)
 f1+f2
 points(5)\x=ddw2/2+zoomx+Cos(f1)*(i*f0)
 points(5)\y=ddh2/2+zoomy+Sin(f1)*(i*f0)
 f1+f2
 
 points(6)\x=ddw2/2+zoomx+Cos(f1)*(i*2*f0)
 points(6)\y=ddh2/2+zoomy+Sin(f1)*(i*2*f0)
 f1+f2
 points(7)\x=ddw2/2+zoomx+Cos(f1)*(i*f0)
 points(7)\y=ddh2/2+zoomy+Sin(f1)*(i*f0)
 f1+f2
 
 points(8)\x=ddw2/2+zoomx+Cos(f1)*(i*2*f0)
 points(8)\y=ddh2/2+zoomy+Sin(f1)*(i*2*f0)
 f1+f2
 points(9)\x=ddw2/2+zoomx+Cos(f1)*(i*f0)
 points(9)\y=ddh2/2+zoomy+Sin(f1)*(i*f0)
 f1+f2
 
 f0*1.046
 
 
 hdc=StartDrawing(ScreenOutput()) 
DrawingMode(#PB_2DDrawing_Default)
 If hdc 
 Box(0,0,0,0,RGB(i*3.8,i*3.8,i*3.8))
     Polygon_(hdc,points(),10) 
 EndIf 

 
StopDrawing()    
FlipBuffers() 

Next
;fin de l'etoile **************************************

;                        PlayMusic(1)


;  debut flash
For i=255 To 8 Step -8
ClearScreen(RGB(i,i,i))
FlipBuffers() 
Next


ClearScreen(0)


Structure pixel 
posx.f
posy.f
xx.f
yy.f
centrex.l
centrey.l
rayon.f
couleur.l
EndStructure 

NewList pixel.pixel() ; pour pas s'y perdre, vaux mieux donner le meme nom a la structure qu'a la liste

time=0
centrex=ddw2/2
centrey=ddh2/2
angle.f=0
rnd_angle.f=20
rnd_randon=200
vitessex.f=0.02
vitessey.f=0.02
nbb=0

;############
;############
;############
;############
;############
;############

craque=0
craque2=0
presente= 0


Repeat

ExamineKeyboard() 

ClearScreen(0)


;********************************************
If time<900
For i=1 To 20
    AddElement(pixel())
      pixel()\centrex=centrex
      pixel()\centrey=centrey
      rayon.f=5+Random(500)
      angle=Random(6559)
      x = Cos(angle)*rayon
      y = Sin(angle)*rayon
      pixel()\posx = x
      pixel()\posy = y
      z=Random(100)+20
      pixel()\xx = x/z
      pixel()\yy = y/z
      pixel()\couleur = 130+Random(Random(10000))
Next
EndIf
;********************************************


time+1

 If time<1040
nbb+1
If time>500
;bspline(0,0,200,0,200,200,0,200,RGB(255,180,150),hdc)
vitessex+0.00005
vitessey+0.00002
EndIf
hdc=StartDrawing(ScreenOutput()) ;*********************** S T A R T
;LineXY(30,0,100,100,RGB(255,255,0))

;********** A partir d'ici, tout est "LinkedList"

      ForEach pixel.pixel() ; tant qu'il y a des etoiles on les affiches
              
        With pixel() 
        

          x=\centrex+\posx+\xx+Cos(nbb/1000)*Cos(nbb/100)*nbb/2
          y=\centrey+\posy+\yy+Sin(nbb/100)*Cos(nbb/100)*nbb/2
          \xx*(1+vitessex*2)
          \yy*(1+vitessey*2)
                    
            If x>ddw-2 Or x<1 Or y>ddh-2 Or y<1
            DeleteElement(pixel()) ; on la tue

            Else ; sinon 

            \couleur*(1+vitessex)
            If \couleur>65535
            \couleur=65535
            EndIf
            
            If \couleur<32768
            rvb=\couleur/129
            Plot(x,y,RGB(rvb,rvb,rvb)) ; on l'affiche
            Else
            Plot(x,y,RGB(255,255,255)) ; on l'affiche
            rvb=(\couleur-32768)/130
            Plot(x+1,y,RGB(rvb,rvb,rvb)) ; on l'affiche
            Plot(x-1,y,RGB(rvb,rvb,rvb)) ; on l'affiche
            Plot(x,y+1,RGB(rvb,rvb,rvb)) ; on l'affiche
            Plot(x,y-1,RGB(rvb,rvb,rvb)) ; on l'affiche
            rvb/2
            Plot(x+1,y+1,RGB(rvb,rvb,rvb)) ; on l'affiche
            Plot(x-1,y-1,RGB(rvb,rvb,rvb)) ; on l'affiche
            Plot(x-1,y+1,RGB(rvb,rvb,rvb)) ; on l'affiche
            Plot(x+1,y-1,RGB(rvb,rvb,rvb)) ; on l'affiche
            EndIf
            EndIf
        EndWith
      Next ; ce "foreach:next" s'addapte donc toujours au vrai nombre d'etoiles

;********** fin de la technique "LinkedList"

; DrawText(50,50,Str(time),RGB(255,50,50),0)
; DrawText(50,100,Str(presente),RGB(255,50,50),0)
; DrawText(50,150,Str(vitessex),RGB(255,50,50),0)
      StopDrawing() 
EndIf


If presente>=300 And presente<501 ;  etoile qui fait disparaitre sph
presente+1
EndIf

      ;############################################################
      ;############################################################
If presente>=500 And presente<815

If presente=500
Dim points.Point(10) 
gro.f=0
f0.f=1.00001
f1.f=1
f2.f=3.14159265/5
EndIf
presente+1

points(0)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*250
points(0)\y=262+Sin(f1)*Sin(gro)*250
f1+f2
points(1)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*130
points(1)\y=262+Sin(f1)*Sin(gro)*130
f1+f2

points(2)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*250
points(2)\y=262+Sin(f1)*Sin(gro)*250
f1+f2
points(3)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*130
points(3)\y=262+Sin(f1)*Sin(gro)*130
f1+f2

points(4)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*250
points(4)\y=262+Sin(f1)*Sin(gro)*250
f1+f2
points(5)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*130
points(5)\y=262+Sin(f1)*Sin(gro)*130
f1+f2

points(6)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*250
points(6)\y=262+Sin(f1)*Sin(gro)*250
f1+f2
points(7)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*130
points(7)\y=262+Sin(f1)*Sin(gro)*130
f1+f2
points(8)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*250
points(8)\y=262+Sin(f1)*Sin(gro)*250
f1+f2
points(9)\x=ddw2/2-12+zoomx+Cos(f1)*Sin(gro)*130
points(9)\y=262+Sin(f1)*Sin(gro)*130
f1+f2

f1+f0-1
f0*1.0003
gro+0.01

hdc=StartDrawing(ScreenOutput()) 


If hdc 
   Box(0,0,0,0,RGB(255,255,220))
   Polygon_(hdc,points(),10) 
EndIf 
StopDrawing() 
EndIf

FlipBuffers() 


If time>1200
End
EndIf
Until KeyboardPushed(#PB_Key_Escape)
End
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Vos plus beaux stars scroll

Message par falsam »

Joli ce dernier code :wink:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Vos plus beaux stars scroll

Message par djes »

D'accord avec Falsam, bien fignolé :)
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

Merci messieux 8)
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Vos plus beaux stars scroll

Message par Ar-S »

Jolie.

Petite modif de mon code pour un effet d'étoile filante (un peu à l'arrache)
Le principe étant de gruger via un compteur de clearscreen.

Code : Tout sélectionner

; Ar-S
Enumeration Sprites
  #Star
  #Star2
  #Star3
  #Star4
EndEnumeration

DisableDebugger

Declare IniSpr()
Declare CreaStar()
Declare iniStar()

#NbrStar = 399

Define.i   ev
Global.b Quit
Global.i SL, SH, FL, FH
Global iS

If InitSprite()<>0 And InitMouse()<>0 And InitKeyboard()<>0
 
Else
  MessageRequester("erreur","initialisation")
  End
EndIf


; Gestion de la résolution
ExamineDesktops()
FL = DesktopWidth(0)
FH = DesktopHeight(0)


; *************************************************
;- Initialisation des éléments de stockage         *
; *************************************************

Structure star
  ID.i
  X.i
  Y.i
  Vit.i
EndStructure


Global Dim Star.Star(#NbrStar)
Global Dim Fix.Star(#NbrStar)
; ------------------------------------------------


Macro ET(N,Val)
  Star(N)\Val
EndMacro


; *************************************************
;-          CREATION DES SPRITES                    *
; *************************************************


Procedure CreaStar()
  CreateSprite(#Star,1,1)
  CreateSprite(#Star2,2,2)
    CreateSprite(#Star3,1,1)
    CreateSprite(#Star4,2,2)
   
StartDrawing(SpriteOutput(#Star))
  Box(0,0,1,1,$FFFFFF)
  StopDrawing()
 
  StartDrawing(SpriteOutput(#Star2))
  Box(0,0,2,2,$FFFFFF)
  StopDrawing()
 
  StartDrawing(SpriteOutput(#Star3))
  Box(0,0,1,1,$FFFFFF)
  StopDrawing()
 
StartDrawing(SpriteOutput(#Star4))
  Box(0,0,2,2,$FFFFFF)
  StopDrawing()
 
EndProcedure



; *************************************************
;-          INITIALISATION DES SPRITES             *
; *************************************************

Procedure iniStar()
  
   For i = 0 To #NbrStar
     Fix(i)\X = Random(Fl)
     Fix(i)\Y = Random(FL)
    Next
  
  For i = 0 To #NbrStar Step 4
    ET(i,ID)    = #Star ; 1ere etoile : #star obligatoire
    ET(i,X)     = Random(FL)
    ET(i,Y)     = Random(FH)
    ET(i,Vit)   = Random(8,1)
    
    ET(i+1,ID)  = #Star2
    ET(i+1,X)  = ET(i,X-3)
    ET(i+1,Y)  = ET(i,Y)
    ET(i+1,Vit)  = ET(i,Vit)
    
    ET(i+2,ID)  = #Star3
    ET(i+2,X)  = ET(i,X-5)
    ET(i+2,Y)  = ET(i,Y)
    ET(i+2,Vit)  = ET(i,Vit)
    
    ET(i+3,ID)  = #Star4
    ET(i+3,X)  = ET(i,X-9)
    ET(i+3,Y)  = ET(i,Y)
    ET(i+3,Vit)  = ET(i,Vit)
    
  Next
  
  Debug i
EndProcedure



; *************************************************
;-              AFFICHAGE DES SPRITES              *
; *************************************************


Procedure ShowStar()
  Shared iS
  For is=0 To #NbrStar Step 4
    
    DisplayTransparentSprite(#Star,ET(iS,X),ET(iS,Y),255)
    DisplayTransparentSprite(#Star2,ET(iS+1,X),ET(iS,Y),200)
    DisplayTransparentSprite(#Star3,ET(iS+2,X),ET(iS,Y),150)
    DisplayTransparentSprite(#Star4,ET(iS+3,X),ET(iS,Y),125)
    
    ET(iS,X) + ET(iS,Vit) 
  
    
    
    ET(iS+1,X)  = ET(iS,X-3)
    ET(iS+1,Y)  = Random ( ET(iS,Y+4), ET(iS,Y-4) ) ;ET(iS,Y)
    ET(iS+1,Vit)  = ET(iS,Vit)
    
    ET(iS+2,X)  = ET(iS,X-8)
    ET(iS+2,Y)  = Random ( ET(iS,Y+8), ET(iS,Y-8) ) ;ET(iS,Y)
    ET(iS+2,Vit)  = ET(iS,Vit)
    
    ET(iS+3,X)  = ET(iS,X-25)
    ET(iS+3,Y)  = Random ( ET(iS,Y+14), ET(iS,Y-14) ) ; ET(iS,Y) 
    ET(iS+3,Vit)  = ET(iS,Vit) 
    
    If ET(iS,X) > FL 
      ET(iS,X) = - Random(FL,0)
      ET(iS,Y) = Random(FH)
    EndIf
    
   
  Next
  
  TR = (Random(255,100))
  For i=0 To #NbrStar
    DisplayTransparentSprite(#Star, Fix(i)\X, Fix(i)\Y,TR)  
  Next
  
EndProcedure



; *************************************************
;-                   Programme                     *
; *************************************************
OpenScreen(FL, FH, 32, "")
SetFrameRate(60)

CreaStar()
iniStar()

Repeat
 
  ExamineKeyboard()
  
  Count + 1
  If Count = 5
    ClearScreen(0)
    Count = 0
  EndIf
  
  ShowStar()

  FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)

End

~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Vos plus beaux stars scroll

Message par Ar-S »

Version 3D en 2D
Molette pour accélérer / ralentir
Avec 2000 étoiles ça reste super fluide chez moi. Baissez #NbrStar=2000 si ça rame chez vous.

Code : Tout sélectionner

; 2D / 3D starfield effect by Ar-S
; Original code de Padman

#NbrStar=2000
#MAXSPEED = 10
ExamineDesktops()

Global L = DesktopWidth(0), H = DesktopHeight(0)

Structure Star
  X.i
  Y.i
  Z.i
EndStructure

Global Dim Star.Star(#NbrStar)

Macro S(N,V)
  Star(N)\V
EndMacro

Global speed=3

InitSprite() : InitKeyboard() : InitMouse()

Procedure  rnd(min.w,max.w)
  a =  max - Random (max-min)
  ProcedureReturn a
EndProcedure

Procedure  ini_stars()
  For c.w=0 To #NbrStar
    S(c,X) = Rnd(-H/2,L/2) << 8
    S(c,Y) = Rnd(-H/2,L/2) << 7
    S(c,Z) = Rnd(2,255)
 Next
EndProcedure

Procedure UpdateStar()
  For c=0 To #NbrStar
    S(c,Z)  = S(c,Z)-speed
    If S(c,Z) <=2
      S(c,Z) = 255
    EndIf
    s_x = (S(c,X) / S(c,Z)) + (L/2)
    s_y = (S(c,Y) / S(c,Z)) + (H/2)
    col = RGB( 255 - S(c,Z), 255 - S(c,Z), 255 - S(c,Z))
    Circle (s_x,s_y,1,col)
  Next
EndProcedure


OpenScreen(L, H, 32, "")
ini_stars()

Repeat
  
  ExamineMouse()
  
  tiks = MouseWheel()
  If Tiks > 0
    speed + 1
    If speed >= #MAXSPEED : speed = #MAXSPEED : EndIf
  ElseIf Tiks < 0
    Speed - 1
    If speed <= 0 : speed = 0 : EndIf
  EndIf
    
  ClearScreen(RGB(0,0,0))
 
  StartDrawing(ScreenOutput())   
    updatestar()
  StopDrawing()                   
 
  FlipBuffers() 
  ExamineKeyboard()
 Until KeyboardPushed(#PB_Key_Escape)  
End

~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Vos plus beaux stars scroll

Message par Micoute »

Un que je trouve très beau et je n'ai rien modifié

Code : Tout sélectionner

; German forum:
; Author: Nickolas Göddel (updated for PB4.00 by blbltheworm)
; Date: 12. December 2002
; OS: Windows
; Demo: Yes


 Procedure AbsLNG(a.l)
  If a >> 31
    a * -1
  EndIf
  ProcedureReturn a
EndProcedure
;Procedure Mod(a.l, b.l)
;  Erg.l = a - a / b * b
;  If a >> 31 : Erg + AbsLNG(b) : EndIf
;  ProcedureReturn Erg
;EndProcedure

If InitSprite() = #False Or InitKeyboard() = #False Or InitMouse() = #False
  MessageRequester("Fehler", "DirectX 7.0 oder höher nicht installiert.", 16)
  End
EndIf

;-- Konstanten
#Font = 3

Global XRes.l, YRes.l
XRes = 1024                      ;Auflösung: XRes x YRes (Normal im Verhältnis 4:3)
YRes = 768
BackColor = RGB(0, 0, 100)         ;Hintergrundfarbe

If LoadFont(#Font, "System", FontSizeY) = #False
  MessageRequester("Fehler", "Schriftart konnte nicht geladen werden.", 16)
  End
EndIf

;OpenWindow(0, 0, 0, XRes, YRes, #PB_Window_Systemmenu, "Dots-Returns")
;If OpenWindowedScreen(WindowID(),0, 0, XRes, YRes, 0, 0, 0) = #False
If OpenScreen(XRes, YRes, 32, "Dots-Returns") = #False
  If OpenScreen(XRes, YRes, 24, "Dots-Returns") = #False
    MessageRequester("Fehler", "Screen konnte nicht initialisiert werden.", 16)
    End
  EndIf
EndIf

;-- Font

Text.s = "Crazy Dots - (c) Nicolas Göddel 12-12-2002"
FontSizeY = 15                ;Anzahl an Dots auf der Y-Achse
FPosition.l = 0                 ;Anfangsposition im Schriftzug (Normal: 0)
FTimePerPixel.l = 5             ;Frames, die vergehen bis die Schriftposition um eins weitergeht
FTimeCount.l = FTimePerPixel    ;Zählvariable (Normal: FTimePerPixel)

StartDrawing(ScreenOutput())
  DrawingFont(FontID(#Font))
  FontSizeX.l = TextWidth(Text)
StopDrawing()

Global Dim TextGitter.l(FontSizeX - 1, FontSizeY - 1)

CreateImage(#Font, FontSizeX, FontSizeY)
StartDrawing(ImageOutput(#Font))
  Box(0, 0, FontSizeX, FontSizeY, RGB(255, 255, 255))
  FrontColor(RGB(0,0,0))
  DrawText(0, -2,Text)
  For x.l = 0 To FontSizeX - 1
    For y.l = 0 To FontSizeY - 1
      TextGitter(x, y) = 255 - Red(Point(x, y))
    Next
  Next
StopDrawing()
FreeImage(#Font)

;-- Dots
XMaxDots.l = 30                 ;Dots auf der X-Achse (Normal: 30)
YMaxDots.l = FontSizeY          ;Dots auf der Y-Achse (Normal: FontSizeY)
DotsRadius.l = 10               ;Radius der Dots (Normal: 10)
DotsReturn.f = 0.90             ;Geschwindikeit, mit der die Dots zurück an ihren Platz gehen (Normal: 0.90)
MinAbstand.f = DotsRadius * 16  ;Abstand zur Lichtkegelmitte, ab der sich die Dots bewegen
DotsJump.f = 10                 ;Geschwindigkeit der Dots bei Berührung mit dem Lichtkegelmitte

Structure Dots
  x.f
  y.f
  xrel.f
  yrel.f
  xstep.f
  ystep.f
  Winkel.l
  f.f
  Aktiv.l
  Color.l
EndStructure

Global Dim Dots.Dots(XMaxDots - 1, YMaxDots - 1)

For x.l = 0 To XMaxDots - 1
  For y.l = 0 To YMaxDots - 1
    Dots(x, y)\x = (XRes * x) / XMaxDots + (DotsRadius * 2)
    Dots(x, y)\y = (YRes * y) / YMaxDots + (DotsRadius * 2)
    Dots(x, y)\xrel = 0
    Dots(x, y)\yrel = 0
    Dots(x, y)\xstep = 0
    Dots(x, y)\ystep = 0
    Dots(x, y)\Color = Random(512)
  Next
Next

CreateSprite(1, DotsRadius * 2, DotsRadius * 2, 0)
StartDrawing(SpriteOutput(1))
Circle(DotsRadius, DotsRadius, DotsRadius, RGB(255, 255, 0))
StopDrawing()

;-- Lichtkegel
MX = XRes / 2                   ;Anfangsposition des Lichtkegels auf der X-Achse
MY = YRes / 2                   ;Anfangsposition des Lichtkegels auf der Y-Achse
MWinkel = Random(360)           ;Anfangswinkel, in desse Richtung sich der Lichtkegel bewegt
MaxSpeed.f = 20                 ;Maximale Geschwindikeit des Lichtkegels (Normal: 20)
MSpeed.f = 0                    ;Momentane Geschwindigkeit des Lichtkegels (Normal: 0)
MBSpeed.f = 0.05                ;Zunahme pro Frame der Geschwindigkeit des Lichtkegels (Normal: 0.05)
MAbstand = MinAbstand           ;(Normal: MinAbstand)
MOn.l = 0                       ;Status der Bewegung des Lichtkegels (Normal: 0 = An)
MStopFrames = 5                 ;Anzahl an Frames, die vergehen müssen, bevor MOn wieder 0 bzw. an ist

CreateSprite(0, MinAbstand * 2, MinAbstand * 2, 0)
StartDrawing(SpriteOutput(0))
For r.l = MinAbstand To 0 Step -1
  Pro.f = 1 - (r / MinAbstand)
  Circle(MinAbstand, MinAbstand, r, RGB(Red(BackColor), Pro * 255, Blue(BackColor)))
Next
StopDrawing()

;-- Lichter
Structure Lichter
  x.f
  y.f
  xstep.f
  ystep.f
  Frame.l
EndStructure
Global NewList Lichter.Lichter()

MaxLichter.l = 2000             ;Anzahl der sich im Hintergrund befindlichen Lichter
LMaxSpeed.f = 3                 ;Maximale Geschwindigkeit der Lichter
LROTSpeed.f = 0.1               ;Maximale Richtungsänderungsgeschwindigkeit der Lichter
LRand.l = 10                    ;(Normal: 10)

For a.l = 1 To MaxLichter
  AddElement(Lichter())
  Lichter()\x = Random(XRes)
  Lichter()\y = Random(YRes)
  Lichter()\xstep = (Random(2000) - 1000) / 1000
  Lichter()\ystep = (Random(2000) - 1000) / 1000
  Lichter()\Frame = Random(360)
Next

;-- Hauptschleife
Repeat
  If IsScreenActive() = #False
    ReleaseMouse(1)
    While IsScreenActive() = #False : Delay(100) : Wend
  EndIf
 
  ClearScreen(RGB(Red(BackColor),Green(BackColor),Blue(BackColor)))
 
  ;--   Mausabfrage
  ExamineMouse()
  MDX.l = MouseDeltaX()
  MDY.l = MouseDeltaY()
  If MDX Or MDY
    MX + MDX
    MY + MDY
    MOn = MStopFrames
  EndIf
  If MX + MinAbstand < 0 : MX = -MinAbstand : EndIf
  If MX - MinAbstand > XRes : MX = XRes + MinAbstand : EndIf
  If MY + MinAbstand < 0 : MY = -MinAbstand : EndIf
  If MY - MinAbstand > YRes : MY = YRes + MinAbstand : EndIf
 
  If Tmp
    FreeSprite(1)
    CreateSprite(1, DotsRadius * 2, DotsRadius * 2, 0)
    StartDrawing(SpriteOutput(1))
    Circle(DotsRadius, DotsRadius, DotsRadius, RGB(255, 255, 0))
    StopDrawing()
    Tmp = #False
  EndIf
 
  ;Berechnung des Winkels des Lichtkegels, falls er aus dem Bild laufen will
  If MOn = 0
    If MSpeed < MaxSpeed : MSpeed + MBSpeed : EndIf
    MX + Cos(MWinkel * 3.14159256 / 180) * MSpeed
    MY + Sin(MWinkel * 3.14159256 / 180) * MSpeed
    Zufall.l = 10 + Random(5)
    If MX < MAbstand
      If MWinkel < 180
        MWinkel - Zufall
      Else
        MWinkel + Zufall
      EndIf
    ElseIf MY < MAbstand
      If MWinkel < 270 And MWinkel > 90
        MWinkel - Zufall
      Else
        MWinkel + Zufall
      EndIf
    ElseIf MX > XRes - MAbstand
      If MWinkel < 180
        MWinkel + Zufall
      Else
        MWinkel - Zufall
      EndIf
    ElseIf MY > YRes - MAbstand
      If MWinkel < 270 And MWinkel > 90
        MWinkel + Zufall
      Else
        MWinkel - Zufall
      EndIf
    Else
      MWinkel + Random(20) - 10
    EndIf
  Else
    MOn - 1
    MSpeed = 0
  EndIf 
 
  MWinkel = Mod(MWinkel, 360)

  MW.l = MouseWheel()
  MinAbstand + MW * 5
  If MinAbstand < 1 : MinAbstand = 1 : MW = 0 : EndIf
  If MW <> 0
    FreeSprite(0)
    CreateSprite(0, MinAbstand * 2, MinAbstand * 2, 0)
    StartDrawing(SpriteOutput(0))
    For r.l = MinAbstand To 0 Step -1
      Pro.f = 1 - (r / MinAbstand)
      Circle(MinAbstand, MinAbstand, r, RGB(Red(BackColor), Pro * 255, Blue(BackColor)))
    Next
    StopDrawing()
  EndIf
 
  DisplayTransparentSprite(0, MX - MinAbstand, MY - MinAbstand)
 
  ;--   Lichter

  StartDrawing(ScreenOutput())
    ResetList(Lichter())
    While NextElement(Lichter())
      Lichter()\x + Lichter()\xstep * LMaxSpeed
      Lichter()\y + Lichter()\ystep * LMaxSpeed
      If Lichter()\x < LRand
        Lichter()\xstep + LROTSpeed
      EndIf
      If Lichter()\y < LRand
        Lichter()\ystep + LROTSpeed
      EndIf
      If Lichter()\x > XRes - LRand - 1
        Lichter()\xstep - LROTSpeed
      EndIf
      If Lichter()\y > YRes - LRand - 1
        Lichter()\ystep - LROTSpeed
      EndIf
      Lichter()\xstep + (Random(200) - 100) / 1000
      Lichter()\ystep + (Random(200) - 100) / 1000
      If Lichter()\xstep > 1 : Lichter()\xstep = 1 : EndIf
      If Lichter()\ystep > 1 : Lichter()\ystep = 1 : EndIf
      If Lichter()\xstep < -1 : Lichter()\xstep = -1 : EndIf
      If Lichter()\ystep < -1 : Lichter()\ystep = -1 : EndIf
      If Lichter()\x > 0 And Lichter()\x < XRes - 1 And Lichter()\y > 0 And Lichter()\y < YRes - 1
        Plot(Lichter()\x, Lichter()\y, $FFFFFF)
      EndIf
    Wend
 
  ;--   Dots_kompliziert
 
  For x.l = 0 To XMaxDots - 1
    For y.l = 0 To YMaxDots - 1
      PosX.f = Dots(x, y)\x + Dots(x, y)\xrel
      PosY.f = Dots(x, y)\y + Dots(x, y)\yrel
      Abs.f = Sqr(Pow(Abs(MX - PosX), 2) + Pow(Abs(MY - PosY), 2))
      ;Wenn Punkt innerhalb des Kreises liegt
      If Abs < MinAbstand
        Dots(x, y)\F = 1 - (Abs / MinAbstand)
       
        If Dots(x, y)\F < 0.1
          Dots(x, y)\xstep * -1
          Dots(x, y)\ystep * -1
          Dots(x, y)\Winkel = Random(360)
        EndIf
       
        If Dots(x, y)\Aktiv = #False
          Dots(x, y)\Winkel = Random(360)
        Else
          Dots(x, y)\Winkel + Random(10) - 5
        EndIf
       
        Dots(x, y)\xstep = (Cos(Dots(x, y)\Winkel * 3.14159256 / 180) * Dots(x, y)\F * DotsJump)
        Dots(x, y)\ystep = (Sin(Dots(x, y)\Winkel * 3.14159256 / 180) * Dots(x, y)\F * DotsJump)

        Dots(x, y)\Aktiv = #True
      ;Wenn Punkt außerhalb des Kreises liegt
      ElseIf Abs > MinAbstand
        Dots(x, y)\Winkel = 0
        Dots(x, y)\Aktiv = #False
        Dots(x, y)\F = 0
      EndIf

      Dots(x, y)\xrel + Dots(x, y)\xstep
      Dots(x, y)\yrel + Dots(x, y)\ystep
      If Dots(x, y)\Aktiv = #False
        Dots(x, y)\xstep * DotsReturn
        Dots(x, y)\ystep * DotsReturn
        Dots(x, y)\xrel * DotsReturn
        Dots(x, y)\yrel * DotsReturn
      EndIf
     
      ;--   Grafikausgabe
      Tmp = Dots(x, y)\Color
      If Tmp > 255 : Tmp = 511 - Tmp : EndIf
      Dots(x, y)\Color + Random(10)
      Dots(x, y)\Color = Mod(Dots(x, y)\Color, 512)
     
      If FPosition + x < FontSizeX And FPosition + x > 0
        PixelC.l = TextGitter(x + FPosition, y)
      Else
        PixelC.l = 0
      EndIf
     
      Color.l = RGB(255 * Dots(x, y)\F, PixelC, 255 - Tmp)
     
      If PixelC
        DrawingMode(0)
      Else
        DrawingMode(4)
      EndIf
     
      Circle(Dots(x, y)\x + Dots(x, y)\xrel, Dots(x, y)\y + Dots(x, y)\yrel, DotsRadius, Color)
    Next
  Next
 
  ;Überprüfung, ob der Schriftzug weiterrücken soll
  If FTimeCount = 0
    FPosition = Mod(FPosition + 1, FontSizeX)
    If FPosition = 0 : FPosition = - XMaxDots : EndIf
    FTimeCount = FTimePerPixel
  EndIf

  FTimeCount - 1

  StopDrawing()
  FlipBuffers()
 
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape) 

Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

La aussi, je ne retrouve pas le coté "scroll" :cry:
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

Le soldat inconnu avait fait ça :

Code : Tout sélectionner


; Le soldat inconnu
; Starfield V2
; Purebasic V4.51
ProcedureDLL.l ColorLuminosity2(Couleur, Echelle.f) ; Eclaicir ou foncer une couleur
   Protected Rouge, Vert, Bleu
   
   Rouge = Red (Couleur) * Echelle
   Vert = Green (Couleur) * Echelle
   Bleu = Blue (Couleur) * Echelle
   
   If Rouge > 255 : Rouge = 255 : EndIf
   If Vert > 255 : Vert = 255 : EndIf
   If Bleu > 255 : Bleu = 255 : EndIf
   
   ProcedureReturn RGB (Rouge, Vert, Bleu)
EndProcedure



Structure InfoEtoile
   x.l
   y.l
   z.l
   Couleur.l
EndStructure

NewList Etoile.InfoEtoile()

ExamineDesktops()
Ecran_Largeur = DesktopWidth(0)
Ecran_Hauteur = DesktopHeight(0)

EffetPerspective.f = Ecran_Largeur * 2 / 3


NbAjoutEtoile = 25
#ProfondeurDefautEtoile = 8
Vitesse = 21


; On ouvre l'openscreen
If InitSprite () = 0 Or InitKeyboard () = 0 Or InitMouse () = 0
   MessageRequester ( "Erreur" , "Impossible d'initialiser la souris ,le clavier ou l'écran. Vérifiez la présence de DirectX 7 ou supérieur." , 0)
   End
EndIf

If OpenScreen ( Ecran_Largeur , Ecran_Hauteur , 32, "Etoiles" ) = 0
   MessageRequester ( "Erreur" , "Impossible d'ouvrir l'écran." , 0)
   End
EndIf

Repeat
   ClearScreen (RGB(0, 0, 0))
   
   ; On lit les évènements clavier et souris
   ExamineKeyboard ()
   
   ; On crée des étoiles
   ResetList (Etoile())
   For n = 1 To NbAjoutEtoile
      AddElement (Etoile())
      Etoile()\x = Random ( Ecran_Largeur * #ProfondeurDefautEtoile ) - Ecran_Largeur * #ProfondeurDefautEtoile / 2
      Etoile()\y = Random ( Ecran_Hauteur * #ProfondeurDefautEtoile ) - Ecran_Hauteur * #ProfondeurDefautEtoile / 2
      If Etoile()\x = 0 Or Etoile()\y = 0
         DeleteElement (Etoile())
      Else
         Etoile()\Couleur = $FCE8CB ; Bleu
         Etoile()\z = #ProfondeurDefautEtoile * EffetPerspective.f
      EndIf
   Next
   
   ; On déplace les étoiles
   StartDrawing ( ScreenOutput ())
      ResetList (Etoile())
      While NextElement (Etoile())
         Etoile()\z - Vitesse
         Temp.f = EffetPerspective.f / Etoile()\z
         If Etoile()\z <= 0 ; Si l'étoile est sorti de l'écran en Z
            DeleteElement (Etoile())
         Else
            x2 = Etoile()\x * Temp + Ecran_Largeur / 2 ; Coordonnée de l'étoile
            y2 = Etoile()\y * Temp + Ecran_Hauteur / 2
            If x2 <= 0 Or x2 >= Ecran_Largeur - 1 Or y2 <= 0 Or y2 >= Ecran_Hauteur - 1 ; Si on sort de l'écran, on supprime l'étoile
               DeleteElement (Etoile())
            Else ; Sinon, on affiche l'étoile
               
               ; Centre
               Plot (x2, y2, ColorLuminosity2(Etoile()\Couleur, Temp * 1.5))
               If Temp > 0.2
                  ; Cotés
                  Temp * 0.4
                  Plot (x2 - 1, y2, ColorLuminosity2(Etoile()\Couleur, Temp))
                  Plot (x2, y2 - 1, ColorLuminosity2(Etoile()\Couleur, Temp))
                  Plot (x2 + 1, y2, ColorLuminosity2(Etoile()\Couleur, Temp))
                  Plot (x2, y2 + 1, ColorLuminosity2(Etoile()\Couleur, Temp))
                  ; Diagonales
                  Temp * 0.6
                  Plot (x2 - 1, y2 - 1, ColorLuminosity2(Etoile()\Couleur, Temp))
                  Plot (x2 + 1, y2 - 1, ColorLuminosity2(Etoile()\Couleur, Temp))
                  Plot (x2 - 1, y2 + 1, ColorLuminosity2(Etoile()\Couleur, Temp))
                  Plot (x2 + 1, y2 + 1, ColorLuminosity2(Etoile()\Couleur, Temp))
               EndIf
            EndIf
         EndIf
      Wend
      
      
      ; Calcul du FPS
      #DefinitionFPS = 20
      cpt + 1
      If cpt = #DefinitionFPS
         cpt = 0
         fps.f = #DefinitionFPS * 1000 / ( ElapsedMilliseconds ()+1 - Temps)
         Temps = ElapsedMilliseconds ()
      EndIf
      FrontColor (RGB(0, 0, 0))
      DrawText ( 0, 5,"FPS = " + StrF (fps, 1))
      DrawText (0, 20, "Etoiles = " + Str ( CountList (Etoile())))
      DrawText (0, 35, "Vitesse = " + Str (Vitesse))
      DrawText ( 0, 50,"Ajout = " + Str (NbAjoutEtoile))
      
   StopDrawing ()
   
   FlipBuffers ()
   
   If IsScreenActive () = 0
      End
   EndIf
   
   If KeyboardReleased ( #PB_Key_Up )
      Vitesse + 5
   EndIf
   If KeyboardReleased ( #PB_Key_Down ) And Vitesse > 5
      Vitesse - 5
   EndIf
   If KeyboardReleased ( #PB_Key_Right )
      NbAjoutEtoile + 5
   EndIf
   If KeyboardReleased ( #PB_Key_Left ) And NbAjoutEtoile > 1
      NbAjoutEtoile - 5
   EndIf
   
Until KeyboardPushed ( #PB_Key_Escape )
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

et je ne sais qui , avait fait ça :

Code : Tout sélectionner



If InitSprite () = 0
    MessageRequester ( "Erreur" , "Impossible d'initialiser directx" , #PB_MessageRequester_Ok )
    End
EndIf



; ---------- Mode fenetré ----------
#WindowWidth = 1024
#WindowHeight = 768
hwnd = OpenWindow (0, 0, 0, #WindowWidth , #WindowHeight , "Test",#PB_Window_SystemMenu | #PB_Window_ScreenCentered  )
If hwnd = 0
    MessageRequester ( "Erreur" , "Impossible d'ouvrir l'écran" , #PB_MessageRequester_Ok )
    End
EndIf

If OpenWindowedScreen (hwnd, 0, 0, #WindowWidth , #WindowHeight , 1, 0, 0) = 0
    MessageRequester ( "Erreur" , "Impossible d'ouvrir l'écran" , #PB_MessageRequester_Ok )
    End
EndIf
; ----------------------------------

; ou

; ---------- Plein écran ----------
; #WindowWidth = 640
; #WindowHeight = 480
; If OpenScreen(640, 480, 32, "Starfield") = 0
; MessageRequester ("Erreur", "Impossible d'ouvrir l'écran", #PB_MessageRequester_Ok)
; End
; EndIf
; ----------------------------------




InitKeyboard ()
ClearScreen (RGB(0,0,0))
FlipBuffers ()
ClearScreen (RGB(0,0,0))


; ---------- INIT ----------
#nb = 500
Dim x2.f( #nb )
Dim y2.f( #nb )
Dim decalx.f ( #nb )
Dim decaly.f ( #nb )
Dim dist.f( #nb )
Dim col( #nb )

For i = 1 To #nb
    x2.f(i) = ( Random (256) - 128 )
    If x2(i) = 0
        x2(i) = 1
    EndIf
    
    y2.f(i) = ( Random (256) - 128 )
    If y2(i) = 0
        y2(i) = 1
    EndIf
    
    dist(i) = Random (20)
    If dist(i) = 0
        dist(i) = 1
    EndIf
    col (i) = Abs (x2(i)) + Abs (y2(i))
Next
; --------------------------


Repeat
    ExamineKeyboard ()
    ClearScreen (RGB(0,0,0))
    If StartDrawing ( ScreenOutput ())
        
        
        rx2.f = rx2 * 0.99 + ( Random (10) - 5) / 1000
        ry2.f = ry2 * 0.99 + ( Random (10) - 5) / 1000
        
        rx.f = rx * 0.99 + rx2
        ry.f = ry * 0.99 + ry2
        
        For i = 1 To #nb
            
            x2.f(i) = rx * dist (i) / 3 + x2(i) * 1.005
            y2.f(i) = ry * dist (i) / 3 + y2(i) * 1.005
            
            x.f = ( #WindowWidth / 2) + x2(i) + decalx(i) * dist(i)
            Y.f = ( #WindowHeight / 2) + y2(i) + decaly(i) * dist(i)
            
            If x < 0 Or x > #WindowWidth - 1 Or Y < 0 Or Y > #WindowHeight - 1
                x2.f(i) = ( Random (256) - 128 )
                If x2(i) = 0
                    x2(i) = 1
                EndIf
                
                y2.f(i) = ( Random (256) - 128 )
                If y2(i) = 0
                    y2(i) = 1
                EndIf
                
                dist.f(i) = Random (20)
                If dist(i) = 0
                    dist(i) = 1
                EndIf
                
                decalx.f (i) = -rx * dist (i)
                decaly.f (i) = -ry * dist (i)
                
                col (i) = Abs (x2(i)) + Abs (y2(i))
            Else
                
                Plot (x,Y, RGB (col(i),col(i),col(i)))
                
            EndIf
        Next
        StopDrawing ()
    EndIf
    
    FlipBuffers ()
    WindowEvent()
    Delay(10)
Until KeyboardPushed ( #PB_Key_Escape ) 
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

Pupil avait converti un code de BlitzBasic attention mal de mer assuré ! :)

Code : Tout sélectionner



; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : STARFIELD DEMO - Blitz to Purebasic
; File : RotatingStarField.pb
; File Version : 1.0.1
; Programmation : OK
; Programmed by : Pupil
; Updated by : Guimauve
; Date : 18-04-2002
; Last Update : 22-04-2006
; Coded for PureBasic V4.51
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure definition >>>>>

Structure StarField
   
   Quantity.l
   Speed.l
   Size.b
   Direction.b
   DeltaAngle.f
   Width.w
   Height.w
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Access Macros >>>>>

Macro StarFieldQuantity(ObjectA)
   
   ObjectA\Quantity
   
EndMacro

Macro StarFieldSpeed(ObjectA)
   
   ObjectA\Speed
   
EndMacro

Macro StarFieldSize(ObjectA)
   
   ObjectA\Size
   
EndMacro

Macro StarFieldDirection(ObjectA)
   
   ObjectA\Direction
   
EndMacro

Macro StarFieldDeltaAngle(ObjectA)
   
   ObjectA\DeltaAngle
   
EndMacro

Macro StarFieldWidth(ObjectA)
   
   ObjectA\Width
   
EndMacro

Macro StarFieldHeight(ObjectA)
   
   ObjectA\Height
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure definition >>>>>

Structure Position3D
   
   x.l
   y.l
   z.l
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Access Macros >>>>>

Macro Position3Dx(ObjetA)
   
   ObjetA\x
   
EndMacro

Macro Position3Dy(ObjetA)
   
   ObjetA\y
   
EndMacro

Macro Position3Dz(ObjetA)
   
   ObjetA\z
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.w RandomMinMax(min.w, max.w)
   
   ProcedureReturn max - Random (max - min)
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure SetupStars(*ObjectA.StarField, Array Array.Position3D(1))   
   MAX_STAR.l = StarFieldQuantity(*ObjectA)
   STAR_SIZE.l = StarFieldSize(*ObjectA)
   Half_Width = StarFieldWidth(*ObjectA) >> 1
   Half_Height = StarFieldHeight(*ObjectA) >> 1
   
   For Counter = 0 To MAX_STAR
      
      Position3Dx(Array(Counter)) = RandomMinMax(- Half_Width, Half_Width) << 6
      Position3Dy(Array(Counter)) = RandomMinMax(- Half_Height, Half_Height) << 6
      Position3Dz(Array(Counter)) = RandomMinMax(2, 255)
      
   Next Counter
   
   StartDrawing ( ScreenOutput ())
      
      For i = 0 To 255
         FrontColor ( RGB (i, i, i))
         Box (i * STAR_SIZE, 0, STAR_SIZE, STAR_SIZE)
      Next
      
   StopDrawing ()
   
   For i = 0 To 255
      GrabSprite (i, i * STAR_SIZE, 0, STAR_SIZE, STAR_SIZE)
   Next
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure UpdateStars(*ObjectA.StarField, Array Array.Position3D(1))
   
   Quantity = StarFieldQuantity(*ObjectA)
   Direction = StarFieldDirection(*ObjectA)
   DeltaAngle.f = StarFieldDeltaAngle(*ObjectA)
   Speed = StarFieldSpeed(*ObjectA)
   Half_Width = StarFieldWidth(*ObjectA) >> 1
   Half_Height = StarFieldHeight(*ObjectA) >> 1
   
   cos.f = Cos (-Direction * DeltaAngle)
   sin.f = Sin (-Direction * DeltaAngle)
   
   For Counter = 0 To Quantity
      
      Position3Dz(Array(Counter)) - Speed
      
      x.l = Position3Dx(Array(Counter))
      y.l = Position3Dy(Array(Counter))
      
      Position3Dy(Array(Counter)) = y * cos - x * sin
      Position3Dx(Array(Counter)) = x * cos + y * sin
      
      If Position3Dz(Array(Counter)) <= 2
         Position3Dz(Array(Counter)) = 255
      EndIf
      
      s_x.w = Position3Dx(Array(Counter)) / Position3Dz(Array(Counter)) + Half_Width
      s_y.w = Position3Dy(Array(Counter)) / Position3Dz(Array(Counter)) + Half_Height
      col.w = 255 - Position3Dz(Array(Counter))
      
      DisplaySprite (col, s_x, s_y)
      
   Next
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure RunStarsAnimation(*ObjectA.StarField)
   
   Dim Stars.Position3D(StarFieldQuantity(*ObjectA))
   
   SetupStars(*ObjectA, Stars())
   
   Repeat
      
      FlipBuffers ()
      ClearScreen (0)
      
      UpdateStars(*ObjectA, Stars())
      
      ExamineMouse ()
      ExamineKeyboard ()
      
   Until MouseDeltaX () Or MouseDeltaY () Or MouseWheel () Or KeyboardPushed ( #PB_Key_All )
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

ScreenW = GetSystemMetrics_ ( #SM_CXSCREEN )
ScreenH = GetSystemMetrics_ ( #SM_CYSCREEN )
ScreenD = 32

StarFieldQuantity(StarField.StarField) = 3500
StarFieldSpeed(StarField) = 5
StarFieldSize(StarField) = 2 ; In pixel
StarFieldDirection(StarField) = -1 ; -1 = CCW : 1 = CW
StarFieldDeltaAngle(StarField) = 0.030
StarFieldWidth(StarField) = ScreenW
StarFieldHeight(StarField) = ScreenH

If InitSprite () = 0 Or InitKeyboard () = 0 Or InitMouse () = 0
   
   MessageRequester ( "Error" , "Can't open DirectX 7 Or later" , 0)
   
Else
   
   If OpenScreen (ScreenW, ScreenH, ScreenD, "Rotating StarField" ) = 0
      
      MessageRequester ( "Error" , "Can't open screen !" , 0)
      
   Else
      
      RunStarsAnimation(StarField)
      
   EndIf
   
EndIf
   
End
   
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<< 


Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

encore un autre du Soldat inconnu

Code : Tout sélectionner


; star field 2
; auteur inconu !!
; purebasic 4.00

#dobro=1
#Police=1
SSum.w = 8000 ; Amount of Stars
Cspeed.f=1
CameraZ.f=0


; ***********************************
Resultat = InitSprite()
FontID = LoadFont(#Police, "arial", 18, #PB_Font_Bold )
EcranX = GetSystemMetrics_(#SM_CXSCREEN):;=largeur de l'ecran
EcranY = GetSystemMetrics_(#SM_CYSCREEN):;=hauteur de l'ecran
    WindowID = OpenWindow(1, 0, 0, EcranX, EcranY , "hello",  #PB_Window_SystemMenu|#PB_Window_BorderLess |#PB_Window_ScreenCentered ) 
    
    WindowID = WindowID(1) 
    If OpenWindowedScreen(WindowID,0,0,EcranX,EcranY,1,1,1) = 0 
        MessageBox_ (0,"Could not open screen", "blahhh blaa", #MB_ICONINFORMATION|#MB_OK) 
        End 
    EndIf
    
    
    SetFrameRate(60) 
    xmax.w=10000 
    ymax.w=10000 
    zmax.w=2000 
    sspeed.w=-10 
    zmin.w=10 
    num.w=5000 ;get slow around 2500-3000 and i have 2.66 cpu 
    centerx.w=EcranX/2 
    centery.w=EcranY/2 
    zoom.w=60 
    shade.w=0 
    Dim sx(num) 
    Dim sy(num) 
    Dim sz(num) 
    For i=0 To num 
        sx(i)=Random(xmax)-xmax/2 
        sy(i)=Random(ymax)-ymax/2 
        sz(i)=Random(zmax) 
    Next i 
    
    Repeat 
        Event=WindowEvent()
        StartDrawing( ScreenOutput())  
        For i=0 To num 
            sz(i)=sz(i)+sspeed 
            If sz(i)<=zmin 
                sz(i)=zmax 
                sx(i)=Random(xmax)-xmax/2 
                sy(i)=Random(ymax)-ymax/2 
            EndIf 
            screenx.w=(sx(i)*zoom)/sz(i)+centerx 
            screeny.w=(-sy(i)*zoom)/sz(i)+centery 
            shade=Int(255/zmax* -sz(i)) 
            If screenx < EcranX
                If screeny < EcranY
                    If screenx > 0 
                        If screeny > 0  
                            Rouge=Random(255)+1
                            Vert=Random(255)+1
                            Bleu=Random(255)+1
                            Circle(screenx, screeny,1,RGB(Rouge ,Vert,Bleu)) 
                        EndIf 
                    EndIf 
                EndIf 
            EndIf 
        Next i 
        StopDrawing()  
        FlipBuffers():; affiche l'ecran
        ClearScreen(RGB(0, 0, 0)) :;efface l'ecran
    Until Event=#PB_Event_CloseWindow 
    
    
    
    



Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
TazNormand
Messages : 1294
Inscription : ven. 27/oct./2006 12:19
Localisation : Calvados (14)

Re: Vos plus beaux stars scroll

Message par TazNormand »

Ce qu'il peut nous manquer LSI :cry:

Qui sait ce qu'il est advenu de lui ???
Image
Image
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

cooool :P
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Vos plus beaux stars scroll

Message par Ar-S »

SPH a écrit :La aussi, je ne retrouve pas le coté "scroll" :cry:
on est plus trop dans le starfield effectivement (mais la physique est sympa)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Répondre