Menu
▾
▴
[Win32forth-cvs] win32forth/demos WINCLOCK.F,1.4,1.5
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:24
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/demos Modified Files: WINCLOCK.F Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes Index: WINCLOCK.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/WINCLOCK.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** WINCLOCK.F 26 Apr 2008 11:14:32 -0000 1.4 --- WINCLOCK.F 30 Apr 2008 15:51:08 -0000 1.5 *************** *** 7,200 **** needs NoConsole.f needs Resources.f false value turnkey? \ --------------------------------------------------------------- - \ ext-windc class - \ --------------------------------------------------------------- - - :class ext-windc <super windc - \ *G Extended windc class. - \ ** There are a few things missing in the windc class so I - \ ** added them here. - - int SavedState - - :M ClassInit: ( -- ) - \ *G Init the class - ClassInit: super - 0 to SavedState - ;m - - \ This method was added here because of a bug in the gdiDC class - \ (Sonntag, April 20 2008 - dbu) - :M Restore: ( SavedState -- ) - \ *G The Restore method restores the device context to the specified state. - \ ** The DC is restored by popping state information off a stack created by - \ ** earlier calls to the Save: method. - hObject call RestoreDC ?win-error ;M - - :M Destroy: ( -- ) - \ *G Destroy the device context. - Valid?: super - if \ First we restore the state of the device context. - \ After that all gdi objects that are currently selected - \ into this dc can be saftly destroyd later! - SavedState Restore: self - - GetHandle: super call DeleteDC ?win-error - 0 PutHandle: super - then ;M - - :M SetHandle: ( hObject -- ) - \ *G Set the handle of the object. \n - \ ** If the current handle of the object is valid it will be destroyed. - Destroy: self - PutHandle: super - - \ we save the state of the device contect here, so we - \ can restore it later. - Save: super to SavedState - ;M - - :m ~: ( -- ) - \ *G Clean up on dispose. - Destroy: self ;m - - ;class - - \ --------------------------------------------------------------- - \ timer-window class - \ --------------------------------------------------------------- - - :class timer-window <super window - \ *G timer-window class. - \ ** This class can be used for windows that should handle timer events. - \ ** Only one timer for the window can be used with this class. - - int timer - - :m ClassInit: ( -- ) - \ *G Init the class - ClassInit: super - 0 to timer - ;m - - :m KillTimer: ( -- ) - \ *G Destroy the timer for this window. - timer ?dup - if hWnd Call KillTimer ?win-error \ destroy the timer - 0 to timer - then ;m - - :M CreateTimer: ( ms -- ) - \ *G Create the timer for this window. - KillTimer: self \ not needed, but it doesn't hurt... - NULL swap hWnd hWnd Call SetTimer to timer - ;m - - :M On_Done: ( -- ) - \ *G Things to do before program termination - KillTimer: self \ destroy the timer, we are done - On_Done: super - ;M - - :M On_Timer: ( -- ) - \ *G Thing's to do when the window recives a timer event. Default does nothing. - ;m - - :M WM_TIMER ( -- ) \ handle the WM_TIMER events - On_Timer: [ self ] ;M - - ;class - - - \ --------------------------------------------------------------- - \ bitmap-dc class - \ --------------------------------------------------------------- - - :class bitmap-dc <super ext-windc - \ *G Bitmap device context class. - \ ** This can be used for buffered drawing. - - int bitmap - int bitmap-height - int bitmap-width - - :M ClassInit: ( -- ) - \ *G Init the class - ClassInit: super - 0 to bitmap - 0 to bitmap-height - 0 to bitmap-width - ;M - - :M Valid?: ( -- f ) - \ *G Check if it's save to use this device. - Valid?: super bitmap 0<> and ;M - - :M Fill: { color_object \ -- } - \ *G Fill the display bitmap with a specified color. - Valid?: self - if 0 0 bitmap-width bitmap-height color_object FillArea: super - then ;M - - :m Destroy: ( -- ) - \ *G Destroys the display bitmap. - - \ first we destroy the device context - Destroy: super - - \ and than the bitmap - bitmap 0<> - if bitmap call DeleteObject ?win-error - 0 to bitmap - then ;M - - :M Init: { width height RefDC \ -- } - \ *G Create the display bitmap and select it to our device context. - \ ** Our device context will be compatible to the reference device. - - Destroy: self - - width 0> height 0> and - if width to bitmap-width - height to bitmap-height - - CreateCompatibleDC: RefDC ?dup - if SetHandle: super - bitmap-width bitmap-height CreateCompatibleBitmap: RefDC ?dup - if dup to bitmap SelectObject: super drop - OEM_FIXED_FONT SelectStockObject: super drop - WHITE_PEN SelectStockObject: super drop - BLACK SetBkColor: super - WHITE SetTextColor: super - - BLACK Fill: self - then - then - then ;m - - :M On_EraseBackground: ( hwnd msg wparam lparam -- res ) - 4drop 0 ;M \ let the On_Paint: Method redraw the background - - :m Paint: { ps_left ps_top ps_right ps_bottom DestDC -- } - \ *G Draw the display bitmap into the destination device condtext. - Valid?: self - if SRCCOPY \ blitmode - ps_left ps_top \ sourcex,y - self \ sourcedc - ps_right ps_bottom \ sizex,y - ps_left ps_top \ destinationx,y - BitBlt: DestDC - then ;M - - :m ~: ( -- ) - \ *G Clean up on dispose. - Destroy: self ;m - - ;class - - \ --------------------------------------------------------------- \ line-dc - Device context class for simple line drawing \ --------------------------------------------------------------- --- 7,16 ---- needs NoConsole.f needs Resources.f + needs lib\BitmapDC.f + needs lib\TimerWindow.f false value turnkey? \ --------------------------------------------------------------- \ line-dc - Device context class for simple line drawing \ --------------------------------------------------------------- |
