Thread: [Win32forth-cvs] win32forth/src COLORS.F,1.2,1.3

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24087/src

Modified Files:
	COLORS.F 
Log Message:
- Changed the ColorObject class to use an instance of the gdiCOLORREF class to hold the color.
- Added a Choose: method to the ColorObject class to open the ChooseColor dialog. 
- Marked FOREGROUND and BACKGROUND as deprecated.

Index: COLORS.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/COLORS.F,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** COLORS.F	29 Aug 2005 15:56:27 -0000	1.2
--- COLORS.F	6 Nov 2005 09:14:37 -0000	1.3
***************
*** 4,7 ****
--- 4,8 ----
  cr .( Loading Object Color...)
  
+ needs gdi/gdiStruct.f
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 110,114 ****
  \ local data allocated for each color object that is defined.
  
! int colorref            \ the actual color reference value
  int hbrush              \ the brush handle
  int hpen                \ the pen handle
--- 111,115 ----
  \ local data allocated for each color object that is defined.
  
! gdiCOLORREF colorref    \ the actual color reference value
  int hbrush              \ the brush handle
  int hpen                \ the pen handle
***************
*** 134,144 ****
                          \ and a brush for each color object.
                  UnInitColor: self       \ delete previous pens/brushes
!                 colorref penwidth PenStyle Call CreatePen        to hpen
!                 colorref                   Call CreateSolidBrush to hbrush
                  ;M
  
  :M ClassInit:   ( -- )  \ compile time initialization for each color object
                          \ as it is defined
!                 0 0 0 rgb to colorref
                  0         to hpen
                  0         to hbrush
--- 135,145 ----
                          \ and a brush for each color object.
                  UnInitColor: self       \ delete previous pens/brushes
!                 GetColor: colorref penwidth PenStyle Call CreatePen        to hpen
!                 GetColor: colorref                   Call CreateSolidBrush to hbrush
                  ;M
  
  :M ClassInit:   ( -- )  \ compile time initialization for each color object
                          \ as it is defined
!                 0 0 0 SetRGB: colorref
                  0         to hpen
                  0         to hbrush
***************
*** 155,159 ****
  
  :M Color:       ( -- colorref )                 \ get the colorref value
!                 colorref ;M
  
  :M Pen:         ( -- hpen )                     \ get the color pen handle
--- 156,160 ----
  
  :M Color:       ( -- colorref )                 \ get the colorref value
!                 GetColor: colorref ;M
  
  :M Pen:         ( -- hpen )                     \ get the color pen handle
***************
*** 164,179 ****
  
  :M NewColor:    ( colorref -- ) \ set a color object to a new color ref value
!                 dup colorref <>
!                 if      to colorref
!                           InitColor: [ self ]   \ create the new  pens/brushes
!                 else    drop
!                 then    ;M
  
  :M PenWidth:    ( pen_width -- )                \ set the pen width
                  1 max dup penwidth <>
!                 if      to penwidth
!                           InitColor: [ self ]
!                 else    drop
!                 then    ;M
  
  ;Class
--- 165,190 ----
  
  :M NewColor:    ( colorref -- ) \ set a color object to a new color ref value
!                 dup GetColor: colorref <>
!                 if   SetColor: colorref
!                      InitColor: [ self ]        \ create the new  pens/brushes
!                 else drop
!                 then ;M
! 
! :M Choose:      ( hWnd -- f )                   \ let the user choose a color
!                 Choose: colorref
!                 if   InitColor: [ self ] true   \ create the new  pens/brushes
!                 else false
!                 then ;M
! 
! :M CustomColors: ( -- addr len ) \ return address and length of the user defined
!                                  \ custom colors
!                 CustomColors: colorref ;M
  
  :M PenWidth:    ( pen_width -- )                \ set the pen width
                  1 max dup penwidth <>
!                 if   to penwidth
!                      InitColor: [ self ]
!                 else drop
!                 then ;M
  
  ;Class
***************
*** 198,207 ****
                          \ and a brush for each color object.
                  UnInitColor: self       \ delete previous pens/brushes
!                 colorref to lbColor     \ same as colorref
                  lpStyle                 \ if not NULL
                  StyleCount
                  &LOGBRUSH
!                 penwidth PenStyle Call ExtCreatePen     to hpen
!                 colorref          Call CreateSolidBrush to hbrush
                  ;M
  
--- 209,218 ----
                          \ and a brush for each color object.
                  UnInitColor: self       \ delete previous pens/brushes
