FastImageOutput

[djes]

S.M. a mis sur le forum anglais une petite routine très sympathique. Je vous invite à faire un tour!

http://www.purebasic.fr/english/viewtop ... 154#150154

[Dr. Dri]

Super intéressant ce code
Ca donne des idées ^^

Dri

[Frenchy Pilou]

En passant: Le jeu Puzzle Bubble il déchire!

[djes]

En passant: Le jeu Puzzle Bubble il déchire!

Tu parles du mien ou de l'original?

[Gillou]

Merci, c'est génial, mon meilleur résultat c'était le double en temps.

Encore merci! ça va vachement me servir

En comparaison :

Structure DrawingInfoStruct
  Type.l
  Window.l
  DC.l
  ReleaseProcedure.l
  PixelBuffer.l
  Pitch.l
  Width.l
  Height.l
  Depth.l
  PixelFormat.l
  StopDirectAccess.l
  StartDirectAccess.l
EndStructure

Global FastImgOutputID.DrawingInfoStruct

Procedure ___ReleaseFastImageOutput()
   If FastImgOutputID\DC: DeleteDC_ (FastImgOutputID\DC):FastImgOutputID\DC=0: EndIf ; free the created memory DC
EndProcedure

Procedure ___StopDirectAccess()
   ProcedureReturn FastImgOutputID\DC
EndProcedure

Procedure ___StartDirectAccess()
   GetPixel_ (FastImgOutputID\DC,0,0) ; make sure all GDI operations are finished
   ProcedureReturn FastImgOutputID\PixelBuffer
EndProcedure

; FastImageOutput() provides a faster pixel access for 32-,24- and 15 bit images(DIBSesctions).
; However, for now only plot(x,y,color) works faster. (point(x,y) seems to be not optimized for direct memory access at the moment. You can use the PointFast() command from the E2D Userlib to get a faster point command.)
Procedure FastImageOutput(Image)
   If GetObject_ ( ImageID (Image),SizeOf(DIBSECTION),ds.DIBSECTION)=0
     ProcedureReturn 0 ; no DIBSECTION
   EndIf

  FastImgOutputID\Type=7 ; allows direct memory access
  FastImgOutputID\ReleaseProcedure=@___ReleaseFastImageOutput()
  FastImgOutputID\PixelBuffer=ds\dsBm\bmBits+ds\dsBm\bmWidthBytes*(ds\dsBm\bmHeight-1) ;needed because the image if top down
  FastImgOutputID\Pitch=-ds\dsBm\bmWidthBytes
  FastImgOutputID\Width=ds\dsBm\bmWidth
  FastImgOutputID\Height=ds\dsBm\bmHeight
  FastImgOutputID\Depth=ds\dsBm\bmBitsPixel

   Select FastImgOutputID\Depth
     Case 32
      FastImgOutputID\PixelFormat= #PB_PixelFormat_32Bits_BGR
     Case 24
      FastImgOutputID\PixelFormat= #PB_PixelFormat_24Bits_BGR
     Case 16
      FastImgOutputID\Depth=15
      FastImgOutputID\PixelFormat= #PB_PixelFormat_15Bits
     Default
       ProcedureReturn 0 ; only 32-,24- and 15bit DIBSections are supported
   EndSelect

  MemDC= CreateCompatibleDC_ (0)
   If MemDC=0: ProcedureReturn 0: EndIf ; the memory DC cannot be created
   SelectObject_ (MemDC, ImageID (Image))
  FastImgOutputID\DC=MemDC

  FastImgOutputID\StopDirectAccess=@___StopDirectAccess()
  FastImgOutputID\StartDirectAccess=@___StartDirectAccess()
   ProcedureReturn FastImgOutputID
EndProcedure

