PureBasic

Bonjour

Dans un petit morceau de code, je cherche une fonte bitmap via un PNG

ensuite je souhaite faire pleins de petites images pour chaque lettre (comme je pouvais faire sur amiga)

J'ai juste l'impression qu'un GRABIMAGE me fait perdre le canal Alpha (le fond devenant noir au lieu de transparent)

Une idée ?

GrabSprite ??

Bonjour Uhuru.

Je n'ai pas rencontré de souci avec GrabImage.

Code : Tout sélectionner

Declare Start()
Declare Exit()

UsePNGImageDecoder()

Start()

Procedure Start()
  Protected Font = CatchImage(#PB_Any, ?Font)
  Protected One  = GrabImage(Font, #PB_Any, 0, 0, 32, 32)
  
  OpenWindow(0, 0, 0, 800, 600, "GrabImage", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ImageGadget(0, 10, 10, 32, 32, ImageID(One))
  
  BindEvent(#PB_Event_CloseWindow, @Exit())
  
  Repeat : WaitWindowEvent(10) : ForEver   
EndProcedure

Procedure Exit()
  End
EndProcedure

DataSection
  Font:
  IncludeBinary "tbj_font.png"
EndDataSection

Code + image sur ce lien : https://github.com/pbcodex/2D-GrabImage ... master.zip

a tout hasard , si tu voulais utiliser les fontes pour faire des animations, le mieux reste les Sprites

donc avec GrabSprite ça donne ça :
ici j'utilises des lettres que je dessine (j'ecris ) préalablement dans l'ecran avant de les graber
mais ce pourrait etre tout aussi bien des lettres dans une image

Code : Tout sélectionner

; By Zorro
#Window =0
#Font =0

Structure Spr 
	Id.i
	x.f
	y.f
	pas.f
EndStructure
Dim Spr.spr(100)

Global taille_x,taille_y,Pas
taille_x=400
taille_y=300
Taille_fonte=70
InitSprite()

LoadFont(#Font, "Verdana", Taille_fonte)
Flags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
If OpenWindow(#Window, 0, 0, taille_x,taille_y, "Text Scroll", Flags)
	OpenWindowedScreen(WindowId(#Window),1,1,taille_x,taille_y)
	CreateImage(#planche,taille_x,taille_y)
	If StartDrawing(ScreenOutput())
		DrawingFont(FontID(#Font))
		DrawingMode(#PB_2DDrawing_Transparent)
		DrawText(10, 10, "ZORRO", #White)
		StopDrawing()
		FlipBuffers()
		for y=1 to taille_y-1 step 128
			For x=1 to taille_x-1 step 70
				spr=spr+1 
				spr(spr)\id.i=spr 
				spr(spr)\x=x
				spr(spr)\y=y
				spr(spr)\pas.f=random( 15,8)
				if GrabSprite(spr(spr)\id.i,spr(spr)\x,spr(spr)\y,70,128)
				Else
					spr=spr-1
				Endif
				if Spr=5 :break 2:Endif
			Next x
		Next y
	EndIf
	; debug spr
	
	
EndIf
While WaitWindowEvent(2) ! #PB_Event_CloseWindow
	i=i+1
	if i=6 :i=1:endif
	spr(i)\y.f=spr(i)\y.f+spr(i)\pas.f
	if spr(i)\y.f>taille_y-90 or spr(i)\y.f<-32
		spr(i)\pas.f=-spr(i)\pas.f
	Endif
	DisplaySprite(i,spr(i)\x.f,spr(i)\y.f)
	
	FlipBuffers()
Wend

Code : Tout sélectionner

While WaitWindowEvent(2) ! #PB_Event_CloseWindow
...
Wend

Première fois que je vois utiliser un XOR de cette façon.
Et pourtant ça marche

Ou alors tu as voulu mettre <> ? (qui est plus classique)

Marc56 a écrit : Ou alors tu as voulu mettre <> ? (qui est plus classique)

non non !

oups ! .....

ouufff !

Grabimage est buggé concernant le canal alpha des png.

http://www.purebasic.fr/english/viewtop ... =4&t=65242

Moi je perd totalement le canal

Ici un test avec un scroll

J'utilise l'image ici (PNG avec fond en alpha) :

Et bien au final , j'ai un GROS carré noir

au lieu d'avoir des lettres noires sur fond bleu

Code : Tout sélectionner

DataSection

	fontcircle:
	IncludeBinary"gfxo/circle.png"		
  couleur:
EndDataSection

If InitSound()=0:MessageRequester("Oops!", "Sound could not be initialized, quitting!"):End:EndIf
If InitSprite()=0:MessageRequester("Oops!","Video could not be initialized, quitting!"):End:EndIf
If InitKeyboard()=0:MessageRequester("Oops!","Keyboard could not be initialized, quitting!"):End:EndIf

UsePNGImageDecoder()

#scrx=800
#scry=600
Global fs
Dim gfxfont(60)

title$="Title"

fs=MessageRequester("Title","FullScreen?",#PB_MessageRequester_YesNoCancel)
If fs=#PB_MessageRequester_No
	OpenWindow(1,0,0,#scrx,#scry,title$,#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_BorderLess)
	OpenWindowedScreen(WindowID(1),0,0,#scrx,#scry,0,0,0)
	StickyWindow(1,1)
	ShowCursor_(0)
ElseIf fs=#PB_MessageRequester_Yes
	OpenScreen(#scrx,#scry,32, title$)
	SetFrameRate(60)
Else
	End
EndIf

Global  loop.w ,xp.w , yp.w , t.s , tptr.w , sco.b

xp = 0
yp = 0

Font = CatchImage(#PB_Any, ?fontcircle)

For loop =1 To 60       
  gfxfont(loop) = GrabImage(Font,#PB_Any,xp,yp,31,31)   
  xp = xp + 32                                         
  ;                                                    
  If xp > = 320
    yp = yp + 32
    xp = 0
  EndIf
Next

t.s="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 

Repeat 
  
  If fs=#PB_MessageRequester_No
    Repeat ;Evenement window
    Event = WindowEvent()
    Select Event    
      Case #PB_Event_CloseWindow
        End
    EndSelect  
    Until Event=0
  EndIf
  ExamineKeyboard() 
  
  ClearScreen($FF0000) 
  
  ; Scroll circle

  StartDrawing(ScreenOutput())
  cco = 0
  For cc = 0 To 34
    letterc = (Asc(UCase(Mid(t.s, tptr+cc, 1)))-31)  
  DrawImage(ImageID(gfxfont(letterc)), 380+300*-Sin((sco+cco)/270), 320+300*Cos((cco+sco)/90)) 
  cco = cco + 32
  Next
  sco = sco -2
  If sco < -32
  tptr = tptr + 1
  sco=sco + 32
  EndIf
  If tptr > (Len(t.s)-30)
  tptr = 1
  EndIf
  StopDrawing()             
  FlipBuffers() 

Until KeyboardPushed(#PB_Key_Escape) 
End

de toute façons pour ce genre de code, il vaut mieux utiliser les Sprites , c'est fait pour ça !

et ça marche !

Merci pour ta réponse mais ca ne m'aide pas ici.
Peux tu me proposer un code de remplacement sans toucher l'algo en remplaçant les images par des sprites ?

ya qu'a demander

remet ton chemin ligne 4 car j'ai du le modifier pour mon system
(Note qu'avec les Sprites, ce sera bien plus rapide qu'avec les images !! )
et que j'ai garder ton architectures tel quel
on peut faire plus présentable et plus "Pro" (avec l'utilisation d'une Structure par exemple )
et en evitant les lignes a rallonge (utilisation des ":" )
pis j'aime pas les "ElseIf", je prefere les Select Case Endselect

je me suis permis d'ajouter le control de la resolution pour le plein ecran
evidement, il faudra modifier ton algo pour centrer en fonction de la resolution
au moins comme ça le plein ecran s'adapte a toutes les configurations

[reedit]
j'ai aussi corrigé ta boucle d'event , car sinon au bout d'un moment ça plante car tu saturai la liste des events

rajout d'un test ligne 78 car au bout d'un moment on a un plantage car on sort du cadre du tableau

Code : Tout sélectionner


Enumeration
	#win
EndEnumeration

If InitSound()=0:MessageRequester("Oops!", "Sound could not be initialized, quitting!"):End:EndIf
If InitSprite()=0:MessageRequester("Oops!","Video could not be initialized, quitting!"):End:EndIf
If InitKeyboard()=0:MessageRequester("Oops!","Keyboard could not be initialized, quitting!"):End:EndIf

UsePNGImageDecoder()

;- initialisation
ExamineDesktops()
DesktopWidth(0)
scrx=DesktopWidth(0) ;=800
scry=DesktopHeight(0) ;600


Global fs
Global Dim gfxfont(60)
Global  loop.w ,xp.w , yp.w , t.s , tptr.w , sco.b

xp = 0
yp = 0
title$="Title"
t.s="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

;-requester
fs=MessageRequester("Title","FullScreen?",#PB_MessageRequester_YesNoCancel)
select Fs
	Case #PB_MessageRequester_No
	scrx=800 : scry=600
	OpenWindow(#win,0,0,scrx,scry,title$,#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_BorderLess)
	OpenWindowedScreen(WindowID(#win),0,0,scrx,scry,0,0,0)
	StickyWindow(#win,1)
	ShowCursor_(0)
	Case #PB_MessageRequester_Yes
	OpenScreen(scrx,scry,32, title$)
	SetFrameRate(60)
	Default
	End
EndSelect

;-catchimage
Font = CatchImage(#PB_Any, ?fontcircle)
StartDrawing(ScreenOutput())
	DrawingMode(#PB_2DDrawing_Default )
	DrawImage(ImageId(Font),0,0)
StopDrawing()

;-GrabSprite
For loop =1 To 60       
	gfxfont(loop) = GrabSprite(#PB_Any,xp,yp,31,31)   
	xp = xp + 32                                         
	;                                                   
	If xp > = 320
		yp = yp + 32
		xp = 0
	EndIf
Next

Repeat
	Repeat ;Evenement window
		if IsWindow(#win)
			Event = WaitWindowEvent(2)
			Select Event   
				Case #PB_Event_CloseWindow
				End
			EndSelect 
		Endif
	Until Event=0
	ExamineKeyboard()
	
	;Algo
	cco = 0
	For cc = 0 To 34
		letterc = (Asc(UCase(Mid(t.s, tptr+cc, 1)))-31) 
		if letterc <0:letterc=-letterc :endif; Rajouter pour eviter un plantage au bout d'un moment
		TransparentSpriteColor(gfxfont(letterc),rgb(255,255,255))
		DisplayTransparentSprite(gfxfont(letterc), 380+300*-Sin((sco+cco)/270), 320+300*Cos((cco+sco)/90))
		cco = cco + 32
	Next
	sco = sco -2
	If sco < -32
		tptr = tptr + 1
		sco=sco + 32
	EndIf
	If tptr > (Len(t.s)-30)
		tptr = 1
	EndIf
	
	FlipBuffers()
	ClearScreen($FF0000)
	
Until KeyboardPushed(#PB_Key_Escape)
End

DataSection
	fontcircle:
	IncludeBinary"circle.png"      
	couleur:
EndDataSection

Sur mon ordi, le code de uhuru fonctionne si on remplace DrawImage par DrawAlphaImage, tout simplement.

Code : Tout sélectionner

DataSection

		fontcircle:
		IncludeBinary"circle.png"      
	couleur:
EndDataSection

If InitSound()=0:MessageRequester("Oops!", "Sound could not be initialized, quitting!"):End:EndIf
If InitSprite()=0:MessageRequester("Oops!","Video could not be initialized, quitting!"):End:EndIf
If InitKeyboard()=0:MessageRequester("Oops!","Keyboard could not be initialized, quitting!"):End:EndIf

UsePNGImageDecoder()
;LoadImage(1,"fontcircle.png")
#scrx=800
#scry=600
Global fs
Dim gfxfont(60)

title$="Title"

fs=MessageRequester("Title","FullScreen?",#PB_MessageRequester_YesNoCancel)
If fs=#PB_MessageRequester_No
		OpenWindow(1,0,0,#scrx,#scry,title$,#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_BorderLess)
		OpenWindowedScreen(WindowID(1),0,0,#scrx,#scry,0,0,0)
		StickyWindow(1,1)
		ShowCursor_(0)
ElseIf fs=#PB_MessageRequester_Yes
		OpenScreen(#scrx,#scry,32, title$)
		SetFrameRate(60)
Else
		End
EndIf

Global  LOOP.w ,xp.w , yp.w , t.s , tptr.w , sco.b

xp = 0
yp = 0

Font = CatchImage(#PB_Any, ?fontcircle)

For LOOP =1 To 60       
	gfxfont(LOOP) = GrabImage(Font,#PB_Any,xp,yp,31,31)   
	xp = xp + 32                                         
	;                                                    
	If xp > = 320
		yp = yp + 32
		xp = 0
	EndIf
Next

t.s="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 

Repeat 
	
	If fs=#PB_MessageRequester_No
		Repeat ;Evenement window
		Event = WindowEvent()
		Select Event    
			Case #PB_Event_CloseWindow
				End
		EndSelect  
		Until Event=0
	EndIf
	ExamineKeyboard() 
	
	ClearScreen($FF0000) 
	
	; Scroll circle

	StartDrawing(ScreenOutput())
	cco = 0
	For cc = 0 To 34
		letterc = (Asc(UCase(Mid(t.s, tptr+cc, 1)))-31)  
	DrawAlphaImage(ImageID(gfxfont(letterc)), 380+300*-Sin((sco+cco)/270), 320+300*Cos((cco+sco)/90),255) 
	cco = cco + 32
	Next
	sco = sco -2
	If sco < -32
	tptr = tptr + 1
	sco=sco + 32
	EndIf
	If tptr > (Len(t.s)-30)
	tptr = 1
	EndIf
	StopDrawing()             
	FlipBuffers() 

Until KeyboardPushed(#PB_Key_Escape) 
End

C'est vrai aussi que c'est un cas où il est nettement préférable d'utiliser les sprites.

M.

@Mesa : laisse tourner pendant quelques minutes
tu verra ça plante

j'ai corrigé ce point dans ma version SPrite

Code : Tout sélectionner

if letterc <0:letterc=-letterc :endif; Rajouter pour eviter un plantage au bout d'un moment

mais je t'accordes que la version image fonctionne

PureBasic

Grabimage et alpha ?

Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?

Re: Grabimage et alpha ?