PureBasic Forums - English

Fangbeast wrote:Happy nude year! from downunder and I wish everyone a basket full of nipples!

; code by Dobro http://michel.dobro.free.fr/
Declare.f RotationX(X, Angle.f, dist)
Declare.f RotationY(Y, Angle.f, dist)
Declare feux ( taille_du_cercle, nombre_de_point)
Declare text()
Declare Ondulation(X,Y,Texte.s,r,v,b)
Global de
#dobro =1
#Police =1
#Sprite =1
#pi =3.1415926

; ***** variables a OLIV *********
         ; Variables

#HauteurSin = 10 ; Coef qui joue sur la hauteur de la sinusoide
#LargeurSin = 20 ; Coef qui joue sur la largeur de la sinusoide
#VitesseAngle = 2 * #pi / 50 ; vitesse de modification de l'angle de départ du texte
#Vitesse = 25 ; Temps du Delay() qui ralentit/augmente l'animation.
Global Angle.f, FontID , long_text_bas,x_win,y_win
         ; ****************************************


; ***********************************
Resultat = InitSprite ()
FontID = LoadFont ( #Police , "Comic Sans MS" , 24, #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, #PB_Window_SystemMenu|#PB_Window_BorderLess |#PB_Window_ScreenCentered , "souris bouton droit pour sortir" )
     WindowID = WindowID (1)
    Result = OpenWindowedScreen ( WindowID ,0,0, EcranX, EcranY, 1, 0,0)
    Resultat = InitMouse ()
    
     Repeat
         ExamineMouse ()
        Event= WaitWindowEvent ()
        feux ( 200, 100)
         If MouseButton (2)
             End
         EndIf
     Until Event= #PB_Event_CloseWindow
    
    
     Procedure feux ( taille, nombre_de_point)
    EcranX = GetSystemMetrics_ ( #SM_CXSCREEN ): ;=largeur de l'ecran
    EcranY = GetSystemMetrics_ ( #SM_CYSCREEN ): ;=hauteur de l'ecran
        de= Random (25500)
          RandomSeed (de)
        hauteur= Random (EcranY/2 )+taille
        largeur= Random (EcranX/2)+taille
        r= Random (255)+100
        v= Random (255)+100
        b= Random (255)+100
        couleur= RGB (r,v,b)
        taille_boulet= Random (5)+1
        
        X1=largeur
        Y1=hauteur
        
         For t= EcranY To hauteur Step -10
             StartDrawing ( ScreenOutput ())
             Box (X1, t,4,4,couleur)
             StopDrawing ()
             FlipBuffers (): ; affiche l'ecran
             ClearScreen (0,0,0)
            text()
         Next t
         StartDrawing ( ScreenOutput ())
         Circle (X1, t,50, couleur)
         StopDrawing ()
         FlipBuffers (): ; affiche l'ecran
         ClearScreen (0,0,0)
        text()
        
         For taille_du_cercle=0 To taille Step 4
             ; ******************* faire un cercle ********************************
             For compt=1 To nombre_de_point
                X=taille_du_cercle* Cos ( compt*(2*3.1415926/nombre_de_point)) + (X1) ; la formule du cercle /360 = 360 points
                Y=taille_du_cercle * Sin ( compt*(2*3.1415926/nombre_de_point)) + (Y1 ) ; la formule du cercle
                 ; ***********************************************
                 StartDrawing ( ScreenOutput ())
                 Circle (X, Y,taille_boulet, couleur)
                 StopDrawing ()
                
                 ExamineMouse ()
                 If MouseButton (2)
                     End
                 EndIf
                
             Next compt
             FlipBuffers (): ; affiche l'ecran
             ClearScreen (0,0,0)
            text()
         Next taille_du_cercle
         ProcedureReturn
     EndProcedure
    
     Procedure text()
    EcranX = GetSystemMetrics_ ( #SM_CXSCREEN ): ;=largeur de l'ecran
    EcranY = GetSystemMetrics_ ( #SM_CYSCREEN ): ;=hauteur de l'ecran
            RandomSeed (13)
         For t=1 To 400
            xp= Random (EcranX)
            yp= Random (EcranY)
            r= Random (255)+150: If r>255:r=r-50: EndIf
            v= Random (255)+150: If v>255:v=v-50: EndIf
            b= Random (255)+150: If b>255:b=b-50: EndIf
            coul= RGB (r,v,b)
             StartDrawing ( ScreenOutput ())
             Circle (xp, yp,1, coul) ; les etoiles
             StopDrawing ()
         Next t
        text$= "Happy newyear to Forum PureBasic"
        long_text= Len (text$)
        Ondulation(EcranX /4,EcranY/2,text$,255,255,0)
         RandomSeed (de)
     EndProcedure
     Procedure Ondulation(X,Y,Texte.s,r,v,b)
         ; procedure realisé par OLIV
         StartDrawing ( ScreenOutput ()) ; Pour pouvoir utiliser les commandes des dessin 2D.
         DrawingMode (1) ; On selectionne le mode pour ne pas avoir de fond derrière les lettres.
         FrontColor (r,v,b) ; On change la couleur.
         DrawingFont ( FontID ()) ; On change la police
        Angle + #VitesseAngle ; Angle de départ de la sinusoide en radian
         If Angle >= 2 * #pi
            Angle = 0
         EndIf
         ; On affiche toute les lettres
        PosX = 10 ; Position du caractère
         For n = 1 To Len (Texte) ; Pour chaque lettre du texte
            Lettre.s = Mid (Texte, n, 1) ; on récupère la lettre à la position n
            PosY = 50 + #HauteurSin * Sin (Angle + PosX / #LargeurSin ) ; on calcul la position en Y de la lettre
             ; On part du centre de l'image (50) puis on ajoute un sin
             ; #HauteurSin fait varier l'amplitude du mouvement
             ; l'angle mis dans le sinus est d'abord composé de l'angle de départ d'affichage du texte (Angle)
             ; puis on augmente l'angle au fur et à mesure que l'on affiche des lettres avec le coefficient #LargeurSin qui permet de faire varier la largeur de la sinusoide
             Locate (X+PosX, Y+PosY)
             DrawText (Lettre)
            PosX + TextLength (Lettre)
         Next
         StopDrawing () ; On signife que l'on arrête les fonctions dessin 2D.
     EndProcedure