PureBasic

@Djes

Désolé, j'entorse un peu le règlement: j'ai fait ce code hors compètition... Bon... Faut utiliser les 4 flèches et puis c'est tout...

Code : Tout sélectionner

Macro BL(X):For I=0 To 3:X:Next:EndMacro:Dim G(14,28):Dim G2(14,28):Dim C(1);##
Macro IT:X+PX(PC,I,Rt),Y+PY(PC,I,Rt):EndMacro:Dim PX(6,3,3):Dim PY(6,3,3);#####
Macro F(X,Y):For X=0 To Y:EndMacro:Macro N:Next:EndMacro:Macro Q:EndIf:EndMacro
F(I,28):G(1,I)=1:G(13,I)=1:G(I%13,27)=1:N:F(Pe,6):eC=0:F(Eg,1):F(PL,3);########
If Val("$"+Mid("33F06336747172",2*Pe+1+Eg,1))&(1<<PL):F(Ag,3):Y=1-PL:A=1.57*Ag;
C=Cos(A):S=Sin(A):PX(Pe,eC,Ag)=C*Eg-S*Y:PY(Pe,eC,Ag)=S*Eg+C*Y:N:eC+1:Q:N:N:N;##
Macro K0:AddKeyboardShortcut:EndMacro:OpenWindow(0,0,0,208,432,"",$CF0001);####
K0(0,37,10):K0(0,40,32):K0(0,39,12):K0(0,38,16):X=7:Y=2:D=1000:C(0)=$FFFFFF;###
C(1)=$1:Ok=1:Repeat:Delay(1):Et=WindowEvent():StartDrawing(WindowOutput(0));###
F(A,28):F(B,14):Box(B*16-16,(A-1)*16,16,16,C(G(B,A)|G2(B,A))):N:N:StopDrawing()
If Ok:BL(G2(IT)=0):MN=0:If Et=13101:MN=EventMenu():If MN=32:CH!1:Q:Q;#######
EL=ElapsedMilliseconds():If EL>T Or CH:T=EL+D:Y+1:Q:CA=0:F(I,3):If G(IT):CA=1:Q
N:If CA:Y-1:CH=0:MN=0:BL(G(IT)=1):X=7:Y=2:SC+1:If D>100:D-10:Q:DY=0;###########
For Y3=26 To 0 Step -1:CM=1:For X3=1 To 12:If G(X3,Y3)=0:CM=0:Q;###############
G(X3,Y3+DY)=G(X3,Y3):N:If CM:DY+1:Q:If Y3-DY<=0:Break:Q:N:SC+(DY*(DY+1));######
SetWindowTitle(0,Str(SC)):PC=Random(6):Rt=Random(3):Ok=1:F(I,3):If G(IT):Ok=0:Q
N:Else:BL(G2(IT)=1):Q:BL(G2(IT)=0):NS=0:If MN&8:NS=MN-11:Q:If NS:X+NS:Q:C0=0;##
F(I,3):If G(IT):C0=1:Q:N:If C0:X-NS:Q:If MN&16:Rt+1:Rt&3:Q:C3=0:F(I,3):If G(IT)
C3=1:Q:N:If C3:Rt-1:Rt&3:Q:BL(G2(IT)=1):Q:Until Et=16;#########################

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : PSphere
;* Author : djes
;* Date   : 06/17/2009
;* Notes  : -
;*
;*****************************************************************************
InitSprite():Macro g(t,d):Macro t:d:endmacr:EndMacro:g(d,drawing)o:g(n,Next)o
g(so,ScreenOutput)o:Structure v:x.f:y.f:z.f:c.i:EndStructure:w=511:r=255:k=127
g(q,s())o:g(C(m,l,p),Cos(0.03)*q\m l Sin(0.03)*q\p)o:g(e,EndIf)o:t$="PUREBASIC"
OpenWindow(0,0,0,w,w,""):OpenWindowedScreen(WindowID(0),0,0,w,w,0,0,0)
NewList s.v():LoadFont(1,"Arial",16):Start#D(so()):DrawingFont(FontID(1))
DrawText(10,0,t$,r,0):For y=-r To r:For x=-r To r:z=Sqr($FE01-(x*x)-(y*y))
If z>0:If Point(x&k,y&63)<>0:AddElement(q):If x&1=0:z*-1:e:q\x=x:q\y=y:q\z=z
q\c=-1:e:e:n x:n y:Stop#D():Repeat:FlipBuffer#q:ClearScreen(0):Start#D(so())
ForEach(q):Plot(r+q\x,r+q\y,w):b.f=C(x,-,z):q\z=C(z,+,x):q\x=b:b.f=C(x,-,y)
q\y=C(y,+,x):q\x=b:Plot(r+q\x,r+q\y,q\z):n:Stop#D():Until WindowEvent()=16

