sprite2image

Anfängerfragen zum Programmieren mit PureBasic.
Riacon
Beiträge: 61
Registriert: 21.01.2008 09:40

sprite2image

Beitrag von Riacon »

ich kann aus einem image ein sprite machen:

Code: Alles auswählen

If IsSprite(0)
	StartDrawing(SpriteOutput(0))
	DrawImage(ImageID(1),0,0)
	StopDrawing()
EndIf
geht das auch umgekehrt? aus einem sprite ein image machen?
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Jo, ist doch ganz einfach StartDrawing(ImageOutput(0)) ist das Zauberwort:

Code: Alles auswählen

If IsImage(0) 
   StartDrawing(ImageOutput(0)) 
   DisplaySprite(SprtieID(1),0,0) 
   StopDrawing() 
EndIf
Habe ich aus dem Kopf heraus geschrieben, musst mal testen.
ich nehme an, du verwendest PB 3.94?
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

ne, sprites kannste nit drawen...
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

Die Kette GrabSprite() - SaveSprite() - LoadImage() ist keine Option?
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Riacon
Beiträge: 61
Registriert: 21.01.2008 09:40

Beitrag von Riacon »

scholly hat geschrieben:Die Kette GrabSprite() - SaveSprite() - LoadImage() ist keine Option?
dauert zu lange. und ist "häßlich"

helfen würde, wenn ich die adresse eines (geladenen) bildes rauskriegen könnte. so in der art:
adr=@image(1)
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Riacon
Beiträge: 61
Registriert: 21.01.2008 09:40

Beitrag von Riacon »

@scholly
sieht gut aus.

abendessen und dann mal ausprobieren
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Beitrag von hjbremer »

das Thema hatten wir hier schon mal so ähnlich

http://www.purebasic.fr/german/viewtopi ... sc&start=0

ganz am Ende auf der 2.Seite sind Beispiele
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Riacon
Beiträge: 61
Registriert: 21.01.2008 09:40

Beitrag von Riacon »

Code: Alles auswählen

;Riacon Bremen, 24.3.08 mit pb 4.1 und xp sp2

;thx to hjbremer+scholly für die tips
;und unbekannterweise an den coder der procedure CreateBitmapFromSprite(Sprite) 
;und natürlich an purebasic fred & co und windowbilly
;irgendwo ist hier aber noch ein wurm drin. ich tippe mal auf einen speicherüberlauf, wegen dem häufigen erstellen der bmp's

InitSprite()

Structure pixel
pixel.l
EndStructure

Structure live
farbe.l
x.l
y.l
EndStructure


Global bmp.BITMAP
Global img=0
Global breite=100
Global hoehe=100
Global anzahl=0


Procedure CreateBitmapFromSprite(Sprite) 
  hDC=StartDrawing(SpriteOutput(Sprite)) 
  bmp.BITMAP\bmWidth=SpriteWidth(Sprite) 
  bmp\bmHeight=SpriteHeight(Sprite) 
  bmp\bmPlanes=1 
  bmp\bmBitsPixel=GetDeviceCaps_(hDC,#BITSPIXEL) 
  bmp\bmBits=DrawingBuffer() 
  bmp\bmWidthBytes=DrawingBufferPitch() 
  hBmp=CreateBitmapIndirect_(bmp) 
  StopDrawing() 
  FlipBuffers()
  ProcedureReturn hBmp 
EndProcedure

Procedure updatehabitat(breite,hoehe,rechenzeit)
Protected qxpos,qypos,txpos,typos,richtung,pitch,*buffer,*qline.pixel,*tline.pixel,*pixel.pixel,beginn,dauer
beginn=ElapsedMilliseconds()
StartDrawing(SpriteOutput(1))
*buffer=DrawingBuffer()
pitch=DrawingBufferPitch()
dauer=0

	While rechenzeit>dauer
	qxpos=Random(breite-1)
	qypos=Random(hoehe-1)
	*qline=*buffer+qypos*pitch+qxpos<<2
		If *qline\pixel
			richtung=Random(7)
			
			Select richtung
				Case 0
					txpos=qxpos-1
					typos=qypos
				Case 1
					txpos=qxpos+1
					typos=qypos
				Case 2
					txpos=qxpos
					typos=qypos-1
				Case 3
					txpos=qxpos
					typos=qypos+1
				Case 4
					txpos=qxpos-1
					typos=qypos-1
				Case 5
					txpos=qxpos+1
					typos=qypos+1
				Case 6
					txpos=qxpos-1
					typos=qypos+1
				Case 7
					txpos=qxpos+1
					typos=qypos-1
			EndSelect
			
			If Not(txpos<0 Or typos<0 Or txpos>breite-1 Or typos>hoehe-1)
				*tline=*buffer+typos*pitch+txpos<<2
				*tline\pixel=*qline\pixel
			EndIf
	
		EndIf
	
	dauer=ElapsedMilliseconds()-beginn
	Wend
StopDrawing()
EndProcedure

Procedure inithabitat(breite,hoehe,anzahl)
Protected i,xpos,ypos,pitch,*buffer,*line.pixel
If IsSprite(1)
	FreeSprite(1)
EndIf
ClearScreen(0)
CreateSprite(1,breite,hoehe)

StartDrawing(SpriteOutput(1))
*buffer=DrawingBuffer()
pitch=DrawingBufferPitch()

For i=1 To anzahl
  xpos=Random(breite-1)
  ypos=Random(hoehe-1)
  farbe=Random(255*255*255)
 
  *line=*buffer+ypos*pitch+xpos<<2
  *line\pixel=farbe
Next i

StopDrawing()
img=CreateBitmapFromSprite(1)

EndProcedure


OpenWindow(1, 0, 0, 3*breite, 3*hoehe, "sprite2button",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(1),breite,hoehe,breite,hoehe,0,0,0)
inithabitat(breite,hoehe,anzahl)
CreateGadgetList(WindowID(1))
ButtonImageGadget(1,breite,hoehe,breite,hoehe,img)
GadgetToolTip(1,"DON'T push THIS button")


Repeat
event=WaitWindowEvent(1)

Select event
Case #PB_Event_Gadget
	Select EventGadget()
	Case 1
		anzahl+1
		inithabitat(breite,hoehe,anzahl)
	EndSelect
Default
Delay(1)
EndSelect
updatehabitat(breite,hoehe,5)
SetGadgetState(1,CreateBitmapFromSprite(1))

Until event=#PB_Event_CloseWindow

End
Benutzeravatar
scholly
Beiträge: 793
Registriert: 04.11.2005 21:30
Wohnort: Düsseldorf

Beitrag von scholly »

Riacon hat geschrieben:;irgendwo ist hier aber noch ein wurm drin. ich tippe mal auf einen speicherüberlauf, wegen dem häufigen erstellen der bmp's
Wenn ich an der "rechenzeit" im "updatehabitat"-Aufruf rumspiel oder vor "SetGadgetState(1,CreateBitmapFromSprite(1))" nochn "delay(etwas)" einsetzte, dauerts unterschiedlich lang, bis ich nur noch'n grauen Button hab.
Oder meinst Du was anders ?
Ich bin blutiger PB-Anfänger.
seit 17.12.08: PB 4.3 unter XP Home(SP3)
Antworten