Compétition PurePunch des fêtes de fin d'année 2012

Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic.

Le 28 novembre 2012 à 21:49, par comtois

56PARTAGES

Le concours est terminé : Télécharger l'archive du PurePunch 2012

Avant propos: le texte ci-dessous est mal formaté sur la page actu, et le lien vers la pièce jointe n'apparait pas. Vous pouvez vous rendre sur le forum pour une lecture plus aisée et récupérer l'archive.

Avis aux amateurs, djes relance son fameux PurePunch. Lors des compétitions précédentes il nous a permis de voir de jolis démos.

Il est même possible d'utiliser la version démo puisque le concours limite les codes à 80 lignes. Et croyez moi on peut faire de sacrés trucs en 80 lignes! souvenez vous du précédent PurePunch qui limitait les codes à 10 lignes et bien y'en a un qui nous a quand même pondu un RayTracing en 10 lignes !

NOTE : Suite à cette annonce, Fred (l'auteur de PureBasic) annonce qu'il dote le concours de quelques bricoles. Je ne connais pas le détail, c'est surtout pour le 'fun' ce concours

Envoyé par djes

Bonne nouvelle, Fred sponsorise, il y aura donc quelques petits cadeaux

[EDIT]J'ai ajouté en pièce jointe un fichier .zip comportant les codes d'un concours PurePunch précédent. Le RayTracing dont je parle se trouve dans le code numéro 007.Pb.

~ Décembre 2012 ~

Compétition PurePunch des fêtes de fin d'année 2012

Thème

The fantastic PB 5.00 Demo !
Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic. Cette démo peut aussi bien être un utilitaire, un jeu, une démo graphique en 3D, n'importe quoi qui montre vos capacités et celles de la nouvelle version de PB, en en repoussant les limites !
Que le meilleur gagne !

Les lots & les sponsors
Fred et Fantaisie software vont sponsoriser la compétition. La liste de prix est en cours de création.
Si vous voulez sponsoriser, contactez-moi.

Les règles

1° Le programme sera fait en Purebasic version 5.00 sans l'ajout de bibliothèque utilisateur (userlib).
2° Le source du programme ne pourra comporter au maximum que 80 lignes de 80 caractères max par ligne.
3° Etre original, c'est à dire soit être une création complète, soit apporter quelque chose de nouveau à un code existant.
4° Ne pas être néfaste.
5° Possibilité de joindre une (et une seule) image d'une taille maximale de 512 pixels de large sur 512 pixels de haut, en 32 bits. La poster sur le forum ou sur un site accessible durant toute la durée de la compétition, ou la joindre à l'archive complète du projet liée dans le post sur le forum.
6° Possibilité de joindre un fichier sonore (et un seul) d'une taille maximale de 1 Mo. Le poster sur un site accessible durant toute la durée de la compétition, ou le joindre à l'archive complète du projet liée dans le post sur le forum.
7° Il sera possible d'ajouter une ligne de code (non comptée) en début de source avertissant l'utilisateur d'une spécificité du programme (comme par exemple une attente ou la nécessité d'utiliser une bibliothèque sous-système particulière). Celle-ci devra être de la forme

Code :

