Menu
▾
▴
[Win32forth-cvs] win32forth/src/lib BitmapDC.f, NONE, 1.1 ExtDC.f, NONE, 1.1 TimerWindow.f, NONE, 1.1
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:24
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/src/lib Added Files: BitmapDC.f ExtDC.f TimerWindow.f Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes --- NEW FILE: BitmapDC.f --- \ $Id: BitmapDC.f,v 1.1 2008/04/30 15:51:09 dbu_de Exp $ \ *D doc\classes\ \ *! BitmapDC \ *T bitmap-dc -- Bitmap device context class. \ *S Glossary cr .( Loading Bitmap device context class.... ) only forth also definitions in-application require lib/ExtDC.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 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-width int bitmap-height :M ClassInit: ( -- ) \ *G Init the class ClassInit: super 0 to bitmap 0 to bitmap-width 0 to bitmap-height ;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 FillArea: ( color_object -- ) \ *G Fill the display bitmap with a specified color. Fill: self ;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 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 \ *G End of bitmap-dc class \ *Z --- NEW FILE: ExtDC.f --- \ $Id: ExtDC.f,v 1.1 2008/04/30 15:51:09 dbu_de Exp $ \ *D doc\classes\ \ *! ExtDC \ *T ext-windc -- Extended WinDC class. \ *S Glossary cr .( Loading Extended device context class... ) only forth also definitions in-application require DC.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ ext-windc class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :class ext-windc <super windc \ *G Extended version of the WinDC class. int SavedState :M ClassInit: ( -- ) \ *G Init the class ClassInit: super 0 to SavedState ;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 PutHandle: ( hObject -- ) \ *G Set the handle of the object. \n \ ** If the current handle of the object is valid it will be destroyed. SetHandle: self ;m :m ~: ( -- ) \ *G Clean up on dispose. Destroy: self ;m ;class \ *G End of ext-windc class \ *Z --- NEW FILE: TimerWindow.f --- \ $Id: TimerWindow.f,v 1.1 2008/04/30 15:51:09 dbu_de Exp $ \ *D doc\classes\ \ *! TimerWindow \ *T Timer-Window -- Timer-Window class. \ *S Glossary require window.f cr .( Loading Timer-Window class...) only forth also definitions in-application \ --------------------------------------------------------------- \ 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 per 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 \ *G End of timer-window class. \ *Z |
