From: Dirk B. <db...@us...> - 2005-04-24 13:36:05
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4568/apps/Player4 Modified Files: PLAYER4.F Pl_MciWindow.f Pl_Version.f Added Files: TrayWindow.f Log Message: Player 4th Version: 1.01.10 -> Traybar icon added Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** PLAYER4.F 23 Apr 2005 11:00:06 -0000 1.3 --- PLAYER4.F 24 Apr 2005 13:35:54 -0000 1.4 *************** *** 6,10 **** \ \ Created: Donnerstag, März 31 2005 - dbu ! \ Updated: Samstag, April 16 2005 - dbu \ \ A simple Audio- and Videoplayer using the MciVideoWindow class. --- 6,10 ---- \ \ Created: Donnerstag, März 31 2005 - dbu ! \ Updated: Sonntag, April 24 2005 - dbu \ \ A simple Audio- and Videoplayer using the MciVideoWindow class. *************** *** 31,34 **** --- 31,36 ---- needs shell_r.f needs catalog.f + needs TrayWindow.f + needs Player4.frm \ true value turnkey? *************** *** 109,113 **** \ Define the Main Window \ ----------------------------------------------------------------------------- ! :Object MainWindow <super Window 0 value toolbarH \ set to height of toolbar if any --- 111,115 ---- \ Define the Main Window \ ----------------------------------------------------------------------------- ! :Object MainWindow <super TrayWindow 0 value toolbarH \ set to height of toolbar if any *************** *** 181,184 **** --- 183,187 ---- :M On_Init: ( -- ) + On_Init: super ['] dosizing to track-func ['] on_clicked to click-func *************** *** 212,215 **** --- 215,238 ---- bye 0 ;M + \ ----------------------------------------------------------------------------- + \ Traybar handling + \ ----------------------------------------------------------------------------- + :M ShowWindow: ( -- ) + IsVisible?: self 0= + if ShowWindow: super + Video?: Player4W if Resume: Player4W then + SW_RESTORE Show: ControlCenter Update: ControlCenter + then ;M + + :M HideWindow: ( -- ) + IsVisible?: self + if Video?: Player4W if Pause: Player4W then + SW_HIDE Show: ControlCenter Update: ControlCenter + HideWindow: super + then ;M + + :M GetTooltip: ( -- addr len ) + WindowTitle: self zcount ;M + ;Object *************** *** 217,222 **** \ "Control center" dialog \ ----------------------------------------------------------------------------- - needs Player4.frm - : Pause/Resume ( -- ) Playing?: Player4W if Pause/Resume: Player4W then ; --- 240,243 ---- *************** *** 246,250 **** \ ----------------------------------------------------------------------------- : uninit-player4 ( -- ) ! Close: Player4W DestroyWindow: MainWindow ; unload-chain chain-add-before uninit-player4 --- 267,271 ---- \ ----------------------------------------------------------------------------- : uninit-player4 ( -- ) ! \ Close: Player4W DestroyWindow: MainWindow ; unload-chain chain-add-before uninit-player4 Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Pl_MciWindow.f 23 Apr 2005 11:00:08 -0000 1.2 --- Pl_MciWindow.f 24 Apr 2005 13:35:54 -0000 1.3 *************** *** 68,101 **** Video?: self 0= ;M - \ : IsFileType? ( addr len addr1 len1 -- f ) - \ string1$ place string0$ place - \ string0$ count ".EXT-ONLY" 2dup upper - \ string1$ count 2dup upper - \ compare 0= ; - - \ : type-of-media ( addr len -- addr len f ) \ true if it's a video file - \ 2dup - \ 2dup s" .mp3" IsFileType? -rot - \ 2dup s" .mid" IsFileType? -rot - \ s" .wav" IsFileType? - \ OR OR if false else true then ; - \ - \ : IsRealMedia? ( addr len -- f ) \ true if it's a RealPlayer file - \ s" .rm" IsFileType? ; - - \ : GetShortPathName ( addr len -- addr1 len1 ) - \ string0$ place string0$ +null - \ maxstring string1$ rel>abs string0$ 1+ rel>abs Call GetShortPathName drop - \ string1$ zcount ; - \ - \ : (.ms) ( ms -- addr len ) - \ 1000 /mod 60 /mod 60 /mod - \ 2 .#" string1$ place - \ s" :" string1$ +place 2 .#" string1$ +place - \ s" :" string1$ +place 2 .#" string1$ +place - \ s" ." string1$ +place 3 .#" string1$ +place - \ - \ string1$ count ; - : ReTitle ( addr len -- ) WindowTitle: parent zcount string0$ place ?dup --- 68,71 ---- --- NEW FILE: TrayWindow.f --- \ File: TrayWindow.f \ \ Author: Dirk Busch (dbu) \ Email: dir...@wi... \ \ Created: Sonntag, April 24 2005 - dbu \ Updated: Sonntag, April 24 2005 - dbu \ \ A window class that add's an icon in the traybar \ and hides itself when it is minimized cr .( Loading TrayWindow class...) anew -TrayWindow.f needs struct.f allocation ' dword alias HWND \ 4 bytes ' dword alias HICON \ 4 bytes previous internal struct{ \ NOTIFYICONDATA DWORD nid_cbSize HWND nid_hWnd UINT nid_uID UINT nid_uFlags UINT nid_uCallbackMessage HICON nid_hIcon 64 Field: nid_szTip }struct NOTIFYICONDATA #define NIM_ADD 0x00000000 #define NIM_MODIFY 0x00000001 #define NIM_DELETE 0x00000002 #define NIF_MESSAGE 0x00000001 #define NIF_ICON 0x00000002 #define NIF_TIP 0x00000004 2 proc Shell_NotifyIconA as Shell_NotifyIcon external :class TrayWindow <super window sizeof NOTIFYICONDATA mkstruct: pNOTIFYICONDATA :M GetTooltip: ( -- addr len ) s" Tooltip text" ;M :M GetID: ( -- uID ) 1 ;M :M GetFlags: ( -- uFlags ) [ NIF_ICON NIF_MESSAGE NIF_TIP or or ] literal ;M WM_APP 1+ constant WM_CALLBACK_MESSAGE :M On_Init: ( -- ) On_Init: super sizeof NOTIFYICONDATA >struct pNOTIFYICONDATA nid_cbSize ! GetHandle: self >struct pNOTIFYICONDATA nid_hWnd ! GetID: [ self ] >struct pNOTIFYICONDATA nid_uID ! GetFlags: [ self ] >struct pNOTIFYICONDATA nid_uFlags ! WM_CALLBACK_MESSAGE >struct pNOTIFYICONDATA nid_uCallbackMessage ! DefaultIcon: [ self ] >struct pNOTIFYICONDATA nid_hIcon ! GetTooltip: [ self ] >struct pNOTIFYICONDATA nid_szTip swap 64 min cmove pNOTIFYICONDATA NIM_ADD call Shell_NotifyIcon . ;M :M On_Done: ( -- ) pNOTIFYICONDATA NIM_DELETE call Shell_NotifyIcon . On_Done: super ;M :M IsVisible?: ( -- f ) GetHandle: self call IsWindowVisible ;M :M ShowWindow: ( -- ) IsVisible?: self 0= if SW_RESTORE Show: self Update: self then ;M :M HideWindow: ( -- ) IsVisible?: self if SW_HIDE Show: self Update: self then ;M :M WM_CALLBACK_MESSAGE ( hWnd uMsg wParam lParam -- f ) case WM_LBUTTONUP of ShowWindow: [ self ] endof endcase 0 ;M :M WM_SYSCOMMAND ( wparam lparam -- res ) over SC_MINIMIZE = if HideWindow: [ self ] else hWnd WM_SYSCOMMAND 2swap DefWindowProc: self then ;M ;class module |