Menu
▾
▴
[Win32forth-cvs] win32forth/src/gdi gdiTools.f,NONE,1.1 gdiBase.f,1.3,1.4 gdiBrush.f,1.1,1.2 gdiPen.f,1.1,1.2
|
From: Dirk B. <db...@us...> - 2005-12-17 15:11:28
|
Update of /cvsroot/win32forth/win32forth/src/gdi In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6948/src/gdi Modified Files: gdiBase.f gdiBrush.f gdiPen.f Added Files: gdiTools.f Log Message: Some cleanup and start of adding DexH style comments. Index: gdiBase.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/gdi/gdiBase.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** gdiBase.f 6 Nov 2005 07:41:16 -0000 1.3 --- gdiBase.f 17 Dec 2005 15:11:19 -0000 1.4 *************** *** 1,64 **** ! \ gdiBase.f ! \ ! \ Written by Dirk Busch ! \ Sonntag, Oktober 09 2005 ! \ Licence: Public Domain ! ! cr .( Loading GDI class library - Base...) ! ! needs gdiStruct.f ! ! internal ! external ! ! in-application ! [undefined] S-REVERSE [IF] \ from toolset.f ! \ Reverse n items on stack ! \ Usage: 1 2 3 4 5 5 S_REVERSE ==> 5 4 3 2 1 ! CODE S-REVERSE ( n[k]..2 1 0 k -- 0 1 2..n[k] ) ! lea ecx, -4 [esp] \ ecx points 4 under top of stack ! lea ebx, 4 [ecx] [ebx*4] \ ebx points 4 over stack ! \ bump pointers, if they overlap, stop ! @@1: sub ebx, # 4 \ adjust top ! add ecx, # 4 \ adjust bottom ! cmp ecx, ebx \ compare ! jae short @@2 \ ecx passing ebx, so exit ! \ rotate a pair ! \ xor a,b xor b,a xor a,b swaps a and b ! mov eax, 0 [ebx] \ bottom to eax ! xor 0 [ecx], eax \ exchange top and eax ! xor eax, 0 [ecx] ! xor 0 [ecx], eax ! mov 0 [ebx], eax \ eax to bottom ! jmp short @@1 \ next pair ! @@2: pop ebx \ tos ! next c; ! [then] ! [undefined] 3reverse [if] ! : 3reverse ( n1 n2 n3 -- n3 n2 n1 ) ! 3 S-REVERSE ; ! [then] ! [undefined] 4reverse [if] ! : 4reverse ( n1 n2 n3 n4 -- n4 n3 n2 n1 ) ! 4 S-REVERSE ; ! [then] ! [undefined] 5reverse [if] ! : 5reverse ( n1 n2 n3 n4 n5 -- n5 n4 n3 n2 n1 ) ! 5 S-REVERSE ; ! [then] ! [undefined] 6reverse [if] ! : 6reverse ( n1 n2 n3 n4 n5 n6 -- n6 n5 n4 n3 n2 n1 ) ! 6 S-REVERSE ; ! [then] ! [undefined] 8reverse [if] ! : 8reverse ( n1 n2 n3 n4 n5 n6 n7 n8 -- n8 n7 n6 n5 n4 n3 n2 n1 ) ! 8 S-REVERSE ; ! [then] \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1,35 ---- ! \ *! gdiBase ! \ *T GdiObject -- Base class for GDI objects ! \ *Q Version 1.0 ! \ ** This GDI class library was written and placed in the Public Domain ! \ ** in 2005 by Dirk Busch ! \ *P GdiObject is the base class for all GDI objects. This class ! \ ** contains a single ivar, hObject, that is the (MS Windows) handle for the ! \ ** GDI object. \n ! \ ** There will be the following subclasses of GdiObject: ! \ *E gdiPen Class for cosmetic pen's ! \ ** gdiGeometricPen Class for geometric pen's ! \ ** gdiSolidBrush Solid brush class ! \ ** gdiHatchBrush Hatch brush class ! \ ** gdiPatternBrush Pattern brush class ! \ ** gdiDIBPatternBrush DIBPattern brush class ! \ ** GdiFont Class for windows fonts ! \ ** gdiBitmap Class for bitmaps ! \ ** gdiMetafile Class for enhanced metafiles ! \ ** gdiDC Base device context class ! \ ** gdiWindowDC Device context class for windows ! \ ** gdiMetafileDC Device context class for enhanced metafiles ! \ *P Since GdiObject is a generic class it should not be used to create ! \ ** any instances. \n ! \ *S Glossary ! cr .( Loading GDI class library - Base...) ! needs gdiStruct.f ! needs gdiTools.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 68,71 **** --- 39,43 ---- internal + \ List of all GDI objects that are currently defined in the system. VARIABLE gdi-object-link gdi-object-link OFF *************** *** 76,87 **** --- 48,64 ---- \ Base class for all GDI Objects \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + :class GdiObject <super object + \ *G GdiObject is the base class for all GDI Object classes. int hObject \ handle of the GDI object :M ZeroHandle: ( -- ) + \ *G Clear the handle of the object. \n + \ ** If the current handle of the object is valid it will not be destroyed. 0 to hObject ;M :M ClassInit: ( -- ) + \ Init the class ClassInit: super *************** *** 91,120 **** ;M - \ The GetType method retrieves the type of the specified object. - \ Possible return values are: - \ OBJ_BITMAP Bitmap - \ OBJ_BRUSH Brush - \ OBJ_COLORSPACE Color space - \ OBJ_DC Device context - \ OBJ_ENHMETADC Enhanced metafile DC - \ OBJ_ENHMETAFILE Enhanced metafile - \ OBJ_EXTPEN Extended pen - \ OBJ_FONT Font - \ OBJ_MEMDC Memory DC - \ OBJ_METAFILE Metafile - \ OBJ_METADC Metafile DC - \ OBJ_PAL Palette - \ OBJ_PEN Pen - \ OBJ_REGION Region :M GetType: ( -- n ) hObject call GetObjectType ;M - \ The GetObject function retrieves information for the specified graphics object. - \ If the function succeeds, and lpvObject is a valid pointer, the return value is - \ the number of bytes stored into the buffer. - \ If the function succeeds, and lpvObject is NULL, the return value is the number - \ of bytes required to hold the information the function would store into the buffer. - \ If the function fails, the return value is zero. :M GetObject: ( cbBuffer lpvObject -- n ) hObject 3reverse call GetObject ;M --- 68,97 ---- ;M :M GetType: ( -- n ) + \ *G Get the type of the object. \n + \ ** Possible return values are: + \ *L OBJ_BITMAP | Bitmap | + \ *| OBJ_BRUSH | Brush | + \ *| OBJ_COLORSPACE | Color space | + \ *| OBJ_DC | Device context | + \ *| OBJ_ENHMETADC | Enhanced metafile DC | + \ *| OBJ_ENHMETAFILE | Enhanced metafile | + \ *| OBJ_EXTPEN | Extended pen | + \ *| OBJ_FONT | Font | + \ *| OBJ_MEMDC | Memory DC | + \ *| OBJ_METAFILE | Metafile | + \ *| OBJ_METADC | Metafile DC | + \ *| OBJ_PAL | Palette | + \ *| OBJ_PEN | Pen | + \ *| OBJ_REGION | Region | hObject call GetObjectType ;M :M GetObject: ( cbBuffer lpvObject -- n ) + \ *G Get information for the object. \n + \ ** If the function succeeds, and lpvObject is a valid pointer, the return value is + \ ** the number of bytes stored into the buffer. \n + \ ** If the function succeeds, and lpvObject is NULL, the return value is the number + \ ** of bytes required to hold the information the function would store into the buffer. + \ ** If the function fails, the return value is zero. hObject 3reverse call GetObject ;M *************** *** 132,135 **** --- 109,113 ---- :M Destroy: ( -- ) + \ *G Destroy the object. Destroy? if hObject call DeleteObject ?win-error *************** *** 138,152 **** :M GetHandle: ( -- hObject ) hObject ;M :M SetHandle: ( hObject -- ) Destroy: self to hObject ;M - \ Check if this object is valid :M Valid?: ( -- f ) hObject 0<> ;M ! \ **************** INTERNAL SYSTEM FUNCTIONS FOLLOW **************** \ The following functions and methods make sure that any gdi objects \ created in your application get reset at system startup, and deleted --- 116,133 ---- :M GetHandle: ( -- hObject ) + \ *G Get the handle of the object. hObject ;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 to hObject ;M :M Valid?: ( -- f ) + \ *G Check if this object is valid. hObject 0<> ;M ! \ ---------------- INTERNAL SYSTEM FUNCTIONS FOLLOW ---------------- \ The following functions and methods make sure that any gdi objects \ created in your application get reset at system startup, and deleted *************** *** 176,180 **** 0 SetHandle: self ;M ! : destroy-gdi-objects ( -- ) \ destroy all font handles [getmethod] destroy-gdi-objects: GdiObject do-objects ; --- 157,161 ---- 0 SetHandle: self ;M ! : destroy-gdi-objects ( -- ) \ destroy all GDI objects [getmethod] destroy-gdi-objects: GdiObject do-objects ; *************** *** 183,186 **** --- 164,168 ---- ;class + \ *G End of class in-system *************** *** 189,194 **** \ Displays the current set of defined gdi objects \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : .gdi-objects ( -- ) ! gdi-object-link @ begin dup --- 171,176 ---- \ Displays the current set of defined gdi objects \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : .gdi-objects ( -- ) \ w32f sys ! \ *G Display GDI objects whitch are currently defined. gdi-object-link @ begin dup *************** *** 206,210 **** in-application ! : ?IsGdiObject ( a1 -- f ) >r gdi-object-link @ begin dup --- 188,193 ---- in-application ! : ?IsGdiObject ( a1 -- f ) \ w32f ! \ *G Check if a1 is the address of a GdiObject. >r gdi-object-link @ begin dup *************** *** 215,220 **** r>drop false ; ! \ Check if GdiObject is an valid GdiObject. If so return the handle of the object. ! : GetGdiObjectHandle { GdiObject -- handle } GdiObject ?IsGdiObject if GetHandle: GdiObject --- 198,204 ---- r>drop false ; ! : GetGdiObjectHandle { GdiObject -- handle } \ w32f ! \ *G Check if GdiObject is the address of a valid GdiObject. ! \ ** If so return the handle of the object. GdiObject ?IsGdiObject if GetHandle: GdiObject *************** *** 224,228 **** in-system ! : (?GdiCheck) ( a1 -- a1 ) dup ?IsGdiObject 0= if forth-io .rstack --- 208,214 ---- in-system ! : (?GdiCheck) ( a1 -- a1 ) \ w32f sys internal ! \ Verify if a1 is the address of a GdiObject. ! \ If a1 isn't the address of a GdiObject the application will be aborted. dup ?IsGdiObject 0= if forth-io .rstack *************** *** 232,238 **** in-application ! : ?GdiCheck ( a1 -- a1 ) \ verify that a1 is a gdi object address TURNKEYED? ?win-error-enabled 0= or ?EXIT \ leave if error checking is not enabled \in-system-ok (?GdiCheck) ; module --- 218,231 ---- in-application ! : ?GdiCheck ( a1 -- a1 ) \ w32f ! \ *G Verify if a1 is the address of a GdiObject. ! \ ** If a1 isn't the address of a GdiObject and the error checking is enabled ! \ ** the application will be aborted. \n ! \ ** Use it for debugging only. TURNKEYED? ?win-error-enabled 0= or ?EXIT \ leave if error checking is not enabled \in-system-ok (?GdiCheck) ; module + + \ *Z + --- NEW FILE: gdiTools.f --- \ *! gdiTools \ *T GdiTools -- Helper words for the GDI class library \ *Q Version 1.0 \ ** This GDI class library was written and placed in the Public Domain \ ** in 2005 by Dirk Busch \ *S Glossary cr .( Loading GDI class library - Tools...) internal external in-application [undefined] S-REVERSE [IF] \ from toolset.f CODE S-REVERSE ( n[k]..2 1 0 k -- 0 1 2..n[k] ) \ w32f \ *G Reverse n items on stack \n \ ** Usage: 1 2 3 4 5 5 S_REVERSE ==> 5 4 3 2 1 lea ecx, -4 [esp] \ ecx points 4 under top of stack lea ebx, 4 [ecx] [ebx*4] \ ebx points 4 over stack \ bump pointers, if they overlap, stop @@1: sub ebx, # 4 \ adjust top add ecx, # 4 \ adjust bottom cmp ecx, ebx \ compare jae short @@2 \ ecx passing ebx, so exit \ rotate a pair \ xor a,b xor b,a xor a,b swaps a and b mov eax, 0 [ebx] \ bottom to eax xor 0 [ecx], eax \ exchange top and eax xor eax, 0 [ecx] xor 0 [ecx], eax mov 0 [ebx], eax \ eax to bottom jmp short @@1 \ next pair @@2: pop ebx \ tos next c; [then] [undefined] 3reverse [if] : 3reverse ( n1 n2 n3 -- n3 n2 n1 ) \ w32f \ *G Reverse 3 items on stack 3 S-REVERSE ; [then] [undefined] 4reverse [if] : 4reverse ( n1 n2 n3 n4 -- n4 n3 n2 n1 ) \ w32f \ *G Reverse 4 items on stack 4 S-REVERSE ; [then] [undefined] 5reverse [if] : 5reverse ( n1 n2 n3 n4 n5 -- n5 n4 n3 n2 n1 ) \ w32f \ *G Reverse 5 items on stack 5 S-REVERSE ; [then] [undefined] 6reverse [if] : 6reverse ( n1 n2 n3 n4 n5 n6 -- n6 n5 n4 n3 n2 n1 ) \ w32f \ *G Reverse 6 items on stack 6 S-REVERSE ; [then] [undefined] 8reverse [if] : 8reverse ( n1 n2 n3 n4 n5 n6 n7 n8 -- n8 n7 n6 n5 n4 n3 n2 n1 ) \ w32f \ *G Reverse 8 items on stack 8 S-REVERSE ; [then] module \ *Z Index: gdiPen.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/gdi/gdiPen.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** gdiPen.f 1 Nov 2005 12:21:40 -0000 1.1 --- gdiPen.f 17 Dec 2005 15:11:19 -0000 1.2 *************** *** 1,8 **** ! \ gdiPen.f ! \ ! \ Written by Dirk Busch ! \ Sonntag, Oktober 09 2005 ! \ Licence: Public Domain ! \ \ TODO: finish gdiGeometricPen class --- 1,9 ---- ! \ *! gdiPen ! \ *T GdiPen -- Class for GDI Pens ! \ *Q Version 1.0 ! \ ** This GDI class library was written and placed in the Public Domain ! \ ** in 2005 by Dirk Busch ! \ *S Glossary ! \ TODO: finish gdiGeometricPen class *************** *** 15,37 **** \ ---------------------------------------------------------------------- - \ Pen class - for cosmetic pen's \ ---------------------------------------------------------------------- :class gdiPen <super gdiObject ! \ Syle of the pen. Possible values are: ! \ PS_SOLID The pen is solid. ! \ PS_DASH The pen is dashed. This style is valid only when the pen width ! \ is one or less in device units. ! \ PS_DOT The pen is dotted. This style is valid only when the pen width ! \ is one or less in device units. ! \ PS_DASHDOT The pen has alternating dashes and dots. This style is valid ! \ only when the pen width is one or less in device units. ! \ PS_DASHDOTDOT The pen has alternating dashes and double dots. This style is ! \ valid only when the pen width is one or less in device units. ! \ PS_NULL The pen is invisible. ! \ PS_INSIDEFRAME The pen is solid. When this pen is used in any GDI drawing ! \ function that takes a bounding rectangle, the dimensions of the figure are ! \ shrunk so that it fits entirely in the bounding rectangle, taking into account ! \ the width of the pen. This applies only to geometric pens. int Style --- 16,26 ---- \ ---------------------------------------------------------------------- \ ---------------------------------------------------------------------- + \ *W <a name="gdiPen"></a> + :class gdiPen <super gdiObject + \ *G Class for cosmetic pen's ! \ Syle of the pen. int Style *************** *** 44,47 **** --- 33,37 ---- :M ClassInit: ( -- ) + \ *G Init the class ClassInit: super *************** *** 50,79 **** ;M ! :M SetStyle: ( style -- ) to style ;M ! :M SetWidth: ( width -- ) 0 max to width ;M ! :M SetRValue: ( r -- ) SetRValue: Color ;M ! :M SetGValue: ( g -- ) SetGValue: Color ;M ! :M SetBValue: ( b -- ) SetBValue: Color ;M ! :M SetRGB: ( r g b -- ) SetRGB: Color ;M ! :M SetColor: ( colorref -- ) SetColor: Color ;M ! :M SetSysColor: ( n -- ) SetSysColor: Color ;M ! :M ChooseColor: ( hWnd -- f ) Choose: Color ;M ! :M GetStyle: ( -- style ) style ;M ! :M GetWidth: ( -- width ) width ;M ! :M GetRValue: ( -- r ) GetRValue: Color ;M ! :M GetGValue: ( -- g ) GetGValue: Color ;M ! :M GetBValue: ( -- b ) GetBValue: Color ;M ! :M GetColor: ( -- colorref ) GetColor: Color ;M :M Create: ( -- f ) GetColor: color width style call CreatePen SetHandle: super Valid?: super ;M - \ The CreateIndirect function creates a logical cosmetic pen that - \ has the style, width, and color specified in a structure. :M CreateIndirect: ( pLogpen -- f ) dup @ SetStyle: self dup cell+ @ SetWidth: self --- 40,127 ---- ;M ! :M SetStyle: ( style -- ) ! \ *G Set Syle of the pen. Possible values are: ! \ *L PS_SOLID | The pen is solid. | ! \ *| PS_DASH | The pen is dashed. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_DOT | The pen is dotted. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_DASHDOT | The pen has alternating dashes and dots. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_DASHDOTDOT | The pen has alternating dashes and double dots. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_NULL | The pen is invisible. | ! \ *| PS_INSIDEFRAME | The pen is solid. When this pen is used in any GDI drawing function that takes a bounding rectangle, the dimensions of the figure are shrunk so that it fits entirely in the bounding rectangle, taking into account the width of the pen. This applies only to geometric pens. | ! to style ;M ! :M SetWidth: ( width -- ) ! \ *G Set the width of the pen in logical units. If Width is zero, the pen is a single pixel ! \ ** wide, regardless of the current transformation. ! 0 max to width ;M ! :M SetRValue: ( r -- ) ! \ *G Set the red component of the pen color. ! SetRValue: Color ;M ! :M SetGValue: ( g -- ) ! \ *G Set the green component of the pen color. ! SetGValue: Color ;M ! ! :M SetBValue: ( b -- ) ! \ *G Set the blue component of the pen color. ! SetBValue: Color ;M ! ! :M SetRGB: ( r g b -- ) ! \ *G Set the red, green and blue component of the pen color. ! SetRGB: Color ;M ! ! :M SetColor: ( colorref -- ) ! \ *G Set color of the pen. ! SetColor: Color ;M ! ! :M SetSysColor: ( n -- ) ! \ *G Set the color of the pen to a system color. ! SetSysColor: Color ;M ! ! :M ChooseColor: ( hWnd -- f ) ! \ *G Open a dialog to choose the color of the pen. ! Choose: Color ;M ! ! :M GetStyle: ( -- style ) ! \ *G Get Syle of the pen. Possible values are: ! \ *L PS_SOLID | The pen is solid. | ! \ *| PS_DASH | The pen is dashed. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_DOT | The pen is dotted. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_DASHDOT | The pen has alternating dashes and dots. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_DASHDOTDOT | The pen has alternating dashes and double dots. This style is valid only when the pen width is one or less in device units. | ! \ *| PS_NULL | The pen is invisible. | ! \ *| PS_INSIDEFRAME | The pen is solid. When this pen is used in any GDI drawing function that takes a bounding rectangle, the dimensions of the figure are shrunk so that it fits entirely in the bounding rectangle, taking into account the width of the pen. This applies only to geometric pens. | ! style ;M ! ! :M GetWidth: ( -- width ) ! \ *G Get the width of the pen in logical units. If the width is zero, the pen is a single pixel ! \ ** wide, regardless of the current transformation. ! width ;M ! ! :M GetRValue: ( -- r ) ! \ *G Get the red component of the pen color. ! GetRValue: Color ;M ! ! :M GetGValue: ( -- g ) ! \ *G Get the green component of the pen color. ! GetGValue: Color ;M ! ! :M GetBValue: ( -- b ) ! \ *G Get the blue component of the pen color. ! GetBValue: Color ;M ! ! :M GetColor: ( -- colorref ) ! \ *G Get the color of the pen as a windows COLORREF value. ! GetColor: Color ;M :M Create: ( -- f ) + \ *G Create the pen with the current style, color and width. GetColor: color width style call CreatePen SetHandle: super Valid?: super ;M :M CreateIndirect: ( pLogpen -- f ) + \ *G The CreateIndirect function creates a logical cosmetic pen that + \ ** has the style, width, and color specified in a structure. dup @ SetStyle: self dup cell+ @ SetWidth: self *************** *** 83,95 **** ;class \ ---------------------------------------------------------------------- - \ GeometricPen class - for geometric pen's \ ---------------------------------------------------------------------- :class gdiGeometricPen <super gdiObject ! \ ExtCreatePen ;class module --- 131,153 ---- ;class + \ *G End of class \ ---------------------------------------------------------------------- \ ---------------------------------------------------------------------- + \ *W <a name="gdiGeometricPen"></a> + :class gdiGeometricPen <super gdiObject + \ *G Class for geometric pen's \n + \ ** Note: this class isn't implemented yet ! :M ClassInit: ( -- ) ! \ *G Init the class ! ClassInit: super ! ;M ;class + \ *G End of class module + + \ *Z Index: gdiBrush.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/gdi/gdiBrush.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** gdiBrush.f 1 Nov 2005 12:21:40 -0000 1.1 --- gdiBrush.f 17 Dec 2005 15:11:19 -0000 1.2 *************** *** 1,7 **** ! \ gdiBrush.f ! \ ! \ Written by Dirk Busch ! \ Sonntag, Oktober 09 2005 ! \ Licence: Public Domain cr .( Loading GDI class library - Brush...) --- 1,8 ---- ! \ *! gdiBrush ! \ *T GdiBrush -- Classes for GDI Brushes. ! \ *Q Version 1.0 ! \ ** This GDI class library was written and placed in the Public Domain ! \ ** in 2005 by Dirk Busch ! \ *S Glossary cr .( Loading GDI class library - Brush...) *************** *** 13,21 **** \ ---------------------------------------------------------------------- - \ Base class for all brush objects \ ---------------------------------------------------------------------- internal :class gdiBrush <super gdiObject gdiPoint origin --- 14,22 ---- \ ---------------------------------------------------------------------- \ ---------------------------------------------------------------------- internal :class gdiBrush <super gdiObject + \ *G Base class for all brush objects gdiPoint origin *************** *** 47,53 **** \ ---------------------------------------------------------------------- - \ Solid brush class \ ---------------------------------------------------------------------- :class gdiSolidBrush <super gdiBrush \ Color of the brush. --- 48,54 ---- \ ---------------------------------------------------------------------- \ ---------------------------------------------------------------------- :class gdiSolidBrush <super gdiBrush + \ *G Solid brush class \ Color of the brush. *************** *** 58,75 **** ;M ! :M SetRValue: ( r -- ) SetRValue: Color ;M ! :M SetGValue: ( g -- ) SetGValue: Color ;M ! :M SetBValue: ( b -- ) SetBValue: Color ;M ! :M SetRGB: ( r g b -- ) SetRGB: Color ;M ! :M SetColor: ( colorref -- ) SetColor: Color ;M ! :M SetSysColor: ( n -- ) SetSysColor: Color ;M ! :M ChooseColor: ( hWnd -- f ) Choose: Color ;M ! :M GetRValue: ( -- r ) GetRValue: Color ;M ! :M GetGValue: ( -- g ) GetGValue: Color ;M ! :M GetBValue: ( -- b ) GetBValue: Color ;M ! :M GetColor: ( -- colorref ) GetColor: Color ;M :M Create: ( -- f ) GetColor: color call CreateSolidBrush SetHandle: super Valid?: super ;M --- 59,108 ---- ;M ! :M SetRValue: ( r -- ) ! \ *G Set the red component of the brush color. ! SetRValue: Color ;M ! :M SetGValue: ( g -- ) ! \ *G Set the green component of the brush color. ! SetGValue: Color ;M ! ! :M SetBValue: ( b -- ) ! \ *G Set the blue component of the brush color. ! SetBValue: Color ;M ! ! :M SetRGB: ( r g b -- ) ! \ *G Set the red, green and blue component of the brush color. ! SetRGB: Color ;M ! ! :M SetColor: ( colorref -- ) ! \ *G Set color of the brush. ! SetColor: Color ;M ! ! :M SetSysColor: ( n -- ) ! \ *G Set the color of the brush to a system color. ! SetSysColor: Color ;M ! ! :M ChooseColor: ( hWnd -- f ) ! \ *G Open a dialog to choose the color of the brush. ! Choose: Color ;M ! ! :M GetRValue: ( -- r ) ! \ *G Get the red component of the brush color. ! GetRValue: Color ;M ! ! :M GetGValue: ( -- g ) ! \ *G Get the green component of the brush color. ! GetGValue: Color ;M ! ! :M GetBValue: ( -- b ) ! \ *G Get the blue component of the brush color. ! GetBValue: Color ;M ! ! :M GetColor: ( -- colorref ) ! \ *G Get the color of the brush as a windows COLORREF value. ! GetColor: Color ;M :M Create: ( -- f ) + \ *G Create the brush with the current color. GetColor: color call CreateSolidBrush SetHandle: super Valid?: super ;M *************** *** 78,84 **** \ ---------------------------------------------------------------------- - \ Hatch brush class \ ---------------------------------------------------------------------- :class gdiHatchBrush <super gdiSolidBrush \ Style of the brush. Possible values are: --- 111,117 ---- \ ---------------------------------------------------------------------- \ ---------------------------------------------------------------------- :class gdiHatchBrush <super gdiSolidBrush + \ *G Hatch brush class \ Style of the brush. Possible values are: *************** *** 96,103 **** ;M ! :M SetStyle: ( style -- ) to style ;M ! :M GetStyle: ( -- style ) style ;M :M Create: ( -- f ) GetColor: color Style call CreateHatchBrush SetHandle: super Valid?: super ;M --- 129,154 ---- ;M ! :M SetStyle: ( style -- ) ! \ *G Set the style of the brush. Possible values are: ! \ *L HS_BDIAGONAL | 45-degree downward left-to-right hatch | ! \ *| HS_CROSS | Horizontal and vertical crosshatch | ! \ *| HS_DIAGCROSS | 45-degree crosshatch | ! \ *| HS_FDIAGONAL | 45-degree upward left-to-right hatch | ! \ *| HS_HORIZONTAL | Horizontal hatch | ! \ *| HS_VERTICAL | Vertical hatch | ! to style ;M ! ! :M GetStyle: ( -- style ) ! \ *G Get the style of the brush. Possible return values are: ! \ *L HS_BDIAGONAL | 45-degree downward left-to-right hatch | ! \ *| HS_CROSS | Horizontal and vertical crosshatch | ! \ *| HS_DIAGCROSS | 45-degree crosshatch | ! \ *| HS_FDIAGONAL | 45-degree upward left-to-right hatch | ! \ *| HS_HORIZONTAL | Horizontal hatch | ! \ *| HS_VERTICAL | Vertical hatch | ! style ;M :M Create: ( -- f ) + \ *G Create the brush with the current style and color. GetColor: color Style call CreateHatchBrush SetHandle: super Valid?: super ;M *************** *** 106,112 **** \ ---------------------------------------------------------------------- - \ Pattern brush class \ ---------------------------------------------------------------------- :class gdiPatternBrush <super gdiBrush \ Bitmap of the brush. --- 157,163 ---- \ ---------------------------------------------------------------------- \ ---------------------------------------------------------------------- :class gdiPatternBrush <super gdiBrush + \ *G Pattern brush class \ Bitmap of the brush. *************** *** 118,123 **** ;M ! :M SetBitmap: ( Bitmap -- ) to Bitmap ;M ! :M GetBitmap: ( -- Bitmap ) Bitmap ;M :M Create: ( -- f ) --- 169,177 ---- ;M ! :M SetBitmap: ( Bitmap -- ) ! to Bitmap ;M ! ! :M GetBitmap: ( -- Bitmap ) ! Bitmap ;M :M Create: ( -- f ) *************** *** 131,134 **** --- 185,189 ---- \ ---------------------------------------------------------------------- :class gdiDIBPatternBrush <super gdiBrush + \ *G DIBPattern brush class :M ClassInit: ( -- ) *************** *** 136,159 **** ;M - \ The Create function creates a logical brush that has the pattern specified - \ by the device-independent bitmap (DIB). - \ - \ lpPackedDIB Pointer to a packed DIB consisting of a BITMAPINFO structure immediately - \ followed by an array of bytes defining the pixels of the bitmap. - \ Windows 95: Creating brushes from bitmaps or DIBs larger than 8 by 8 pixels - \ is not supported. If a larger bitmap is specified, only a portion of the bitmap - \ is used. - \ Windows NT/ 2000 and Windows 98: Brushes can be created from bitmaps or DIBs - \ larger than 8 by 8 pixels. - \ - \ iUsage Specifies whether the bmiColors member of the BITMAPINFO structure contains - \ a valid color table and, if so, whether the entries in this color table contain - \ explicit red, green, blue (RGB) values or palette indexes. The iUsage parameter - \ must be one of the following values. - \ DIB_PAL_COLORS A color table is provided and consists of an array of 16-bit indexes - \ into the logical palette of the device context into which the brush - \ is to be selected. - \ DIB_RGB_COLORS A color table is provided and contains literal RGB values. :M Create: ( lpPackedDIB iUsage -- f ) call CreateDIBPatternBrushPt SetHandle: super Valid?: super ;M --- 191,210 ---- ;M :M Create: ( lpPackedDIB iUsage -- f ) + \ *G The Create function creates a logical brush that has the pattern specified + \ ** by the device-independent bitmap (DIB). \n + \ ** lpPackedDIB Pointer to a packed DIB consisting of a BITMAPINFO structure immediately + \ ** followed by an array of bytes defining the pixels of the bitmap. \n + \ ** Windows 95: Creating brushes from bitmaps or DIBs larger than 8 by 8 pixels + \ ** is not supported. If a larger bitmap is specified, only a portion of the bitmap + \ ** is used. \n + \ ** Windows NT/ 2000 and Windows 98: Brushes can be created from bitmaps or DIBs + \ ** larger than 8 by 8 pixels. \n + \ ** iUsage Specifies whether the bmiColors member of the BITMAPINFO structure contains + \ ** a valid color table and, if so, whether the entries in this color table contain + \ ** explicit red, green, blue (RGB) values or palette indexes. The iUsage parameter + \ ** must be one of the following values. + \ *L DIB_PAL_COLORS | A color table is provided and consists of an array of 16-bit indexes into the logical palette of the device context into which the brush is to be selected. | + \ ** DIB_RGB_COLORS | A color table is provided and contains literal RGB values. | call CreateDIBPatternBrushPt SetHandle: super Valid?: super ;M *************** *** 162,163 **** --- 213,216 ---- module + + \ *Z |
