PureBasic

Forums PureBasic
Nous sommes le Lun 16/Sep/2019 13:37

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 45 messages ]  Aller à la page Précédente  1, 2, 3
Auteur Message
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 10:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4065
Tres beau stars scroll de face : :P
Code:
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 10:54 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6849
Localisation: IDF (Yvelines)
Joli ce dernier code :wink:

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 11:55 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4223
Localisation: Arras, France
D'accord avec Falsam, bien fignolé :)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 12:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4065
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 12:08 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8750
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:
; 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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 13:28 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8750
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:
; 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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 16:56 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2172
Localisation: 50200 Coutances
Un que je trouve très beau et je n'ai rien modifié
Code:
; 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 GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 18:24 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4065
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 18:50 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2065
Le soldat inconnu avait fait ça :

Code:

; 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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 18:52 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2065
et je ne sais qui , avait fait ça :
Code:


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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 18:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2065
Pupil avait converti un code de BlitzBasic attention mal de mer assuré ! :)

Code:


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 18:56 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2065
encore un autre du Soldat inconnu

Code:

; 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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 19:03 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 27/Oct/2006 12:19
Messages: 1224
Localisation: Calvados (14)
Ce qu'il peut nous manquer LSI :cry:

Qui sait ce qu'il est advenu de lui ???

_________________
Image

Image


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 19:04 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4065
cooool :P

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 19:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8750
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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 45 messages ]  Aller à la page Précédente  1, 2, 3

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye