Thread: [Win32forth-cvs] win32forth/demos ListViewDemo.f,1.6,1.7

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

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

Modified Files:
	ListViewDemo.f 
Log Message:
Rod: Splitter window modified to prevent flicker

Index: ListViewDemo.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/demos/ListViewDemo.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** ListViewDemo.f	3 May 2006 17:34:06 -0000	1.6
--- ListViewDemo.f	4 May 2006 21:47:59 -0000	1.7
***************
*** 1,2 ****
--- 1,3 ----
+ \ Splitter window modified to prevent flicker - May 4th, 2006 Rod
  \ ForthForm generated splitter-window template
  \ Modify according to your needs
***************
*** 59,68 ****
          s" Courier" SetFaceName: vFont
          Create: vFont
          ;M

  :M On_Paint:    ( -- )
          GetSize: Self white Fillarea: dc
          Out$ c@ 0<>
!         if   SaveDC: dc                      \ save device context
               vFont    SelectObject: dc
               ltblue   SetTextColor: dc
--- 60,75 ----
          s" Courier" SetFaceName: vFont
          Create: vFont
+         \ prevent flicker in all child-windows on sizing
+         CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop
          ;M

+ :M On_size: ( -- )   Paint: self ;M
+         \ need to repaint in this child-window as the position of the text depends on its size
+ 
  :M On_Paint:    ( -- )
+         SaveDC: dc                     \ save device context
          GetSize: Self white Fillarea: dc
          Out$ c@ 0<>
!         if
               vFont    SelectObject: dc
               ltblue   SetTextColor: dc
***************
*** 73,78 ****
               lparmLeft 0  (D.) pad +place pad +null
               pad count  Textout: dc
!              RestoreDC: dc
!         then ;M

  :M ShowLeftSelected: ( Z$text Lparm flNew - )
--- 80,86 ----
               lparmLeft 0  (D.) pad +place pad +null
               pad count  Textout: dc
!         then
!         RestoreDC: dc
!         ;M

  :M ShowLeftSelected: ( Z$text Lparm flNew - )
***************
*** 175,178 ****
--- 183,209 ----
  ENDBAR

+ 
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ \ \\\\\ Splitter window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ 
+ :Object Splitter <Super child-window
+ 
+ :M WindowStyle: ( -- style )   \ return the window style
+         WindowStyle: super
+         WS_DISABLED or
+         WS_CLIPSIBLINGS or
+         ;M
+ 
+ :M On_Paint: ( -- )            \ screen redraw method
+         0 0 Width Height LTGRAY FillArea: dc
+         ;M
+ 
+ ;Object
+ 
+ 200 value LeftWidth
+ 5 value thickness
+ 30 value RightTopHeight
+ 
  \ ------------------------------------------------------------------------
  \ Define the the splitter window (this is the main window).
***************
*** 180,261 ****
  :Object SplitterWindow        <Super Window

! 0 value toolbarH    \ set to height of toolbar if any
! 0 value statusbarH  \ set to height of status bar if any
! 0 value clicked
! 0 value wline
! 0 value SeparatorX
! 0 value SeparatorY

! :M WindowStyle:    ( -- style )
!                 WindowStyle: Super WS_CLIPCHILDREN or ;M

! : position-windows ( -- ) \ auto adjust windows
!                 0 toolbarH SeparatorX 1- Height toolbarH - statusbarH - Move: LeftPane
!                 SeparatorX 2 + dup>r toolbarH Width r@ - SeparatorY 1- 25 min toolbarH - Move: RightTopPane
!                 r@ SeparatorY 2 + 25 min Width r> - Height 2 pick - statusbarH - Move: RightBottomPane
!                 self OnPosition ;

! : horizline     ( -- )
!                \ SeparatorX 2+ SeparatorY  MoveTo: dc
!                \ Width SeparatorY LineTo: dc
!                 ;

! : vertline      ( -- )
!                 SeparatorX 0 MoveTo: dc
!                 SeparatorX Height LineTo: dc  ;

! : ?line         ( -- )
!                 wline
!                 if       vertline
!                 else     horizline
!                 then     ;

! : on_clicked    ( -- )
!                 true to clicked
!                 get-dc
!                 R2_NOT SetRop2: dc
!                 black LineColor: dc
!                 mousex SeparatorX = mousex SeparatorX 1+ = or
!                 if      vertline true to wline
!                 else    horizline false to wline
!                 then    hwnd Call SetCapture drop ;

! : On_Mousemove  ( -- )
!                 mousex SeparatorX =
!                 mousex SeparatorX 1+ = or
!                 if      SIZEWE-CURSOR exit
!                 then    mousey Separatory =
!                 mousey Separatory 1+ = or
!                 if      SIZENS-CURSOR
!                 else    arrow-cursor
!                 then    ;

! :M WM_MOUSEMOVE ( h w m l -- res )
!                 WM_MOUSEMOVE WM: super
!                 on_mousemove ;M

