Menu
▾
▴
[Win32forth-cvs] win32forth-stc/demos TreeViewDemo.f, NONE, 1.1 toolbardemo.f, NONE, 1.1 ControlDemo.f, 1.1, 1.2
|
From: George H. <geo...@us...> - 2007-05-08 07:53:54
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7174/win32forth-stc/demos Modified Files: ControlDemo.f Added Files: TreeViewDemo.f toolbardemo.f Log Message: gah:Added more demos and made ControlDemo start on loading --- NEW FILE: toolbardemo.f --- \ $Id: toolbardemo.f,v 1.1 2007/05/08 07:53:50 georgeahubert Exp $ \ Demo from toolbar moved to it's own file \ Define tool strings (short texts that are placed under button bitmap as a part \ of the button) Require toolbar.f Require menu.f :ToolStrings TestButtonStrings ts," Cut" ts," Copy" ts," Paste" ts," Properties" ts," Print" ts," New" ts," Open" ts," Save" ts," Undo" ts," Redo" ts," Delete" ts," Print preview" ts," Find" ts," Replace" ts," Help" ;ToolStrings \ Define tool tips (texts that gives a short description of the buttons function) :ToolStrings TestToolTips ts," Cut Text" ts," Copy Text" ts," Paste Text" ts," Properties" ts," Print File" ts," New File" ts," Open File" ts," Save File" ts," Undo" ts," Redo" ts," Delete" ts," Print preview" ts," Find" ts," Replace" ts," Help" ;ToolStrings \ Define all toolbar buttons in this application. Some will show up by default... :ToolBarTable TestButtonTable \ Bitmap index id Initial state Initial style tool string index STD_CUT 1001 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 0 ToolBarButton, STD_COPY 1002 TBSTATE_CHECKED TBSTATE_ENABLED or TBSTYLE_CHECKGROUP 1 ToolBarButton, SeparatorButton, STD_PASTE 1003 TBSTATE_ENABLED TBSTYLE_BUTTON 2 ToolBarButton, SeparatorButton, STD_PROPERTIES 1004 TBSTATE_ENABLED TBSTYLE_BUTTON 3 ToolBarButton, STD_PRINT 1005 TBSTATE_ENABLED TBSTYLE_BUTTON 4 ToolBarButton, ToolBarTableExtraButtons: \ The following buttons will initialy not be in the tool-bar, but you can \ put them there by customizing it (double click on gray part of the toolbar). STD_FILENEW 1006 TBSTATE_ENABLED TBSTYLE_BUTTON 5 ToolBarButton, STD_FILEOPEN 1007 TBSTATE_ENABLED TBSTYLE_BUTTON 6 ToolBarButton, STD_FILESAVE 1008 TBSTATE_ENABLED TBSTYLE_BUTTON 7 ToolBarButton, STD_UNDO 1009 TBSTATE_ENABLED TBSTYLE_BUTTON 8 ToolBarButton, STD_REDOW 1010 TBSTATE_ENABLED TBSTYLE_BUTTON 9 ToolBarButton, STD_DELETE 1011 TBSTATE_ENABLED TBSTYLE_BUTTON 10 ToolBarButton, STD_PRINTPRE 1012 TBSTATE_ENABLED TBSTYLE_BUTTON 11 ToolBarButton, STD_FIND 1013 TBSTATE_ENABLED TBSTYLE_BUTTON 12 ToolBarButton, STD_REPLACE 1014 TBSTATE_ENABLED TBSTYLE_BUTTON 13 ToolBarButton, STD_HELP 1015 TBSTATE_ENABLED TBSTYLE_BUTTON 14 ToolBarButton, ;ToolBarTable \ Define toolbar for our test application... :Object TestToolBar <super Win32ToolBar :M Start: ( parent -- ) \ Set-up registry key for customization data... z" Software\Win32Forth\Test" \ Registry sub-key z" TestToolBarLayout" \ value key name SetRegistryKey: self \ TestButtonStrings IsButtonStrings: self TestButtonTable IsButtonTable: self TestToolTips IsToolTips: self Start: super HINST_COMMCTRL IDB_STD_SMALL_COLOR 15 AddBitmaps: self drop \ HINST_COMMCTRL IDB_STD_LARGE_COLOR 15 AddBitmaps: self drop ;M :M WindowStyle: ( -- style ) WindowStyle: super CCS_ADJUSTABLE or TBSTYLE_TOOLTIPS or \ TBSTYLE_WRAPABLE or ;M :M On_QueryDelete: ( buttonindex -- f ) 3 <> \ You may not delete Paste-button ;M :M On_QueryInsert: ( buttonindex -- f ) 5 <> \ No insert to the immediate left ;M \ of the Properties-button :M On_CustHelp: ( -- f ) \ Request for customization help z" CustHelp" z" On_Command:" MB_OK MessageBox: self drop true ;M ;Object \ Define our main window :Object MainWindow <super Window int ToolBar :M ClassInit: ( -- ) ClassInit: super NULL to ToolBar ;M :M On_Init: ( -- ) On_Init: super TestToolBar to ToolBar \ Create ToolBar 999 SetId: ToolBar self Start: ToolBar ;M :M WindowTitle: ( -- z" ) z" ToolBar test" ;M :M WindowHasMenu: ( -- f ) true ;M :M WM_NOTIFY ( h m w l -- f ) Handle_Notify: Toolbar ;M :M On_Command: ( hCtrl code id -- f ) GetText: ToolBar z" On_Command:" MB_OK MessageBox: self drop true ;M :M WM_COMMAND ( hwnd msg wparam lparam -- res ) ?dup 0= if LOWORD CurrentMenu if dup DoMenu: CurrentMenu then CurrentPopup if dup DoMenu: CurrentPopup then drop else over HIWORD ( notification code ) rot LOWORD ( ID ) On_Command: [ self ] then 0 ;M :M WM_SIZE ( -- ) WM_SIZE WM: super AutoSize: ToolBar ;M ;Object : Demo ( -- ) start: MainWindow ; Index: ControlDemo.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/demos/ControlDemo.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ControlDemo.f 3 May 2007 08:49:21 -0000 1.1 --- ControlDemo.f 8 May 2007 07:53:50 -0000 1.2 *************** *** 105,106 **** --- 105,108 ---- Start: EditSample ; + demo + --- NEW FILE: TreeViewDemo.f --- \ $Id: TreeViewDemo.f,v 1.1 2007/05/08 07:53:50 georgeahubert Exp $ Require TreeView.f :Class NewTVC <super TreeViewControl Font WinFont :M WindowStyle: ( -- style ) WindowStyle: super TVS_HASLINES or TVS_HASBUTTONS or TVS_DISABLEDRAGDROP or TVS_SHOWSELALWAYS or TVS_LINESATROOT or ;M int hRoot int hSon int hPrev : AddItem ( sztext hAfter hParent nChildren -- ) tvins /tvins erase tvitem /tvitem erase ( nChildren) to cChildren ( hParent) to hParent ( hAfter) to hInsertAfter to pszText TVIF_TEXT TVIF_CHILDREN or to mask tvitem->tvins tvins 0 TVM_INSERTITEMA hWnd Call SendMessage to hPrev ; : FillTreeView ( -- ) z" Root Item" TVI_LAST TVI_ROOT 1 AddItem hPrev to hRoot z" First son" hPrev hRoot 1 AddItem hPrev to hSon z" First Grandson" hPrev hSon 0 AddItem z" Second Grandson" hPrev hSon 0 AddItem z" Second son" hPrev hRoot 0 AddItem z" Third son" hPrev hRoot 1 AddItem hPrev to hSon z" Third Grandson" hPrev hSon 0 AddItem ; :M Start: ( Parent -- ) Start: super 8 Width: WinFont 16 Height: WinFont s" Courier New" SetFaceName: WinFont Create: WinFont true Handle: WinFont WM_SETFONT hWnd CALL SendMessage drop \ activate a new font \ Insert items... FillTreeView ;M :M On_SelChanged: { \ text$ -- f } \ Show text of selected item in message box maxstring LocalAlloc: text$ TVIF_TEXT to mask hItemNew to hItem text$ to pszText maxstring to cchTextMax tvitem 0 TVM_GETITEMA hWnd Call SendMessage drop text$ z" TreeView selection" MB_OK MessageBox: Parent drop false ;M ;Class :Object MainWindow <super Window int TreeView :M On_Init: ( -- ) On_Init: super New> NewTVC to TreeView 1001 SetId: TreeView self Start: TreeView ;M :M WindowTitle: ( -- sztitle ) z" TreeView Test" ;M :M StartSize: ( -- w h ) 100 100 ;M :M On_Size: ( -- ) AutoSize: TreeView ;M :M WM_NOTIFY ( h m w l -- f ) dup @ GetHandle: TreeView = if Handle_Notify: TreeView else false then ;M ;Object Start: MainWindow |