ProcedureDLL TableToImage(Image, Table) ; Crée une image à partir du tableau Image=#Image, Table=@Tableau(), ex : Dim Tableau(ImageWidth(),ImageHeight()) -> @Tableau()
     If IsImage (Image) And Table
         ImageID = ImageID (Image)
        bm.BITMAP
         GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
        bmi.BITMAPINFO
        bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
        bmi\bmiheader\biWidth = bm\bmWidth
        bmi\bmiheader\biHeight = bm\bmHeight
        bmi\bmiheader\biPlanes = 1
        bmi\bmiheader\biBitCount = 32
        bmi\bmiheader\biCompression = #BI_RGB
        pixel = AllocateMemory (bm\bmHeight * bm\bmWidth * 4)
         For nn = 0 To bm\bmwidth - 1
             For n = 0 To bm\bmheight - 1
                color = PeekL (Table + n * 4 + nn * bm\bmHeight * 4)
                 PokeL (pixel + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4, color >> 16 | (color >> 8 & $FF) << 8 | (color & $FF) << 16)
             Next
            table + 4
         Next
        HDC = StartDrawing ( ImageOutput (image))
             SetDIBits_ (HDC, ImageID , 0, bm\bmHeight, pixel, bmi, #DIB_RGB_COLORS )
         StopDrawing ()
         FreeMemory (pixel)
         ProcedureReturn 1
     EndIf
EndProcedure

;Test:
OpenWindow (1,0,0,600,500, "FastImageOutput Test" )

CreateImage (1,600,500,32) ; only 32bit seems to be really faster...

Start= GetTickCount_ ()

StartDrawing (FastImageOutput(1)) ; replace this by ImageOutput(1)
For Y=0 To 499
For X=0 To 599
   Plot (X,Y,X*Y)
Next
Next
StopDrawing ()

Result= GetTickCount_ ()-Start

Start= GetTickCount_ ()
Dim table(600, 500)
For Y=0 To 499
For X=0 To 599
  Table(X,Y) = X*Y
Next
Next
TableToImage(1, Table())
Res= GetTickCount_ ()-Start

StartDrawing ( WindowOutput (1))
DrawImage ( ImageID (1),0,0)
StopDrawing ()
MessageRequester ( "Result:" , Str (Result)+ " ms" + #CRLF$ + Str (Res)+ " ms" )

[djes]

Je m'amuse ...

Code : Tout sélectionner

Structure DrawingInfoStruct
  Type.l
  Window.l
  DC.l
  ReleaseProcedure.l
  PixelBuffer.l
  Pitch.l
  Width.l
  Height.l
  Depth.l
  PixelFormat.l
  StopDirectAccess.l
  StartDirectAccess.l
EndStructure

Global FastImgOutputID.DrawingInfoStruct

Procedure ___ReleaseFastImageOutput()
  If FastImgOutputID\DC:DeleteDC_(FastImgOutputID\DC):FastImgOutputID\DC=0:EndIf ; free the created memory DC
EndProcedure

Procedure ___StopDirectAccess()
  ProcedureReturn FastImgOutputID\DC
EndProcedure

Procedure ___StartDirectAccess()
  GetPixel_(FastImgOutputID\DC,0,0) ; make sure all GDI operations are finished
  ProcedureReturn FastImgOutputID\PixelBuffer
EndProcedure

; FastImageOutput() provides a faster pixel access for 32-,24- and 15 bit images(DIBSesctions).
; However, for now only plot(x,y,color) works faster. (point(x,y) seems to be not optimized for direct memory access at the moment. You can use the PointFast() command from the E2D Userlib to get a faster point command.)
Procedure FastImageOutput(Image)
  If GetObject_(ImageID(Image),SizeOf(DIBSECTION),ds.DIBSECTION)=0
    ProcedureReturn 0 ; no DIBSECTION
  EndIf

  FastImgOutputID\Type=7 ; allows direct memory access
  FastImgOutputID\ReleaseProcedure=@___ReleaseFastImageOutput()
  FastImgOutputID\PixelBuffer=ds\dsBm\bmBits+ds\dsBm\bmWidthBytes*(ds\dsBm\bmHeight-1) ;needed because the image if top down
  FastImgOutputID\Pitch=-ds\dsBm\bmWidthBytes
  FastImgOutputID\Width=ds\dsBm\bmWidth
  FastImgOutputID\Height=ds\dsBm\bmHeight
  FastImgOutputID\Depth=ds\dsBm\bmBitsPixel

  Select FastImgOutputID\Depth
    Case 32
      FastImgOutputID\PixelFormat=#PB_PixelFormat_32Bits_BGR
    Case 24
      FastImgOutputID\PixelFormat=#PB_PixelFormat_24Bits_BGR 
    Case 16
      FastImgOutputID\Depth=15
      FastImgOutputID\PixelFormat=#PB_PixelFormat_15Bits     
    Default
      ProcedureReturn 0 ; only 32-,24- and 15bit DIBSections are supported
  EndSelect

  MemDC=CreateCompatibleDC_(0)
  If MemDC=0:ProcedureReturn 0:EndIf ; the memory DC cannot be created
  SelectObject_(MemDC,ImageID(Image))
  FastImgOutputID\DC=MemDC

  FastImgOutputID\StopDirectAccess=@___StopDirectAccess()
  FastImgOutputID\StartDirectAccess=@___StartDirectAccess() 
  ProcedureReturn FastImgOutputID
EndProcedure


;By Rescator
Procedure.l Ticks_HQ()
  Static maxfreq.q
  Protected t.q
  If maxfreq=0
    QueryPerformanceFrequency_(@maxfreq)
    maxfreq=maxfreq/1000
  EndIf
  QueryPerformanceCounter_(@t.q)
  ProcedureReturn t/maxfreq
EndProcedure

;Test:
OpenWindow(1,0,0,600,500,"FastImageOutput Test")

CreateImage(1,600,500,32) ; only 32bit seems to be really faster...

i.f=-100
Repeat

	Event = WindowEvent() 
	Start=Ticks_HQ()
	
	StartDrawing(FastImageOutput(1)) ; replace this by ImageOutput(1)
	For Y=0 To 499
		For X=0 To 599
		  Plot(X,Y,(Sin((X-300)/(Y-250)+I)+Cos(Y/I+1))*$10000)
		Next
	Next
	StopDrawing()
	StartDrawing(WindowOutput(1))
	DrawImage(ImageID(1),0,0)
	StopDrawing()
	Result=Ticks_HQ()-Start
	i+0.5
	
Until Event = #PB_Event_CloseWindow

MessageRequester("Result:",Str(Result)+" ms")

[wolfjeremy]

Je m'amuse ...

Ma foi c’est une bonne occupation.