Alternative à grabsprite() ou autre astuce ?

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Alternative à grabsprite() ou autre astuce ?

Message par Backup »

en esperant que cela aura aidé majikeyric :)

Merci pour le clipSprite :)
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Alternative à grabsprite() ou autre astuce ?

Message par Fig »

Merci pour le code et merci à Fred pour le clipsprite qui marche ... :D

*J'ai hate de voir la démo finie !
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par majikeyric »

Dobro a écrit :perso , je ferai ceci

une image qui contient un degradé horizontale

un sprite qui contient tes caracteres de couleur rgb(255,255,0) sur fond noir
cette couleur tu peux la considéré comme transparente avec "TransparentSpriteColor(#Sprite, Couleur)"

ensuite il suffit de dessiner ton image de degradé , puis par dessus ton sprite transparent (dont une seule partie est transparente l'interieur des caracteres )
soit tu animes l'image de fond (le degradé ) de haut en pbas , ce qui fera changer le contenu de tes caracteres
soit tu animes le sprite de haut en bas , ce qui fera changer l'interieur des caracteres, qui laisseront passer
le contenu de l'image caché derriere ;)

:)
C'est ce que je fais Dobro, c'est les étapes énoncées plus haut :wink:
Dernière modification par majikeyric le lun. 10/mars/2014 21:26, modifié 1 fois.
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par majikeyric »

Merci pour vos codes.

J'utilise aussi le clipsprite() pour faire l'animation du dégradé, et je n'ai rien omis dans mon code.

J'ai besoin de faire un grabsprite() pour ensuite afficher un arrière plan puis enfin afficher le scrolltexte par dessus (qui va de haut en bas).

Avec le code initial de Dobro, si on passe la surface capturée à
Largeur_sprite=800
Hauteur_sprite=100

(la taille de mon scrolltexte) ça rame aussi...

C'est étrange qui n'est pas un moyen moins gourmand en perf pour faire ça en PB.
J'ai vu une démo faite en freebasic (coppermaster) qui manipule ce genre d'effet (et bien pire! :mrgreen:) avec une fluidité impeccable.
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par majikeyric »

Fig a écrit :*J'ai hate de voir la démo finie !
moi aussi :mrgreen: :D
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Alternative à grabsprite() ou autre astuce ?

Message par Backup »

majikeyric a écrit : C'est étrange qui n'est pas un moyen moins gourmand en perf pour faire ça en PB.
J'ai vu une démo faite en freebasic (coppermaster) qui manipule ce genre d'effet (et bien pire! :mrgreen:) avec une fluidité impeccable.
bon tu peux utiliser les Api pour capturer une portion de l'ecran ....
voir BitBlt_()

