posted May 20, 2003 10:11 PM
Paul,The "Timer" function is not very accurate, try this version
w/ QueryPerformanceCounter(), this code also gives us access
to each pixel, whereas Arc() doesn't 
also, still need to add the clipping, that's why r=550 gpf's,
(we can't set a value to a bit that's not there using dib's)
#COMPILE EXE
#INCLUDE "WIN32API.INC"
GLOBAL memDC AS LONG, hBit AS LONG
CALLBACK FUNCTION CircleSieve()
LOCAL hdc&,i&,a&,b&,r&,r2&,startx&,starty& ,rx2&, count&
LOCAL aSgrd&,aIncr&,btest&
LOCAL Radius AS STRING *3,t1 AS DOUBLE,t2 AS DOUBLE
startx&=50 :starty&=500
SELECT CASE CBMSG
CASE %WM_INITDIALOG
LOCAL bm AS BITMAP, bmi AS BITMAPINFO, rc AS RECT, txt AS STRING GetClientRect CBHNDL, rc
hDC = GetDc(CBHNDL)
bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
bmi.bmiHeader.biWidth = rc.nRight -1
bmi.bmiHeader.biHeight = -rc.nBottom 'top-down DIB - origin in upper left corner
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = %BI_RGB
memDC = CreateCompatibleDC (hDC)
hbit = CreateDIBSection (memDC, bmi, %DIB_RGB_COLORS, 0, 0, 0)
' GlobalLock hbit
SelectObject memDC, hbit
SetBkMode memDC, %TRANSPARENT
ReleaseDc CBHNDL, hDC
CASE %WM_DESTROY
DeleteDC memDC
DeleteObject hbit
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE 300
CONTROL GET TEXT CBHNDL,100 TO Radius
r&=VAL(Radius) : r2&=r&*.707 : rx2&=r&*2
hdc&= GetDC(CBHNDL)
GetObject hbit, SIZEOF(bm), bm
LOCAL rgbclr& ,xofst&, dwp AS DWORD PTR
rgbclr&=&Hffffff&
DIM C1 AS QUAD,C2 AS QUAD
FOR dwp = bm.bmBits TO bm.bmBits + (bm.bmWidth * bm.bmHeight * 4) STEP 4
@dwp = &Haaaaff&
NEXT
xofst&=bm.bmWidth*4
'SUMMATION VERSION
QueryPerformanceCounter C1
' t1 = TIMER
FOR count& = 1 TO 100
i&=0 : aSqrd&=1 : btest&=0 : aIncr&=0
startx&=startx&+5
FOR a&=0 TO r2&
IF aSqrd& > btest& THEN
b&=i& :INCR i&
'Asm routine for: btest&= r&^2-(r&-i&)^2 (by Paul Dixon)
!mov eax,rx2& ;get 2r
!sub eax,i& ;get (2r-i)
!imul i& ;get i(2r-i)
!mov btest&,eax ;store result
END IF
'Asm routine for: "aIncr&=aIncr&+2: aSqrd&=aSqrd&+aIncr&"
! add aIncr&, 2
! mov eax, aIncr&
! add aSqrd&, eax
dwp =bm.bmBits+ (starty&-a&)*xofst& +(startx&+b&)* 4
@dwp = rgbclr&
dwp =bm.bmBits+ (starty&-r&+b&)*xofst& +(startx&+r&-a&)* 4
@dwp = rgbclr&
NEXT a&
NEXT count&
BitBlt hdc&,0,30,bm.bmWidth,bm.bmHeight,memDC,1,1 ,%SRCCOPY
QueryPerformanceCounter C2
' t2 = TIMER
MSGBOX "Timer: "+ FORMAT$(C2-C1,"#0.00000")+$CRLF+"SUMMATION VERSION"
'ARC VERSION
FOR dwp = bm.bmBits TO bm.bmBits + (bm.bmWidth * bm.bmHeight * 4) STEP 4
@dwp = &Haaaaff&
NEXT
startx&=50 :starty&=500
MSGBOX "Start WinAPI Arc() test"
QueryPerformanceCounter C1
' t1 = TIMER
FOR count& = 1 TO 100
startx&=startx&+5
Arc memDC,startx&,starty&-r&,startx&+rx2&,starty&+r&,startx&+r,starty&-r&,startx&,starty&
NEXT count&
BitBlt hdc&,0,30,bm.bmWidth,bm.bmHeight,memDC,1,1 ,%SRCCOPY
QueryPerformanceCounter C2
t2 = TIMER
MSGBOX "Timer: "+ FORMAT$(C2-C1,"#0.00000")+$CRLF+"WINAPI ARC() VERSION"
InvalidateRect CBHNDL, BYVAL %NULL, %TRUE
ReleaseDC CBHNDL, hdc&
END SELECT
END SELECT
END FUNCTION
FUNCTION PBMAIN
LOCAL CirSv&
DIALOG NEW 0,"Circle Sieve",100,50,500,350,%WS_SYSMENU, TO CirSv&
CONTROL ADD TEXTBOX,CirSv&,100,"400",40,1,18,12,%SS_notify OR %ES_number OR %ES_center, %WS_EX_clientedge
CONTROL ADD LABEL,CirSv&,200,"Radius ",10,3,30,12,%ES_center,
CONTROL ADD BUTTON ,CirSv&,300,"DRAW",70,1,50,14,,
DIALOG SHOW MODAL CirSv&, CALL CircleSieve()
END FUNCTION
------------------
Wash DC Area
bbyrne100@aol.com
Brad@ByrneWorld.com
[This message has been edited by Brad D Byrne (edited May 20, 2003).]
PowerBASIC Forums
UBBFriend: Email This Page to Someone! 
posted May 18, 2003 11:54 AM
