Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28249/apps/Player4 Modified Files: MCIWnd.f MciInterface.f Mediatree.f PLAYER4.F PLAYER4.frm Pl_MciWindow.f PopupWindow.f Added Files: CommandID.f Commands.f Log Message: Started rewriting the command handling within Player4th (work in progress). --- NEW FILE: CommandID.f --- \ $Id: CommandID.f,v 1.1 2006/05/16 17:41:26 dbu_de Exp $ \ File: CommandID.f \ \ Author: Dirk Busch (dbu) \ Email: dir...@wi... \ cr .( Loading Menu Command ID's...) : NewID ( <name> -- ) defined IF drop ELSE count "header NextId DOCON , , THEN ; IdCounter constant IDM_FIRST \ File menu NewID IDM_OPEN_FILE NewID IDM_OPEN_FOLDER NewID IDM_OPEN_PLAYLIST NewID IDM_QUIT \ Catalog menu NewID IDM_ADD_FILES NewID IDM_IMPORT_FOLDER NewID IDM_START/RESUME \ Options menu NewID IDM_VIEW_50 NewID IDM_VIEW_100 NewID IDM_VIEW_200 NewID IDM_VIEW_FULLSCREEN NewID IDM_AUDIO_ON NewID IDM_AUDIO_OFF IdCounter constant IDM_LAST : allot-erase ( n -- ) here over allot swap erase ; Create CommandTable IDM_LAST IDM_FIRST - cells allot-erase : IsCommand? ( ID -- f ) IDM_FIRST IDM_LAST within ; : >CommandTable ( ID -- addr ) dup IsCommand? if IDM_FIRST - cells CommandTable + else drop abort" error - command ID out of range" then ; : DoCommand ( ID -- ) >CommandTable @ ?dup IF execute THEN ; : SetCommand ( ID -- ) last @ name> swap >CommandTable ! ; Index: PLAYER4.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.frm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 Binary files /tmp/cvsMPaAWH and /tmp/cvszWCNI9 differ Index: MciInterface.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/MciInterface.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** MciInterface.f 15 May 2005 17:21:52 -0000 1.5 --- MciInterface.f 16 May 2006 17:41:26 -0000 1.6 *************** *** 125,132 **** 0= if drop 0 then ; ! : GetLength ( -- ) \ get video length s" length" GetStatus to Length ; ! :M GetLength: ( -- n ) \ get video length Length ;M --- 125,132 ---- 0= if drop 0 then ; ! : GetLength ( -- ) \ get video length s" length" GetStatus to Length ; ! :M GetLength: ( -- n ) \ get video length Length ;M *************** *** 160,164 **** : (open) ( f -- ) to Video? ! SendCommandBuf GetHeightAndWidth s" ms" SetTimeFormat: self ; --- 160,164 ---- : (open) ( f -- ) to Video? ! SendCommandBuf GetHeightAndWidth s" ms" SetTimeFormat: self ; *************** *** 180,191 **** :M PlayAudioCD: ( -- ) \ doesn't work on my system (dbu) false to Video? ! s" open cdaudio" PlaceCommand ! SendCommandBuf ! s" set cdaudio time format tmsf" PlaceCommand ! SendCommandBuf s" play cdaudio from 1" PlaceCommand ! SendCommandBuf \ s" close cdaudio" PlaceCommand ! \ SendCommandBuf ;M --- 180,191 ---- :M PlayAudioCD: ( -- ) \ doesn't work on my system (dbu) false to Video? ! s" open cdaudio" PlaceCommand ! SendCommandBuf ! s" set cdaudio time format tmsf" PlaceCommand ! SendCommandBuf s" play cdaudio from 1" PlaceCommand ! SendCommandBuf \ s" close cdaudio" PlaceCommand ! \ SendCommandBuf ;M *************** *** 228,232 **** if fullscreen? if PlayFullScreen: self ! else PlayWindow: self then else PlayAudio: self --- 228,232 ---- if fullscreen? if PlayFullScreen: self ! else PlayWindow: self then else PlayAudio: self *************** *** 241,245 **** SendCommandBuf ;M ! :M Close: ( -- ) \ close video s" close " PlaceCommand +PlaceDeviceID SendCommandBuf ;M --- 241,245 ---- SendCommandBuf ;M ! :M Close: ( -- ) \ close video s" close " PlaceCommand +PlaceDeviceID SendCommandBuf ;M *************** *** 306,310 **** :M On_Init: ( -- ) \ initialize the class ! On_Init: super GetHandle: self SetHandle: MCI --- 306,310 ---- :M On_Init: ( -- ) \ initialize the class ! On_Init: super GetHandle: self SetHandle: MCI *************** *** 334,338 **** :M GetLength: ( -- n ) GetLength: MCI ;M ! :M GetPosition: ( -- n ) GetPosition: MCI ;M --- 334,338 ---- :M GetLength: ( -- n ) GetLength: MCI ;M ! :M GetPosition: ( -- n ) GetPosition: MCI ;M *************** *** 340,350 **** :M AudioOn: ( -- ) AudioOn: MCI ;M ! :M AudioOff: ( -- ) AudioOff: MCI ;M ! :M VideoOn: ( -- ) VideoOn: MCI ;M ! :M VideoOff: ( -- ) VideoOff: MCI ;M --- 340,350 ---- :M AudioOn: ( -- ) AudioOn: MCI ;M ! :M AudioOff: ( -- ) AudioOff: MCI ;M ! :M VideoOn: ( -- ) VideoOn: MCI ;M ! :M VideoOff: ( -- ) VideoOff: MCI ;M *************** *** 392,402 **** VideoSize 0= if MinSize: super ! else CalcSize 32 + \ should calc menu and window title height here... then ;M :M On_Size: ( h m w -- ) \ handle resize message ! On_Size: super ! Video?: self if (SetVideoSize) then ;M :M OpenVideo: ( addr len -- ) --- 392,402 ---- VideoSize 0= if MinSize: super ! else CalcSize 32 + \ should calc menu and window title height here... then ;M :M On_Size: ( h m w -- ) \ handle resize message ! On_Size: super ! Video?: self if (SetVideoSize) then ;M :M OpenVideo: ( addr len -- ) *************** *** 424,427 **** --- 424,428 ---- \ MciWindow - class \ --------------------------------------------------------------- + (( :class MciWindow <super window *************** *** 434,438 **** :M On_Init: ( -- ) \ initialize the class ! On_Init: super new> MciChildWindow to MCI --- 435,439 ---- :M On_Init: ( -- ) \ initialize the class ! On_Init: super new> MciChildWindow to MCI *************** *** 461,465 **** :M GetLength: ( -- n ) GetLength: MCI ;M ! :M GetPosition: ( -- n ) GetPosition: MCI ;M --- 462,466 ---- :M GetLength: ( -- n ) GetLength: MCI ;M ! :M GetPosition: ( -- n ) GetPosition: MCI ;M *************** *** 467,477 **** :M AudioOn: ( -- ) AudioOn: MCI ;M ! :M AudioOff: ( -- ) AudioOff: MCI ;M ! :M VideoOn: ( -- ) VideoOn: MCI ;M ! :M VideoOff: ( -- ) VideoOff: MCI ;M --- 468,478 ---- :M AudioOn: ( -- ) AudioOn: MCI ;M ! :M AudioOff: ( -- ) AudioOff: MCI ;M ! :M VideoOn: ( -- ) VideoOn: MCI ;M ! :M VideoOff: ( -- ) VideoOff: MCI ;M *************** *** 493,498 **** :M On_Size: ( h m w -- ) \ handle resize message ! On_Size: super ! On_Size: MCI ;M :M OpenVideo: ( addr len -- ) --- 494,499 ---- :M On_Size: ( h m w -- ) \ handle resize message ! On_Size: super ! On_Size: MCI ;M :M OpenVideo: ( addr len -- ) *************** *** 514,518 **** ;class module - |
|
From: Rod O. <rod...@us...> - 2006-05-15 19:34:03
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv613/apps/SciEdit Modified Files: EdStatusbar.f Log Message: Rod: Added WindowStyle: instead of WS_BORDER -Style: Index: EdStatusbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdStatusbar.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** EdStatusbar.f 14 May 2006 11:13:02 -0000 1.5 --- EdStatusbar.f 15 May 2006 19:33:41 -0000 1.6 *************** *** 38,44 **** Start: super SetMulti: self - WS_BORDER -Style: self Redraw: self ;M :M Clear: ( -- ) z" " EdPart SetText: self --- 38,45 ---- Start: super SetMulti: self ;M + :M WindowStyle: ( -- style) WS_CHILD WS_VISIBLE or ;M + :M Clear: ( -- ) z" " EdPart SetText: self |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-14 20:21:27
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7200/apps/Player4 Modified Files: PLAYER4.F Log Message: Jos: Minimized the execution vectors. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.49 retrieving revision 1.50 diff -C2 -d -r1.49 -r1.50 *** PLAYER4.F 14 May 2006 13:56:11 -0000 1.49 --- PLAYER4.F 14 May 2006 20:21:25 -0000 1.50 *************** *** 20,24 **** decimal - true value turnkey? true value MciDebug? --- 20,23 ---- *************** *** 26,46 **** defer PLAYER ' noop is PLAYER defer RefreshCatalog ' noop is RefreshCatalog - defer RandomizeCatalog ' noop is RandomizeCatalog defer SortCatalog ' noop is SortCatalog - defer SearchCatalog ' noop is SearchCatalog - defer DeleteItem ' noop is DeleteItem - defer DeleteCollection ' noop is DeleteCollection - defer Undelete ' noop is Undelete - defer UndeleteAll ' noop is UndeleteAll - defer ShowDeleted ' noop is ShowDeleted - defer SetRandomLevel ' noop is SetRandomLevel - defer SortRandom ' noop is SortRandom - defer SortLeastPlayed ' noop is SortLeastPlayed - defer SortSize ' noop is SortSize - defer RefreshWindow ' noop is SortSize defer PlaySelectedFromTreeView ' noop is PlaySelectedFromTreeView defer RequestRecord ' noop is RequestRecord ! defer MenuChecks ! defer KeyHandler --- 25,33 ---- defer PLAYER ' noop is PLAYER defer RefreshCatalog ' noop is RefreshCatalog defer SortCatalog ' noop is SortCatalog defer PlaySelectedFromTreeView ' noop is PlaySelectedFromTreeView defer RequestRecord ' noop is RequestRecord ! defer MenuChecks ' noop is MenuChecks ! defer KeyHandler ' noop is KeyHandler *************** *** 342,369 **** \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- ! :noname ( -- ) \ search the catalog catalog-exist? if player-base ask-max-random-level ! then ; is SetRandomLevel ! :noname ( -- ) \ sort catalog by random catalog-exist? if randomize-catalog RefreshCatalog ! then ; is RandomizeCatalog ! :noname ( -- ) \ search the catalog catalog-exist? if sort_by_RandomLevel RefreshCatalog ! then ; is SortRandom ! :noname ( -- ) \ search the catalog catalog-exist? if sort_by_leastPlayed RefreshCatalog ! then ; is SortLeastPlayed ! :noname ( -- ) \ search the catalog catalog-exist? if sort_by_size RefreshCatalog ! then ; is SortSize :noname ( -- ) \ sort catalog by file names --- 329,356 ---- \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- ! : SetRandomLevel ( -- ) \ search the catalog catalog-exist? if player-base ask-max-random-level ! then ; ! : RandomizeCatalog ( -- ) \ sort catalog by random catalog-exist? if randomize-catalog RefreshCatalog ! then ; ! : SortRandom ( -- ) \ search the catalog catalog-exist? if sort_by_RandomLevel RefreshCatalog ! then ; ! : SortLeastPlayed ( -- ) \ search the catalog catalog-exist? if sort_by_leastPlayed RefreshCatalog ! then ; ! : SortSize ( -- ) \ search the catalog catalog-exist? if sort_by_size RefreshCatalog ! then ; :noname ( -- ) \ sort catalog by file names *************** *** 372,384 **** then ; is SortCatalog ! :noname ( -- ) \ search the catalog catalog-exist? ! if player-base search-records ! then ; is SearchCatalog ! ! \ :noname ( -- ) \ search the catalog ! \ catalog-exist? ! \ if player-base ask-max-random-level ! \ then ; is SetRandomLevel :noname ( -- ) --- 359,366 ---- then ; is SortCatalog ! : SearchCatalog ( -- ) \ search the catalog catalog-exist? ! if 0 to last-selected-rec player-base search-records ! then ; :noname ( -- ) *************** *** 387,425 **** then ; is RefreshCatalog ! :noname ( -- ) true to show-deleted Refresh: Catalog false to show-deleted ! ; is ShowDeleted : valid-record? ( - flag ) catalog-exist? last-selected-rec -1 <> and ; ! :noname ( -- ) valid-record? if last-selected-rec delete-record RefreshCatalog -1 to last-selected-rec ! then ; is DeleteItem ! :noname ( -- ) catalog-exist? if delete-collection RefreshCatalog -1 to last-selected-rec ! then ; is DeleteCollection ! :noname ( -- ) valid-record? if last-selected-rec undelete-record RefreshCatalog -1 to last-selected-rec ! then ; is Undelete ! :noname ( -- ) catalog-exist? if undelete-all RefreshCatalog -1 to last-selected-rec ! then ; is UndeleteAll ! :noname ( -- ) \ to update the checks ! Paint: Mainwindow ; is RefreshWindow \ ----------------------------------------------------------------------------- --- 369,407 ---- then ; is RefreshCatalog ! : ShowDeleted ( -- ) true to show-deleted Refresh: Catalog false to show-deleted ! ; : valid-record? ( - flag ) catalog-exist? last-selected-rec -1 <> and ; ! : DeleteItem ( -- ) valid-record? if last-selected-rec delete-record RefreshCatalog -1 to last-selected-rec ! then ; ! : DeleteCollection ( -- ) catalog-exist? if delete-collection RefreshCatalog -1 to last-selected-rec ! then ; ! : Undelete ( -- ) valid-record? if last-selected-rec undelete-record RefreshCatalog -1 to last-selected-rec ! then ; ! : UndeleteAll ( -- ) catalog-exist? if undelete-all RefreshCatalog -1 to last-selected-rec ! then ; ! : RefreshWindow ( -- ) \ to update the checks ! Paint: Mainwindow ; \ ----------------------------------------------------------------------------- *************** *** 520,524 **** :MENUITEM mHandelReq "Ignore requests" vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog then ; --- 502,506 ---- :MENUITEM mHandelReq "Ignore requests" vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog then ; *************** *** 617,621 **** WINPAUSE 10 MS Playing: Player4W - \ KeyHandler ; is PLAYER --- 599,602 ---- |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-14 13:56:16
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15173/apps/Player4 Modified Files: PLAYER4.F PLAYER4.frm Pl_MciWindow.f Log Message: Jos: Made a workaround for Ekey, so w32fConsole.dll is not needed for Player 4th. Now the control center is also able to execute all keystrokes. Keystrokes also work without the CTRL-key Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.48 retrieving revision 1.49 diff -C2 -d -r1.48 -r1.49 *** PLAYER4.F 14 May 2006 09:41:31 -0000 1.48 --- PLAYER4.F 14 May 2006 13:56:11 -0000 1.49 *************** *** 41,44 **** --- 41,47 ---- defer PlaySelectedFromTreeView ' noop is PlaySelectedFromTreeView defer RequestRecord ' noop is RequestRecord + defer MenuChecks + defer KeyHandler + needs NoConsole.f *************** *** 54,126 **** needs Resources.f needs multiopen.f ! needs view.f ! ! : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; ! ! \ ----------------------------------------------------------------------------- ! \ Define the Menu bar ! \ ----------------------------------------------------------------------------- ! MENUBAR player4-Menu-bar ! POPUP "&File" ! MENUITEM "&Play file...\tCtrl+O" 'O' +k_control pushkey ; ! MENUITEM "Play &folder...\tCtrl+F" 'F' +k_control pushkey ; ! MENUITEM "&Play &list...\tShift+L" 'L' +k_control pushkey ; ! MENUSEPARATOR ! MENUITEM "&Exit\tAlt+F4" 'Q' +k_control pushkey ; ! POPUP "&Catalog" ! MENUITEM "&Add file(s)...\tCtrl+M" 'M' +k_control pushkey ; ! MENUITEM "&Import directory tree...\tCtrl+I" 'I' +k_control pushkey ; ! MENUITEM "&Export the catalog to Player.csv" csv-catalog ; ! MENUITEM "S&earch and make a collection..." SearchCatalog ; ! MENUSEPARATOR ! MENUITEM "&Start/Resume playing\tCtrl+R" 'R' +k_control pushkey ; ! MENUSEPARATOR ! SUBMENU "S&ort and view" ! MENUITEM "Define a view and sort" StartViewForm ; ! MENUITEM "&Sort / Refresh" SortCatalog ; ! MENUSEPARATOR ! MENUITEM "Se&t maximum random level" SetRandomLevel ; ! MENUITEM "&Generate random numbers" RandomizeCatalog ; ! ENDSUBMENU ! SUBMENU "Re&quest handling" ! :MENUITEM mHandelReq "Ignore requests" ! vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog ! then ! ; ! :MENUITEM mKeepReq "Keep requests" ! vadr-config KeepRequests invert-check ; ! \ MENUITEM "&Enable all kept requests" EnableKeptRequests ; ! MENUITEM "Se&t request level" player-base SetRequestLevel ; ! MENUITEM "Set a&ll requests to the same level" Level-requests SortCatalog ; ! ENDSUBMENU ! MENUSEPARATOR ! MENUITEM "Show &collection" RefreshCatalog ; ! MENUITEM "Sho&w deleted records" ShowDeleted ; ! MENUSEPARATOR ! MENUITEM "&Delete item" DeleteItem ; ! MENUITEM "D&elete collection..." DeleteCollection ; ! MENUSEPARATOR ! MENUITEM "&Undelete item" Undelete ; ! MENUITEM "Undelete &all" UndeleteAll ; ! ! POPUP "&Options" ! \ MENUITEM "&Fit to Window\tCtrl+W" 'W' +k_control pushkey ; ! MENUITEM " &50%\tCtrl+5" '5' +k_control pushkey ; ! MENUITEM "&100%\tCtrl+1" '1' +k_control pushkey ; ! MENUITEM "&200%\tCtrl+2" '2' +k_control pushkey ; ! MENUSEPARATOR ! MENUITEM "&FullScreen toggle\tCtrl+F" 'S' +k_control pushkey ; ! MENUSEPARATOR ! MENUITEM "&Audio on\tCtrl+A" 'A' +k_control pushkey ; ! MENUITEM "&Audio off\tShift+A" 'A' +k_shift pushkey ; ! MENUSEPARATOR ! :MENUITEM mAutostart "Auto play the catalog at the start" ! vadr-config AutoStart- invert-check ; ! :MENUITEM mTray "Tray window at the start" ! vadr-config AutoMinimized- invert-check ; ! POPUP "&Help" ! MENUITEM "About Player 4th..." k_F1 pushkey ; ! ENDBAR --- 57,61 ---- needs Resources.f needs multiopen.f ! needs view.f *************** *** 179,182 **** --- 114,118 ---- ;Object + defer player4-Menu-bar defer OnPosition ( window -- ) ' drop is OnPosition \ called when window panes are repositioned defer OnInit ( window -- ) ' drop is OnInit \ called during window On_init method *************** *** 222,231 **** :noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y ) ! :M WM_INITMENU ( h m w l -- res ) \ enable/disable the menu items ! vadr-config AutoStart- c@ Check: mAutostart ! vadr-config AutoMinimized- c@ Check: mTray ! vadr-config IgnoreRequests c@ Check: mHandelReq ! vadr-config KeepRequests c@ Check: mKeepReq ! 0 ;M --- 158,163 ---- :noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y ) ! :M WM_INITMENU ( h m w l -- res ) ! MenuChecks 0 ;M *************** *** 247,250 **** --- 179,183 ---- \ mouse click routines for Main Window to track the Splitter movement + : DoSizing ( -- ) mousedown? dragging? or 0= ?EXIT *************** *** 274,280 **** ; :M Classinit: ( -- ) ClassInit: super \ init super class - \ TestBar to CurrentMenu ['] On_clicked SetClickFunc: self ['] On_unclicked SetUnClickFunc: self --- 207,215 ---- ; + :M WM_KEYDOWN ( key l -- res ) + drop KeyHandler 0 ;M + :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_clicked SetClickFunc: self ['] On_unclicked SetUnClickFunc: self *************** *** 330,333 **** --- 265,269 ---- ;M + :M On_Done: ( h m w l -- res ) Close: self *************** *** 366,370 **** \ ----------------------------------------------------------------------------- ! \ "Control center" dialog \ ----------------------------------------------------------------------------- : Pause/Resume ( -- ) --- 302,306 ---- \ ----------------------------------------------------------------------------- ! \ "Control center" dialog \ ----------------------------------------------------------------------------- : Pause/Resume ( -- ) *************** *** 372,376 **** : Stop/Next ( -- ) ! Playing?: Player4W if Close: Player4W then ; 5000 value step --- 308,318 ---- : Stop/Next ( -- ) ! if catalog-exist? ! if SetFocus: ControlCenter play-catalog-random: Player4W ! else Playing?: Player4W ! if Close: Player4W ! then ! then ! then ; 5000 value step *************** *** 544,586 **** On_Paint: MainWindow ; ! defer StopPlayer ! : QuitPlayer ( -- ) ! Close: MainWindow bye ; ! : start/resume ( - ) beep catalog-exist? if play-catalog-random: Player4W then ; ! : KeyHandler ( -- ) ! ekey? ! if ekey ! case ! BL of Pause/Resume endof ! 'O' +k_control of OpenFile: Player4W endof ! 'F' +k_control of OpenFolder: Player4W endof ! 'L' +k_control of OpenPlayList: Player4W endof ! 'S' +k_control of FullScreenToggle endof ! 'Q' +k_control of QuitPlayer endof ! k_F1 of AboutPlayer endof ! k_esc of StopPlayer endof ! 'A' +k_control of AudioOn: Player4W endof ! 'A' +k_shift of AudioOff: Player4W endof ! \ 'W' +k_control of 0 SetVideoSize: Player4W endof ! '5' +k_control of 50 SetVideoSize: Player4W endof ! '1' +k_control of 100 SetVideoSize: Player4W endof ! '2' +k_control of 200 SetVideoSize: Player4W endof ! k_pgdn of Stop/Next endof ! k_down of Stop/Next endof ! k_left of Rewind endof ! k_right of Forward endof ! 'R' +k_control of start/resume endof ! 'M' +k_control of AddFilesFromSelector: Player4W endof ! 'I' +k_control of Import-to-catalog: Player4W RefreshCatalog endof \ 'C' +k_control of PlayAudioCD: Player4W endof \ doesn't work on my system (dbu) endcase ! then ; : InitPlayer ( -- ) --- 486,608 ---- On_Paint: MainWindow ; ! : start/resume ( - ) catalog-exist? if play-catalog-random: Player4W then ; ! : QuitPlayer ( - ) Close: MainWindow bye ; ! : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; ! \ ----------------------------------------------------------------------------- ! \ Define the Menu bar ! \ ----------------------------------------------------------------------------- ! MENUBAR (player4-Menu-bar ! POPUP "&File" ! MENUITEM "&Play file...\tCtrl+O" OpenFile: Player4W ; ! MENUITEM "Play &folder...\tCtrl+F" OpenFolder: Player4W ; ! MENUITEM "&Play &list...\tShift+L" OpenPlayList: Player4W ; ! MENUSEPARATOR ! MENUITEM "&Exit\tAlt+F4" QuitPlayer ; ! POPUP "&Catalog" ! MENUITEM "&Add file(s)...\tCtrl+M" ! AddFilesFromSelector: Player4W ; ! MENUITEM "&Import directory tree...\tCtrl+I" ! Import-to-catalog: Player4W RefreshCatalog ; ! MENUITEM "&Export the catalog to Player.csv" csv-catalog ; ! MENUITEM "S&earch and make a collection..." SearchCatalog ; ! MENUSEPARATOR ! MENUITEM "&Start/Resume playing\tCtrl+R" start/resume ; ! MENUSEPARATOR ! SUBMENU "S&ort and view" ! MENUITEM "Define a view and sort" StartViewForm ; ! MENUITEM "&Sort / Refresh" SortCatalog ; ! MENUSEPARATOR ! MENUITEM "Se&t maximum random level" SetRandomLevel ; ! MENUITEM "&Generate random numbers" RandomizeCatalog ; ! ENDSUBMENU ! SUBMENU "Re&quest handling" ! :MENUITEM mHandelReq "Ignore requests" ! vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog ! then ! ; ! :MENUITEM mKeepReq "Keep requests" ! vadr-config KeepRequests invert-check ; ! \ MENUITEM "&Enable all kept requests" EnableKeptRequests ; ! MENUITEM "Se&t request level" player-base SetRequestLevel ; ! MENUITEM "Set a&ll requests to the same level" ! Level-requests SortCatalog ; ! ENDSUBMENU ! MENUSEPARATOR ! MENUITEM "Show &collection" RefreshCatalog ; ! MENUITEM "Sho&w deleted records" ShowDeleted ; ! MENUSEPARATOR ! MENUITEM "&Delete item" DeleteItem ; ! MENUITEM "D&elete collection..." DeleteCollection ; ! MENUSEPARATOR ! MENUITEM "&Undelete item" Undelete ; ! MENUITEM "Undelete &all" UndeleteAll ; ! POPUP "&Options" ! \ MENUITEM "&Fit to Window\tCtrl+W" 0 SetVideoSize: Player4W ; ! MENUITEM " &50%\tCtrl+5" 50 SetVideoSize: Player4W ; ! MENUITEM "&100%\tCtrl+1" 100 SetVideoSize: Player4W ; ! MENUITEM "&200%\tCtrl+2" 200 SetVideoSize: Player4W ; ! MENUSEPARATOR ! MENUITEM "&FullScreen toggle\tCtrl+F" FullScreenToggle ; ! MENUSEPARATOR ! MENUITEM "&Audio on\tCtrl+A" AudioOn: Player4W ; ! MENUITEM "&Audio off\tShift+A" AudioOff: Player4W ; ! MENUSEPARATOR ! :MENUITEM mAutostart "Auto play the catalog at the start" ! vadr-config AutoStart- invert-check ; ! :MENUITEM mTray "Tray window at the start" ! vadr-config AutoMinimized- invert-check ; ! POPUP "&Help" ! MENUITEM "About Player 4th..." AboutPlayer ; ! ENDBAR ! ' (player4-Menu-bar is player4-Menu-bar ! :Noname ( - ) ! vadr-config AutoStart- c@ Check: mAutostart ! vadr-config AutoMinimized- c@ Check: mTray ! vadr-config IgnoreRequests c@ Check: mHandelReq ! vadr-config KeepRequests c@ Check: mKeepReq ! ; is MenuChecks \ enable/disable the menu items ! defer StopPlayer ! 0x21 constant vk_pgdn ! 0x22 constant vk_down ! 0x25 constant vk_left ! 0x27 constant vk_right ! :Noname ( Vkey -- ) ! case ! BL of Pause/Resume endof ! 'O' of OpenFile: Player4W endof ! 'F' of OpenFolder: Player4W endof ! 'L' of OpenPlayList: Player4W endof ! 'S' of FullScreenToggle endof ! 'Q' of QuitPlayer endof \ Q only ! VK_F1 of AboutPlayer endof ! VK_ESCAPE of StopPlayer endof ! ! 'A' of AudioOn: Player4W endof ! 'A' +k_shift of AudioOff: Player4W endof ! ! 'W' of 0 SetVideoSize: Player4W endof ! '5' of 50 SetVideoSize: Player4W endof ! '1' of 100 SetVideoSize: Player4W endof ! '2' of 200 SetVideoSize: Player4W endof ! ! VK_PGDN of Stop/Next endof \ 21 ! VK_DOWN of Stop/Next endof \ 22 ! VK_LEFT of Rewind endof \ 25 ! VK_RIGHT of Forward endof \ 27 ! ! 'R' of start/resume endof ! 'M' of AddFilesFromSelector: Player4W endof ! 'I' of Import-to-catalog: Player4W RefreshCatalog endof \ 'C' +k_control of PlayAudioCD: Player4W endof \ doesn't work on my system (dbu) endcase ! ; is KeyHandler : InitPlayer ( -- ) *************** *** 595,599 **** WINPAUSE 10 MS Playing: Player4W ! KeyHandler ; is PLAYER --- 617,621 ---- WINPAUSE 10 MS Playing: Player4W ! \ KeyHandler ; is PLAYER *************** *** 615,619 **** ' QuitPlayer is StopPlayer false to MciDebug? ! \ NoConsoleIO NoConsoleInImage \ later when there is a work around for ekey and pushkey ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon --- 637,641 ---- ' QuitPlayer is StopPlayer false to MciDebug? ! NoConsoleIO NoConsoleInImage ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon *************** *** 621,625 **** [else] true to MciDebug? ! ' abort is StopPlayer \ Access to Forth ( Not fullproof ) s" Player4.ico" s" Player4.exe" AddAppIcon --- 643,647 ---- [else] true to MciDebug? ! ' quit is StopPlayer \ Access to Forth ( Not fullproof ) s" Player4.ico" s" Player4.exe" AddAppIcon Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** Pl_MciWindow.f 12 Apr 2006 19:44:24 -0000 1.17 --- Pl_MciWindow.f 14 May 2006 13:56:11 -0000 1.18 *************** *** 21,27 **** : music? ( adr len - f ) valid-sound-ext count (IsValidFileType?) ; ! POPUPBAR player4-Popup-bar POPUP " " ! MENUITEM "&Play file...\tCtrl+O" 'O' +k_control pushkey ; MENUITEM "Play &folder...\tCtrl+F" 'F' +k_control pushkey ; MENUITEM "Play &list...\tShift+L" 'L' +k_control pushkey ; --- 21,27 ---- : music? ( adr len - f ) valid-sound-ext count (IsValidFileType?) ; ! POPUPBAR player4-Popup-bar \ Not yet working POPUP " " ! (( MENUITEM "&Play file...\tCtrl+O" 'O' +k_control pushkey ; MENUITEM "Play &folder...\tCtrl+F" 'F' +k_control pushkey ; MENUITEM "Play &list...\tShift+L" 'L' +k_control pushkey ; *************** *** 33,37 **** MENUITEM "&Forward\tArrow right" k_right pushkey ; MENUSEPARATOR ! MENUITEM "&Exit\tAlt+F4" 'Q' +k_control pushkey ; ENDBAR --- 33,37 ---- MENUITEM "&Forward\tArrow right" k_right pushkey ; MENUSEPARATOR ! MENUITEM "&Exit\tAlt+F4" 'Q' +k_control pushkey ; )) ENDBAR *************** *** 233,237 **** :M OpenFolder: ( -- ) \ let user choose a folder and play all files in it ! z" Play this folder" string0$ GetHandle: self \ >>> BrowseForFolder if string0$ count PlayFolder: self --- 233,237 ---- :M OpenFolder: ( -- ) \ let user choose a folder and play all files in it ! z" Play this folder" string0$ GetHandle: self BrowseForFolder if string0$ count PlayFolder: self Index: PLAYER4.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.frm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 Binary files /tmp/cvsrRJLQ7 and /tmp/cvsuOWZQ6 differ |
|
From: Dirk B. <db...@us...> - 2006-05-14 11:13:07
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4462/apps/SciEdit Modified Files: EdStatusbar.f Log Message: Now using the StatusBar class defined in ExControls instead of the StatusBar class for the console window. Index: EdStatusbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdStatusbar.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** EdStatusbar.f 14 May 2006 09:05:17 -0000 1.4 --- EdStatusbar.f 14 May 2006 11:13:02 -0000 1.5 *************** *** 38,46 **** Start: super SetMulti: self ;M - :M Height: ( -- n ) - GetWindowRect: self drop nip - ;M - :M Clear: ( -- ) z" " EdPart SetText: self --- 38,44 ---- Start: super SetMulti: self + WS_BORDER -Style: self Redraw: self ;M :M Clear: ( -- ) z" " EdPart SetText: self |
|
From: Dirk B. <db...@us...> - 2006-05-14 10:46:22
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28560/src/console Modified Files: BasicWin.f ConsoleStatbar.f Statbar.f Log Message: Renamed the status bar class for the console window (and the supporting classes) into Console_XYZ to show that they should be used for the console window only and not within applications. Index: Statbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Statbar.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Statbar.f 1 May 2005 06:27:41 -0000 1.3 --- Statbar.f 14 May 2006 10:46:19 -0000 1.4 *************** *** 21,25 **** NEEDS BasicWin.f ! CR .( Loading Statusbar class...) --- 21,25 ---- NEEDS BasicWin.f ! CR .( Loading Statusbar class for the Console window...) *************** *** 34,38 **** \ \\\ Simple Statusbar Class \ ! :Class Statusbar <Super ChildWindow INT BorderStyle \ style of border to use --- 34,38 ---- \ \\\ Simple Statusbar Class \ ! :Class Console_Statusbar <Super Console_ChildWindow INT BorderStyle \ style of border to use *************** *** 127,131 **** \ \\\ Multipart Statusbar Class \ ! :Class MultiStatusbar <Super Statusbar INT nParts \ number of parts in statusbar --- 127,131 ---- \ \\\ Multipart Statusbar Class \ ! :Class Console_MultiStatusbar <Super Console_Statusbar INT nParts \ number of parts in statusbar *************** *** 163,165 **** ;Class - |
|
From: Dirk B. <db...@us...> - 2006-05-14 10:46:21
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28560/src/tools Modified Files: ClassBrowser.f Log Message: Renamed the status bar class for the console window (and the supporting classes) into Console_XYZ to show that they should be used for the console window only and not within applications. Index: ClassBrowser.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/ClassBrowser.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ClassBrowser.f 3 May 2005 14:21:59 -0000 1.2 --- ClassBrowser.f 14 May 2006 10:46:19 -0000 1.3 *************** *** 209,213 **** \ the status bar \ ------------------------------------------------------------------------------ ! :Object ClassBrowserStatusbar <Super MultiStatusbar create SingleWidth -1 , \ width of statusbar parts --- 209,213 ---- \ the status bar \ ------------------------------------------------------------------------------ ! :Object ClassBrowserStatusbar <Super Console_MultiStatusbar create SingleWidth -1 , \ width of statusbar parts *************** *** 282,286 **** tempRect.AddrOf GetClientRect: self Left: tempRect Top: tempRect Right: tempRect ! Bottom: tempRect Height: ClassBrowserStatusbar - Move: TreeView --- 282,286 ---- tempRect.AddrOf GetClientRect: self Left: tempRect Top: tempRect Right: tempRect ! Bottom: tempRect Height: ClassBrowserStatusbar - Move: TreeView *************** *** 316,318 **** class-browser - |
|
From: Dirk B. <db...@us...> - 2006-05-14 10:40:28
|
Update of /cvsroot/win32forth/win32forth/apps/WinEd In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26723/apps/WinEd Modified Files: Ed_FrameWindowObj.F Ed_Statbar.F Log Message: Now using the StatusBar class defined in ExControls instead of the StatusBar class for the console window. Index: Ed_Statbar.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_Statbar.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Ed_Statbar.F 28 Aug 2005 07:28:07 -0000 1.3 --- Ed_Statbar.F 14 May 2006 10:40:24 -0000 1.4 *************** *** 4,8 **** \ Created: September 10th, 2003 - 12:20 dbu \ Updated: September 10th, 2003 - 12:20 dbu ! \ Statusbar for Win-Ed \ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 4,8 ---- \ Created: September 10th, 2003 - 12:20 dbu \ Updated: September 10th, 2003 - 12:20 dbu ! \ Statusbar for WinEd \ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 10,38 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! needs Statbar.f \ Status bar Class by Jeff Kelm :Object Win-EdStatusbar <Super MultiStatusbar create MultiWidth 125 , 250 , 400 , 580 , \ width of statusbar parts ! create SingleWidth -1 , \ width of statusbar parts ! :M SetMulti: ( -- ) ! MultiWidth 4 SetParts: self ! ;M ! :M SetSingle: ( -- ) ! SingleWidth 1 SetParts: self ! ;M ! :M Create: ( hParent ) ! Create: super SetMulti: self - Show: self ;M ;Object - - : StartStatusBar ( hWnd -- ) - Create: Win-EdStatusbar - ; - --- 10,30 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! needs ExControls.f :Object Win-EdStatusbar <Super MultiStatusbar create MultiWidth 125 , 250 , 400 , 580 , \ width of statusbar parts ! create SingleWidth -1 , \ width of statusbar parts ! :M SetMulti: ( -- ) ! MultiWidth 4 SetParts: self ;M ! :M SetSingle: ( -- ) ! SingleWidth 1 SetParts: self ;M ! :M Start: ( Parent -- ) ! Start: super SetMulti: self ;M ;Object Index: Ed_FrameWindowObj.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_FrameWindowObj.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Ed_FrameWindowObj.F 28 Aug 2005 07:28:06 -0000 1.5 --- Ed_FrameWindowObj.F 14 May 2006 10:40:24 -0000 1.6 *************** *** 145,149 **** self Start: SubjectList FilesList InitSubject: SubjectList \ we start with files subject ! GetHandle: self StartStatusBar \ start the status bar window-list BEGIN dup @ ?dup --- 145,149 ---- self Start: SubjectList FilesList InitSubject: SubjectList \ we start with files subject ! self Start: Win-EdStatusbar \ start the status bar window-list BEGIN dup @ ?dup *************** *** 151,155 **** self Start: [ r@ ] TRUE Hide: [ r> ] ! cell+ REPEAT DROP FALSE Hide: FilesList --- 151,155 ---- self Start: [ r@ ] TRUE Hide: [ r> ] ! cell+ REPEAT DROP FALSE Hide: FilesList *************** *** 506,510 **** cFiles 0 ?DO MAXCOUNTED ! drop$ 1+ i wParam --- 506,510 ---- cFiles 0 ?DO MAXCOUNTED ! drop$ 1+ i wParam |
|
From: Dirk B. <db...@us...> - 2006-05-14 09:54:29
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12484/src Modified Files: CHILDWND.F Window.f Log Message: Changed the window class. Now every window will become it's own window class name and it's own window class. Note: If the window class name is set with SetClassName: before the Start: method is called no default class name will be set. Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** Window.f 13 May 2006 08:31:24 -0000 1.12 --- Window.f 14 May 2006 09:54:12 -0000 1.13 *************** *** 15,18 **** --- 15,19 ---- 0 value DefaultMenuBar \ Global default menubar + 0 value ClassNameID \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 92,98 **** ['] noop to dbl-click-func ['] noop to track-func ! s" ForthAppWindow" WindowClassName place ! WindowClassName +NULL ! addr: WinRect to wRect ;M --- 93,98 ---- ['] noop to dbl-click-func ['] noop to track-func ! WindowClassName MAXSTRING erase \ clear the class name ! addr: WinRect to wRect ;M *************** *** 225,229 **** dup @ \ window object pointer from ! \ first cell of CREATEPARMS 4 pick ( obj hwnd ) --- 225,229 ---- dup @ \ window object pointer from ! \ first cell of CREATEPARMS 4 pick ( obj hwnd ) *************** *** 263,267 **** ;Record ! : default-window-class ( -- ) \ fill in the defaults for the window class WndClassStyle: [ self ] to Style TheWndProc to wndProc --- 263,268 ---- ;Record ! : default-window-class ( -- ) ! \ Fill in the defaults for the window class. WndClassStyle: [ self ] to Style TheWndProc to wndProc *************** *** 275,282 **** WindowClassName 1+ to ClassName ; ! : register-the-class ( -- f ) \ register the class structure WndClass Call RegisterClass ; ! : register-frame-window ( -- f ) \ init the class and register it default-window-class register-the-class ; --- 276,300 ---- WindowClassName 1+ to ClassName ; ! : register-the-class ( -- f ) ! \ Register the window class. WndClass Call RegisterClass ; ! : default-class-name ( -- ) ! \ The a default window class name for this window. Every window ! \ will become it's own class name and it's own window class. ! \ Note: If the window class name is set with SetClassName: before ! \ the Start: method is called no default class name will be set. ! WindowClassName c@ 0= ! if s" w32fWindow-" WindowClassName place ! ClassNameID (.) WindowClassName +place ! WindowClassName +null ! 1 +to ClassNameID ! then ! \ cr ." The WindowClassName is: " WindowClassName count type ! ; ! ! : register-frame-window ( -- f ) ! \ Init the window class and register it. ! default-class-name default-window-class register-the-class ; *************** *** 308,311 **** --- 326,330 ---- ExWindowStyle: [ self ] \ extended window style Call CreateWindowEx + EraseRect: WinRect ; *************** *** 326,337 **** \ ** set the style member of the the WNDCLASS structure associated with the window. \ ** Default style is CS_DBLCLKS, CS_HREDRAW and CS_VREDRAW. [ CS_DBLCLKS CS_HREDRAW CS_VREDRAW or or ] literal ;M - : SetWndClassStyle ( -- ) - \ Set the style member of the the WNDCLASS structure associated with the window. - WndClassStyle: [ self ] GCL_STYLE SetClassLong: self ; - :M Start: ( -- ) \ *G Create the window. \ The default window class is appropriate for frame windows. Child \ windows will define their own window class. \n --- 345,359 ---- \ ** set the style member of the the WNDCLASS structure associated with the window. \ ** Default style is CS_DBLCLKS, CS_HREDRAW and CS_VREDRAW. + \ *P To prevent flicker on sizing of the window your method should return CS_DBLCLKS + \ ** only. [ CS_DBLCLKS CS_HREDRAW CS_VREDRAW or or ] literal ;M :M Start: ( -- ) \ *G Create the window. + \ *P Before the window is created a default window class name for this window will + \ ** be set. Every window will become it's own class name and it's own window class. + \ ** Note: If the window class name is set with SetClassName: before the Start: method + \ ** is called no default class name will be set. + \ The default window class is appropriate for frame windows. Child \ windows will define their own window class. \n *************** *** 344,349 **** if register-frame-window drop create-frame-window dup to hWnd ! if ! SW_SHOWNORMAL Show: self Update: self then --- 366,370 ---- if register-frame-window drop create-frame-window dup to hWnd ! if SW_SHOWNORMAL Show: self Update: self then *************** *** 352,356 **** :M On_Init: ( -- ) ! \ *G Thing's to do during creation of the window. Default does nothing. ;M --- 373,380 ---- :M On_Init: ( -- ) ! \ *G Thing's to do during creation of the window. ! \ ** The Default is setting the WNDCLASS style to the value ! \ ** the WndClassStyle: method returns. ! \ SetWndClassStyle ;M ;M *************** *** 397,404 **** Close: [ self ] ;M ! :M WM_CREATE On_Init: [ self ] 0 ;M ! :M WM_DESTROY On_Done: [ self ] DefWindowProc: [ self ] --- 421,428 ---- Close: [ self ] ;M ! :M WM_CREATE ( hwnd msg wparam lparam -- res ) On_Init: [ self ] 0 ;M ! :M WM_DESTROY ( hwnd msg wparam lparam -- res ) On_Done: [ self ] DefWindowProc: [ self ] *************** *** 406,423 **** ;M ! :M SetClassName: ( adr len -- ) \ *G Set the window class name. WindowClassName place WindowClassName +NULL ;M ! :M GetClassName: ( -- adr len ) \ *G Get the window class name. WindowClassName count ;M ! :M SetParent: ( hwndParent -- ) \ *G Set owner window (0 if no parent). to Parent ;M ! :M ParentWindow: ( -- hwndparent | 0 if no parent ) \ *G Get owner window. Parent ;M --- 430,451 ---- ;M ! :M SetClassName: ( addr len -- ) \ *G Set the window class name. WindowClassName place WindowClassName +NULL ;M ! :M GetClassName: ( -- addr len ) \ *G Get the window class name. WindowClassName count ;M ! :M SetParent: ( Parent -- ) \ *G Set owner window (0 if no parent). + \ ** Note: The parent is the object address of the parent window + \ ** class not the window handle. to Parent ;M ! :M ParentWindow: ( -- Parent | 0 if no parent ) \ *G Get owner window. + \ ** Note: The parent is the object address of the parent window + \ ** class not the window handle. Parent ;M *************** *** 441,445 **** :M ExWindowStyle: ( -- extended_style ) \ *G User windows should override the ExWindowStyle: method to ! \ ** set the extended window style. Default is null. 0 ;M --- 469,473 ---- :M ExWindowStyle: ( -- extended_style ) \ *G User windows should override the ExWindowStyle: method to ! \ ** set the extended window style. Default is NULL. 0 ;M Index: CHILDWND.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** CHILDWND.F 13 May 2006 08:31:24 -0000 1.5 --- CHILDWND.F 14 May 2006 09:54:12 -0000 1.6 *************** *** 12,28 **** :CLASS Child-Window <Super Window \ *G Child-Window is the base class for all child windows. ! \ *P The windows have a parent, which is the object address, ! \ ** not the window handle. This allows the child to send messages ! \ ** to its parent. - \ int Parent \ window object that is the parent int id \ id for this child window - :M Classinit: ( -- ) - ClassInit: super - s" ChildWindow" WindowClassName place - WindowClassName +NULL - ;M - :M GetParent: ( -- parent ) \ *G Get the object address of the parent window. --- 12,21 ---- :CLASS Child-Window <Super Window \ *G Child-Window is the base class for all child windows. ! \ *P The windows has a parent, which is the object address, ! \ ** not the window handle. This allows the child to send ! \ ** messages to its parent. int id \ id for this child window :M GetParent: ( -- parent ) \ *G Get the object address of the parent window. *************** *** 61,66 **** NULL to hbrBackground NULL to MenuName WindowClassName 1+ to ClassName ! WndClass Call RegisterClass ; : create-child-window ( -- hWnd ) --- 54,64 ---- NULL to hbrBackground NULL to MenuName + + \ Set the window class name for this child window. Every window + \ will become it's own class name and it's own window class. + default-class-name WindowClassName 1+ to ClassName ! ! register-the-class ; : create-child-window ( -- hWnd ) *************** *** 95,100 **** register-child-window drop create-child-window dup to hWnd ! if ! SW_SHOWNORMAL Show: self then ;M --- 93,97 ---- register-child-window drop create-child-window dup to hWnd ! if SW_SHOWNORMAL Show: self then ;M |
|
From: Dirk B. <db...@us...> - 2006-05-14 09:41:34
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8473/apps/Player4 Modified Files: PLAYER4.F Log Message: Removed a duplicate Method Jos forgot in his last update. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.47 retrieving revision 1.48 diff -C2 -d -r1.47 -r1.48 *** PLAYER4.F 13 May 2006 21:43:17 -0000 1.47 --- PLAYER4.F 14 May 2006 09:41:31 -0000 1.48 *************** *** 54,58 **** needs Resources.f needs multiopen.f ! needs view.f : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; --- 54,58 ---- needs Resources.f needs multiopen.f ! needs view.f : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; *************** *** 86,90 **** :MENUITEM mHandelReq "Ignore requests" vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog then ; --- 86,90 ---- :MENUITEM mHandelReq "Ignore requests" vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog then ; *************** *** 234,250 **** ;M - : drawline ( -- ) - SeparatorX @ 0 MoveTo: dc - SeparatorX @ height LineTo: dc ; - - : on_clicked ( -- ) - true to clicked - mousex SeparatorX ! - get-dc - R2_NOT SetRop2: dc - black LineColor: dc - drawline - hwnd Call SetCapture drop ; - : On_Mousemove ( -- ) mousex SeparatorX @ = --- 234,237 ---- *************** *** 260,264 **** \ mouse click routines for Main Window to track the Splitter movement - : DoSizing ( -- ) mousedown? dragging? or 0= ?EXIT --- 247,250 ---- |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-13 21:43:21
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9098/apps/Player4 Modified Files: PLAYER4.F Log Message: Jos: Added the splitter object of Rod Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 *** PLAYER4.F 8 May 2006 17:33:57 -0000 1.46 --- PLAYER4.F 13 May 2006 21:43:17 -0000 1.47 *************** *** 54,59 **** needs Resources.f needs multiopen.f ! needs view.f ! : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; --- 54,58 ---- needs Resources.f needs multiopen.f ! needs view.f : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; *************** *** 165,184 **** ; \ ----------------------------------------------------------------------------- \ Define the Main Window \ ----------------------------------------------------------------------------- :Object MainWindow <super TrayWindow ! 0 value toolbarH \ set to height of toolbar if any 0 value statusbarH \ set to height of status bar if any 0 value clicked :M WindowTitle: ( -- Zstring ) \ window caption z" Player 4th" ;M - :M ClassInit: ( -- ) - ClassInit: super - ;M - :M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window LoadAppIcon ;M --- 164,199 ---- ; + + :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 + + defer OnPosition ( window -- ) ' drop is OnPosition \ called when window panes are repositioned + defer OnInit ( window -- ) ' drop is OnInit \ called during window On_init method + \ ----------------------------------------------------------------------------- \ Define the Main Window \ ----------------------------------------------------------------------------- :Object MainWindow <super TrayWindow ! 3 value thickness 0 value toolbarH \ set to height of toolbar if any 0 value statusbarH \ set to height of status bar if any 0 value clicked + int dragging? + int mousedown? :M WindowTitle: ( -- Zstring ) \ window caption z" Player 4th" ;M :M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window LoadAppIcon ;M *************** *** 186,193 **** :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M ! : position-windows ( -- ) \ auto adjust windows ! 0 toolbarH SeparatorX @ 1- Height toolbarH - statusbarH - dup>r Move: Catalog ! SeparatorX @ 2+ toolbarH Width 2 pick - r> Move: Player4W ! ; :noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y ) --- 201,222 ---- :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M ! : position-windows ( -- ) ! 0 toolbarH SeparatorX @ Height Move: Catalog ! SeparatorX @ thickness + toolbarH Width SeparatorX @ thickness + - Height Move: Player4W ! self OnPosition ; ! ! : InSplitter? ( -- f1 ) \ is cursor on splitter window ! hWnd get-mouse-xy ! 0 height within ! swap SeparatorX @ dup thickness + within and ; ! ! :M WM_SETCURSOR ( h m w l -- ) ! hWnd get-mouse-xy ! toolbarH dup Height + within ! swap 0 width within and ! IF InSplitter? IF SIZEWE-CURSOR ELSE arrow-cursor THEN 1 ! ELSE DefWindowProc: self ! THEN ! ;M :noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y ) *************** *** 229,253 **** on_mousemove ;M ! : dosizing ( -- ) ! clicked 0= ?exit ! drawline ! \ a minimum width of 4 pixels for windows are set, but it can be changed ! mousex 2 cells < mousex width 2 cells - > or ! if position-windows ! false to clicked ! release-dc ! hwnd Call ReleaseCapture ?win-error ! else mousex SeparatorX ! ! drawline ! then ; ! : on_unclicked ( -- ) ! clicked 0= ?exit ! drawline ! mousex SeparatorX ! position-windows ! release-dc ! false to clicked ! hwnd Call ReleaseCapture ?win-error ; :M StartSize: ( -- w h ) --- 258,299 ---- on_mousemove ;M ! \ mouse click routines for Main Window to track the Splitter movement ! ! : DoSizing ( -- ) ! mousedown? dragging? or 0= ?EXIT ! mousex ( 1+ ) width min thickness 2/ - SeparatorX ! 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 ! SeparatorX @ 8 > ! IF 0 thickness 2/ - SeparatorX ! ! ELSE 132 Width 2/ min SeparatorX ! ! THEN ! position-windows ! ; ! ! :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 StartSize: ( -- w h ) |
|
From: bob a. <rd...@us...> - 2006-05-13 20:46:43
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv23431/src/kernel Modified Files: fkernel.f Log Message: add dup-warning? to be able to turn off redefinition warnings Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** fkernel.f 1 May 2006 03:11:48 -0000 1.28 --- fkernel.f 13 May 2006 20:46:40 -0000 1.29 *************** *** 3102,3105 **** --- 3102,3112 ---- \ : IN-APP? ( -- f ) DP ADP = ; \ if the DP is set to ADP + TRUE VALUE DUP-WARNING? + : DUP-WARNING-OFF ( -- ) \ disable warning for redefinitions + FALSE TO DUP-WARNING? ; + + : DUP-WARNING-ON ( -- ) \ enable warning for redefinitions + TRUE TO DUP-WARNING? ; + TRUE VALUE SYS-WARNING? *************** *** 4264,4269 **** WARNING @ IF 2DUP CURRENT @ (SEARCH-SELF) IF ! DROP WARN_NOTUNIQUE WARNMSG THEN THEN --- 4271,4277 ---- WARNING @ IF 2DUP CURRENT @ (SEARCH-SELF) IF ! DROP DUP-WARNING? IF WARN_NOTUNIQUE WARNMSG + THEN THEN THEN |
|
From: bob a. <rd...@us...> - 2006-05-13 20:32:11
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18766/src/console Modified Files: Console2.f Log Message: fix spelling mistakes in a comment Index: Console2.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Console2.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Console2.f 24 Dec 2005 11:57:59 -0000 1.4 --- Console2.f 13 May 2006 20:32:07 -0000 1.5 *************** *** 315,321 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Note: The the Line Editor (in Lineedit.f) is using set-cursor witch \ turn's on the cursor every time it's called. So a call to hide-cursor doesn't ! \ show any efect at all. 1 proc HideCaret : hide-cursor ( -- ) --- 315,321 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Note: The Line Editor (in Lineedit.f) is using set-cursor which \ turn's on the cursor every time it's called. So a call to hide-cursor doesn't ! \ show any effect at all. 1 proc HideCaret : hide-cursor ( -- ) |
|
From: Rod O. <rod...@us...> - 2006-05-13 20:31:06
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18160/apps/SciEdit Modified Files: Main.f Log Message: Rod: Added WndClassStyle: CS_DBLCLKS and removed borders Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/Main.f,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** Main.f 7 May 2006 06:34:26 -0000 1.18 --- Main.f 13 May 2006 20:31:02 -0000 1.19 *************** *** 128,145 **** :M ReSize: ( -- ) ! tempRect.AddrOf GetClientRect: self ! ! Left: tempRect ! ShowToolbar? if Height: TheRebar 2 - else Top: tempRect then ! Right: tempRect ! Bottom: tempRect ! ShowStatusbar? if Height: ScintillaStatusbar - 1+ then ! ShowToolbar? if Height: TheRebar - 1+ then Move: MDIClient ! ShowToolbar? if Width Height: TheRebar GetHandle: TheRebar AdjustWindowSize then ! ShowStatusbar? if Redraw: ScintillaStatusbar then ;M int WindowState :M On_Size: ( h m w -- ) --- 128,145 ---- :M ReSize: ( -- ) ! 0 ! ShowToolbar? if Height: TheRebar else 0 then ! width ! height ! ShowStatusbar? if Height: ScintillaStatusbar - then ! ShowToolbar? if Height: TheRebar - then Move: MDIClient ! ShowToolbar? if Width Height: TheRebar GetHandle: TheRebar AdjustWindowSize then ! ShowStatusbar? if Redraw: ScintillaStatusbar then ;M + :M MinSize: ( -- width height ) 412 0 ;M \ prevent menu wrapping onto another line + int WindowState :M On_Size: ( h m w -- ) *************** *** 275,282 **** LoadAppIcon ;M ! :M On_Init: ( -- ) ! ! On_Init: super InitScintillaControl \ Dienstag, August 03 2004 dbu AccelTable EnableAccelerators \ init the accelerator table --- 275,281 ---- LoadAppIcon ;M ! :M WndClassStyle: ( -- style ) CS_DBLCLKS ;M + :M On_Init: ( -- ) InitScintillaControl \ Dienstag, August 03 2004 dbu AccelTable EnableAccelerators \ init the accelerator table *************** *** 284,288 **** self Start: TheRebar EnableToolbar ! load-defaults ReSize: self ;M --- 283,291 ---- self Start: TheRebar EnableToolbar ! On_Init: super ! \ with CS_DBLCLKS as WndClassStyle to prevent flicker ! \ Statusbar must now be started before MDIClient ! \ ( not needed) CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ! load-defaults ;M |
|
From: Rod O. <rod...@us...> - 2006-05-13 20:28:58
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17505/apps/SciEdit Modified Files: EdStatusbar.f EdToolbar.f Log Message: Rod: Removed WS_BORDER Index: EdToolbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdToolbar.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** EdToolbar.f 10 Jun 2005 16:44:11 -0000 1.2 --- EdToolbar.f 13 May 2006 20:28:55 -0000 1.3 *************** *** 218,222 **** :M WindowStyle: ( -- style ) WindowStyle: super ! [ WS_CLIPSIBLINGS WS_CLIPCHILDREN or CCS_NODIVIDER or RBS_VARHEIGHT or RBS_BANDBORDERS or WS_BORDER or RBS_AUTOSIZE or ] literal or ;M --- 218,222 ---- :M WindowStyle: ( -- style ) WindowStyle: super ! [ WS_CLIPSIBLINGS WS_CLIPCHILDREN or CCS_NODIVIDER or RBS_VARHEIGHT or RBS_BANDBORDERS or RBS_AUTOSIZE or ] literal or ;M Index: EdStatusbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdStatusbar.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** EdStatusbar.f 8 Oct 2005 08:24:58 -0000 1.2 --- EdStatusbar.f 13 May 2006 20:28:55 -0000 1.3 *************** *** 25,28 **** --- 25,32 ---- 1 constant LinePart + :M DefStyle: ( -- style ) + [ WS_VISIBLE WS_CHILD or WS_CLIPSIBLINGS or ] literal + ;M + :M SetMulti: ( -- ) MultiWidth MultiParts SetParts: self |
|
From: Rod O. <rod...@us...> - 2006-05-13 20:27:36
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17174/src/lib Modified Files: ScintillaControl.f Log Message: Rod: Removed WS_BORDER style Index: ScintillaControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ScintillaControl.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ScintillaControl.f 6 May 2006 15:43:48 -0000 1.3 --- ScintillaControl.f 13 May 2006 20:27:32 -0000 1.4 *************** *** 665,669 **** :M WindowStyle: ( -- Style ) WindowStyle: SUPER ! [ WS_BORDER WS_TABSTOP OR ] literal OR ;M --- 665,669 ---- :M WindowStyle: ( -- Style ) WindowStyle: SUPER ! WS_TABSTOP or ;M |
|
From: Rod O. <rod...@us...> - 2006-05-13 08:31:33
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8152/src Modified Files: CHILDWND.F Window.f Log Message: Rod: Put WndClassStyle: [ self ] in WndClass Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Window.f 9 May 2006 16:18:48 -0000 1.11 --- Window.f 13 May 2006 08:31:24 -0000 1.12 *************** *** 264,268 **** : default-window-class ( -- ) \ fill in the defaults for the window class ! [ CS_DBLCLKS CS_HREDRAW CS_VREDRAW or or ] literal to Style TheWndProc to wndProc 0 to clsExtra --- 264,268 ---- : default-window-class ( -- ) \ fill in the defaults for the window class ! WndClassStyle: [ self ] to Style TheWndProc to wndProc 0 to clsExtra *************** *** 344,348 **** if register-frame-window drop create-frame-window dup to hWnd ! if SetWndClassStyle SW_SHOWNORMAL Show: self Update: self --- 344,348 ---- if register-frame-window drop create-frame-window dup to hWnd ! if SW_SHOWNORMAL Show: self Update: self Index: CHILDWND.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** CHILDWND.F 9 May 2006 16:18:48 -0000 1.4 --- CHILDWND.F 13 May 2006 08:31:24 -0000 1.5 *************** *** 52,56 **** : register-child-window ( -- f ) ! [ CS_DBLCLKS CS_HREDRAW CS_VREDRAW or or ] literal to Style TheWndProc to WndProc 0 to ClsExtra --- 52,56 ---- : register-child-window ( -- f ) ! WndClassStyle: [ self ] to Style TheWndProc to WndProc 0 to ClsExtra *************** *** 95,99 **** register-child-window drop create-child-window dup to hWnd ! if SetWndClassStyle SW_SHOWNORMAL Show: self then ;M --- 95,99 ---- register-child-window drop create-child-window dup to hWnd ! if SW_SHOWNORMAL Show: self then ;M |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-12 20:07:07
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29467 Modified Files: Mediatree.f PopupWindow.f Log Message: Jos: Optimized PopupWindow.f and made the popup menu less aggressive. Index: PopupWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PopupWindow.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** PopupWindow.f 19 Apr 2006 12:39:20 -0000 1.4 --- PopupWindow.f 12 May 2006 20:06:57 -0000 1.5 *************** *** 1,13 **** anew -PopupWindow.f - defer GetPositionCatalog - \ ----------------------------------------------------------------------------- \ Define the Popup bar for the mediatree in a new window \ ----------------------------------------------------------------------------- ! 0 value _hwnd ! ! defer ClosePopupWindow ' noop is ClosePopupWindow POPUPBAR PopupOnRecord --- 1,9 ---- anew -PopupWindow.f \ ----------------------------------------------------------------------------- \ Define the Popup bar for the mediatree in a new window \ ----------------------------------------------------------------------------- ! defer ClosePopupWindow ' noop is ClosePopupWindow POPUPBAR PopupOnRecord *************** *** 15,53 **** MENUITEM "Play file" ClosePopupWindow PlaySelectedFromTreeView ; MENUITEM "Request record" ClosePopupWindow RequestRecord ; - MENUITEM "Exit menu" ClosePopupWindow ; ENDBAR ! :Object PopupWindow <super Window int focus ! ColorObject FrmColor \ the background color ! :M ClassInit: ( -- ) ClassInit: super PopupOnRecord ! SetPopupBar: Self true to Focus ;M ! \ Needs the rbuttondown to do it right ! : StartPopup ( -- ) 0 WM_RBUTTONDOWN GetHandle: self Call PostMessage drop ; :M WindowStyle: ( -- style ) WS_POPUP ;M ! :M StartSize: ( -- width height ) 70 30 ;M :M StartPos: ( -- x y ) mousex mousey ;M ! :M WM_LBUTTONDOWN ( h m w l -- res ) 2drop 0 close: Self ;M ! :M On_KillFocus: ( h m w l -- ) 2drop focus if SetFocus: self then ;M ! ! :M On_Paint: ( -- ) ! focus ! if hwnd to _hwnd ! 0 0 GetSize: self Addr: FrmColor FillArea: dc ! _hwnd start: PopupOnRecord ! StartPopup ! then ! ;M ! :M On_Done: ( h m w l -- res ) On_Done: super 0 ;M ! :noname ( - ) false to focus ! _hwnd call DestroyWindow drop ! ; is ClosePopupWindow ;Object ! \ start: PopupWindow --- 11,45 ---- MENUITEM "Play file" ClosePopupWindow PlaySelectedFromTreeView ; MENUITEM "Request record" ClosePopupWindow RequestRecord ; ENDBAR ! :Object PopupWindow <super Window ! int focus ! :M ClassInit: ( -- ) ClassInit: super PopupOnRecord ! SetPopupBar: Self true to Focus ;M ! \ The popupmenu needs a rbuttondown to do it right ! : StartPopup ( -- ) 0 WM_RBUTTONDOWN GetHandle: self Call PostMessage drop ; ! : CleanupClose ( h_m w_l - res ) 2drop 0 close: Self ; :M WindowStyle: ( -- style ) WS_POPUP ;M ! :M StartSize: ( -- width height ) 3 3 ;M :M StartPos: ( -- x y ) mousex mousey ;M ! :M WM_LBUTTONDOWN ( h m w l -- res ) CleanupClose ;M ! :M On_KillFocus: ( h m w l -- res ) CleanupClose ;M ! :M On_Done: ( h m w l -- res ) On_Done: super 0 ;M ! :M Start: ( mousex mousey -- ) to mousey to mousex Start: super ;M ! :noname ( - ) false to focus ! hwnd call DestroyWindow drop ! ; is ClosePopupWindow ! :M On_Paint: ( -- ) ! focus if hwnd start: PopupOnRecord StartPopup then ;M ;Object ! \ mousex mousey start: PopupWindow \ Start needs mousex mousey ! ! \s Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** Mediatree.f 12 Apr 2006 19:44:24 -0000 1.29 --- Mediatree.f 12 May 2006 20:06:57 -0000 1.30 *************** *** 10,13 **** --- 10,14 ---- 0 value hItem-last-selected + defer GetPositionCatalog :Class MediaTree <super TreeViewControl *************** *** 214,218 **** if hWnd dup get-mouse-xy GetPositionCatalog ! rot + to mousey + to mousex Start: PopupWindow then --- 215,219 ---- if hWnd dup get-mouse-xy GetPositionCatalog ! rot + >r + r> Start: PopupWindow then *************** *** 303,307 **** wait-cursor ! SW_HIDE Show: self \ hideing the window makes the refresh about 2times faster EnableNotify? false to EnableNotify? --- 304,308 ---- wait-cursor ! \ SW_HIDE Show: self \ hideing the window makes the refresh about 2times faster EnableNotify? false to EnableNotify? |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-08 17:36:03
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3143/apps/Player4 Modified Files: PLAYER4.F Log Message: Jos: diasabled NoConsoleIO and NoConsoleInImage Wll be activated later when there is a work around for ekey and pushkey Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 *** PLAYER4.F 2 May 2006 12:21:40 -0000 1.45 --- PLAYER4.F 8 May 2006 17:33:57 -0000 1.46 *************** *** 583,587 **** ' QuitPlayer is StopPlayer false to MciDebug? ! NoConsoleIO NoConsoleInImage ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon --- 583,587 ---- ' QuitPlayer is StopPlayer false to MciDebug? ! \ NoConsoleIO NoConsoleInImage \ later when there is a work around for ekey and pushkey ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-07 12:35:45
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29271/demos Modified Files: ListViewDemo.f Log Message: Jos: LVS_SHOWSELALWAYS will keep the selected items visible Index: ListViewDemo.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/ListViewDemo.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** ListViewDemo.f 6 May 2006 12:31:16 -0000 1.10 --- ListViewDemo.f 7 May 2006 12:35:39 -0000 1.11 *************** *** 23,27 **** :M WindowStyle: ( -- style ) WindowStyle: super ! [ LVS_REPORT LVS_SORTASCENDING or LVS_EDITLABELS or ] literal or ;M --- 23,27 ---- :M WindowStyle: ( -- style ) WindowStyle: super ! [ LVS_REPORT LVS_SHOWSELALWAYS OR LVS_SORTASCENDING or LVS_EDITLABELS or ] literal or ;M *************** *** 40,44 **** :M WindowStyle: ( -- style ) WindowStyle: super ! [ LVS_REPORT LVS_EDITLABELS or ] literal or ;M --- 40,44 ---- :M WindowStyle: ( -- style ) WindowStyle: super ! [ LVS_REPORT LVS_SHOWSELALWAYS OR LVS_EDITLABELS or ] literal or ;M |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-07 10:54:29
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13769/src/lib Modified Files: Listview.f Log Message: Jos: Changed the return parameters of GetItemText: into a counted string Index: Listview.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Listview.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Listview.f 6 May 2006 16:14:06 -0000 1.6 --- Listview.f 7 May 2006 10:54:26 -0000 1.7 *************** *** 314,318 **** :M GetItemSpacing: ( fsmall -- f ) 0 swap LVM_GETITEMSPACING hWnd Call SendMessage ;M :M GetItemState: ( mask i -- f ) LVM_GETITEMSTATE hWnd Call SendMessage ;M ! :M GetItemText: ( pitem iItem -- count ) LVM_GETITEMTEXT hWnd Call SendMessage ;M :M GetSelectedCount: ( -- n ) 0 0 LVM_GETSELECTEDCOUNT hWnd Call SendMessage ;M :M InsertItem: ( pitem -- index | -1 ) 0 LVM_INSERTITEM hWnd Call SendMessage ;M --- 314,319 ---- :M GetItemSpacing: ( fsmall -- f ) 0 swap LVM_GETITEMSPACING hWnd Call SendMessage ;M :M GetItemState: ( mask i -- f ) LVM_GETITEMSTATE hWnd Call SendMessage ;M ! :M GetItemText: ( pitem iItem -- adr count ) >r dup r> ! LVM_GETITEMTEXT hWnd Call SendMessage swap 5 cells+ @ swap ;M :M GetSelectedCount: ( -- n ) 0 0 LVM_GETSELECTEDCOUNT hWnd Call SendMessage ;M :M InsertItem: ( pitem -- index | -1 ) 0 LVM_INSERTITEM hWnd Call SendMessage ;M |
|
From: Dirk B. <db...@us...> - 2006-05-07 06:34:30
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13841/apps/SciEdit Modified Files: EdAbout.f EdCommand.f EdMenu.f EdVersion.f Main.f Log Message: Some minor mods. Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/Main.f,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** Main.f 6 May 2006 15:45:04 -0000 1.17 --- Main.f 7 May 2006 06:34:26 -0000 1.18 *************** *** 7,17 **** \ \ Created: Donnerstag, Juni 10 2004 - dbu ! \ Updated: Sonntag, August 22 2004 - dbu \ \ This Editor based on the "Scintilla source code edit control". \ See www.scintilla.org for more information about the control. - \ Saturday, May 06 2006 Added Print and PageSetup - Rod - cr .( Loading SciEdit...) --- 7,15 ---- \ \ Created: Donnerstag, Juni 10 2004 - dbu ! \ Updated: Saturday, May 06 2006 - dbu \ \ This Editor based on the "Scintilla source code edit control". \ See www.scintilla.org for more information about the control. cr .( Loading SciEdit...) Index: EdVersion.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdVersion.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** EdVersion.f 21 Jan 2006 08:59:41 -0000 1.9 --- EdVersion.f 7 May 2006 06:34:26 -0000 1.10 *************** *** 1,5 **** \ $Id$ ! 10127 value sciedit_version# \ Version numbers: v.ww.rr --- 1,5 ---- \ $Id$ ! 10128 value sciedit_version# \ Version numbers: v.ww.rr *************** *** 25,28 **** --- 25,29 ---- DBU Dirk Busch (di...@wi...) EAB Ezra Boyce + ROD Rod Oakford \ --------------------------------------------------------------------------- *************** *** 231,232 **** --- 232,237 ---- - New "Typewriter" command (CTRL+ALT+T) that turns the selected text into typwriter style for DexH. + + \ changes for Version 1.01.28 + Rod Saturday, May 06 2006 + - Added Print and PageSetup Index: EdAbout.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdAbout.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsUpvwDF and /tmp/cvsGECYsb differ Index: EdCommand.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdCommand.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** EdCommand.f 6 May 2006 15:45:04 -0000 1.8 --- EdCommand.f 7 May 2006 06:34:26 -0000 1.9 *************** *** 7,13 **** \ \ Created: Mittwoch, Juni 09 2004 - dbu ! \ Updated: Samstag, Juli 03 2004 - 10:52 - dbu ! ! \ Saturday, May 06 2006 Added Print and PageSetup - Rod cr .( Loading Menu Commands...) --- 7,11 ---- \ \ Created: Mittwoch, Juni 09 2004 - dbu ! \ Updated: Saturday, May 06 2006 - Rod cr .( Loading Menu Commands...) *************** *** 80,90 **** then ; IDM_OPEN_HTML_FILE SetCommand ! : OnPrint ( -- ) ActiveChild IF Print: CurrentWindow THEN ; IDM_PRINT SetCommand ! : PageSetup: ( -- ) ! GetHandle: frame hOwner ! ! [ PSD_MARGINS ( PSD_MINMARGINS or ) PSD_INTHOUSANDTHSOFINCHES or ] literal PSDFlags ! ! PageSetupDlg drop ! ; IDM_PAGE_SETUP SetCommand : ExitApp ( -- ) --- 78,89 ---- then ; IDM_OPEN_HTML_FILE SetCommand ! : OnPrint ( -- ) ! ActiveChild IF Print: CurrentWindow THEN ; IDM_PRINT SetCommand ! : PageSetup ( -- ) ! GetHandle: frame hOwner ! ! [ PSD_MARGINS ( PSD_MINMARGINS or ) PSD_INTHOUSANDTHSOFINCHES or ] literal PSDFlags ! ! PageSetupDlg drop ! ; IDM_PAGE_SETUP SetCommand : ExitApp ( -- ) Index: EdMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdMenu.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** EdMenu.f 6 May 2006 15:45:04 -0000 1.8 --- EdMenu.f 7 May 2006 06:34:26 -0000 1.9 *************** *** 7,17 **** \ \ Created: Sonntag, Juli 04 2004 - dbu ! \ Updated: Mittwoch, Juli 28 2004 - dbu ! \ ! \ Saturday, May 06 2006 Added Print and PageSetup - Rod \ \ Menu support for SciEdit - cr .( Loading Scintilla Menu...) --- 7,14 ---- \ \ Created: Sonntag, Juli 04 2004 - dbu ! \ Updated: Saturday, May 06 2006 - Rod \ \ Menu support for SciEdit cr .( Loading Scintilla Menu...) *************** *** 38,42 **** MenuSeparator :MenuItem mf_print "&Print...\tCtrl+P" IDM_PRINT DoCommand ; ! :MenuItem mf_page_setup "Page Set&up..." IDM_PAGE_SETUP DoCommand ; MenuSeparator MenuItem "E&xit\tALT+F4" IDM_EXIT DoCommand ; --- 35,39 ---- MenuSeparator :MenuItem mf_print "&Print...\tCtrl+P" IDM_PRINT DoCommand ; ! :MenuItem mf_page_setup "Page Set&up..." IDM_PAGE_SETUP DoCommand ; MenuSeparator MenuItem "E&xit\tALT+F4" IDM_EXIT DoCommand ; *************** *** 185,189 **** dup Enable: mf_openhl dup Enable: mf_print ! \ dup Enable: mf_page_setup \ Edit menu --- 182,186 ---- dup Enable: mf_openhl dup Enable: mf_print ! dup Enable: mf_page_setup \ Edit menu *************** *** 253,256 **** --- 250,254 ---- ?BrowseMode: ActiveChild not Enable: mf_saveas ?Selection: ActiveChild Enable: mf_openhl + GetTextLength: ActiveChild Enable: mf_print \ Edit menu |
|
From: Jos v.d.V. <jo...@us...> - 2006-05-06 16:14:09
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25122/src/lib Modified Files: Listview.f Log Message: Jos: Changed GetItemText:. It is better to leave the count of the found string on the stack. Index: Listview.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Listview.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Listview.f 3 May 2006 17:34:06 -0000 1.5 --- Listview.f 6 May 2006 16:14:06 -0000 1.6 *************** *** 314,318 **** :M GetItemSpacing: ( fsmall -- f ) 0 swap LVM_GETITEMSPACING hWnd Call SendMessage ;M :M GetItemState: ( mask i -- f ) LVM_GETITEMSTATE hWnd Call SendMessage ;M ! :M GetItemText: ( pitem iItem -- ) LVM_GETITEMTEXT hWnd Call SendMessage drop ;M :M GetSelectedCount: ( -- n ) 0 0 LVM_GETSELECTEDCOUNT hWnd Call SendMessage ;M :M InsertItem: ( pitem -- index | -1 ) 0 LVM_INSERTITEM hWnd Call SendMessage ;M --- 314,318 ---- :M GetItemSpacing: ( fsmall -- f ) 0 swap LVM_GETITEMSPACING hWnd Call SendMessage ;M :M GetItemState: ( mask i -- f ) LVM_GETITEMSTATE hWnd Call SendMessage ;M ! :M GetItemText: ( pitem iItem -- count ) LVM_GETITEMTEXT hWnd Call SendMessage ;M :M GetSelectedCount: ( -- n ) 0 0 LVM_GETSELECTEDCOUNT hWnd Call SendMessage ;M :M InsertItem: ( pitem -- index | -1 ) 0 LVM_INSERTITEM hWnd Call SendMessage ;M |
|
From: Rod O. <rod...@us...> - 2006-05-06 15:45:08
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10365/apps/SciEdit Modified Files: CommandID.f EdCommand.f EdMenu.f Main.f Log Message: Rod: Added Print and PageSetup Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/Main.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** Main.f 21 Jan 2006 08:59:41 -0000 1.16 --- Main.f 6 May 2006 15:45:04 -0000 1.17 *************** *** 12,15 **** --- 12,17 ---- \ See www.scintilla.org for more information about the control. + \ Saturday, May 06 2006 Added Print and PageSetup - Rod + cr .( Loading SciEdit...) *************** *** 607,610 **** --- 609,613 ---- FCONTROL 'S' IDM_SAVE ACCELENTRY FALT 'S' IDM_SAVE_ALL ACCELENTRY + FCONTROL 'P' IDM_PRINT ACCELENTRY \ FCONTROL 'R' IDM_RELOAD ACCELENTRY FSHIFT FCONTROL or 'O' IDM_OPEN_HIGHLIGHTED_FILE ACCELENTRY *************** *** 693,696 **** --- 696,700 ---- : Main ( -- ) start: Frame + GetHandle: frame hwndOwner ! DefaultPrinter \ initialise PSD and PD init-shared-type ['] sciedit_win32forth-message is win32forth-message Index: CommandID.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/CommandID.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** CommandID.f 21 Jan 2006 08:59:41 -0000 1.7 --- CommandID.f 6 May 2006 15:45:04 -0000 1.8 *************** *** 8,11 **** --- 8,13 ---- \ Updated: Samstag, Juli 03 2004 - 10:52 - dbu + \ Saturday, May 06 2006 Added Print and PageSetup - Rod + cr .( Loading Menu Command ID's...) *************** *** 27,30 **** --- 29,34 ---- NewID IDM_RELOAD NewID IDM_OPEN_HTML_FILE + NewID IDM_PRINT + NewID IDM_PAGE_SETUP NewID IDM_EXIT NewID IDM_OPEN_RECENT_FILE Index: EdCommand.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdCommand.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** EdCommand.f 21 Jan 2006 08:59:41 -0000 1.7 --- EdCommand.f 6 May 2006 15:45:04 -0000 1.8 *************** *** 9,12 **** --- 9,14 ---- \ Updated: Samstag, Juli 03 2004 - 10:52 - dbu + \ Saturday, May 06 2006 Added Print and PageSetup - Rod + cr .( Loading Menu Commands...) *************** *** 78,81 **** --- 80,91 ---- then ; IDM_OPEN_HTML_FILE SetCommand + : OnPrint ( -- ) ActiveChild IF Print: CurrentWindow THEN ; IDM_PRINT SetCommand + + : PageSetup: ( -- ) + GetHandle: frame hOwner ! + [ PSD_MARGINS ( PSD_MINMARGINS or ) PSD_INTHOUSANDTHSOFINCHES or ] literal PSDFlags ! + PageSetupDlg drop + ; IDM_PAGE_SETUP SetCommand + : ExitApp ( -- ) 0 0 WM_CLOSE Gethandle: Frame call SendMessage Index: EdMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdMenu.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** EdMenu.f 21 Jan 2006 08:59:41 -0000 1.7 --- EdMenu.f 6 May 2006 15:45:04 -0000 1.8 *************** *** 9,14 **** --- 9,17 ---- \ Updated: Mittwoch, Juli 28 2004 - dbu \ + \ Saturday, May 06 2006 Added Print and PageSetup - Rod + \ \ Menu support for SciEdit + cr .( Loading Scintilla Menu...) *************** *** 34,37 **** --- 37,43 ---- MenuSeparator + :MenuItem mf_print "&Print...\tCtrl+P" IDM_PRINT DoCommand ; + :MenuItem mf_page_setup "Page Set&up..." IDM_PAGE_SETUP DoCommand ; + MenuSeparator MenuItem "E&xit\tALT+F4" IDM_EXIT DoCommand ; \ MenuSeparator *************** *** 178,181 **** --- 184,189 ---- \ dup Enable: mf_reload dup Enable: mf_openhl + dup Enable: mf_print + \ dup Enable: mf_page_setup \ Edit menu |
|
From: Rod O. <rod...@us...> - 2006-05-06 15:43:53
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9809/src/lib Modified Files: ScintillaControl.f Log Message: Rod: Added methods for printing - FormatRange: and Print: Index: ScintillaControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ScintillaControl.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ScintillaControl.f 31 Aug 2005 17:03:19 -0000 1.2 --- ScintillaControl.f 6 May 2006 15:43:48 -0000 1.3 *************** *** 10,13 **** --- 10,15 ---- \ See www.scintilla.org for more information about the control. + \ Saturday, May 06 2006 Added methods for printing - Rod + cr .( Loading Scintilla Control...) *************** *** 1914,1917 **** --- 1916,1996 ---- + \ ----------------------------------------------------------------------------- + \ Printing + \ ----------------------------------------------------------------------------- + + Record: RangeToFormat + int hdcPrinter + int hdcTarget + rectangle Pagesize + rectangle rcPage + int cpMin \ CharacterRange + int cpMax + ;Record + + :M FormatRange: ( f -- n ) RangeToFormat swap SCI_FORMATRANGE SendMessage:Self ;M + + \ assume PSD_INTHOUSANDTHSOFINCHES used in PageSetup + : Xpixels ( n -- n ) DPI: ThePrinter drop 1000 */ ; + : Ypixels ( n -- n ) DPI: ThePrinter nip 1000 */ ; + \ if PSD_INHUNDREDTHSOFMILLIMETERS used replace 1000 with 2540 + + : SetFormatRange ( -- ) + GetHandle: ThePrinter dup to hdcPrinter to hdcTarget + rtMargin @ Xpixels rtMargin cell+ @ Ypixels + Width: ThePrinter rtMargin 2 cells+ @ Xpixels - + Height: ThePrinter rtMargin 3 cells+ @ Ypixels - + SetRect: PageSize EraseRect: rcPage + 0 to cpMin GetTextLength: self to cpMax + ; + + :M Print: ( -- ) + hWnd hwndOwner ! + 1 nFromPage w! + + \ Find number of pages needed to print the file using the default printer + hDevMode 2@ \ save selected printer + Auto-print-init PutHandle: ThePrinter + SetFormatRange + SaveDC: ThePrinter + ( PageNo ) 1 + BEGIN + FALSE FormatRange: self to cpMin + dup nMaxPage < cpMin cpMax < and + WHILE 1+ + REPEAT dup nToPage w! nMaxPage w! + RestoreDC: ThePrinter + print-close + hDevMode 2! \ restore selected printer + \ Number of pages is put into nToPage and nMaxPage + + false + PD_HIDEPRINTTOFILE + nToPage w@ print-init2 ?dup + IF + PutHandle: ThePrinter + \ FileName 1+ DocName ! + SetFormatRange + Print-flags PD_SELECTION and + IF GetSelectionStart: self to cpMin GetSelectionEnd: self to cpMax THEN + \ Print-flags PD_CURRENTPAGE and + \ IF GetFirstVisibleLine: self dup PositionFromLine: self to cpMin LinesOnScreen: self + 1- PositionFromLine: self to cpMax THEN + SaveDC: ThePrinter + print-start + ( PageNo ) 1 + BEGIN + dup Get-frompage Get-topage between + IF start-page TRUE FormatRange: self to cpMin end-page + ELSE FALSE FormatRange: self to cpMin + THEN + dup nMaxPage < cpMin cpMax < and + WHILE 1+ + REPEAT drop ( last PageNo ) + print-end + RestoreDC: ThePrinter + print-close + THEN + ;M + ;Class |
1040 messages has been excluded from this view by a project administrator.
