.. Get Pixel Speed Test

Category: Graphics - GDI

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Include "Win32API.inc"
Global hDlg As Dword, B() As Long, P() As Long
Global qFreq, qT, qOH, qOverhead As Quad
 
Function PBMain() As Long
   ReDim P(127,127)
   QueryPerformanceFrequency qFreq    'clock frequency
   Tix qOH : Tix qOH : Tix End qOH    'qOH = Tix overhead (done twice per Intel)
   Dialog New Pixels, 0, "Test Code",300,300,370,250, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 200, "GetPixel API (desktopDC)", 10,10,160,20
   Control Add Button, hDlg, 203, "GetPixel API (memoryDC)", 10,40,160,20
   Control Add Button, hDlg, 201, "Graphic Get Pixel", 10,70,160,20
   Control Add Button, hDlg, 202, "Graphic bmp$ + Pointers", 10,100,160,20
   Control Add Button, hDlg, 204, "GetBitmapBits", 10,130,160,20
   Control Add Button, hDlg, 205, "GetDIBits", 10,160,160,20
   Control Add Button, hDlg, 206, "DIB Section", 10,190,160,20
   Control Add Graphic, hDlg, 300, "", 200,20, 130,130, %WS_Border
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local hBMP,hBitMap,hBitmapDC,hDesktopDC,hMemoryDC,hGraphic,hGraphicDC As Dword, bmp$
   Local bm As Bitmap, x,y,iResult,i,ddw,ddh,iColor,iStart,iEnd As Long, pStart,p,pBits As Long Ptr
   Local bmi As BitMapInfo, pColor As Long Ptr
   If Cb.Msg = %WM_Command And Cb.Ctl = 200 Then   'GetPixel API (desktopDC)
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                 'handle to desktop DC
      For x = 0 To 15                           'slow even at 16x16. couldn't wait for 128x128
         For y = 0 To 15
            P(x,y) = GetPixel(hDesktopDC,x,y)    'get colors
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
   If Cb.Msg = %WM_Command And Cb.Ctl = 201 Then    'Graphic Get Pixel
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                  'handle to desktop DC
      Desktop Get Size To ddw,ddh                  'desktop size
      Graphic Bitmap New ddw,ddh To hGraphic       'create Graphic memory bitmap
      Graphic Attach hGraphic,0                  'attach to memory bitmap
      Graphic Get DC To hGraphicDC               'get DC of memory bitmap
      BitBlt hGraphicDC,0,0,ddw,ddh,hDesktopDC,0,0,%SrcCopy  'copy desktop image to Graphic memory bitmap
      ReleaseDC(%Null, hDeskTopDC)               'release desktop DC
      For x = 0 To 127
         For y = 0 To 127
            Graphic Get Pixel (x,y) To P(x,y)     'get colors
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
   If Cb.Msg = %WM_Command And Cb.Ctl = 202 Then   'Graphic bmp$ + Pointers
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                     'handle to desktop DC
      Desktop Get Size To ddw,ddh                     'desktop size
      Graphic Bitmap New ddw,ddh To hBitmap           'create Graphic memory bitmap
      Graphic Attach hBitmap,0                      'attach to memory bitmap
      Graphic Get DC To hBitmapDC                   'get DC of memory bitmap
      BitBlt hBitmapDC, 0,0,ddw,ddh, hDeskTopDC, 0,0, %SRCCopy 'copy desktop image to Graphic memory bitmap
      Graphic Get Bits To bmp$                      'get color data in form of string
      pStart = StrPtr(bmp$)+8                       'pointer to start of color data in bit string
      ReleaseDC(%Null, hDeskTopDC)                  'release desktop DC
      For x = 0 To 127
         For y = 0 To 127
            p = pStart + (y*ddw + x)*4                'get colors
            P(x,y) = RGB(@p)
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
   If Cb.Msg = %WM_Command And Cb.Ctl = 203 Then     'GetPixel API (memoryDC)
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                           'handle to desktop DC
      Desktop Get Size To ddw,ddh                           'desktop size
      hMemoryDC = CreateCompatibleDC(hDesktopDC)          'create compatible memory DC
      hBMP      = CreateCompatibleBitmap(hDesktopDC,ddw,ddh)'create DDB
      SelectObject(hMemoryDC,hBMP)                        'put hBMP into memory DC
      BitBlt hMemoryDC,0,0,ddw,ddh,hDesktopDC,0,0,%SrcCopy  'copy desktop DC into memory DC
      ReleaseDC(%Null, hDeskTopDC)                        'release desktop DC
      For x = 0 To 127
         For y = 0 To 127
            P(x,y) = GetPixel(hMemoryDC,x,y)               'get colors
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
   If Cb.Msg = %WM_Command And Cb.Ctl = 204 Then      'GetBitmapBits
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                           'handle to desktop DC
      Desktop Get Size To ddw,ddh                           'desktop size
      hMemoryDC = CreateCompatibleDC(hDesktopDC)          'create compatible memory DC
      hBMP      = CreateCompatibleBitmap(hDesktopDC,ddw,ddh)'create DDB
      SelectObject(hMemoryDC,hBMP)                        'put hBMP into memory DC
      BitBlt hMemoryDC,0,0,ddw,ddh,hDesktopDC,0,0,%SrcCopy  'copy desktop DC into memory DC
      ReleaseDC(%Null, hDeskTopDC)                        'release desktop DC
      hBitMap = GetCurrentObject(hMemoryDC, %OBJ_BITMAP)  'get handle to bitmap in memory DC
      GetObject(hBitmap, SizeOf(bm), bm)                  'get info about bitmap
      ReDim B(0 To bm.bmwidth-1, 0 To bm.bmheight-1)
      iResult = GetBitmapBits (hBitmap, bm.bmwidthbytes*bm.bmheight, B(0,0))
      For x = 0 To 127     '128x128 pixels
         For y = 0 To 127
            P(x,y) = RGB(B(x,y))
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
   If Cb.Msg = %WM_Command And Cb.Ctl = 205 Then    'GetDIBits
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                           'handle to desktop DC
      Desktop Get Size To ddw,ddh                           'desktop size
      hMemoryDC = CreateCompatibleDC(hDesktopDC)          'create compatible memory DC
      hBMP      = CreateCompatibleBitmap(hDesktopDC,ddw,ddh)'create DDB
      SelectObject(hMemoryDC,hBMP)                        'put hBMP into memory DC
      BitBlt hMemoryDC,0,0,ddw,ddh,hDesktopDC,0,0,%SrcCopy  'copy desktop DC into memory DC
      ReleaseDC(%Null, hDeskTopDC)                        'release desktop DC
      hBitMap = GetCurrentObject(hMemoryDC, %OBJ_BITMAP)  'get handle to bitmap in memory DC
      GetObject(hBitmap, SizeOf(bm), bm)                  'get info about the bitmap
      ReDim B(0 To bm.bmwidth-1, 0 To bm.bmheight-1)      'size Long array to hold all colors
 
      bmi.bmiHeader.biSize        = SizeOf(bmi.bmiHeader) 'set bmi info (needed for GetDIBits)
      bmi.bmiHeader.biWidth       = bm.bmWidth
      bmi.bmiHeader.biHeight      = -bm.bmHeight          'Put top in TOP instead on bottom!
      bmi.bmiHeader.biPlanes      = 1
      bmi.bmiHeader.biBitCount    = 32
      bmi.bmiHeader.biCompression = %BI_RGB
 
      GetDIBits hMemoryDC, hBitMap, 0, bm.bmHeight, B(0,0), bmi, %DIB_RGB_COLORS
      For x = 0 To 127     '128x128 pixels
         For y = 0 To 127
            P(x,y) = RGB(B(x,y))
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
   If Cb.Msg = %WM_Command And Cb.Ctl = 206 Then    'CreateDibSection
      Reset P() : Tix qT
      hDesktopDC = GetDC(%Null)                           'handle to desktop DC
      Desktop Get Size To ddw,ddh                           'desktop size
      hMemoryDC = CreateCompatibleDC(hDesktopDC)          'create compatible memory DC
 
      bmi.bmiHeader.biSize        = SizeOf(bmi.bmiHeader) 'set bmi info (needed for GetDIBits)
      bmi.bmiHeader.biWidth       = ddw
      bmi.bmiHeader.biHeight      = -ddh
      bmi.bmiHeader.biPlanes      = 1
      bmi.bmiHeader.biBitCount    = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hBMP = CreateDIBSection(hMemoryDC, bmi, %DIB_RGB_COLORS, 0, 0, 0)
 
      SelectObject(hMemoryDC,hBMP)                        'put hBMP section into memory DC
      BitBlt hMemoryDC,0,0,ddw,ddh,hDesktopDC,0,0,%SrcCopy  'copy desktop DC into memory DC
      ReleaseDC(%Null, hDeskTopDC)                        'release desktop DC
 
      GetObject(hBMP, SizeOf(bm), bm)                  'get info about the bitmap
      For x = 0 To 127     '128x128 pixels
         For y = 0 To 127
            pBits = bm.bmBits + (y*ddw + x)*4
            P(x,y) = RGB(@pBits)
         Next y
      Next x
      Tix End qT : DrawResults : MsgBox Format$((qT-qOH)*1000/qFreq, "###,###")
   End If
 
End Function
 
Sub DrawResults
   Local x,y,iColor As Long
   Graphic Attach hDlg, 300, ReDraw
   Graphic Clear : Graphic ReDraw
   Sleep 500
   For x = 0 To 127
      For y = 0 To 127
         Graphic Set Pixel(x,y),P(x,y)
      Next y
   Next x
   Graphic ReDraw
End Sub
 
'gbs_00943
'Date: 03-10-2012
 


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm