Menu
▾
▴
win32forth-cvs
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16317 Modified Files: CommandID.f EdImageWindow.f EdTabControl.f EdToolbar.f Main.f ProjectTree.f Added Files: EdFilePane.f FileWindow.frm Log Message: .Added directory window and project toolbar. EAB Index: EdTabControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdTabControl.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** EdTabControl.f 11 Jun 2006 18:04:10 -0000 1.9 --- EdTabControl.f 14 Jun 2006 06:02:56 -0000 1.10 *************** *** 166,169 **** --- 166,171 ---- ;class + fload edfilepane.f + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ an extended TabControl class *************** *** 189,192 **** --- 191,195 ---- ClassBrowserWindow cVocTree + :M WndClassStyle: ( -- style ) \ Set the style member of the the WNDCLASS structure. *************** *** 200,205 **** 4dup Move: cFileList 4dup Move: cProjectTree ! 4dup Move: cClassTree ! Move: cVocTree ;M --- 203,209 ---- 4dup Move: cFileList 4dup Move: cProjectTree ! 4dup Move: cClassTree ! 4dup Move: cVocTree ! Move: TheFolderView ;M *************** *** 213,216 **** --- 217,221 ---- SW_HIDE Show: cVocTree SW_HIDE Show: cClassTree + SW_HIDE Show: TheFolderView ; *************** *** 220,223 **** --- 225,229 ---- SW_HIDE Show: cVocTree SW_HIDE Show: cClassTree + SW_HIDE Show: TheFolderView ; *************** *** 227,230 **** --- 233,237 ---- SW_HIDE Show: cProjectTree SW_HIDE Show: cClassTree + SW_HIDE Show: TheFolderView ; *************** *** 234,237 **** --- 241,253 ---- SW_HIDE Show: cProjectTree SW_HIDE Show: cVocTree + SW_HIDE Show: TheFolderView + ; + + : ShowFolderView ( -- ) + SW_HIDE Show: cClassTree + SW_HIDE Show: cFileList + SW_HIDE Show: cProjectTree + SW_HIDE Show: cVocTree + SW_SHOW Show: TheFolderView ; *************** *** 243,250 **** \ Show the control for the currently selected tab. GetSelectedTab: cTab ! case 0 of ShowFiles endof ! 1 of ShowProject endof ! 2 of ShowVocs endof ! 3 of ShowClasses endof endcase ;M --- 259,267 ---- \ Show the control for the currently selected tab. GetSelectedTab: cTab ! case 0 of ShowFiles endof ! 1 of ShowProject endof ! 2 of ShowFolderView endof ! 3 of ShowVocs endof ! 4 of ShowClasses endof endcase ;M *************** *** 278,281 **** --- 295,299 ---- self Start: cVocTree self Start: cClassTree + self Start: TheFolderView self Start: cTab \ must be started last *************** *** 293,302 **** TCIF_TEXT IsMask: cTab ! z" Vocabularies" IsPszText: cTab 3 InsertTab: cTab TCIF_TEXT IsMask: cTab z" Classes" IsPszText: cTab ! 4 InsertTab: cTab \ ------------------------------------------------------------------------ --- 311,324 ---- TCIF_TEXT IsMask: cTab ! z" Directory" IsPszText: cTab 3 InsertTab: cTab + + TCIF_TEXT IsMask: cTab + z" Vocabularies" IsPszText: cTab + 4 InsertTab: cTab TCIF_TEXT IsMask: cTab z" Classes" IsPszText: cTab ! 5 InsertTab: cTab \ ------------------------------------------------------------------------ Index: EdImageWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdImageWindow.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** EdImageWindow.f 9 Jun 2006 17:03:35 -0000 1.2 --- EdImageWindow.f 14 Jun 2006 06:02:56 -0000 1.3 *************** *** 3,7 **** cr .( Loading Image Viewer...) ! fload apps\forthform\imagewindow.f create imagefiles \ image files that can be viewed --- 3,7 ---- cr .( Loading Image Viewer...) ! needs imagewindow.f create imagefiles \ image files that can be viewed --- NEW FILE: FileWindow.frm --- \ FILEWINDOW.FRM \- textbox needs excontrols.f \- -filelister.f needs filelister.f \ folder browser \ Coordinates and dimensions for imgButton1 9 value imgButton1X 4 value imgButton1Y 24 value imgButton1W 22 value imgButton1H \ Coordinates and dimensions for ImgButton2 43 value ImgButton2X 4 value ImgButton2Y 24 value ImgButton2W 22 value ImgButton2H \ Coordinates and dimensions for ImgButton3 77 value ImgButton3X 4 value ImgButton3Y 24 value ImgButton3W 22 value ImgButton3H \ Coordinates and dimensions for ImgButton4 111 value ImgButton4X 4 value ImgButton4Y 24 value ImgButton4W 22 value ImgButton4H \ Coordinates and dimensions for ImgButton5 145 value ImgButton5X 4 value ImgButton5Y 24 value ImgButton5W 22 value ImgButton5H ComboListBox cmblstPathPicker FileWindow TheDirectory ComboListBox CmbLstFilters :Object frmFileWindow <Super Child-Window Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color :M ClassInit: ( -- ) ClassInit: super +dialoglist \ allow handling of dialog messages 384 to id \ set child id, changeable \ Insert your code here ;M :M Display: ( -- ) \ unhide the child window SW_SHOWNORMAL Show: self ;M :M Hide: ( -- ) \ hide the...aughhh but you know that! SW_HIDE Show: self ;M :M WindowTitle: ( -- ztitle ) z" Select File" ;M :M StartSize: ( -- width height ) 184 449 ;M :M Close: ( -- ) \ Insert your code here Close: super ;M :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont Create: WinFont \ set form color to system color COLOR_BTNFACE Call GetSysColor NewColor: FrmColor self Start: cmblstPathPicker 2 30 180 17 Move: cmblstPathPicker Handle: Winfont SetFont: cmblstPathPicker self Start: TheDirectory 2 50 180 371 Move: TheDirectory self Start: CmbLstFilters 2 423 180 23 Move: CmbLstFilters Handle: Winfont SetFont: CmbLstFilters ;M :M WM_COMMAND ( h m w l -- res ) over LOWORD ( ID ) self \ object address on stack WMCommand-Func ?dup \ must not be zero if execute else 2drop \ drop ID and object address then 0 ;M :M SetCommand: ( cfa -- ) \ set WMCommand function to WMCommand-Func ;M :M On_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc ;M :M On_Done: ( -- ) Delete: WinFont \ Insert your code here On_Done: super ;M ;Object Index: ProjectTree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ProjectTree.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** ProjectTree.f 13 Jun 2006 19:14:50 -0000 1.9 --- ProjectTree.f 14 Jun 2006 06:02:56 -0000 1.10 *************** *** 9,14 **** needs fcases.f - s" apps\ProMgr\res" "fpath+ - true value name-only? true value no-duplicates? --- 9,12 ---- *************** *** 19,23 **** --- 17,24 ---- 0 value ThisList \ temp pointer to list being used 0 value ThisItem \ temp pointer to new item + \ 0 value TheProject + \ 0 value TheStatusBar 0 value TheStatusBar + 0 value dirty? 0 value Modified *************** *** 371,382 **** : .buildfile ( -- ) ! \ mainfile c@ dup ! \ if s" Build file: " ! \ else s" No build file set" ! \ then new$ dup>r place ! \ mainfile count r@ +place ! \ if s" ---- Total files in project= " r@ +place ! \ totalfiles: self (.) r@ +place ! \ then r> dup +null 1+ 1 SetText: TheStatusBar false to dirty? ; --- 372,383 ---- : .buildfile ( -- ) ! mainfile c@ dup ! if s" " ! else s" No build file set" ! then new$ dup>r place ! mainfile count r@ +place ! if s" ---- Total files in project= " r@ +place ! totalfiles: self (.) r@ +place ! then r> count SetText: ProjInfo false to dirty? ; *************** *** 480,491 **** :M On_SelChanged: ( -- f ) lparamNew to SelectedItem itemid: SelectedItem ! if ReleaseBuffer: viewerfile ! FileExt off ! else GetName: SelectedItem zcount pad place ! pad IDM_OPEN_RECENT_FILE DoCommand ! then false ;M :M SelectItem: ( hItem -- ) TVGN_CARET TVM_SELECTITEM SendMessage:SelfDrop ;M --- 481,507 ---- :M On_SelChanged: ( -- f ) + new$ >r lparamNew to SelectedItem itemid: SelectedItem ! \ <<<<<<< ProjectTree.f ! if ! s" Number of files = " r@ place ! #items: SelectedItem (.) r@ +place ! r@ ! FileExt off ! else ! GetName: SelectedItem dup zcount ! 2dup ".ext-only" 2dup lower FileExt place \ set FileExt ! ! GetName: SelectedItem zcount r@ place ! r@ dup IDM_OPEN_RECENT_FILE DoCommand ! ! then ! count Settext: ProjStatus .buildfile ! SetFocus: self \ ProjectManager.htm item lost focus before ! false ! r>drop ! ;M :M SelectItem: ( hItem -- ) TVGN_CARET TVM_SELECTITEM SendMessage:SelfDrop ;M *************** *** 980,988 **** if 2dup addfile ! \ 2dup asciiz 0 SetText: ProjectStatusBar dialog? IF 2dup pad place -2 pad c+! s" .res" pad +place pad count addfile ! \ 2dup asciiz 0 SetText: ProjectStatusBar THEN skip-recurse? --- 996,1004 ---- if 2dup addfile ! 2dup SetText: ProjStatus dialog? IF 2dup pad place -2 pad c+! s" .res" pad +place pad count addfile ! 2dup SetText: ProjStatus THEN skip-recurse? *************** *** 1000,1011 **** reset-results GetBuildFile: TheProject nip 0= ! if SelectAFile c@ ! if 0 GetFile: GetFilesDialog ! SetBuildFile: TheProject ! else 2drop exit ! then then - if Clear: TheProject then GetBuildFile: TheProject ModuleList: TheProject AddItem: TheProject --- 1016,1029 ---- reset-results GetBuildFile: TheProject nip 0= ! if SelectAFile c@ ! if 0 GetFile: GetFilesDialog ! SetBuildFile: TheProject ! else drop exit ! then GetBuildFile: TheProject ModuleList: TheProject ! AddItem: TheProject ! true to Modified then if Clear: TheProject then + s" " SetText: ProjStatus GetBuildFile: TheProject ModuleList: TheProject AddItem: TheProject *************** *** 1014,1027 **** \ clear-status-bar GetBuildFile: TheProject BuildNeededFiles SortParentLists: TheProject - \ #addedfiles Modified or to Modified - \ #addedfiles (.) pad place - \ s" files added " pad +place - \ #linecount (.) pad +place - \ s" total lines search of " pad +place - \ total-size (.) pad +place - \ s" bytes" pad +place - \ pad +NULL - \ pad 1+ 0 SetText: ProjectStatusBar ; IDM_BUILD_PRJ SetCommand --- 1032,1046 ---- \ clear-status-bar GetBuildFile: TheProject BuildNeededFiles + #addedfiles Modified or to Modified + #addedfiles (.) pad place + s" files added " pad +place + #linecount (.) pad +place + s" total lines search of " pad +place + total-size (.) pad +place + s" bytes" pad +place + pad count SetText: ProjStatus + GetBuildFile: TheProject SetBuildFile: TheProject \ update info + SortParentLists: TheProject ; IDM_BUILD_PRJ SetCommand Index: EdToolbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdToolbar.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EdToolbar.f 5 Jun 2006 09:19:00 -0000 1.1 --- EdToolbar.f 14 Jun 2006 06:02:56 -0000 1.2 *************** *** 21,26 **** --- 21,40 ---- anew -ScintillaToolbar.f + TextBox ProjStatus + TextBox ProjInfo + INTERNAL + EXTERNAL + + false value ButtonText? + true value FlatToolBar? + + \ ----------------------------------------------------------------------------------- + \ Main-Toolbar + \ ----------------------------------------------------------------------------------- + + :Object ControlToolbar <super Win32ToolBar + load-bitmap ControlBitmaps "res\toolbar.bmp" *************** *** 101,115 **** ;ToolBarTable - EXTERNAL - - false value ButtonText? - true value FlatToolBar? - - \ ----------------------------------------------------------------------------------- - \ Main-Toolbar - \ ----------------------------------------------------------------------------------- - - :Object ControlToolbar <super Win32ToolBar - int hbitmap 72 constant LargeButtonWidth \ for buttons with text --- 115,118 ---- *************** *** 117,121 **** 24 constant SmallButtonWidth \ a little bigger than Windows default 18 constant SmallButtonHeight ! 30 constant #buttons :M ClassInit: ( -- ) --- 120,124 ---- 24 constant SmallButtonWidth \ a little bigger than Windows default 18 constant SmallButtonHeight ! 17 constant #buttons :M ClassInit: ( -- ) *************** *** 183,186 **** --- 186,264 ---- ;Object + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ \\\\\ The Project Toolbar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + + :Object ptoolbar <Super Win32Toolbar + + load-bitmap ptoolbarBitmap "ToolbarBitmaps.bmp" + + :ToolStrings ptoolbarTooltips + ts," New Project" + ts," Open Project" + ts," Save Project" + ts," Delete item" + ts," Build Project" + ts," Archive project" + ts," Add files" + ts," Copy project files" + ;ToolStrings + + :ToolBarTable ptoolbarTable + \ Bmp ndx ID Initial Style Initial State Tooltip Ndx + \ The default state and style for all buttons are enabled and button style + \ You can modify as desired + 0 IDM_NEW_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 0 ToolBarButton, + 1 IDM_OPEN_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 1 ToolBarButton, + 2 IDM_SAVE_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 2 ToolBarButton, + 3 IDM_DELETE_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 3 ToolBarButton, + 4 IDM_BUILD_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 4 ToolBarButton, + 5 IDM_ZIP_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 5 ToolBarButton, + 6 IDM_ADD_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 6 ToolBarButton, + 7 IDM_COPY_PRJ TBSTATE_ENABLED TBSTYLE_BUTTON 7 ToolBarButton, + ;ToolBarTable + + int hbitmap + + :M ClassInit: ( -- ) + ClassInit: super + 0 to hbitmap + ;M + + :M Start: ( parent -- ) + ptoolbarTable IsButtonTable: self + ptoolbarTooltips IsTooltips: self + + Start: super + + 16 18 word-join 0 TB_SETBITMAPSIZE hwnd call SendMessage drop \ smaller height of toolbar + + ptoolbarbitmap usebitmap + map-3Dcolors \ use system colors for background + GetDc: self dup CreateDIBitmap to hbitmap \ create bitmap handle from memory image + ReleaseDc: self + hbitmap \ do we have a handle? + if 0 hbitmap 8 AddBitmaps: self drop + then + ;M + + :M WindowStyle: ( -- style ) + WindowStyle: super + [ TBSTYLE_TOOLTIPS TBSTYLE_WRAPABLE or nostack1 + CCS_NOPARENTALIGN or CCS_NORESIZE or ] LITERAL or + FlatToolBar? + if TBSTYLE_FLAT or + then + ;M + + :M On_Done: ( -- ) + hbitmap + if hbitmap Call DeleteObject drop + 0 to hbitmap + then On_Done: super + ;M + + ;Object + \ ----------------------------------------------------------------------------------- \ Rebar *************** *** 189,204 **** :Object TheRebar <super RebarControl ! : insert-band ( hWnd fstyle -- ) to fstyle to hWndChild ! [ RBBIM_CHILD RBBIM_CHILDSIZE or RBBIM_STYLE or RBBIM_SIZE or ] LITERAL to bfmask 0 to cxMinChild ! 25 to cyMinChild 25 to cyChild \ band height 200 to cyMaxChild \ max band height 1 to cyIntegral ! 200 to cx \ band width InsertBand: self ; --- 267,285 ---- :Object TheRebar <super RebarControl ! Font TextFont ! ! : insert-band ( hWnd fstyle size -- ) ! to cx to fstyle to hWndChild ! [ RBBIM_CHILD RBBIM_CHILDSIZE or RBBIM_STYLE or RBBIM_SIZE or RBBIM_TEXT or ] LITERAL to bfmask 0 to cxMinChild ! 22 to cyMinChild 25 to cyChild \ band height 200 to cyMaxChild \ max band height 1 to cyIntegral ! \ 450 to cx \ band width InsertBand: self ; *************** *** 209,218 **** eraseband-info GetHandle: ControlToolBar ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal insert-band ; :M Start: ( parent -- ) Start: super ! hwnd if add-toolbars then ;M :M WindowStyle: ( -- style ) --- 290,335 ---- eraseband-info GetHandle: ControlToolBar ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 450 insert-band ! ; ! ! : add-projStat ( -- ) ! self Start: ProjStatus ! true ReadOnly: ProjStatus ! ! eraseband-info GetHandle: ProjStatus ! z" Project Status:" to lptext ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 200 insert-band ! ; ! ! : add-projInfo ( -- ) ! self Start: ProjInfo ! true ReadOnly: ProjInfo ! ! eraseband-info GetHandle: ProjInfo ! z" Build File:" to lptext ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 200 insert-band ! ; ! ! : add-projtoolbar ( -- ) ! self Start: pToolBar ! ! eraseband-info GetHandle: pToolBar ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 200 insert-band ; :M Start: ( parent -- ) + + s" MS Sans Serif" SetFaceName: TextFont + 8 Width: TextFont + Create: TextFont + Start: super ! hwnd ! if add-toolbars ! add-projstat ! add-projtoolbar ! add-projinfo ! Handle: textFont dup SetFont: ProjStatus SetFont: ProjInfo ! then ;M :M WindowStyle: ( -- style ) *************** *** 223,226 **** --- 340,345 ---- :M Close: ( -- ) Close: ControlToolBar + Close: pToolBar + Delete: TextFont Close: super ;M *************** *** 292,294 **** ! |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X