! : dosizing      ( -- )
!                 clicked 0= ?exit
!                 ?line
!                 \ a minimum width of 4 pixels for windows are set, but it can be changed
!                 mousex 2 cells < mousex width 2 cells - > or
!                 mousey 2 cells < mousey height 2 cells - > or or
!                 if      position-windows
!                         false to clicked
!                         release-dc
!                         hwnd Call ReleaseCapture ?win-error
!                 else    wline
!                         if      mousex to SeparatorX
!                         else    mousey to SeparatorY
!                         then    ?line
!                 then    ;

! : on_unclicked  ( -- )
!                 clicked 0= ?exit
!                 ?line
!                 position-windows
!                 release-dc
!                 false to clicked
!                 hwnd Call ReleaseCapture ?win-error ;

  :M StartSize:   ( -- w h )
--- 211,286 ----
  :Object SplitterWindow        <Super Window

! 0 value ToolBarHeight    \ set to height of toolbar if any
! 0 value StatusBarHeight  \ set to height of status bar if any

! int dragging?
! int mousedown?

! : LeftHeight ( -- n )   Height StatusBarHeight - ToolBarHeight - ;
! : RightBottomHeight ( -- n )   Height StatusBarHeight - ToolBarHeight - RightTopHeight - ;

! : position-windows ( -- )
!         0  ToolBarHeight  LeftWidth  LeftHeight  Move: LeftPane
!         LeftWidth thickness +  ToolBarHeight  Width LeftWidth thickness + -  RightTopHeight  Move: RightTopPane
!         LeftWidth thickness +  ToolBarHeight RightTopHeight +  Width LeftWidth thickness + -  RightBottomHeight  Move: RightBottomPane
!         LeftWidth  ToolBarHeight  thickness  LeftHeight  Move: Splitter
!         self OnPosition ;

! : InSplitter? ( -- f1 )   \ is cursor on splitter window
!         hWnd get-mouse-xy
!         0 height within
!         swap  LeftWidth dup thickness + within  and ;

! \ mouse click routines for Main Window to track the Splitter movement

! : DoSizing ( -- )
!         mousedown? dragging? or 0= ?EXIT
!         mousex ( 1+ ) width min  thickness 2/ -  to LeftWidth
!         position-windows
!         WINPAUSE ;

! : On_clicked ( -- )
!         mousedown? 0= IF  hWnd Call SetCapture drop  THEN
!         true to mousedown?
!         InSplitter? to dragging?
!         DoSizing ;

! : On_unclicked ( -- )
!         mousedown? IF  Call ReleaseCapture drop  THEN
!         false to mousedown?
!         false to dragging? ;

! : On_DblClick ( -- )
!         false to mousedown?
!         InSplitter? 0= ?EXIT
!         LeftWidth 8 >
!         IF      0 thickness 2/ - to LeftWidth
!         ELSE    132 Width 2/ min to LeftWidth
!         THEN
!         position-windows
!         ;

! :M WM_SETCURSOR ( h m w l -- )
!         hWnd get-mouse-xy
!         ToolBarHeight dup LeftHeight + within
!         swap  0 width within and
!         IF  InSplitter? IF  SIZEWE-CURSOR   ELSE  arrow-cursor  THEN  1
!         ELSE  DefWindowProc: self
!         THEN
!         ;M
! 
! :M Classinit:   ( -- )
!         ClassInit: super   \ init super class
!         TestBar to CurrentMenu
!         ['] On_clicked     SetClickFunc: self
!         ['] On_unclicked   SetUnClickFunc: self
!         ['] DoSizing       SetTrackFunc: self
!         ['] On_DblClick    SetDblClickFunc: self
!         ;M
! 
! :M WindowHasMenu: ( -- f )   true ;M
! 
! :M WindowStyle:    ( -- style )
!                 WindowStyle: Super WS_CLIPCHILDREN or ;M

  :M StartSize:   ( -- w h )
***************
*** 266,273 ****

  :M On_Init:     ( -- )
-                 ['] dosizing to track-func
-                 ['] on_clicked to click-func
-                 ['] on_unclicked to unclick-func
- 
                  395  Setid: LeftPane
                  self Start: LeftPane
--- 291,294 ----
***************
*** 276,286 ****
                  397  Setid: RightBottomPane
                  self Start: RightBottomPane
! 
                  self OnInit    \ perform user function
! 
!                 Startsize: self 2 / to SeparatorY 5 / to SeparatorX
!                 TestBar SetMenuBar:  self
! 
!                 position-windows ;M

  :M On_Done:     ( h m w l -- res )
--- 297,305 ----
                  397  Setid: RightBottomPane
                  self Start: RightBottomPane
!                 self Start: Splitter
                  self OnInit    \ perform user function
!                 \ prevent flicker in window on sizing
!                 CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop
!                 ;M

  :M On_Done:     ( h m w l -- res )

Thread: [Win32forth-cvs] win32forth/demos ListViewDemo.f,1.6,1.7

win32forth-cvs