!                 GetColor: colorref to lbColor \ same as colorref
                  lpStyle                 \ if not NULL
                  StyleCount
                  &LOGBRUSH
!                 penwidth PenStyle  Call ExtCreatePen     to hpen
!                 GetColor: colorref Call CreateSolidBrush to hbrush
                  ;M
  
***************
*** 212,216 ****
                  \ init the LOGBRUSH structure to some defaults
                  BS_SOLID  to lbStyle
!                 colorref  to lbColor
                  NULL      to lbHatch
                  \ init remaining parameters to defaults
--- 223,227 ----
                  \ init the LOGBRUSH structure to some defaults
                  BS_SOLID  to lbStyle
!                 GetColor: colorref  to lbColor
                  NULL      to lbHatch
                  \ init remaining parameters to defaults
***************
*** 258,262 ****
  128 128   0  palettergb new-color YELLOW
  255 255   0  palettergb new-color LTYELLOW
! 204   0 204  palettergb new-color DKMAGENTA  \ JaP   
  128   0 128  palettergb new-color MAGENTA
  255   0 255  palettergb new-color LTMAGENTA
--- 269,273 ----
  128 128   0  palettergb new-color YELLOW
  255 255   0  palettergb new-color LTYELLOW
! 204   0 204  palettergb new-color DKMAGENTA  \ JaP
  128   0 128  palettergb new-color MAGENTA
  255   0 255  palettergb new-color LTMAGENTA
***************
*** 266,298 ****
  128  64   0  palettergb new-color BROWN
  
- \ Note: FOREGROUND and BACKGROUND doesn't work for the console window.
- \ The only way to set the foreground and/or background color for the console
- \ window is using the word FGBG! like this:
- \
- \          Color: red BG@ FGBG!  \ set red foreground color
- \          FG@ Color: blue FGBG! \ set blue background color
- \
- \ To work with the console window FOREGROUND and BACKGROUND should be
- \ replaced with:
- \
- \ : FG!    { color_object -- }
- \          color_object ?ColorCheck drop
- \          Color: color_object BG@ FGBG! ;
- \
- \ : BG!    { color_object -- }
- \          color_object ?ColorCheck drop
- \          FG@ Color: color_object FGBG! ;
  
! : foreground    { color_object \ theDC -- } \ set foreground text color
!                 color_object ?ColorCheck drop
!                 conHndl call GetDC to theDC  \ get and save the Device Control #
!                 Color: color_object theDC Call SetTextColor drop
!                 theDC conHndl call ReleaseDC drop ;
  
! : background    { color_object \ theDC -- } \ set background text color
!                 color_object ?ColorCheck drop
!                 conHndl call GetDC to theDC  \ get and save the Device Control #
!                 Color: color_object theDC Call SetBkColor drop
!                 theDC conHndl call ReleaseDC drop ;
  
  
--- 277,292 ----
  128  64   0  palettergb new-color BROWN
  
  
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! \ Set console text color
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
! : FOREGROUND    { color_object \ theDC -- } \ set foreground text color
!         color_object ?ColorCheck drop
!         Color: color_object BG@ FGBG! ; DEPRECATED
! 
! : BACKGROUND    { color_object \ theDC -- } \ set background text color
!         color_object ?ColorCheck drop
!         FG@ Color: color_object FGBG! ; DEPRECATED
  
  
***************
*** 307,319 ****
  :M InitColor:   ( -- )                  \ define color as a hatched color
                  UnInitColor: self       \ delete previous pens/brushes
!                 colorref penwidth PS_SOLID Call CreatePen        to hpen
!                 colorref HS_DIAGCROSS      Call CreateHatchBrush to hbrush
                  ;M
  
  ;Class
- 
- \ : new-hatch-color ( colorref -<name>- ) \ make a hatched color
- \                 HatchColorObject                \ define a new object
- \                 NewColor: NewObject ;           \ and initialize it
- 
- 
--- 301,307 ----
  :M InitColor:   ( -- )                  \ define color as a hatched color
                  UnInitColor: self       \ delete previous pens/brushes
!                 GetColor: colorref penwidth PS_SOLID Call CreatePen        to hpen
!                 GetColor: colorref HS_DIAGCROSS      Call CreateHatchBrush to hbrush
                  ;M
  
  ;Class

Thread: [Win32forth-cvs] win32forth/src COLORS.F,1.2,1.3

win32forth-cvs