Sélectionner tout

    MessageRequester("Information", "Message", #PB_MessageRequester_Ok)

8° Date et heure limite : 31 décembre, 23h59

A la fin de la période, un fil pour le vote sera mis en place afin d'élire le meilleur programme. Seules les personnes inscrites sur le forum avant le 27 novembre pourront voter (3 points pour le 1er, 2 points pour le second, 1 point pour le troisième).

Comment poster

Postez le code dans le forum après y avoir ajouté et complété l'entête suivant :

Code :

Sélectionner tout

1
2
3
4
5
6
7
8
9
10
11
12
;********************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : 
;* Author   :
;* Date     :
;* Notes    :
;*
;********************************************************

Bonne chance à tous les compétiteurs !

Source de l'information

Une erreur dans cette actualité ? Signalez-nous-la !

Votre nom : Votre e-mail :

Décrivez l'erreur que vous souhaitez porter à notre connaissance :

;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : Pure4Power
;* Author   : cederavic
;* Date     : 12/01/2012
;* Notes    : Hmmm... Better to play with two players!
;*          : media.png can be downloaded here : http://slimevoid.net/games/pure4power/media.png
;*
;*****************************************************************************
#width=512:#height=440
Global Dim g(6,5),tu=1,pw=-1,Dim f(6,5):Declare checkWin()
InitSprite():UsePNGImageDecoder():UsePNGImageEncoder()
OpenWindow(0,0,0,#width,#height,"Pure4Power",13107201)
CanvasGadget(0,0,0,#width,#height,#PB_Canvas_ClipMouse)
media=LoadImage(#PB_Any,"media.png")
GrabImage(media,0,0,0,512,440)
GrabImage(media,1,0,440,72,72)
GrabImage(media,2,72,440,72,72)
LoadFont(0,"Consolas",22,#PB_Font_HighQuality|#PB_Font_Bold)
playertuTime=ElapsedMilliseconds()
Repeat:Repeat:wEvent=WindowEvent():If wEvent=16:quit=#True:EndIf
If wEvent=#WM_LBUTTONUP And dp=#False:If pw=0
dropCol=Int((WindowMouseX(0)-8)/72)
If g(dropCol,0)=0:dp=#True:dy=0:EndIf:Else:FreeArray(g()):Global Dim g(6,5)
tu=1:pw=0:EndIf:EndIf:Until wEvent=#Null:If dp=#True:dy+12
cr=Int((dy-8)/72)+1:If cr=6:dp=#False:g(dropCol,cr-1)=tu:checkWin()
If tu=1:tu=2:Else:tu=1:EndIf:playertuTime=ElapsedMilliseconds():Else
If g(dropCol,cr) > 0:dp=#False:g(dropCol,cr -1)=tu:checkWin()
If tu=1:tu=2:Else:tu=1:EndIf
playertuTime=ElapsedMilliseconds():EndIf:EndIf:EndIf
StartDrawing(CanvasOutput(0))
DrawingMode(#PB_2DDrawing_Gradient):LinearGradient(0,0,0,#height)
BackColor(RGBA(182,180,255,255)):FrontColor(RGBA(100,182,255,255))
Box(0,0,#width,#height,RGBA(0,42,224,255)):If (dp=#True)
DrawAlphaImage(ImageID(tu),dropCol * 72+4,dy+4):ElseIf (pw=0)
DrawAlphaImage(ImageID(tu),Int((WindowMouseX(0)-8)/72) * 72+4,4,128)
EndIf:For x=0 To 6:For y=0 To 5:If (g(x,y) > 0):If (pw=0)
DrawAlphaImage(ImageID(g(x,y)),x * 72+4,y * 72+4):Else
DrawAlphaImage(ImageID(g(x,y)),x * 72+4,y * 72+4,63+f(x,y) * 192)
EndIf:EndIf:Next:Next:DrawAlphaImage(ImageID(0),0,0)
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
DrawingFont(FontID(0)):If (pw > 0)
text.s="Player "+Str(pw)+" has won!"
DrawText(#width/2-TextWidth(text)/2+2,126,text,RGBA(32,32,32,127))
DrawText(#width/2-TextWidth(text)/2,128,text,RGBA(42,241,64,255))
text.s="Click to play again"
DrawText(#width/2-TextWidth(text)/2+2,126+48,text,RGBA(32,32,32,127))
DrawText(#width/2-TextWidth(text)/2,128+48,text,RGBA(42,241,64,255))
ElseIf (pw=0):If (ElapsedMilliseconds()-playertuTime < 3000)
alpha.f=255-(255 * (ElapsedMilliseconds()-playertuTime)/3000.0)
text.s="Player "+Str(tu)+" turn"
If tu=1:color=RGBA(255,174,0,alpha):Else:color=RGBA(255,16,16,alpha):EndIf
DrawText(#width/2-TextWidth(text)/2+2,126,text,RGBA(32,32,32,(alpha/2)))
DrawText(#width/2-TextWidth(text)/2,128,text,color):EndIf:Else
text.s="Click to Play"
DrawText(#width/2-TextWidth(text)/2+2,126,text,RGBA(32,32,32,127))
DrawText(#width/2-TextWidth(text)/2,128,text,RGBA(242,180,100,255))
EndIf:StopDrawing():Until quit=#True:End
Procedure p(x,y,dx,dy,player,win):If x<0 Or x>6 Or y<0 Or y>5
ProcedureReturn win:EndIf:If g(x,y)<>player:ProcedureReturn win:EndIf
If g(x,y)=player:f(x,y)=1:ProcedureReturn p(x+dx,y+dy,dx,dy,player,win+1):EndIf
EndProcedure
Procedure checkWin():For x=0 To 6:For y=0 To 5:If (g(x,y) > 0)
For dx=-1 To 1:For dy=-1 To 1:If (dx <> 0 Or dy <> 0):FreeArray(f())
Global Dim f(6,5):If p(x,y,dx,dy,g(x,y),0) >= 4
pw=g(x,y):ProcedureReturn pw:EndIf:EndIf:Next:Next:EndIf
Next:Next:ProcedureReturn 0:EndProcedure

;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : Meal Master Quickview
;* Author   : electrochrisso
;* Date     : 04.12.2012
;* Notes    : Download Recipes Here: http://home.earthlink.net/~darkstar105/
;*
;*****************************************************************************
OpenWindow(0,100,0,842,540,"Meal Master Quickview",#PB_Window_SystemMenu)
CreateToolBar(0,WindowID(0)):ToolBarStandardButton(0,#PB_ToolBarIcon_Open)
ListViewGadget(0,0,28,200,512)
EditorGadget(1,202,28,640,512,#PB_Editor_ReadOnly)
SetGadgetColor(0,#PB_Gadget_BackColor,$FAFFF5)
SetGadgetColor(1,#PB_Gadget_BackColor,$F0FFFF)
SetGadgetFont(1,LoadFont(0,"Courier",10))
Repeat:Select WaitWindowEvent():Case #PB_Event_Menu:Select EventMenu()
Case 0:f$=OpenFileRequester("Open Menu Master File","","Text (*.txt)",0)
If f$:If ReadFile(0,f$):ClearGadgetItems(0):SetGadgetText(1,""):Repeat
a$=ReadString(0):If Left(a$,12)="      Title:":AddGadgetItem(0,-1,Mid(a$,13))
EndIf:Until Eof(0):CloseFile(0):EndIf:EndIf:EndSelect
Case #PB_Event_Gadget:Select EventGadget():Case 0:If ReadFile(0,f$)
Repeat:a$=ReadString(0)
Until a$=Left(a$,12)+GetGadgetItemText(0,GetGadgetState(0))
While a$<>"MMMMM":If a$<>"MMMMM":b$+a$+#CRLF$:a$=ReadString(0):EndIf:Wend
CloseFile(0):EndIf:SetGadgetText(1,b$):b$="":EndSelect
Case #PB_Event_CloseWindow:End:EndSelect:ForEver

;******************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : SPACE INVADERS PONG
;* Author   : Graph100
;* Date     : 02/12/12
;* Notes    : Just enjoy the little game ! There is no score, nor levels ;)
;*            But there are two ending : you win or you loose.
;*            You win by destroying the Space Invaders MasterShip (the big red
;*            one), with the red ball
;*            You loose if the Space Invaders touches the earth, if you came to
;*            loose all your three lives and if the red ball thrown by the
;*            Space Invaders MotherShip touches the earth
;*
;******************************************************************************
Structure p:x.d:y.d:t.l:x1.d:y1.d:EndStructure:Dim e.p(9,5):m=286:z=m:b.p\x=294
InitSprite():InitKeyboard():NewList t.p():v=3:NewList r.p():NewList g.p():l=100
#h=400:OpenWindow(0,0,0,600,#h,"PP",$C80001):x=32:LoadImage(0,"512.png"):b\y=82
OpenWindowedScreen(WindowID(0),0,0,600,#h,0,0,0):b\x1=(Random(10)-5)/5:b\y1=1;#
Macro O:EndIf:EndMacro:Macro D(i,x,y):DisplayTransparentSprite(i,x,y):EndMacro;
Macro S(i,x,y,j,w,h):SpritePixelCollision(i,x,y,j,w,h):EndMacro:Macro N:Next;##
EndMacro:NewList _t.p():Macro C2(i):If i\t>0:D(i\t+24,i\x-10,i\y-10):O:i\t+1;##
If i\t>15:DeleteElement(i):O:EndMacro:Macro C(i,x,y,w,h):CreateSprite(i,w,h);##
GrabImage(0,1,x,y,w,h):StartDrawing(SpriteOutput(i)):DrawImage(ImageID(1),0,0);
StopDrawing():TransparentSpriteColor(i,0):EndMacro:LoadFont(0,"Arial",19,272);#
Macro F1(i,j,k):For i=j To k:EndMacro:Macro C1(t1):StartDrawing(ScreenOutput())
DrawingFont(FontID(0)):DrawText(0,0,t1):i2=TextWidth(t1):j2=TextHeight(t1)-1;##
F1(i,0,i2):F1(j,0,j2):If Point(i,j):AddElement(_t()):_t()\x=i:_t()\y=j;########
_t()\x1=Random(600):_t()\y1=Random(#h):_t()\t=Point(i,j):O:N:N:Box(0,0,i2,j2,0)
StopDrawing():EndMacro:F1(i,0,11):C(i,i*24,50,24,16):N:F1(i,0,5);##############
C(i+12,i*6,80,6,16):N:C(18,320,50,26,16):C(19,0,0,510,50):C(20,0,462,510,50);##
C(21,22,110,468,15):C(22,288,50,32,16):C(23,510,0,2,512):#b=540:F1(i,0,15);####
C(i+24,i*20,141,20,20):N:Macro Q(x1,y1,w,h,t1):F1(t2,0,t1):AddElement(r());####
r()\x=Random(w)+x1:r()\y=Random(h)+y1:r()\t=-Random(t1):N:EndMacro:F1(i,0,7);##
C(i+40,346+i*16,50,16,16):N:Repeat:Repeat:w=WindowEvent():Until w=0 Or w=16:_+1
ExamineKeyboard():ClearScreen(0):D(19,44,v1):D(20,44,350):D(23,42,0);##########
D(23,556,0):If f And a>0:a-1:D(21,66,40):O:If v>0:F1(i,1,v):D(18,9,i*30):N;####
If l<70:If _%6=0:If l<60:With e((59-l)%10,(59-l)/10);##########################
\t=l/10:\x=294:\y=40:EndWith:O:l+1:O:Else:u+ed:If u>=262 Or u<=48:ed=-ed:y+10:O
EndIf:For j=0 To 5:For i=0 To 9:With e(i,j);###################################
If l=100:\t=-1:O:If \t<>-1:If l<70:\x+2*(i*30+u-\x)/8:\y+(j*20+y-\y)/8:Else;###
\x=u+i*30:\y=y+j*20:If Random(1000)=0:AddElement(g()):g()\t=\t/2+13:g()\y=\y+16
g()\x=\x+12:O:O:D(\t*2+_%40/20,\x,\y):If S(20,44,350,\t*2+_%40/20,\x,\y):v=0:O;
If l1>3 And S(40,b\x,b\y,\t*2+_%40/20,\x,\y):\t=-1:Q(\x,\y,24,16,20):h-1:Else;#
ForEach t():If S(12,t()\x,t()\y,\t*2+_%40/20,\x,\y):DeleteElement(t()):\t=-1;##
h-1:Q(\x,\y,24,16,20):Break:O:N:O:O:N:N:EndWith:If h=0:l=0:l1+1:h=60:ed=2:u=150
y=110:O:dx=0:If KeyboardPushed(203):m-3:dx=-1:If m<44:m=44:O:O:If _%18=0:ta=1:O
If KeyboardPushed(205):m+3:dx=1:If m>530:m=530:O:O:D(18,m,340):D(22,z,65);#####
If ta And KeyboardReleased(57):ta=0:AddElement(t()):t()\x=m+10:t()\y=324:O;####
D(40+_%32/4,b\x,b\y):If l1>3:b\x+b\x1:b\y+b\y1:If b\x<z+8:z-4:O:If b\x>z+8:z+4;
O:If b\x<44 Or b\x>#b:b\x1=-b\x1:b\x+b\x1:O:If b\y>60 And S(40,b\x,b\y,22,z,65)
b\y1=-b\y1:b\y=80:O:If b\y<344 And S(40,b\x,b\y,18,m,340):b\y1=-b\y1:b\y=324;##
b\x1+dx:If Abs(b\x1)>5:b\x1=5*Sign(b\x1):O:O:If S(40,b\x,b\y,20,44,350):v=0:O;#
If b\y<30:v=-2:EndIf:EndIf:ForEach t():With t();###############################
\y-2:D(12,\x,\y):If S(12,\x,\y,21,66,40) Or \y<-8:If \y>0:f=1:a=8:O;###########
DeleteElement(t()):EndIf:EndWith:Next:ForEach g():With g();####################
\y-12+\t:D(\t,\x,\y):If S(\t,\x,\y,20,44,345):DeleteElement(g());##############
ElseIf S(\t,\x,\y,18,m,340):DeleteElement(g()):v-1:O:EndWith:N:ElseIf v=0:v-1;#
Q(m,340,26,16,100):F1(j,0,5):F1(i,0,9):If e(i,j)\t<>-1;########################
Q(e(i,j)\x,e(i,j)\y,24,16,20):O:N:N:F1(i,0,5):e(0,i)\t=i:e(0,i)\x=294;#########
e(0,i)\y=40:N:C1("Les SPACE INVADERS envahissent la terre..."):f=1:a=j2;#######
ElseIf v=-2:v-1:C1("Tu as vaincus les SPACE INVADERS !!"):ElseIf v=-3;#########
If v1>-50 And _%5=0:Q(70,0,454,40+v1,20):v1-1:O:D(18,m,340);#PUREPUNCH#DEC#2012
D(40+_%32/4,m+5,320-50*Abs(Sin(_/10))):Else:F1(i,0,5);######SPACE#INVADERS#PONG
ra.d=920+25*Abs(Sin(_/24+i)*Sin(_/8+i)*Sin(_/8+i));############PAR#GRAPH100####
e(0,i)\x=e(0,i)\x+(300+ra*Cos(0.2*Sin(_/90+i/2)-#PI/2)-e(0,i)\x)/x;############
e(0,i)\y=e(0,i)\y+(1270+ra*Sin(0.2*Sin(_/90+i/2)-#PI/2)-e(0,i)\y)/x;###########
D(e(0,i)\t*2+_%40/20,e(0,i)\x,e(0,i)\y):Q(e(0,i)\x+12,e(0,i)\y+24,2,2,2):N;####
If _%200=0:f=-f:a=j2:O:If _%3=0:a-1:O:If _%20=0:x/2+1:O:O;###JOYEUSE#NOUVELLE##
StartDrawing(ScreenOutput()):ForEach _t():With _t();##ANNEE#A#TOUT#LE#FORUM#!!#
\x1+(300-i2/2+\x+2*Sin(\y+_/5)-\x1)/8:If (f=-1 And \y>=a) Or (f=1 And \y>=j2-a)
\y1+(200+\y-\y1)/8:Else:\y1+(100+\y-\y1)/8:O:Box(\x1,\y1,1,1,\t):EndWith:N;####
StopDrawing():ForEach r():C2(r()):N:FlipBuffers();#############################
Until w=16 Or KeyboardPushed(1)

;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : Magic Ruban
;* Author    : Ar-S
;* Date       : Dec 2012 
;* Notes    : This code is non unicode.
;*
;*****************************************************************************
;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : Magic Ruban
;* Author    : Ar-S
;* Date       : Dec 2012 
;* Notes    : This code is non unicode.
;*
;*****************************************************************************
inf$ = "Write a message into the editor then create your magic ruban!"+Chr(10)
inf$ + "C = Clear   -     P = Paste"
MessageRequester("Information", inf$, #PB_MessageRequester_Ok)
UsePNGImageEncoder() : UsePNGImageDecoder()
NewList T.i() : NewList Message.s()
Macro M : Macro : EndMacro
M Rnd : Random(200) : EndMacro
M Gb : Global : EndMacro
M Dg : DisableGadget : EndMacro
M Bt : ButtonGadget : EndMacro
M SGT (inside) : SetGadgetText(5,inside) : EndMacro
M SDC : StartDrawing(CanvasOutput(1)) : EndMacro
M SDI(gad) : StartDrawing(ImageOutput(gad)) : EndMacro
Gb Name$ = "Magic Ruban" : Gb GO,RUBOK : RUBOK=0
Gb imgfile$ = GetCurrentDirectory()+"MyRuban.rub"
Gb titre : titre = LoadImage(12,GetCurrentDirectory()+"title.png")
Procedure Msgt(mess.s,Opt = 0)
  ProcedureReturn  MessageRequester("Info",mess.s, Opt)
EndProcedure
OpenWindow (0, 0, 0, 600, 450,Name$, #PB_Window_SystemMenu)
CanvasGadget (1, 1, 1, 600, 256)
Bt(2, 42, 349, 159, 20, "Create a "+Name$)
Bt(3, 201, 349, 200, 20, "Save my "+Name$)
Bt(4, 402, 349, 200, 20, "Read a "+Name$)
EditorGadget(5, 1, 258, 600, 90)
Bt(6, 1, 349, 20, 20, "C") : Bt(7, 21, 350, 20, 20, "P")
ImageGadget(8,4,370,592,80,titre) 
SendMessage_(GadgetID(5), #EM_LIMITTEXT, 600, 0)
SendMessage_(GadgetID(5), #EM_SETTARGETDEVICE, #Null, 0)
SGT("Enter your message in here : Max 600 car. Enjoy "+Name$) : DG(3,1)
GO = 1 : SDC : Box(0,0,600, 257, $0) : StopDrawing()
Repeat : Select WaitWindowEvent() : Case #PB_Event_Gadget:Select EventGadget()
Case 2 : ClearList (T()) : Mess$ = GetGadgetText(5) : LenM = Len(Mess$)
For NumCar=1 To LenM : AddElement (T()) : T()=Asc(Mid(Mess$, NumCar,1)) : Next
Max=0 : ForEach T() : Size=T() : If Size > Max : Max=T() : EndIf : Next : Max+1
If CreateImage (10, 600, Max) : SDI(10) : Box(0,0,600, Max-1, $0)
For Pix = 0 To lenM-1
SelectElement(T(), Pix) : R = Rnd+55 : G = Rnd+55 : B = Rnd+55
Line(Pix,0,1,Max-2, RGB(R-5, G-5, B-5))
Line(Pix,0,1,T()-1, RGB(R, G, B)) : Next : StopDrawing()
SDC : DrawImage(ImageID(10),0,0,600,256) : StopDrawing()
If RUBOK = 0 : RUBOK+1 : DG(3,0) : EndIf : EndIf
Case 3 : SaveImage(10, imgfile$, #PB_ImagePlugin_PNG) : FreeImage(10)
msgt( imgfile$ + " has been save")
Case 4 : ClearList(Message())
imgLoad$ = OpenFileRequester(name$,imgfile$, "Ruban File *.rub|*.rub" ,0)
If imgLoad$ <> "" : If LoadImage(11, imgLoad$) : ClearList(Message())
T$ = "" : SGT("") : imgL = ImageWidth(11) : imgH = ImageHeight(11)
SDC : DrawImage(ImageID(11),0,0,600,256) : StopDrawing()
SDI(11) : NbrCar = 0 : For L = 0 To ImgL-1 : i = 0 : Stop = 0
Repeat : COL = Point(L, i) : If i = 0 : NewCOL = COL : EndIf
If NewCOL <> COL : AddElement (Message())
Message() = Chr(i+1) : T$ + Message() : NewCOL = COL : NbrCar+1  : Stop = 1
Else : i+1 : If i = imgH-1 : Stop = 1 : EndIf : EndIf : Until Stop = 1
Next L : StopDrawing() : FreeImage(11) : SGT(T$) : Else : EndIf : EndIf     
Case  5 : If GetGadgetText(5) = "" : DG(2,1) : Else : DG(2,0) : EndIf
Case  6 : Q=msgt ("Do you really want to clear everything ?", 4)
If Q = 6 : SGT("") : If RUBOK = 1 : RUBOK-1 : DG(3,1) : EndIf
SDC : Box(0,0,600, 256, $0) : StopDrawing() : EndIf
Case 7 : If GetClipboardText() <> "" :  SGT(GetClipboardText())
Else : Msgt ("There is no text in the clipboard !") : EndIf
EndSelect
Case #PB_Event_CloseWindow : If EventWindow() = 0 : CloseWindow(0)
FreeImage(12) : End : EndIf : EndSelect : ForEver

;******************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;
;* Name     : PanelGadget Color Toobar
;* Author   : Kernadec
;* Date     : 04.12.2012
;* Notes    : ...
;*
;******************************************************************************
Enumeration
      #Win:#PanelGadget1
      #bouton1:#bouton2
      #Container1:#Container2
      #Canvas1:#Canvas2
      #ToolBar1:#ToolBar2
EndEnumeration
Enumeration 1
      #icon1:#icon2:#icon3:#icon4:#icon5:#icon6:#icon7:#icon8
EndEnumeration
#Options=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
titre$="PanelGadget color & ToolBar"
Procedure.f GradientCallback1(x, y)
   ProcedureReturn Cos(x * 0.5) * Sin(y * 0.5) / Cos(x*0.5)
EndProcedure
Procedure.f GradientCallback2(x, y)
   ProcedureReturn Cos(x * 0.6) * Sin(x * 0.6) / Cos(x*0.6)
EndProcedure 
OpenWindow( #Win, 0, 0, 300, 200,titre$,#Options)
PanelGadget(#PanelGadget1,10,10,WindowWidth(#Win)-20,WindowHeight(#Win)-20)
AddGadgetItem(#PanelGadget1, -1, "Panel 1")
ContainerGadget(#Container1, 0, 0, 272,24,#PB_Container_BorderLess) 
CloseGadgetList()
CanvasGadget(#Canvas1, 0, 25, 272,128):StartDrawing(CanvasOutput(#Canvas1))
DrawingMode(#PB_2DDrawing_Gradient):BackColor($00FFFF):FrontColor($FF0F0F)
CustomGradient(@GradientCallback1()):Box(0, 0, 272,128):StopDrawing()
DisableGadget(#Canvas1,1):ButtonGadget(#bouton1, 90,  62, 100, 56, "Button1")
CreateToolBar(#ToolBar1,GadgetID(#Container1))
ToolBarStandardButton(#icon1,#PB_ToolBarIcon_New)
ToolBarStandardButton(#icon2,#PB_ToolBarIcon_Open)
ToolBarStandardButton(#icon3,#PB_ToolBarIcon_Undo)
ToolBarStandardButton(#icon4,#PB_ToolBarIcon_Redo)
;-----------------------------------------------------------------------------
AddGadgetItem(#PanelGadget1, -1, "Panel 2")
ContainerGadget(#Container2,  0, 0, 272,24,#PB_Container_BorderLess)
CloseGadgetList()
CanvasGadget(#Canvas2, 0, 25, 272,128):StartDrawing(CanvasOutput(#Canvas2))
DrawingMode(#PB_2DDrawing_Gradient):BackColor($00FFFF):FrontColor($FF0F0F)
CustomGradient(@GradientCallback2()):Box(0, 0, 272,128):StopDrawing()
DisableGadget(#Canvas2,1):ButtonGadget(#bouton2, 90,  62, 100, 56, "Button2")
CreateToolBar(#ToolBar2, GadgetID(#Container2))
ToolBarStandardButton(#icon5,#PB_ToolBarIcon_Cut)
ToolBarStandardButton(#icon6,#PB_ToolBarIcon_Copy)
ToolBarStandardButton(#icon7,#PB_ToolBarIcon_Paste)
ToolBarStandardButton(#icon8,#PB_ToolBarIcon_Replace)
Repeat
      Select WaitWindowEvent()
            Case #PB_Event_CloseWindow
                  End
            Case #PB_Event_Gadget
                  Select EventGadget()
                        Case #bouton1
                              Debug "Identifiant bouton: "+Str(EventGadget())
                        Case #bouton2
                              Debug "Identifiant bouton: "+Str(EventGadget())
                  EndSelect
            Case #PB_Event_Menu
                  Debug "Identifiant ToolBar: "+Str(EventMenu())   
      EndSelect
      ResizeGadget(#bouton1,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
      ResizeGadget(#bouton2,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
      ;ResizeGadget = mode XP, Seven No ResizeGadget, vista No test.
ForEver

;*******************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : FAST EDITOR 2D
;* Author   : Comtois
;* Date     : 30/12/2012
;* Notes    : Esc to Quit : Left button add a tile: Right button remove a tile
;*
;*******************************************************************************
Macro G(n,t,u):GrabSprite(n,t,u,32,32):EndMacro:Macro E:EndIf:EndMacro;*********
InitSprite():InitKeyboard():InitMouse():OpenScreen(1024,768,32,"M"):#X=32:#Y=32;
Global W,Z,F:Global Dim M(32,24):LoadSprite(16,"S.bmp"):DisplaySprite(16,0,0);**
For I=0 To 7:G(i,i*32,0):G(i+8,i*32,32):Next i:G(20,0,64):Procedure T(x,y,R):F=0
If R:If x<32:If M(x+1,y)>0:F|1:E:E:If x>0:If M(x-1,y)>0:F|2:E:E:If y<24;********
If M(x,y+1)>0:F|4:E:E:If y>0:If M(x,y-1)>0:F|8:E:E:If M(x,y)>0:If F=0:F=15:E;***
Else:F=0:E:E:Ch=M(x,y):M(x,y)=F:If Ch<>F Or R=0:If x>0:T(x-1,y,1):E:If x<32;****
T(x+1,y,1):E:If y>0:T(x,y-1,1):E:If y<24:T(x,y+1,1):E:E:EndProcedure:Repeat;****
ClearScreen(0):For j=0 To 24:For i=0 To 32:DisplaySprite(M(i,j),i*#X,j*#Y);*****
Next i:Next j:ExamineMouse():ExamineKeyboard():P=MouseX():Q=MouseY();***********
DisplayTransparentSprite(20,P-#X/2,Q-#Y/2):W=P/#X:Z=Q/#Y:If W<=32 And Z<=24;****
If MouseButton(2):M(W,Z)=0:T(W,Z,0):E:If MouseButton(1):M(W,Z)=17:T(W,Z,1):E:E:;
FlipBuffers():Until KeyboardPushed(1);******************************************

Identifiez-vous

Créer un compte

Compétition PurePunch des fêtes de fin d'année 2012

Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic.

Identifiant
Mot de passe

Mot de passe oublié ?

Identifiez-vous

Créer un compte

Compétition PurePunch des fêtes de fin d'année 2012 Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic.

Compétition PurePunch des fêtes de fin d'année 2012

Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic.