Thread: [Win32forth-cvs] win32forth/src/lib RebarControl.f, 1.6, 1.7 bitmap.f, 1.6, 1.7 toolbar.f, 1.6, 1.7

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

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9785/src/lib

Modified Files:
	RebarControl.f bitmap.f toolbar.f 
Log Message:
ForthForm updates. EAB

Index: toolbar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/toolbar.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** toolbar.f	23 Nov 2006 18:52:32 -0000	1.6
--- toolbar.f	27 Dec 2006 18:30:18 -0000	1.7
***************
*** 420,424 ****

  :M AddButtons:  ( 'button_table noButtons -- n )
!                 swap swap TB_ADDBUTTONS  hwnd Call SendMessage
                  ;M

--- 420,424 ----

  :M AddButtons:  ( 'button_table noButtons -- n )
!                 TB_ADDBUTTONS  hwnd Call SendMessage
                  ;M

Index: bitmap.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/bitmap.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** bitmap.f	13 Oct 2006 03:50:29 -0000	1.6
--- bitmap.f	27 Dec 2006 18:30:18 -0000	1.7
***************
*** 212,216 ****
  \ a bitmap in any window

! :Class BitmapObject     <super Object

  int &bitmap
--- 212,216 ----
  \ a bitmap in any window

! :Class BitmapObject     <super Child-Window

  int &bitmap
***************
*** 218,221 ****
--- 218,230 ----
  int xpos
  int ypos
+ WinDC bitmap-dc
+ 
+ int sprite-bitmap
+ 
+ int SpriteWidth
+ int SpriteHeight
+ int OffsetY
+ 
+ int  ParentDC

  :M SetXY:       ( x y -- )
***************
*** 227,230 ****
--- 236,243 ----
                  WHITE to BackGroundColor
                  0 0 SetXY: self
+ 		0 to OffsetY
+ 		16 to SpriteWidth
+ 		15 to SpriteHeight
+ 		0 to parentdc
                  ;M

***************
*** 307,310 ****
--- 320,451 ----
                 to BackGroundColor ;M

+ \ The following adapted from Mike Kemper's bitmap routines
+ 
+ :M Start: 	{ \ hdcMem hbm --  }
+                 &bitmap 0= abort" Bitmap not yet set!"   \ continue only if object has a bitmap
+                 &bitmap to currentbitmap
+ 		GetDC: self  PutHandle: dc
+ 		0 call CreateCompatibleDC PutHandle: bitmap-dc
+ 
+          dib.width dib.height CreateCompatibleBitmap: dc to sprite-bitmap
+          sprite-bitmap SelectObject: bitmap-dc
+          GetHandle: dc  ReleaseDC: self
+ 
+          GetHandle: bitmap-dc                   \ device context
+          CreateDIBitmap to hbm
+ 
+          GetHandle: bitmap-dc  call CreateCompatibleDC to hdcMem
+          hbm hdcMem call SelectObject drop
+ 
+ 
+          SRCCOPY 0 0
+          hdcMem
+          dib.height                            \ image height
+          dib.width                             \ image width
+          0 0 GetHandle: bitmap-dc
+          call BitBlt ?WinError
+          hdcMem call DeleteDC ?WinError
+          hbm call DeleteObject ?WinError
+       ;M
+ 
+ :M SetParentDC: ( dc --  )
+       to ParentDC ;M
+ 
+ :M GetParentDC: (  -- dc )
+       ParentDC ;M
+ 
+ :M GetWinDC: (  -- dc )
+       GetHandle: bitmap-dc ;M
+ 
+ :M SetSpriteSize: ( width height --  )
+       to SpriteHeight  to SpriteWidth ;M
+ 
+ :M GetSpriteSize: (  -- width height )
+       SpriteWidth SpriteHeight ;M
+ 
+ :M SetOffsetY: ( y --  )
+       to OffsetY ;M
+ 
+ :M GetOffsetY: (  -- y )
+       OffsetY ;M
+ 
+ \ -------------------------------------------------------------------------
+ \ ----- Draw a sized image at x, y within the parent's DC
+ \ -------------------------------------------------------------------------
+ :M PutImage: { sprite# x y --  }
+       SRCCOPY                                \ direct copy
+       OffsetY sprite# SpriteWidth *          \ source y x
+       GetHandle: bitmap-dc                   \ source DC
+       SpriteHeight SpriteWidth y x           \ height width y x
+       ParentDC                               \ dest DC
+       call BitBlt drop ;M                    \ draw it
+ 
+    \ -------------------------------------------------------------------------
+    \ ----- Copy a sized image from a parent's DC at x, y to our bitmap image
+    \ -------------------------------------------------------------------------
+    :M GetImage: { sprite# x y --  }
+       SRCCOPY                                \ direct copy
+       y x                                    \ source y x
+       ParentDC                               \ source DC
+       SpriteHeight SpriteWidth               \ height width
+       OffsetY sprite# SpriteWidth *          \ dest y x
+       GetHandle: bitmap-dc                   \ dest DC
+       call BitBlt drop ;M                    \ copy it
+ 
+    \ -------------------------------------------------------------------------
+    \ ----- Logically AND's a sized image with the parent's DC at x, y
+    \ -------------------------------------------------------------------------
+    :M AndBlit: { sprite# x y  --  }
+       SRCAND
+       OffsetY sprite# SpriteWidth *
+       GetHandle: bitmap-dc
+       SpriteHeight SpriteWidth
+       y x
+       ParentDC
+       call BitBlt drop ;M
+ 
+    \ -------------------------------------------------------------------------
+    \ ----- Logically OR's a sized image with the parent's DC at x, y
+    \ -------------------------------------------------------------------------
+    :M OrBlit: { sprite# x y --  }
+       SRCPAINT
+       OffsetY sprite# SpriteWidth *
+       GetHandle: bitmap-dc
+       SpriteHeight SpriteWidth
+       y x
+       ParentDC
+       call BitBlt drop ;M
+ 
+    \ -------------------------------------------------------------------------
+    \ ----- Draw a sized, masked image at x, y within the parent's DC
+    \ -------------------------------------------------------------------------
+    :M PutImageMasked: { sprite# x y --  }
+       sprite# y x AndBlit: self
+       sprite# y x OrBlit: self ;M
+ 
+    \ -------------------------------------------------------------------------
+    \ ----- Draws the entire bitmap on the parent's DC at x, y
+    \ -------------------------------------------------------------------------
+    :M PutBMP: { x y --  }
+       &bitmap to currentbitmap	\ in case it was changed
+       SRCCOPY
+       0 0
+       GetHandle: bitmap-dc
+       dib.height dib.Width
+       y x
+       ParentDC
+       call BitBlt drop ;M
+ 
+    :M Close: (  --  )
+       GetHandle: bitmap-dc ?dup
+       if Call DeleteDC ?WinError
+          0 PutHandle: bitmap-dc
+       then
+       sprite-bitmap ?dup
+       if sprite-bitmap call DeleteObject drop
+          0 to sprite-bitmap
+       then 0 to &bitmap
+       Close: super ;M
+ 
  ;Class

Index: RebarControl.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/RebarControl.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** RebarControl.f	11 Jun 2006 09:03:50 -0000	1.6
--- RebarControl.f	27 Dec 2006 18:30:17 -0000	1.7
***************
*** 12,16 ****
  :Class RebarControl   <Super Control

! Record: REBARBBANDINFO
      int     binfoSize
      int     bfMask
--- 12,16 ----
  :Class RebarControl   <Super Control

! Record: REBARBANDINFO
      int     binfoSize
      int     bfMask
***************
*** 33,40 ****
      int     lParam
      int     cxHeader
! ;Recordsize: sizeof(REBARBBANDINFO)

  : Eraseband-info ( -- )
!         REBARBBANDINFO sizeof(REBARBBANDINFO) dup>r erase
          r> to binfoSize ;

--- 33,40 ----
      int     lParam
      int     cxHeader
! ;Recordsize: sizeof(REBARBANDINFO)

  : Eraseband-info ( -- )
!         REBARBANDINFO sizeof(REBARBANDINFO) dup>r erase
          r> to binfoSize ;

***************
*** 70,77 ****
  :M IdToIndex: ( uBandID -- uBand )   0 swap RB_IDTOINDEX SendMessage:Self ;M

! :M InsertBandAt: ( uBand -- )   REBARBBANDINFO swap RB_INSERTBAND SendMessage:SelfDrop ;M

  :M InsertBand: ( -- )   -1 InsertBandAt: self ;M   \ band info should have been set
!         
  :M MaximizeBand: ( fIdeal uBand -- )   RB_MAXIMIZEBAND SendMessage:SelfDrop ;M

--- 70,77 ----
  :M IdToIndex: ( uBandID -- uBand )   0 swap RB_IDTOINDEX SendMessage:Self ;M

! :M InsertBandAt: ( uBand -- )   REBARBANDINFO swap RB_INSERTBAND SendMessage:SelfDrop ;M

  :M InsertBand: ( -- )   -1 InsertBandAt: self ;M   \ band info should have been set
! 
  :M MaximizeBand: ( fIdeal uBand -- )   RB_MAXIMIZEBAND SendMessage:SelfDrop ;M

***************
*** 90,94 ****
              \ Make sure Common Controls are loaded
              ICC_COOL_CLASSES 8 sp@ Call InitCommonControlsEx 3drop
!             z" ReBarWindow32" Create-Control 
              0 0 SetBarInfo: self
          then ;M
--- 90,94 ----
              \ Make sure Common Controls are loaded
              ICC_COOL_CLASSES 8 sp@ Call InitCommonControlsEx 3drop
!             z" ReBarWindow32" Create-Control
              0 0 SetBarInfo: self
          then ;M
***************
*** 116,120 ****
  :M GetToolTips: ( -- hwndToolTip )   0 0 RB_GETTOOLTIPS SendMessage:Self ;M
  :M MoveBand: ( iTo iFrom -- )    RB_MOVEBAND SendMessage:SelfDrop ;M
! :M SetBandInfo: ( uBand -- )   REBARBBANDINFO swap RB_SETBANDINFO SendMessage:SelfDrop ;M
  :M SetBkColor: ( clrBk -- )   0 swap RB_SETBKCOLOR SendMessage:SelfDrop ;M
  :M SetPalette: ( hpal -- )   0 swap RB_SETPALETTE SendMessage:SelfDrop ;M
--- 116,120 ----
  :M GetToolTips: ( -- hwndToolTip )   0 0 RB_GETTOOLTIPS SendMessage:Self ;M
  :M MoveBand: ( iTo iFrom -- )    RB_MOVEBAND SendMessage:SelfDrop ;M
! :M SetBandInfo: ( uBand -- )   REBARBANDINFO swap RB_SETBANDINFO SendMessage:SelfDrop ;M
  :M SetBkColor: ( clrBk -- )   0 swap RB_SETBKCOLOR SendMessage:SelfDrop ;M
  :M SetPalette: ( hpal -- )   0 swap RB_SETPALETTE SendMessage:SelfDrop ;M
***************
*** 781,783 ****

  The rebar control sends notification messages to the window you specify with this message.
! This message does not actually change the parent of the rebar control.

Thread: [Win32forth-cvs] win32forth/src/lib RebarControl.f, 1.6, 1.7 bitmap.f, 1.6, 1.7 toolbar.f, 1.6, 1.7

win32forth-cvs