Dobro a écrit :je vous met celui ci , bien qu'il soit hors compete

Ben non... Ton code n'est plus hors compete!

Edit: j'ai corrigé le bug. C'était un dépassement d'index du tableau (index négatif).

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : ColorWave
;* Author : Dobro
;* Date   : 06/17/2009
;* Notes  : optimisé par Olivier
;*
;*****************************************************************************
Macro S(X,Y):E#X=GetSystemMetrics_(Y):EndMacro:InitSprite():InitMouse():S(X,0)
Macro c:EndIf:EndMacro:S(Y,1):w=OpenWindow(0,0,0,EX,EY,"",$80C80001):CX=(EX)/2
OpenWindowedScreen(w,0,0,EX,EY,1,0,0):V.f=8.2:a.f=0:G.f=$78:p.f=0.3:V.f=2:a.F
L=500:Dim T.l(L):Macro Q(X):Abs(Cos(a+(X))*255):EndMacro:For i=0 To L:D=100
a+(2*#PI/L):T(i)=RGB(Q(4*#PI/6),Q(#PI/3),Q(0)):Next:Repeat:U+Cos(3.6):b+Sin(36)
StartDrawing(ScreenOutput()):a=Sin((x+U)/(L+Sin(x/D)*D))*75+75:For Y=1 To EY-1
U=Cos((Y+b)/(300+Cos(Y/D)*D))*150:E=a+U:E=Abs(E):E%500:E=T(E):i=Y:G+V:If G>120
V=-V:c:If G<-120:V=-0.001:V=-V:c:Macro h(X):Sin((a+i*p*X)*0.0174533)*G
EndMacro:x=CX-300+H(10):Line(x+H(3),Y,L,0,E):Next:ExamineMouse():StopDrawing()
a+V:WindowEvent():FlipBuffers():ClearScreen(0):Until MouseButton(2)

J'ai pas tout suivi là, mais c'est pas grave! Il est très chouette ce code

je viens de nettoyer tout le topic des commentaires , comme ça on a accès direct aux codes

bien sur vous pouvez toujours laisser vos commentaires , de temps en temps
je ferai le ménage, pour laisser un topic de Punchs !

je trouve que c'est plus cool pour le future, de tomber directe sur les codes
plutôt que d'avoir a se taper 3 ou 4 pages de discutions, avant

mais comme je vous le dit, le but n'est pas de vous empecher de discuter
mais juste de nettoyer le topic de temps en temps

mon commentaire ne faisait qu'une seule et petite ligne, pour rester dans l'esprit de la chose... Fred a mis le sien aussi... de commentaire hein

beauregard a écrit :mon commentaire ne faisait qu'une seule et petite ligne, pour rester dans l'esprit de la chose... Fred a mis le sien aussi... de commentaire hein

( c'est comme dire, bah ! je n'ai jetté qu'un petit bout de papier dans la foret !
en oubliant que 1+1+1+1+1+1+1 ....etc ça fais beaucoups

)

je pourrai te dire que tout a l'heure il y avait une page en plus rien qu'avec les commentaires, que je trouve le topic beaucoup plus clair maintenant ..
(et encore KCC n'a pas ete tres bavard)

et j'ai laissé les messages de présentation a l'interieur des codes
(encore heureux)

que si vous preferez ce topic avec les discussions, et les commentaires
et que j'ai eu tord de vouloir faire un brin de nettoyage, parceque je pense trop
au futurs membres qui rechercheront un code, et qui mettront 3 plombes a trouver, voir qui abandonneront leurs recherches, pour demander que quelqu'un veuille bien le rechercher a leur place , pas de probleme ...

comme je l'ai dit je n'empêche pas les commentaires, mais une fois qu'ils ont été lu , je ne vois pas trop l'intérêt de les garder dans un topic qui se veux un recueil de codes avant tout !!

pour info mon forum est d'ailleurs fait sur ce model
si tu cherche un code, tu pourra plus vite le trouver chez moi , qu'ici

@Dobro

Si tu n'as pas vu avec Djes, la flagellation sur la place publique est préconisée! ça me surprend un peu. N'oublie pas qu'on poste nos avis, nos boutades, des choses qui font et défont l'ambiance. Et puis c'est un sujet en cours puisque c'est durant ce mois-ci.

Aussi c'est sûr que récupérer nos avis dans ces cas-là, ce n'est pas toujours simple. Si c'est à refaire, pourquoi ne pas créer un nouveau sujet avec sondage durant quelques jours dans la même section (dans le Hors sujet, ça peut être trop éloigné du sujet à traiter), le temps qu'une demi douzaine de personnes puissent donner leur avis? Et puis virer le sondage une fois que la décision a bien mûri à plusieurs?

Maintenant, c'est fait c'est fait. Ce n'est pas un drame. C'est plus direct!

En tout cas, j'ai déliré avec tes macros: finalement, tu commences à te faire la main avec ces petites bestioles-là!!!

Ollivier

wow, c top vos trucs les mecs

..............

14 ?

Macro M:Macro:EndMacro:M l:Dim:EndMacro:M rd:random:EndMacro:M E:EndIf:EndMacro
M fin:StopDrawing():FlipBuffers():ClearScreen(RGB(0, 0, 0)):EndMacro:M cal1:
ux=(sx(i)*zo)/sz(i)+cx:uy=(-sy(i)*zo)/sz(i)+cy:EndMacro:InitSprite():M cal2
sh=Int(255/zm*-sz(i)):If ux<EX:EndMacro:M N1:Next:EndMacro:P=255
EX=GetSystemMetrics_(0):EY=GetSystemMetrics_(1):M _w:OpenWindow:EndMacro:
M w_e:WindowEvent():EndMacro:M st_d:StartDrawing:EndMacro:M s_o:ScreenOutput
EndMacro:M F1:For i=0 To:EndMacro:M ows:openwindowedScreen:EndMacro:
M ow:_w:EndMacro:M jEndMacro:M C1:Circle(ux, uy,1,RGB(r ,v,b)):EndMacro:
WD=Ow(1,0,0,EX,EY,"",2160590849):M do1:OWS(WD,0,0,EX,EY,1,1,1):xm=10*j:ym=10*j:
zm=2*j:sp=-10:zn=10:n=5*j:EndMacro:M do2:cx=EX/2:cy=EY/2:zo=60:sh=0:l sx(n)
:l sy(n):l sz(n):EndMacro:do1:do2:F1 n:sx(i)=Rd(xm)-xm/2:sy(i)=Rd(ym)-ym/2:
sz(i)=Rd(zm):N1:Repeat:Ev=w_e:St_d(s_o()):F1 n:sz(i)=sz(i)+sp:If sz(i)<=zn:
sz(i)=zm:sx(i)=Rd(xm)-xm/2:sy(i)=Rd(ym)-ym/2:E:cal1:cal2:If uy<EY:If ux>0:
If uy>0:r=Rd(P)+1:v=Rd(P)+1:b=Rd(P)+1:C1:E:E:E:E:N1:fin:Until Ev=16

cà ressemble à petit défi dans le défi...

10 pour moi (722 cars)

Code : Tout sélectionner

InitSprite():EX=GetSystemMetrics_(0):EY=GetSystemMetrics_(1)
Macro R:Random:EndMacro::WD=OpenWindow(1,0,0,EX,EY,"",2160590849)
j=1000:xm=10*j:ym=10*j:zm=2*j:sp=-10:zn=10:n=5*j:cx=EX/2:cy=EY/2:zo=60:sh=0
Dim sx(n):Dim sy(n):Dim sz(n):OpenWindowedScreen(WD,0,0,EX,EY,1,1,1)
For i=0 To n:sx(i)=R(xm)-xm/2:sy(i)=R(ym)-ym/2:sz(i)=R(zm):Next
Repeat:StartDrawing(ScreenOutput()):For i=0 To n:sz(i)+sp:If sz(i)<=zn:sz(i)=zm
sx(i)=R(xm)-xm/2:sy(i)=R(ym)-ym/2:EndIf:ux=(sx(i)*zo)/sz(i)+cx
uy=(-sy(i)*zo)/sz(i)+cy:sh=Int(255/zm*-sz(i)):If ux<EX:If uy<EY:If ux>0:If uy>0
r=R(255)+1:v=R(255)+1:b=R(255)+1:Circle(ux,uy,1,RGB(r,v,b)):EndIf:EndIf:EndIf
EndIf:Next:StopDrawing():FlipBuffers():ClearScreen(0):Until WindowEvent()=16

Franchement Dobro je suis sûr que tu as fait exprès, vu la gueule du code

Sympa l'effet à part çà, j'espère que je ne l'ai pas 'abimé'...

@dobro

Juste pour te chambrer gentiment (une façon de faire un coucou depuis le temps),

tu as posté il y a 10 jours :

perso je n'utilise jamais les macros, mais bon ...

http://www.purebasic.fr/french/viewtopic.php?t=9464

Maintenant tu vas pouvoir dire :

perso je n'utilise que les macros, mais bon ...

Dans ton <Punch> je compte 10 macros, soit une par ligne.

c'est bon !! je boude !

Tu devrais pas.

Ton StarEffect est très bien.
C'est le 1er du genre en plus dans ce concours je crois.

En plus, ton post va m'amener à poster un souhait dans la rubrique ' Suggestions et améliorations'.

à tout de suite...

PureBasic

Compétition PurePunch Numéro 2