Menu
▾
▴
[Win32forth-cvs] win32forth/src/lib RebarControl.f,1.2,1.3
|
From: Rod O. <rod...@us...> - 2006-06-06 01:24:34
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv1425/src/lib Modified Files: RebarControl.f Log Message: Rod: Changed to use Control rather than Child-Window, added more methods Index: RebarControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/RebarControl.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** RebarControl.f 1 May 2005 06:27:42 -0000 1.2 --- RebarControl.f 4 Jun 2006 21:13:02 -0000 1.3 *************** *** 1,103 **** ! \ RebarControl.f Rebar Control Object ! WinLibrary COMCTL32.DLL ! :Class RebarControl <Super Child-Window - record: rbinfo - int cbsize - int fmask \ ( RBIM_IMAGELIST ) - int himl \ image list handle if any - ;recordsize: sizeof(rbinfo) ! /* ! record: icexinfo ! int icexsize ! int icexclass ! ;recordsize: sizeof(icexinfo) ! */ ! record: rbbandinfo ! INT binfoSize ! INT bfMask ! INT fStyle int clrFore int clrBack int lpText ! INT cch int iImage int hwndChild ! INT cxMinChild ! INT cyMinChild ! INT cx int hbmBack ! INT wID ! INT cyChild ! INT cyMaxChild ! INT cyIntegral ! INT cxIdeal int lParam ! INT cxHeader ! ;recordsize: sizeof(rbbandinfo) ! create rebar-class z," ReBarWindow32" \ Pre-registered class ! : create-rebar ( -- hWnd ) ! \ Make sure Common Controls are loaded ! ICC_COOL_CLASSES 8 sp@ Call InitCommonControlsEx 3drop ! NULL \ Creation parameter ! appInst \ Instance handle ! ID \ Child id ! Parent conhndl = ! if conhndl ! else GetHandle: Parent \ parent window handle ! then ! 0 0 \ Size h,w ! 0 0 \ Position y,x ! WindowStyle: [ self ] \ Style ! NULL \ Window name ! rebar-class \ Pre-registered class ! WS_EX_TOOLWINDOW \ Extended style ! Call CreateWindowEx ! ; ! : eraseband-info ( -- ) ! rbbandinfo sizeof(rbbandinfo) dup>r erase ! r> to binfosize ; ! :M ClassInit: ( -- ) ! ClassInit: super ! rbinfo sizeof(rbinfo) dup>r erase ! r> to cbsize ! eraseband-info ;M ! :M SetRebarInfo: ( hwndiml mask -- ) ! to fmask to himl ! rbinfo 0 RB_SETBARINFO hwnd Call SendMessage drop ;M ! :M InsertBand: ( -- ) \ band info should have been set ! rbbandinfo -1 RB_INSERTBAND hwnd Call SendMessage drop ! ;M ! :M Start: ( Parent -- ) ! hWnd ! if drop ! SW_SHOWNOACTIVATE Show: self ! else ! to Parent ! create-rebar to hWnd ! 0 0 SetRebarInfo: self ! then ! ;M ! :M WindowStyle: ( -- style ) ! [ WS_CHILD WS_VISIBLE or ] literal ! ;M ;Class \s **************************** Some Information On Rebar Controls ******************************* --- 1,122 ---- ! \ $Id$ ! \ RebarControl.f Rebar Control Class ! \ Changed to use Control rather than Child-Window ! \ Added more methods - Sunday, June 04 2006 21:20:10 Rod ! WinLibrary COMCTL32.DLL ! :Class RebarControl <Super Control ! ! : SendMessage:Self ( lParam wParam message -- result ) hWnd call SendMessage ; ! : SendMessage:SelfDrop ( lParam wParam message -- ) SendMessage:Self drop ; ! ! Record: REBARBBANDINFO ! int binfoSize ! int bfMask ! int fStyle int clrFore int clrBack int lpText ! int cch int iImage int hwndChild ! int cxMinChild ! int cyMinChild ! int cx int hbmBack ! int wID ! int cyChild ! int cyMaxChild ! int cyIntegral ! int cxIdeal int lParam ! int cxHeader ! ;Recordsize: sizeof(REBARBBANDINFO) ! : Eraseband-info ( -- ) ! REBARBBANDINFO sizeof(REBARBBANDINFO) dup>r erase ! r> to binfoSize ; ! :M ClassInit: ( -- ) ! ClassInit: super ! \ Make sure Common Controls are loaded ! ICC_COOL_CLASSES 8 sp@ Call InitCommonControlsEx 3drop ! Eraseband-info ;M ! :M WindowStyle: ( -- style ) [ WS_CHILD WS_VISIBLE or ] literal ;M ! :M ExWindowStyle: ( -- style ) WS_EX_TOOLWINDOW ;M ! :M AutoSize: ( -- ) 0 0 WM_SIZE SendMessage:SelfDrop ;M ! :M DeleteBand: ( uBand -- ) 0 swap RB_DELETEBAND SendMessage:SelfDrop ;M ! :M EndDrag: ( -- ) 0 0 RB_ENDDRAG SendMessage:SelfDrop ;M ! :M GetBarHeight: ( -- h ) 0 0 RB_GETBARHEIGHT SendMessage:SelfDrop ;M ! :M Height: ( -- h ) GetWindowRect: self nip swap - nip ;M ! Record: RBHITTESTINFO ! int x ! int y ! int flags ! int ib ! ;Record ! :M HitTest: ( -- iBand ) ! hWnd get-mouse-XY to y to x ! RBHITTESTINFO 0 RB_HITTEST SendMessage:Self ;M ! ! :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 iBand -- ) RB_MAXIMIZEBAND SendMessage:SelfDrop ;M + :M MinimizeBand: ( iBand -- ) 0 swap RB_MINIMIZEBAND SendMessage:SelfDrop ;M + + :M SetBarInfo: ( himl fmask -- ) 12 sp@ 0 RB_SETBARINFO SendMessage:SelfDrop 3drop ;M + + :M Start: ( Parent -- ) + hWnd + if drop + SW_SHOWNOACTIVATE Show: self + else + to Parent + z" ReBarWindow32" Create-Control + 0 0 SetBarInfo: self + then ;M + (( + \ Not yet used/tested + :M BeginDrag: ( uBand -- ) ( GetHandle: self get-mouse-XY word-join ) -1 swap RB_BEGINDRAG SendMessage:SelfDrop ;M + :M DragMove: ( -- ) -1 0 RB_DRAGMOVE SendMessage:SelfDrop ;M + :M GetBandBorders: ( rect uBand -- ) 0 RB_GETBANDBORDERS SendMessage:SelfDrop ;M + :M GetBandCount: ( -- n ) 0 0 RB_GETBANDCOUNT SendMessage:Self ;M + :M GetBkColor: ( -- clrBk ) 0 0 RB_GETBKCOLOR SendMessage:Self ;M + :M GetPalette: ( -- hpal ) 0 0 RB_GETPALETTE SendMessage:Self ;M + :M GetRect: ( rect uBand -- ) 0 RB_GETRECT SendMessage:SelfDrop ;M + :M GetRowCount: ( -- n ) 0 0 RB_GETROWCOUNT SendMessage:Self ;M + :M GetRowHeight: ( iRow -- height ) 0 swap RB_GETROWHEIGHT SendMessage:Self ;M + :M GetTextColor: ( -- clrText ) 0 0 RB_GETTEXTCOLOR SendMessage:Self ;M + :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 + :M SetParent: ( hwndParent -- ) 0 swap RB_SETPARENT SendMessage:SelfDrop ;M + :M SetTextColor: ( clrText -- ) 0 RB_SETTEXTCOLOR SendMessage:SelfDrop ;M + :M SetToolTips: ( hwndToolTip -- ) 0 swap RB_SETTOOLTIPS SendMessage:SelfDrop ;M + :M ShowBand: ( f i -- ) RB_SHOWBAND SendMessage:SelfDrop ;M + :M SizeToRect: ( rect -- ) 0 RB_SIZETORECT SendMessage:SelfDrop ;M + )) ;Class + \s **************************** Some Information On Rebar Controls ******************************* |
