Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm