PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Mon MessageResqueter Perso ...

https://www.purebasic.fr/french/viewtopic.php?t=9409

Page 1 sur 2

Mon MessageResqueter Perso ...

Publié : mar. 19/mai/2009 13:50
par jbernard13
bonjour
Voici un petit MessageResqueter perso , j'ai voulu aussi rendre hommage à un grand programmeur du Forum .....

Code : Tout sélectionner

;***** Mon MessageRequester perso *****
;***** écris par Jbernard13 *******

;****** Constantes ******
Enumeration
  #Message_Perso
  #text_01
  #Bouton_ok
  #Font1
EndEnumeration
Global Font01
;*** Chargement de la police ****
Font01= LoadFont ( #Font1 , "arial" ,20, #PB_Font_Bold )


;******* Création de la fenetre et des Gadgets 
; Initialisations Diverses
If InitSprite () =0 
  MessageRequester ( "Error" , "Sprite system can't be initialized" , 0)
  End
EndIf
If OpenWindow(#Message_Perso,0,0,300,100,"Informations",#PB_Window_ScreenCentered)
  If OpenWindowedScreen ( WindowID ( #Message_Perso),30,20,50,40,0,0,0)
    ClearScreen ( RGB (0,0,0))
    TextGadget(#text_01,120,10,110,60,"Coucou à Tous",#PB_Text_Center)
    SetGadgetFont(#text_01,Font01)
    SetGadgetColor(#text_01, #PB_Gadget_FrontColor,RGB(255,255,15))
    SetGadgetColor(#text_01, #PB_Gadget_BackColor,RGB(0,0,0)) 
    ButtonGadget(#Bouton_ok,250,70,30,30,"OK")
    PureCOLOR_SetButtonColor(#Bouton_ok,RGB($FF,$FF,$0),RGB(0,0,0))
    EndIf

  SetWindowColor(#Message_Perso,RGB($0,$0,$0))
  CreateSprite(0,32,32)
  StartDrawing(SpriteOutput(0))
    Circle(16,16,16,RGB(255,255,15)) 
    
    Circle( 10,10,5,RGB(0,250,255))
    Circle( 10,10,2,RGB(0,0,0))
    Circle( 22,10,5,RGB(0,250,255))
   Circle( 22,10,2,RGB(0,0,0))
    Box (10,22,10,5,RGB(0,0,0)) 
   Box (20,20,4,4,RGB(0,0,0))
   Box (7,20,4,4,RGB(0,0,0))
  StopDrawing()
   DisplaySprite(0,10,10) 
  FlipBuffers()
  EndIf





;***** Boucle du programme *****
Repeat 
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Bouton_ok 
       
          
      EndSelect
  
      Quitter =#True
  EndSelect
Until Quitter
End

Publié : mar. 19/mai/2009 14:01
par TazNormand
Je demande une version avec le sprite qui se balade dans le requester !!: :D

Et il sert à quoi ton select vide ?

Publié : mar. 19/mai/2009 14:03
par Backup
super! JB13 :)

Publié : mar. 19/mai/2009 14:24
par jbernard13
TazNormand
regarde mon code
j'ai mis Select WaitWindowEvent() puis Case #PB_Event_Gadget pour activer le bouton et fermer la fenetre .

Publié : mar. 19/mai/2009 14:34
par TazNormand
oui, mais je pense que ton "Quitter =#True " devrait se trouver juste après le "Case #Bouton_ok", tu ne crois pas ?

ton code marche car tu n'as que ce bouton !!!

Et pour le sprite qui bouge ?

Publié : mar. 19/mai/2009 14:36
par jbernard13
je voulais juste faire un messagerequester donc je ferais pas bouger le sprite .

Publié : mar. 19/mai/2009 15:05
par Ar-S
héhé, sympa le smiley :P

Publié : mar. 19/mai/2009 15:38
par TazNormand
je l'ai fais pour toi le smiley qui bouge, et aussi pour moi, ça me familiarise avec PB.

En passant, j'ai essayé de faire un thread pour le displaysprite, et remplacer le WaitWindowEvent par un WindowEvent, mais ça fait du clipping; pourquoi donc ?

Code de Smiley mobile au regard Salace (cf film "la maison du bonheur")

Code : Tout sélectionner


;***** Mon MessageRequester perso *****
;***** écris par Jbernard13 *******

;****** Constantes ******
Enumeration
	#Message_Perso
	#text_01
	#Bouton_ok
	#Font1
EndEnumeration
Global Font01
;*** Chargement de la police ****
Font01= LoadFont ( #Font1 , "arial" ,20, #PB_Font_Bold )


;******* Création de la fenetre et des Gadgets 
; Initialisations Diverses
If InitSprite () =0 
	MessageRequester ( "Error" , "Sprite system can't be initialized" , 0)
	End
EndIf
If OpenWindow(#Message_Perso,0,0,300,100,"Informations",#PB_Window_ScreenCentered)
	If OpenWindowedScreen ( WindowID ( #Message_Perso),10,10,100,80,0,0,0)
		ClearScreen ( RGB (0,0,0))
		TextGadget(#text_01,120,10,110,60,"Coucou à Tous",#PB_Text_Center)
		SetGadgetFont(#text_01,Font01)
		SetGadgetColor(#text_01, #PB_Gadget_FrontColor,RGB(255,255,15))
		SetGadgetColor(#text_01, #PB_Gadget_BackColor,RGB(0,0,0)) 
		ButtonGadget(#Bouton_ok,250,70,30,30,"OK")
		;PureCOLOR_SetButtonColor(#Bouton_ok,RGB($FF,$FF,$0),RGB(0,0,0))
		EndIf

	SetWindowColor(#Message_Perso,RGB($0,$0,$0))
	CreateSprite(0,32,32)
	StartDrawing(SpriteOutput(0))
		Circle(16,16,16,RGB(255,255,15)) 
		
		Circle( 10,10,5,RGB(0,250,255))
		;Circle( 10,10,2,RGB(0,0,0))
		Box (7,10,6,2,RGB(0,0,0))  ; Salace Gauche
		Circle( 22,10,5,RGB(0,250,255))
		;Circle( 22,10,2,RGB(0,0,0))
		Box (19,10,6,2,RGB(0,0,0))  ; Salace Droite
		
		Box (10,22,10,5,RGB(0,0,0)) 
		Box (20,20,4,4,RGB(0,0,0))
		Box (7,20,4,4,RGB(0,0,0))
	StopDrawing()
		DisplaySprite(0,10,10) 
	FlipBuffers()
	EndIf

;***** Boucle du programme *****
x=0
Xmax=100
y=0
Ymax=80
SpeedX=2
SpeedY=1
Repeat 
	Select WindowEvent()
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #Bouton_ok 
				
								Quitter =#True
			EndSelect
	

	EndSelect
	
	DisplayTranslucentSprite(0,x,y,220) 
	FlipBuffers()
	ClearScreen(RGB(0,0,0))
	x=x+SpeedX
	y=y+SpeedY
	If x>Xmax-32
	     x=Xmax-32
	    SpeedX=SpeedX*-1
	EndIf
	 If x<0
	    x=0
	    SpeedX=SpeedX*-1
	 EndIf
	 If y>Ymax-32
	     y=Ymax-32
	    SpeedY=SpeedY*-1
	EndIf
	 If y<0
	    y=0
	    SpeedY=SpeedY*-1
	 EndIf
Until Quitter
End

Publié : mar. 19/mai/2009 15:44
par Backup
ma version :) (qui est multisprites ready)
et ne prends pas trop de temps machine !!!
cntrol+alt+del

Code : Tout sélectionner


;***** Mon MessageRequester perso *****
;***** écris par Jbernard13 *******


;****** Constantes ******
Enumeration
	#Message_Perso
	#Bouton_ok
	#Font1
    #spr_text
 EndEnumeration

Structure sprite
    x.l
    y.l
    pas_x.l
    pas_y.l
EndStructure
nbr_sprite=0
Dim sprite.sprite(nbr_sprite)
For i=0 To nbr_sprite
    sprite(nbr_sprite)\pas_x=1
sprite(nbr_sprite)\pas_y=1
Next i

Global Font01
;*** Chargement de la police ****
Font01= LoadFont ( #Font1 , "arial" ,20, #PB_Font_Bold )


;******* Création de la fenetre et des Gadgets 
; Initialisations Diverses
If InitSprite () =0 
	MessageRequester ( "Error" , "Sprite system can't be initialized" , 0)
	End
EndIf
If OpenWindow(#Message_Perso,0,0,300,100,"Informations",#PB_Window_ScreenCentered)
	If OpenWindowedScreen ( WindowID ( #Message_Perso),0,0,300,70,0,0,0)
	 EndIf
    CreateSprite(#spr_text,300,40)
    StartDrawing(SpriteOutput(#spr_text))
        DrawingFont(Font01)
        Resultat = DrawText(0, 0, "Coucou a Tous !" ,RGB($FA,$DE,$1F),0) 
    StopDrawing() 
    
    ButtonGadget(#Bouton_ok,250,70,30,30,"OK")
    PureCOLOR_SetButtonColor(#Bouton_ok,RGB($FF,$FF,$0),RGB(0,0,0)) 
    SetWindowColor(#Message_Perso,RGB($0,$0,$0))
    
    ; **** le smiley *****************
	For i=0 To nbr_sprite
    CreateSprite(i,32,32)
	StartDrawing(SpriteOutput(i))
		Circle(16,16,16,RGB(255,255,15)) 
		
		Circle( 10,10,5,RGB(0,250,255))
		Circle( 10,10,2,RGB(0,0,0))
		Circle( 22,10,5,RGB(0,250,255))
		Circle( 22,10,2,RGB(0,0,0))
		Box (10,22,10,5,RGB(0,0,0)) 
		Box (20,20,4,4,RGB(0,0,0))
		Box (7,20,4,4,RGB(0,0,0))
    StopDrawing()
    ; *******************************
Next i
    Global xw=0
    Global  yw=0
    Global  larg_w=300
    Global  haut_w=70
    
EndIf

;***** Boucle du programme *****
Repeat 
    
	Select WaitWindowEvent(2)
        Case #PB_Event_Gadget
			Select EventGadget()
                Case #Bouton_ok 					
            EndSelect 
			Quitter =#True
    EndSelect
    
    ; *********** regles de rebonds ***************
    For i=0 To nbr_sprite
    If sprite(i)\x>larg_w-32 Or sprite(i)\x<xw
        sprite(i)\pas_x=-sprite(i)\pas_x
    EndIf
    If sprite(i)\y>haut_w-32 Or sprite(i)\y<yw
        sprite(i)\pas_y=-sprite(i)\pas_y
    EndIf
    sprite(i)\x=sprite(i)\x+sprite(i)\pas_x
    sprite(i)\y=sprite(i)\y+sprite(i)\pas_y
    ; *********************************************
    ; ****** affiche les sprites *****************
    DisplayTransparentSprite(i,sprite(i)\x,sprite(i)\y) 
Next i
    DisplayTransparentSprite(#spr_text,30,20)  
    ; ***************************************
    FlipBuffers()
    
	
    ClearScreen(RGB(0,0,0))
    
Until Quitter
End

Publié : mar. 19/mai/2009 15:47
par TazNormand
excellent !!!

Tiens tant que j'y suis, le proxy de mon boulot me bloque l'accès en téléchargement pour les librairies Purecolor de Gnozal, quelqu'un pourrait'il me donner un lien ailleurs (RS, Megaupload, free), s'il vous plaît.

merci d'avance

Publié : mar. 19/mai/2009 16:13
par jbernard13
je vois que mon code vous donne des idées faisons un concours de messageRequester ...

Publié : mar. 19/mai/2009 16:41
par TazNormand
Avec des Rasters à l'arrache (optimisation ZÉRO) (Pardon pour vos yeux chastes)

je vais modifier ce soir si j'ai le temps chez moi pour utiliser structure, et moins de sprites

Code : Tout sélectionner



;***** Mon MessageRequester perso *****
;***** écris par Jbernard13 *******

;****** Constantes ******
Enumeration
		#Message_Perso
		#text_01
		#Bouton_ok
		#Font1
EndEnumeration
Global Font01
;*** Chargement de la police ****
Font01= LoadFont ( #Font1 , "arial" ,20, #PB_Font_Bold )


;******* Création de la fenetre et des Gadgets 
; Initialisations Diverses
If InitSprite () =0 
		MessageRequester ( "Error" , "Sprite system can't be initialized" , 0)
		End
EndIf
If OpenWindow(#Message_Perso,0,0,300,100,"Informations",#PB_Window_ScreenCentered)
		If OpenWindowedScreen ( WindowID ( #Message_Perso),10,10,100,80,0,0,0)
				ClearScreen ( RGB (0,0,0))
				TextGadget(#text_01,120,10,110,60,"Coucou à Tous",#PB_Text_Center)
				SetGadgetFont(#text_01,Font01)
				SetGadgetColor(#text_01, #PB_Gadget_FrontColor,RGB(255,255,15))
				SetGadgetColor(#text_01, #PB_Gadget_BackColor,RGB(0,0,0)) 
				ButtonGadget(#Bouton_ok,250,70,30,30,"OK")
				;PureCOLOR_SetButtonColor(#Bouton_ok,RGB($FF,$FF,$0),RGB(0,0,0))
				EndIf

		SetWindowColor(#Message_Perso,RGB($0,$0,$0))		
		CreateSprite(2,100,8,#PB_Sprite_Texture)
		CreateSprite(3,100,8,#PB_Sprite_Texture)
		StartDrawing(SpriteOutput(2))
		    For i = 0 To 7
		        LineXY(0,i,100,i,RGB(0,i*32,0))
    		Next i
        StopDrawing()
        StartDrawing(SpriteOutput(3))
		    For i = 0 To 7
		        LineXY(0,i,100,i,RGB(i*32,0,0))
    		Next i
        StopDrawing()
        
		CreateSprite(0,32,32)
		StartDrawing(SpriteOutput(0))
				Circle(16,16,16,RGB(255,255,15)) 
				
				Circle( 10,10,5,RGB(0,250,255))
				;Circle( 10,10,2,RGB(0,0,0))
				Box (7,10,6,2,RGB(0,0,0))  ; Salace Gauche
				Circle( 22,10,5,RGB(0,250,255))
				;Circle( 22,10,2,RGB(0,0,0))
				Box (19,10,6,2,RGB(0,0,0))  ; Salace Droite
				
				Box (10,22,10,5,RGB(0,0,0)) 
				Box (20,20,4,4,RGB(0,0,0))
				Box (7,20,4,4,RGB(0,0,0))
		StopDrawing()
				DisplaySprite(0,10,10) 
		FlipBuffers()
		EndIf

;***** Boucle du programme *****
x=0
Xmax=100
y=0
Ymax=80
SpeedX=2
SpeedY=1
rast1Y=0
rast2Y=0
spd1=2
spd2=1
Repeat 
		Select WindowEvent()
				Case #PB_Event_Gadget
						Select EventGadget()
								Case #Bouton_ok 
								
																Quitter =#True
						EndSelect
		

		EndSelect
		DisplayTranslucentSprite(2,0,rast1y,220) 
		DisplayTranslucentSprite(3,0,rast2y,220) 
		DisplayTranslucentSprite(2,0,rast2y+12,220) 
		DisplayTranslucentSprite(3,0,rast1y+12,220) 
		DisplayTranslucentSprite(2,0,rast2y-12,220) 
		DisplayTranslucentSprite(3,0,rast1y-12,220) 
		
		DisplayTranslucentSprite(0,x,y,220) 
		FlipBuffers()
		ClearScreen(RGB(0,0,0))
		x=x+SpeedX
		y=y+SpeedY
		rast1y=rast1y+spd1
		rast2y=rast2y+spd2
		If rast1y<8
		    rast1y=8
		    spd1=spd1*-1
		EndIf
		If rast1y>ymax-8
		    rast1y=ymax-8
		    spd1=spd1*-1
		EndIf
	    If rast2y<8
		    rast2y=8
		    spd2=spd2*-1
		EndIf
		If rast2y>ymax-8
		    rast2y=ymax-8
		    spd2=spd2*-1
		EndIf
		
		If x>Xmax-32
					x=Xmax-32
				SpeedX=SpeedX*-1
		EndIf
		If x<0
				x=0
				SpeedX=SpeedX*-1
		EndIf
		If y>Ymax-32
					y=Ymax-32
				SpeedY=SpeedY*-1
		EndIf
		If y<0
				y=0
				SpeedY=SpeedY*-1
		EndIf
Until Quitter
End
:oops:

Publié : mar. 19/mai/2009 17:56
par Backup
.............

Publié : mar. 19/mai/2009 22:11
par TazNormand
Bon, je viens d'essayer ton code Dobro, et pas de bol, marche pas avec la version demo.

j'ai commenté l'appel à l'API pour jouer les MID, mais le source est trop gros.

Je ne devrais pas tarder à acheter la version complète le temps que mes ventes eBay se finalisent. j'essaierai à ce moment là, à moins que tu ne mettes un lien vers un exe...

Publié : mar. 19/mai/2009 22:32
par Backup
TazNormand a écrit : à moins que tu ne mettes un lien vers un exe...
voila : :)

http://michel.dobro.free.fr/Forum_PB/demob13.zip
Fuseau horaire sur UTC+01:00
Page 1 sur 2

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru