PureBoard

Code: Alles auswählen

If IsSprite(0)
	StartDrawing(SpriteOutput(0))
	DrawImage(ImageID(1),0,0)
	StopDrawing()
EndIf

Code: Alles auswählen

If IsImage(0) 
   StartDrawing(ImageOutput(0)) 
   DisplaySprite(SprtieID(1),0,0) 
   StopDrawing() 
EndIf

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