tiens j'ai retrouver cette procedure , qui peut ... peut etre etre mieux que la Version Purebasic de GrabSprite
(j'ai pas testé )

Code : Tout sélectionner

Procedure.l GrabSpriteEx(sprite, buffer, x, y, width, height, mode=0)
  ; netmaestro 2007
  ; Grab a Sprite from the backbuffer or visible screen
  ; buffer values: 0=backbuffer, 1=visible screen
  If buffer
    srcDC = GetDC_(ScreenID())
  Else
    srcDC = StartDrawing(ScreenOutput())
  EndIf
  trgDC = CreateCompatibleDC_(srcDC)
  BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height)
  SelectObject_( trgDC, BMPHandle)
  BitBlt_( trgDC, 0, 0, Width, Height, srcDC, x, y, #SRCCOPY)
  DeleteDC_( trgDC)
  If buffer
    ReleaseDC_(ScreenID(), srcDC)
  Else
    StopDrawing()
  EndIf
  result = CreateSprite(sprite, width, height, mode)
  If sprite = #PB_Any
    output = result
  Else
    output = sprite
  EndIf
  StartDrawing(SpriteOutput(output))
    DrawImage(BMPHandle, 0, 0)
  StopDrawing()
  DeleteObject_(BMPHandle)
  ProcedureReturn output
EndProcedure  
il me semble que nos exemples utilisant ClipSprite ne rame pas ....
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par majikeyric »

Merci, elle marche mais a l'air plus lente que le grabsprite PB.
Dobro a écrit :il me semble que nos exemples utilisant ClipSprite ne rame pas ....
Effectivement car il n'y a pas de grabsprite() :mrgreen:
j'en ai besoin pour pouvoir ré-afficher ensuite le sprite du scrolltext sur un arrière-plan à une position verticale variable.

Je vais essayer d'étudier le source freebasic de la démo "copper-master".
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Alternative à grabsprite() ou autre astuce ?

Message par Backup »

majikeyric a écrit :j'en ai besoin pour pouvoir ré-afficher ensuite le sprite du scrolltext sur un arrière-plan à une position verticale variable.
.

Pourquoi ne pas en faire une copie dans ce cas ?
CopySprite(#Sprite1, #Sprite2 [, Mode])


enfin .. sans voir le code ...
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par majikeyric »

Je me suis mal exprimé:
j'ai besoin du résultat obtenu à l'écran pour le ré-afficher sur autre chose et à une autre position (et avec un DisplayTransparent)

en gros, comme ça:

Code : Tout sélectionner

	ClipSprite(copperbars,0,y,#LargeurEcran,#HauteurFonte)
	DisplaySprite(copperbars,0,y)
	AfficheScrollTexte(y)
	scroll=GrabSprite(#PB_Any,0,y,#LargeurEcran,#HauteurFonte)
	DisplaySprite(ecran(index),0,0)            ; arrière-plan
	DisplayTransparentSprite(scroll,0,y)
	FreeSprite(scroll)
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Alternative à grabsprite() ou autre astuce ?

Message par Backup »

j'etais tombé il y a pas mal de temp sur ces procedures

le but de Einander etait de reproduire les fonctions de copie de section d'ecran
du Gfa Basic :)
je les avaient mis en Purebasic 4.10 et ça marche encore en 5.21 :)

voici le code : (c'est hyper rapide )

Code : Tout sélectionner

; English forum: http://purebasic.myforums.net/viewtopic.php?t=7731&highlight=
; Author: einander
; Date: 08. October 2003

;Conversion Purebasic 4.10 : Dobro

; My dreams come true: working GFA16 commands in PB!  
; CLS,GET,PUT,STRETCH,GRAB ;(grab is a PUT for part of image) 


;Binary raster operation - october 7 - 2003 - by Einander 
;Combines the bits from the selected pen with the bits in the destination bitmap. 
;(Bit-block transfer of color Data from source DC into a destination DC) 

; -********Choose your BitMap on line 39************* 
;With Debugger option Off, gets your BitMap; else, only part of debug window 

; 15 combination modes: 
;#BLACKNESS, #DSTINVERT, #MERGECOPY, #MERGEPAINT, #NOTSRCCOPY, #NOTSRCERASE ;#PATCOPY 
; #PATINVERT, #PATPAINT, #SRCAND, #SRCCOPY, #SRCERASE, #SRCINVERT, #SRCPAINT, #WHITENESS 

Declare Get(n_wind,x,Y,Wi,He)    ; Get source image - returns image handle 
Declare Put(n_wind,x,Y,IMG,mode) ; Draws image from IMG TO DEST (DEST = GetDC_(SrcID))  
Declare Stretch(n_wind,x,Y,Wi,He,IMG,mode)  ; draws stretched image  
Declare Grab(n_wind,StartX,StartY,Wi,He,IMG,x,Y,mode)  ; draws part of image 
Declare CLS(n_wind,color)   ; clear screen 

;__________________________ 
UseJPEGImageDecoder()
IMAGE$="E:\Dobro\Mes_Photos\Araignées\SV105195.JPG" ; met le chemin d'une image valide ici
#window=0

LoadImage(1,IMAGE$) 
WIMG=100 : HIMG=100 
ResizeImage(1,WIMG,HIMG)  ; STARTING  WITH 100 X 100 PIXS 

id=OpenWindow(#window,0,0,WIMG,HIMG,"",#PB_Window_BorderLess )    
StartDrawing(WindowOutput(#window)) 
	DrawImage(ImageID(1),0,0) 
	IMG=Get(#window,0,0,WIMG,HIMG) 
StopDrawing() 
CloseWindow(0) 

_X=GetSystemMetrics_(#SM_CXSCREEN) : _Y=GetSystemMetrics_(#SM_CYSCREEN) 
hwnd=OpenWindow(#window,0,0,_X,_Y,"",#WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE) 
CLS(#window,#Blue)      



;Testing some modes 

Put(#window,220,100,IMG,#SRCCOPY) 
Put(#window,350,100,IMG,#SRCPAINT) 

Stretch(#window,20,200,200,200,IMG,#NOTSRCERASE) 
x=0 : Y=_Y-150 

Repeat 
	Grab(#window,0,0,50,50,IMG,20+i,Y,#SRCINVERT) 
	i+50 
	Grab(#window,50,50,50,50,IMG,20+i,Y,#SRCINVERT) 
	Y-50 
Until  Y<50 

Repeat 
Until WaitWindowEvent()= #PB_Event_CloseWindow  

End  



Procedure Get(n_wind,x,Y,Wi,He)    ; Get source image - returns image handle 
	SRC=GetDC_(WindowID(n_wind)) 
	DEST = CreateCompatibleDC_(SRC) 
	SelectObject_(DEST,CreateImage(0,Wi,He))  
	BitBlt_(DEST,0,0,Wi,He,SRC,x,Y,#SRCCOPY) 
	ProcedureReturn DEST 
EndProcedure 

Procedure Put(n_wind,x,Y,IMG,mode) ; Draws image from IMG TO DEST (DEST = GetDC_(SrcID))  
	BitBlt_(GetDC_(WindowID(n_wind)),x,Y,ImageWidth(n_wind),ImageHeight(n_wind),IMG,0,0,mode) 
EndProcedure 

Procedure Stretch(n_wind,x,Y,Wi,He,IMG,mode)  ; draws stretched image  
	StretchBlt_(GetDC_(WindowID(n_wind)),x,Y,Wi,He,IMG,0,0,ImageWidth(n_wind),ImageHeight(n_wind),mode) 
EndProcedure 

Procedure Grab(n_wind,StartX,StartY,Wi,He,IMG,x,Y,mode)  ; draws part of image 
	BitBlt_(GetDC_(WindowID(n_wind)),x,Y,Wi,He,IMG,StartX,StartY,mode) 
EndProcedure 

Procedure CLS(n_wind,color)   ; clear screen 
	StartDrawing(WindowOutput(n_wind)) 
		Box(0,0,WindowWidth(n_wind),WindowHeight(n_wind),color) 
	StopDrawing() 
EndProcedure 



; ExecutableFormat=Windows
; EnableXP
; DisableDebugger
; EOF
; Epb

Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Alternative à grabsprite() ou autre astuce ?

Message par Fig »

Voila avec un sprite de fond, sans grabsprite() et avec transparence. Ca te convient Majikeyric ? :?:

Code : Tout sélectionner

;*******************************************************************************************************
;- déclarations des procedures
;*******************************************************************************************************
Declare msg_erreur(Chaine$)
;*******************************************************************************************************
DisableDebugger

;- test du materiel
;*******************************************************************************************************
If InitSprite()=0
   msg_erreur("impossible d'initialiser les sprites"+Chr(10)+" le prg va quitter ")
   End
EndIf
If InitMouse()=0
   msg_erreur("impossible d'initialiser la souris"+Chr(10)+" le prg va quitter ")
   End
EndIf

If InitKeyboard()=0
   msg_erreur("impossible d'initialiser le clavier"+Chr(10)+" le prg va quitter ")
   End
EndIf
;*******************************************************************************************************
;-initialisations constante structure tableaux variables
;*******************************************************************************************************
Enumeration
   #win
EndEnumeration
Enumeration
   #degrade
   #fond
EndEnumeration
Enumeration
   #police
EndEnumeration

Largeur_screen=1024
Hauteur_screen=768

Structure degrade
   x.w
   y.w
   sensx.l
   sensy.l
EndStructure

degrade.degrade
degrade\sensy.l=10
degrade\sensx.l=0
degrade\x.w=0
degrade\y.w=0
Largeur_degrade=Largeur_screen
Hauteur_degrade=Hauteur_screen
; ****************************************
Structure sprite
   x.w
   y.w
   sensx.l
   sensy.l
EndStructure

sprite.sprite
sprite\sensy.l=0
sprite\sensx.l=-10
sprite\x.w=-Largeur_screen
sprite\y.w=hauteur_screen/2
Largeur_sprite=500
Hauteur_sprite=100

;-ouvre ecran
;*******************************************************************************************************
OpenWindow(#win,1,1,Largeur_screen,Hauteur_screen,"test",#PB_Window_SystemMenu |#PB_Window_ScreenCentered    )
OpenWindowedScreen(WindowID(#win),1,1,Largeur_degrade, Hauteur_degrade,1, 1,1,#PB_Screen_WaitSynchronization )
KeyboardMode(1)
;*******************************************************************************************************
;-creation Sprite de fond
;*******************************************************************************************************
CreateSprite(#degrade,Largeur_degrade, Hauteur_degrade,32)
;*******************************************************************************************************
LoadFont(#Police, "Bauhaus 93", 50 ,#PB_Font_Bold)
;**************************************************************************************************
   ;Affiche un fond
   CreateSprite(#fond,Largeur_screen,Hauteur_screen)
   StartDrawing(SpriteOutput(#fond))
   For i=1 To 500
    Circle(Random(Largeur_screen),Random(hauteur_screen),Random(10)+4,#Blue)
   Next i
   StopDrawing()
;-boucle principale
Repeat
   FlipBuffers() ; affiche le resultat a l'ecran !
   ClearScreen(#Black) ; nettoie l'ecran apres affichage
   WindowEvent()
   ;- Examine le materiel
   ;*******************************************************************************************************
   ExamineKeyboard()
   ExamineMouse()
   ;*******************************************************************************************************
   ;- logique de deplacement
   ;*******************************************************************************************************
  degrade\y.w=degrade\y.w+degrade\sensy.l 
;  degrade\x.w=degrade\x.w+degrade\sensx.l
;* Nécessaire si on veut un dégradé changeant horizontalement en plus...
;    If degrade\x.w>largeur_screen/2 Or degrade\x.w<1
;       degrade\sensx*-1
;    EndIf
   If degrade\y.w>Hauteur_screen/2 Or degrade\y.w<1
      degrade\sensy*-1
   EndIf
   ; *************
   ;-deplacement
   ;*************
   sprite\y.w=sprite\y.w+sprite\sensy.l
   sprite\x.w=sprite\x.w+sprite\sensx.l
   If sprite\y.w>(hauteur_screen-hauteur_sprite-10) Or sprite\y.w<10
      sprite\sensy*-1
   EndIf   
   If sprite\x.w<-Largeur_Sprite
      sprite\x.w=Largeur_Screen+Largeur_Sprite
   EndIf
   ;*******************************************************************************************************
   ;-changement du texte si besoin
   ;*******************************************************************************************************
   texte$="By Dobro 0123456789..."
   ;*******************************************************************************************************
   ;-affichage des sprites
   ;*******************************************************************************************************
   ;Affiche un fond
    DisplaySprite(#fond,0,0)
   ;recréé le dégradé dans le sprite
   TransparentSpriteColor(#degrade, RGB(0,255,255))
   StartDrawing(SpriteOutput(#degrade))
   Box(1, 1, Largeur_degrade, Hauteur_degrade, $0)
   DrawingMode(#PB_2DDrawing_Gradient)   
   BackColor($0)
   For i=0 To 255
      GradientColor(0.4, RGB(i,0,0))
      GradientColor(0.8,RGB(0,i,0))
      GradientColor(0.16,RGB(0,0,i))
      GradientColor(0.32,RGB(0,i,i))
      GradientColor(0.64,RGB(i,i,0))
   Next i
   LinearGradient(0, 0, 0, Hauteur_degrade)
   DrawingFont(FontID(#Police))
   DrawText(degrade\x,degrade\y,texte$,#Black,RGB(0,255,255))
   Largeur_sprite=TextWidth(texte$)
   Hauteur_sprite=TextHeight(texte$)
   StopDrawing()
   ;découpe le dégradé aux dimensions du scoll
   ClipSprite(#degrade,degrade\x,degrade\y,Largeur_sprite, Hauteur_sprite)
   ;affiche le scroll
   DisplayTransparentSprite(#degrade,sprite\x,sprite\y)
Until KeyboardPushed(#PB_Key_Escape)
End
; ********* Zone des sous-programme ******************

; **************** Zone des procedures  ******************
Procedure  msg_erreur(Chaine$)
   MessageRequester("erreur", Chaine$, #PB_MessageRequester_Ok )
EndProcedure
; *************************************************************
; Epb
PS: on doit même pouvoir virer le clip sprite avec cette méthode, mais je n'ai pas le temps là, je dois y aller...
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
blendman
Messages : 2017
Inscription : sam. 19/févr./2011 12:46

Re: Alternative à grabsprite() ou autre astuce ?

Message par blendman »

salut

pour dessiner avec un drawtext() et un dégradé :
(mais attention, sur certaines cartes, le drawtext() est super lent) :

Code : Tout sélectionner


If OpenWindow(0, 0, 0, 640,480, " texte gradient" , #PB_Window_ScreenCentered|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget)
  
  CreateImage(0,640,480,32)
  LoadFont(0, "verdana", 40)
  
  
  text$ = "Game texte gradient"
  If StartDrawing(ImageOutput(0)) 
    ; on ajoute d ela transparence
    DrawingMode(#PB_2DDrawing_AlphaChannel)
    Box(0, 0, 640,480, RGBA(0,0,0,0))
    ; on draw le text  
    DrawingFont(FontID(0))               
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent )
    DrawText(20,20, text$)
    ; puis le dégradé
    DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaClip)      
    BackColor(RGBA(255,0,0,255))
    ;GradientColor(0.4, RGBA(0,255,0,255)) ; on peut ajouter d'autres couleurs
    ;GradientColor(0.6, RGBA(0,125,0,255))
    FrontColor(RGBA(0,255,0,255))
    
    LinearGradient(30, 50, 30, TextHeight(text$))  ; changer les paramètres ici pour changer le gradient
    Box(0, 0, 640,480)
 
    StopDrawing()
  EndIf
  
  ImageGadget(0,0,0,640,480,ImageID(0))
    
  Repeat
    
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
Sinon, je confirme que ne plus avoir la possibilité de dessiner sur un sprite c'est vraiment dommage, car c'était top :(.
C'est quoi AGK ? :?:
c'est un outil (ide + langage (au choix : pascal, basic dérivé du db ou c++) + compiler) qui permet de compiler pour PC (win, mac (linux ?)), android et ios. Mais c'est avant tout dédié aux jeux (pas de gadgets disponibles), et c'est moins "ouvert" que purebasic (pas d'utilisation d'api).
Par contre, il y a pas mal de fonctions très pratiques intégrées : particule, physique, animation de sprite, depth, view/zoom, etc...
Ca facilite la création de jeux, mais je pense que c'est moins performant que purebasic sur des gros jeux.
L'avantage c'est surtout la compilation pour android et ios.
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par falsam »

blendman a écrit :Sinon, je confirme que ne plus avoir la possibilité de dessiner sur un sprite c'est vraiment dommage, car c'était top :(.

Code : Tout sélectionner

InitSprite():InitKeyboard()

OpenWindow(0,0,0,640,640,"Press ESC to exit...",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,640,640)

CreateSprite(0, 256,256)
CreateSprite(1, 512,512)

StartDrawing(SpriteOutput(0))
  DrawingMode(#PB_2DDrawing_Gradient)
  BackColor($000099)
  FrontColor($dd0000)
  LinearGradient(0, 0, 0, 256) 
  Box(0,0,256,256)
StopDrawing()

; We want sprite 0 drawn on sprite 1, so step 1: Grab the drawing image
StartDrawing(SpriteOutput(0))
  this = GrabDrawingImage(#PB_Any,0,0,256,256)
StopDrawing()

; Step 2: Draw the grabbed image to sprite 1:
StartDrawing(SpriteOutput(1))
  Box(0,0,512,512,RGB(255,255,223))
  DrawImage(ImageID(this),128,128)
StopDrawing()

Repeat
  While WindowEvent():Wend
  ClearScreen(0)
  DisplaySprite(1, 60,60)
  FlipBuffers()
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
C'est bien ça ? :)
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Alternative à grabsprite() ou autre astuce ?

Message par Backup »

@Falsam , non , il s'agit de pouvoir dessiner en temp reel dans le sprite ;)
tout comme on le fait sur l'ecran, la fenetre, le canvas .....

avant avec UseBuffer , tu choisissais le Sprite comme output de dessin




@Fig , je prefere comme ça :mrgreen:

Code : Tout sélectionner

;*******************************************************************************************************
;- déclarations des procedures
;*******************************************************************************************************
Declare msg_erreur(Chaine$)
;*******************************************************************************************************
;;DisableDebugger

;- test du materiel
;*******************************************************************************************************
If InitSprite()=0
	msg_erreur("impossible d'initialiser les sprites"+Chr(10)+" le prg va quitter ")
	End
EndIf
If InitMouse()=0
	msg_erreur("impossible d'initialiser la souris"+Chr(10)+" le prg va quitter ")
	End
EndIf

If InitKeyboard()=0
	msg_erreur("impossible d'initialiser le clavier"+Chr(10)+" le prg va quitter ")
	End
EndIf
;*******************************************************************************************************
;-initialisations constante structure tableaux variables
;*******************************************************************************************************
Enumeration
	#win
EndEnumeration
Enumeration
	#degrade
	#boule
EndEnumeration
Enumeration
	#police
EndEnumeration

Largeur_screen=1024
Hauteur_screen=768

Structure degrade
	x.w
	y.w
	sensx.l
	sensy.l
EndStructure

degrade.degrade
degrade\sensy.l=10
degrade\sensx.l=0
degrade\x.w=0
degrade\y.w=0
Largeur_degrade=Largeur_screen
Hauteur_degrade=Hauteur_screen


Structure boule
	x.w
	y.w
	sensx.f
	sensy.f
EndStructure
global Dim boule.boule(500)
for i=0 to 499
	boule(i)\x.w=random(largeur_screen)
	boule(i)\y.w=random(hauteur_screen)
next i
; ****************************************
Structure sprite
	x.w
	y.w
	sensx.l
	sensy.l
EndStructure

sprite.sprite
sprite\sensy.l=0
sprite\sensx.l=-10
sprite\x.w=-Largeur_screen
sprite\y.w=hauteur_screen/2
Largeur_sprite=500
Hauteur_sprite=100

;-ouvre ecran
;*******************************************************************************************************
OpenWindow(#win,1,1,Largeur_screen,Hauteur_screen,"test",#PB_Window_SystemMenu |#PB_Window_ScreenCentered    )
OpenWindowedScreen(WindowID(#win),1,1,Largeur_degrade, Hauteur_degrade,1, 1,1,#PB_Screen_WaitSynchronization )
KeyboardMode(1)
;*******************************************************************************************************
;-creation Sprite de fond
;*******************************************************************************************************
CreateSprite(#degrade,Largeur_degrade, Hauteur_degrade,32)
;*******************************************************************************************************
LoadFont(#Police, "Bauhaus 93", 50 ,#PB_Font_Bold)
;**************************************************************************************************
;Affiche un fond
CreateSprite(#boule,32,32)
StartDrawing(SpriteOutput(#boule))
	DrawingMode(#PB_2DDrawing_Gradient)   
	BackColor($E65352)
	FrontColor($0)
	CircularGradient(16,16, 16)
	Circle(16,16,16)
StopDrawing()


;-boucle principale
Repeat
	
	WindowEvent()
	;- Examine le materiel
	;*******************************************************************************************************
	ExamineKeyboard()
	ExamineMouse()
	;*******************************************************************************************************
	;- logique de deplacement
	;*******************************************************************************************************
	degrade\y.w=degrade\y.w+degrade\sensy.l
	;  degrade\x.w=degrade\x.w+degrade\sensx.l
	;* Nécessaire si on veut un dégradé changeant horizontalement en plus...
	;    If degrade\x.w>largeur_screen/2 Or degrade\x.w<1
	;       degrade\sensx*-1
	;    EndIf
	If degrade\y.w>Hauteur_screen/2 Or degrade\y.w<1
		degrade\sensy*-1
	EndIf
	; *************
	;-deplacement
	;*************
	sprite\y.w=sprite\y.w+sprite\sensy.l
	sprite\x.w=sprite\x.w+sprite\sensx.l
	If sprite\y.w>(hauteur_screen-hauteur_sprite-10) Or sprite\y.w<10
		sprite\sensy*-1
	EndIf   
	If sprite\x.w<-Largeur_Sprite
		sprite\x.w=Largeur_Screen+Largeur_Sprite
	EndIf
	;*******************************************************************************************************
	;-changement du texte si besoin
	;*******************************************************************************************************
	texte$="By Dobro and Fig ..."
	;*******************************************************************************************************
	;-affichage des sprites
	;*******************************************************************************************************
	;Affiche un fond
	for i=1 to 500
		boule(i)\sensx.f=random(2)+ -1
		boule(i)\x=boule(i)\x+boule(i)\sensx.f
		boule(i)\sensy.f=random(2)+ -1
		boule(i)\y=boule(i)\y+boule(i)\sensy.f
		DisplayTransparentSprite(#boule,boule(i)\x,boule(i)\y)
	next i
	
	
	
	;recréé le dégradé dans le sprite
	TransparentSpriteColor(#degrade, RGB(0,255,255))
	StartDrawing(SpriteOutput(#degrade))
		Box(1, 1, Largeur_degrade, Hauteur_degrade, $0)
		DrawingMode(#PB_2DDrawing_Gradient)   
		BackColor($0)
		For i=0 To 255
			GradientColor(0.4, RGB(i,0,0))
			GradientColor(0.8,RGB(0,i,0))
			GradientColor(0.16,RGB(0,0,i))
			GradientColor(0.32,RGB(0,i,i))
			GradientColor(0.64,RGB(i,i,0))
		Next i
		LinearGradient(0, 0, 0, Hauteur_degrade)
		DrawingFont(FontID(#Police))
		DrawText(degrade\x,degrade\y,texte$,#Black,RGB(0,255,255))
		Largeur_sprite=TextWidth(texte$)
		Hauteur_sprite=TextHeight(texte$)
	StopDrawing()
	;découpe le dégradé aux dimensions du scoll
	ClipSprite(#degrade,degrade\x,degrade\y,Largeur_sprite, Hauteur_sprite)
	;affiche le scroll
	DisplayTransparentSprite(#degrade,sprite\x,sprite\y)
	
	
	
	FlipBuffers() ; affiche le resultat a l'ecran !
	ClearScreen(#Black) ; nettoie l'ecran apres affichage
	
Until KeyboardPushed(#PB_Key_Escape)
End
; ********* Zone des sous-programme ******************

; **************** Zone des procedures  ******************
Procedure  msg_erreur(Chaine$)
	MessageRequester("erreur", Chaine$, #PB_MessageRequester_Ok )
EndProcedure
; *************************************************************
; Epb

Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Alternative à grabsprite() ou autre astuce ?

Message par falsam »

@Dobro : Heure en temps reel dans un sprite.

Code : Tout sélectionner

Define.i n=1

InitSprite():InitKeyboard()

OpenWindow(0,0,0,640,640,"Press ESC to exit...",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,640,640)

CreateSprite(0, 256,64)

Procedure TimeUpdate(Sprite)
  Protected Buffer.s = FormatDate("%hh:%ii:%ss", Date())  
  
  StartDrawing(SpriteOutput(Sprite))
  DrawingMode(#PB_2DDrawing_Gradient)
  BackColor($000099)
  FrontColor($dd0000)
  LinearGradient(0, 0, 0, 64) 
  Box(0,0,256,64)
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(100, 20, Buffer, RGB(255, 255, 255))
  StopDrawing()
EndProcedure

Repeat
  While WindowEvent():Wend
  ClearScreen(0)
  TimeUpdate(0)
  x+n
  If x>350
    n=-1
  ElseIf x<50
    n=1
  EndIf
  
  
  DisplaySprite(0, x, 60)
  FlipBuffers()
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Répondre