RE: Bitmap clearing
- Posted by Patrick.Barnes at transgrid.com.au Jan 30, 2003
- 526 views
Hey Jordah... I found an error in your PatBLT procedure... I didn't notice until now, because some of the pixmap wasn't clearing correctly, and I couldn't figure out why: >------------------------------------------- >procedure PatBlt(atom hdc,atom x,atom y,atom cx,atom cy,atom rop) >------------------------------------------- > if not w32Func(zPatBlt,{hdc,x,y,cy,cy,rop}) then > warnErr("PatBlt Failed") \-------perhaps that should be cx? > end if >end procedure Very frustrating, I tore my program almost to pieces looking for the bug, and it was your fault all along! :oP Hopefully you don't have that same error sitting somewhere. Thanks for the demo. VERY useful. -Pat -----Original Message----- From: jordah at btopenworld.com [mailto:jordah at btopenworld.com] Sent: Saturday, 25 January 2003 15:49 To: EUforum Subject: Re: Bitmap clearing Hi Patrick, I alittle bit under-estimated win32lib. It does alot of work for the end-user. Its getDC has a very kewl construct. also, i have attached BlankPixmap() which is a faster way to blank a pixmap. Try this demo in the win32lib directory because it requires mail.bmp Hope this helps. Jordah. --------------------------------------------------------- --File : Demo For Patrick --Version: --Date : --Author : Jordah Ferguson --------------------------------------------------------- include win32lib.ew ------------------------------------------- constant MainWindow = create(Window,"Demo for Patrick",0,Default,Default,600,400,0), Pixmap1 = create(Pixmap,"",0,0,0,300,300,0), zPatBlt = registerw32Function(gdi32,"PatBlt",{C_LONG,C_LONG,C_INT,C_INT,C_INT,C_INT},C _INT), ------------------------------------------- Bitmap1 = loadBitmapFromFile(current_dir()&"\\mail.bmp") ------------------------------------------- procedure PatBlt(atom hdc,atom x,atom y,atom cx,atom cy,atom rop) ------------------------------------------- if not w32Func(zPatBlt,{hdc,x,y,cy,cy,rop}) then warnErr("PatBlt Failed") end if end procedure ------------------------------------------- global procedure stretchBlt( atom dst, integer dstX, integer dstY, atom src, integer srcX, integer srcY, integer destWide, integer destHigh, integer srcWide, integer srcHigh, integer rop ) ------------------------------------------- atom srcDC, dstDC srcDC = getDC( src ) dstDC = getDC( dst ) if not w32Func( xStretchBlt, { dstDC, dstX, dstY, destWide, destHigh, srcDC, srcX, srcY, srcWide, srcHigh, rop} ) then warnErr( "stretchBlt:StretchBlt failed." ) end if releaseDC( dst ) releaseDC( src ) end procedure ------------------------------------------- procedure BlankPixmap(integer Pixmap,atom BkColor) ------------------------------------------- atom hdc,brush,oldbrush sequence rect rect = getRect(Pixmap) hdc = getDC(Pixmap) -- This already performs selectobject() brush = w32Func(xCreateSolidBrush,{BkColor}) oldbrush = w32Func(xSelectObject,{hdc,brush}) PatBlt(hdc,rect[1],rect[2],rect[3],rect[4],#00F00021) oldbrush = w32Func(xSelectObject,{hdc,oldbrush}) oldbrush = w32Func(xDeleteObject,{brush}) releaseDC(hdc) end procedure ------------------------------------------- procedure DrawToPixmap(integer Pix,atom hBmp,atom px,atom py,atom bitcx,atom bitcy) ------------------------------------------- sequence rect rect = getRect(hBmp) stretchBlt(Pix,px,py,hBmp,0,0,bitcx,bitcy,rect[3],rect[4],SRCCOPY) end procedure ------------------------------------------- procedure DrawToScreen(integer dest,integer Pix,atom x,atom y,atom cx,atom cy) ------------------------------------------- sequence rect rect = getRect(Pix) stretchBlt(dest,x,y,Pix,0,0,cx,cy,rect[3],rect[4],SRCCOPY) end procedure ------------------------------------------- procedure onPaint_Proc(integer id,integer event,sequence params) ------------------------------------------- sequence rect,rec,re re = getClientRect(MainWindow) rect = getRect(Pixmap1) rec = getRect(Bitmap1) BlankPixmap(Pixmap1,White) DrawToPixmap(Pixmap1,Bitmap1,floor((rect[3]-rec[3])/2)-40,floor((rect[4]-rec [4])/2)-40,rec[3]+40,rec[4]+40) DrawToScreen(MainWindow,Pixmap1,re[1],re[2],re[3],re[4]) end procedure setHandler(MainWindow,w32HPaint,routine_id("onPaint_Proc")) ------------------------------------------- procedure onResize_Proc(integer id,integer event,sequence params) ------------------------------------------- DrawToScreen(MainWindow,Pixmap1,0,0,params[2],params[3]) end procedure setHandler(MainWindow,w32HResize,routine_id("onResize_Proc")) ------------------------------------------- WinMain(MainWindow,Normal) --- TOPICA - Start your own email discussion group. FREE! *********************************************************************** ***********************************************************************