unit main; {$DEFINE _DEBUG} //{$DEFINE ICONSIZE} //{$DEFINE UNICODEFORM} //{$DEFINE UNICODEAPP} {$DEFINE VMR} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, ActnList, AppEvnts, Grids, ImgList, Menus, ToolWin, DirectShow9, AppCommand, myComboBox, myDShow, myFileDialog, myFolderDialog, myGrid, myMessagePanel, mySendTo, myTaskBarMenu, myTrackBar, myWStrings; type TApp_CheaPlayer = class(TForm) ActionList1: TActionList; Action_File_OpenFile: TAction; Action_File_OpenFolder: TAction; Action_File_OpenThisFolder: TAction; Action_File_Property: TAction; Action_File_Restore: TAction; Action_File_Minimize: TAction; Action_File_Exit: TAction; Action_FileCmd: TAction; Action_FileCmd_Rename: TAction; Action_FileCmd_Move: TAction; Action_FileCmd_Copy: TAction; Action_FileCmd_Trash: TAction; Action_FileCmd_RemoveFromHDD: TAction; Action_File_SaveAs: TAction; Action_List_FolderName: TAction; Action_List_Edit: TAction; Action_List_Del: TAction; Action_List_Clear: TAction; Action_List_Copy: TAction; Action_List_Paste: TAction; Action_Sort: TAction; Action_Sort_FileName: TAction; Action_Sort_Path: TAction; Action_Sort_Name: TAction; Action_Sort_Ext: TAction; Action_Sort_Shuffle: TAction; Action_Play_PlayPause: TAction; Action_Play_Replay: TAction; Action_Play_Back: TAction; Action_Play_Next: TAction; Action_Play_SkipBack: TAction; Action_Play_SkipNext: TAction; Action_Play_FrameBack: TAction; Action_Play_FrameNext: TAction; Action_PlayRate: TAction; Action_PlayRate_20: TAction; Action_PlayRate_17: TAction; Action_PlayRate_15: TAction; Action_PlayRate_13: TAction; Action_PlayRate_11: TAction; Action_PlayRate_10: TAction; Action_PlayRate_09: TAction; Action_PlayRate_07: TAction; Action_PlayRate_05: TAction; Action_PlayRate_03: TAction; Action_PlayRate_01: TAction; Action_Play_Mute: TAction; Action_Zoom_Wallvideo: TAction; Action_Zoom_FullScreen: TAction; Action_Zoom_MaxScreen: TAction; Action_Zoom_50: TAction; Action_Zoom_100: TAction; Action_Zoom_200: TAction; Action_Zoom_Up: TAction; Action_Zoom_Down: TAction; Action_Zoom_Fit: TAction; Action_Zoom_KeepAspect: TAction; Action_Zoom_AspectStandard: TAction; Action_Zoom_AspectHiVision: TAction; Action_Zoom_AspectEVista: TAction; Action_Zoom_AspectAVista: TAction; Action_Zoom_AspectWideScope: TAction; Action_Zoom_Capture: TAction; Action_Opt_Random: TAction; Action_Opt_Resume: TAction; Action_Opt_TimeVerbose: TAction; Action_Opt_LargeIcon: TAction; Action_Debug_Window: TAction; Action_Help_VersionInfo: TAction; MainMenu_Main: TMainMenu; MenuItem_File: TMenuItem; MenuItem_File_OpenFile: TMenuItem; MenuItem_File_OpenFolder: TMenuItem; MenuItem_File_SaveAs: TMenuItem; MenuItem_File_Line1: TMenuItem; MenuItem_List_Edit: TMenuItem; MenuItem_List_Delete: TMenuItem; MenuItem_List_Clear: TMenuItem; MenuItem_File_Line2: TMenuItem; MenuItem_FileCmd: TMenuItem; MenuItem_FileCmd_Rename: TMenuItem; MenuItem_FileCmd_Move: TMenuItem; MenuItem_FileCmd_Copy: TMenuItem; MenuItem_FileCmd_Line1: TMenuItem; MenuItem_FileCmd_RemoveFromHDD: TMenuItem; MenuItem_FileCmd_Trash: TMenuItem; MenuItem_SendTo: TMenuItem; MenuItem_File_Property: TMenuItem; MenuItem_File_Line3: TMenuItem; MenuItem_File_Exit: TMenuItem; MenuItem_Play: TMenuItem; MenuItem_Play_PlayPause: TMenuItem; MenuItem_Play_Replay: TMenuItem; MenuItem_Play_Back: TMenuItem; MenuItem_Play_Next: TMenuItem; MenuItem_Play_Line1: TMenuItem; MenuItem_Play_SkipBack: TMenuItem; MenuItem_Play_SkipNext: TMenuItem; MenuItem_Play_FrameBack: TMenuItem; MenuItem_Play_FrameNext: TMenuItem; MenuItem_Play_Line2: TMenuItem; MenuItem_PlayRate: TMenuItem; MenuItem_PlayRate_20: TMenuItem; MenuItem_PlayRate_17: TMenuItem; MenuItem_PlayRate_15: TMenuItem; MenuItem_PlayRate_13: TMenuItem; MenuItem_PlayRate_11: TMenuItem; MenuItem_PlayRate_10: TMenuItem; MenuItem_PlayRate_09: TMenuItem; MenuItem_PlayRate_07: TMenuItem; MenuItem_PlayRate_05: TMenuItem; MenuItem_PlayRate_03: TMenuItem; MenuItem_PlayRate_01: TMenuItem; MenuItem_Play_Line3: TMenuItem; MenuItem_Play_Mute: TMenuItem; MenuItem_Zoom: TMenuItem; MenuItem_Zoom_50: TMenuItem; MenuItem_Zoom_100: TMenuItem; MenuItem_Zoom_200: TMenuItem; MenuItem_Zoom_Line1: TMenuItem; MenuItem_Zoom_Fit: TMenuItem; MenuItem_Zoom_KeepAspect: TMenuItem; MenuItem_Zoom_Line2: TMenuItem; MenuItem_Zoom_FullScreen: TMenuItem; MenuItem_Zoom_MaxScreen: TMenuItem; MenuItem_Zoom_Wallvideo: TMenuItem; MenuItem_Zoom_Line3: TMenuItem; MenuItem_Zoom_Size: TMenuItem; MenuItem_Zoom_AspectStandard: TMenuItem; MenuItem_Zoom_AspectHiVision: TMenuItem; MenuItem_Zoom_AspectEVista: TMenuItem; MenuItem_Zoom_AspectAVista: TMenuItem; MenuItem_Zoom_AspectWideScope: TMenuItem; MenuItem_Zoom_Capture: TMenuItem; MenuItem_Opt: TMenuItem; MenuItem_Opt_Random: TMenuItem; MenuItem_Opt_Resume: TMenuItem; MenuItem_Opt_TimeVerbose: TMenuItem; MenuItem_Opt_LargeIcon: TMenuItem; MenuItem_Opt_Line1: TMenuItem; MenuItem_Opt_Debug: TMenuItem; MenuItem_Help: TMenuItem; MenuItem_Help_VersionInfo: TMenuItem; PopupMenu_Main: TPopupMenu; MenuItem_PFile: TMenuItem; MenuItem_PFile_OpenFile: TMenuItem; MenuItem_PFile_OpenFolder: TMenuItem; MenuItem_PFile_SaveAs: TMenuItem; MenuItem_PFileLine1: TMenuItem; MenuItem_PList_Edit: TMenuItem; MenuItem_PList_Clear: TMenuItem; MenuItem_PList_Del: TMenuItem; MenuItem_PPlay: TMenuItem; MenuItem_PPlay_PlayPause: TMenuItem; MenuItem_PPlay_Replay: TMenuItem; MenuItem_PPlay_Back: TMenuItem; MenuItem_PPlay_Next: TMenuItem; MenuItem_PPlay_Line1: TMenuItem; MenuItem_PPlay_SkipBack: TMenuItem; MenuItem_PPlay_SkipNext: TMenuItem; MenuItem_PPlay_FrameBack: TMenuItem; MenuItem_PPlay_FrameNext: TMenuItem; MenuItem_PPlay_Line2: TMenuItem; MenuItem_PPlayRate: TMenuItem; MenuItem_PPlayRate_20: TMenuItem; MenuItem_PPlayRate_17: TMenuItem; MenuItem_PPlayRate_15: TMenuItem; MenuItem_PPlayRate_13: TMenuItem; MenuItem_PPlayRate_11: TMenuItem; MenuItem_PPlayRate_10: TMenuItem; MenuItem_PPlayRate_09: TMenuItem; MenuItem_PPlayRate_07: TMenuItem; MenuItem_PPlayRate_05: TMenuItem; MenuItem_PPlayRate_03: TMenuItem; MenuItem_PPlayRate_01: TMenuItem; MenuItem_PPlay_Line3: TMenuItem; MenuItem_PPlay_Mute: TMenuItem; MenuItem_PZoom: TMenuItem; MenuItem_PZoom_50: TMenuItem; MenuItem_PZoom_100: TMenuItem; MenuItem_PZoom_200: TMenuItem; MenuItem_PZoom_Line1: TMenuItem; MenuItem_PZoom_Wallvideo: TMenuItem; MenuItem_PZoom_FullScreen: TMenuItem; MenuItem_PZoom_MaxScreen: TMenuItem; MenuItem_PZoom_Line2: TMenuItem; MenuItem_PZoom_Fit: TMenuItem; MenuItem_PZoom_KeepAspect: TMenuItem; MenuItem_PZoom_Line3: TMenuItem; MenuItem_PZoom_AspectStandard: TMenuItem; MenuItem_PZoom_AspectHiVision: TMenuItem; MenuItem_PZoom_AspectEVista: TMenuItem; MenuItem_PZoom_AspectAVista: TMenuItem; MenuItem_PZoom_AspectWideScope: TMenuItem; MenuItem_PZoom_Line4: TMenuItem; MenuItem_PZoom_Capture: TMenuItem; MenuItem_POpt: TMenuItem; MenuItem_POpt_Random: TMenuItem; MenuItem_POpt_Resume: TMenuItem; MenuItem_POpt_TimeVerbose: TMenuItem; MenuItem_POpt_LargeIcon: TMenuItem; MenuItem_POpt_Line1: TMenuItem; MenuItem_PDebug_Window: TMenuItem; MenuItem_PLine1: TMenuItem; MenuItem_PFileCmd: TMenuItem; MenuItem_PFileCmd_Rename: TMenuItem; MenuItem_PFileCmd_Move: TMenuItem; MenuItem_PFileCmd_Copy: TMenuItem; MenuItem_PFileCmd_Line1: TMenuItem; MenuItem_PFileCmd_RemoveFromHDD: TMenuItem; MenuItem_PFileCmd_Trash: TMenuItem; MenuItem_PSendTo: TMenuItem; MenuItem_PFile_Property: TMenuItem; MenuItem_PLine2: TMenuItem; MenuItem_PFile_Exit: TMenuItem; PopupMenu_List: TPopupMenu; MenuItem_PPList_Clear: TMenuItem; MenuItem_PPList_Del: TMenuItem; PopupMenu_Zoom: TPopupMenu; MenuItem_ZZoom50: TMenuItem; MenuItem_ZZoom100: TMenuItem; MenuItem_ZZoom200: TMenuItem; MenuItem_ZZoomLine1: TMenuItem; MenuItem_ZZoomFit: TMenuItem; MenuItem_ZZoomKeepAspect: TMenuItem; MenuItem_ZZoomLine2: TMenuItem; MenuItem_ZZoomAspectStandard: TMenuItem; MenuItem_ZZoomAspectHiVision: TMenuItem; MenuItem_ZZoomAspectEVista: TMenuItem; MenuItem_ZZoomAspectAVista: TMenuItem; MenuItem_ZZoomAspectWideScope: TMenuItem; PopupMenu_PlayRate: TPopupMenu; MenuItemRate_PlayRate_20: TMenuItem; MenuItemRate_PlayRate_17: TMenuItem; MenuItemRate_PlayRate_15: TMenuItem; MenuItemRate_PlayRate_13: TMenuItem; MenuItemRate_PlayRate_11: TMenuItem; MenuItemRate_PlayRate_10: TMenuItem; MenuItemRate_PlayRate_09: TMenuItem; MenuItemRate_PlayRate_07: TMenuItem; MenuItemRate_PlayRate_05: TMenuItem; MenuItemRate_PlayRate_03: TMenuItem; MenuItemRate_PlayRate_01: TMenuItem; PopupMenu_Volume: TPopupMenu; MenuItem_PPPlayMute: TMenuItem; PopupMenu_File_OpenFile: TPopupMenu; PopupMenu_File_OpenFolder: TPopupMenu; PopupMenu_File_OpenThisFolder: TPopupMenu; Panel_Top: TPanel; ToolBar_Main: TToolBar; ToolButton_FileOpenFile: TToolButton; ToolButton_FileOpenFolder: TToolButton; ToolButton_File_OpenThisFolder: TToolButton; ToolButton_MainSpc1: TToolButton; ToolButton_ListDisp: TToolButton; ToolButton_ListEdit: TToolButton; ToolButton_ListDel: TToolButton; ToolButton_MainSpc2: TToolButton; ToolButton_ZoomCapture: TToolButton; ToolButton_MainSpc3: TToolButton; ToolButton_ZoomWallvideo: TToolButton; ToolButton_ZoomFullScreen: TToolButton; ToolButton_ZoomMaxScreen: TToolButton; ToolButton_Zoom100: TToolButton; ToolButton_MainSpc4: TToolButton; ToolButton_ZoomKeepAspect: TToolButton; ToolButton_OptRandom: TToolButton; ToolButton_MainSpc5: TToolButton; Label_Size: TLabel; ComboBox_Playlist: TMyComboBox; Shape_Top: TShape; DShow_Player: TMyDirectShowPlayer; Panel_Bottom: TPanel; Panel_Seek: TPanel; TrackBar_Seek: TMyTrackBar; Panel_Control: TPanel; ToolBar_Control: TToolBar; ToolButton_PlayPlayPause: TToolButton; ToolButton_PlayReplay: TToolButton; ToolButton_PlayBack: TToolButton; ToolButton_PlayNext: TToolButton; ToolButton_PlayFrameBack: TToolButton; ToolButton_PlayFrameNext: TToolButton; ToolButton_ControlSpc1: TToolButton; ToolButton_PlayMute: TToolButton; TrackBar_Volume: TMyTrackBar; ProgressBar_FileCmd: TProgressBar; Label_Time: TLabel; Dialog_File_OpenFolder: TMyOpenFolderDialog; Dialog_File_OpenFile: TMyOpenFileDialog; Dialog_File_OpenThisFolder: TMyOpenFolderDialog; Dialog_Save: TMySaveFileDialog; Dialog_FileCmd_Rename: TMySaveFileDialog; Dialog_FileCmd_Move: TMyOpenFolderDialog; Dialog_FileCmd_Copy: TMyOpenFolderDialog; ImageList1: TImageList; Timer_Time: TTimer; Timer_IsPlay: TTimer; Timer_GetFile: TTimer; ApplicationEvents1: TApplicationEvents; MyMessagePanel1: TMyMessagePanel; MenuItem_File_OpenThisFolder: TMenuItem; MenuItem_PFile_OpenThisFolder: TMenuItem; Action_Debug_Event: TAction; Action_Debug_EnumFilters: TAction; Action_Debug_EnumSytemFilters: TAction; Action_Debug_SaveAsGRF: TAction; MenuItem_Debug: TMenuItem; MenuItem_Debug_Event: TMenuItem; MenuItem_Debug_EnumFilters: TMenuItem; MenuItem_Debug_EnumSystemFilters: TMenuItem; MenuItem_Debug_Line1: TMenuItem; Dialog_Debug_SaveAsGRF: TMySaveFileDialog; MenuItem_Debug_SaveAsGRF: TMenuItem; MenuItem_PDebug: TMenuItem; MenuItem_PDebug_SaveAsGRF: TMenuItem; MenuItem_PDebug_Line1: TMenuItem; MenuItem_PDebug_EnumSystemFilters: TMenuItem; MenuItem_PDebug_EnumFilters: TMenuItem; MenuItem_PDebug_Event: TMenuItem; Action_FileCmd_MoveAs: TAction; Action_FileCmd_CopyAs: TAction; Dialog_FileCmd_CopyAs: TMySaveFileDialog; Dialog_FileCmd_MoveAs: TMySaveFileDialog; Action_Opt_ConfirmErr: TAction; Action_Opt_AllowImage: TAction; MenuItem_PPList_Line1: TMenuItem; MenuItem_PPList_Sort_FileName: TMenuItem; MenuItem_PPList_Sort_Path: TMenuItem; MenuItem_PPList_Sort_Name: TMenuItem; MenuItem_PPList_Sort_Ext: TMenuItem; MenuItem_PPList_Line2: TMenuItem; S1: TMenuItem; MenuItem_PPList_FolderName: TMenuItem; MenuItem_Opt_AllowImage: TMenuItem; MenuItem_PPList_Edit: TMenuItem; procedure actNop(Sender: TObject); procedure Action_File_OpenFileExecute (Sender: TObject); procedure Action_File_OpenFolderExecute (Sender: TObject); procedure Action_File_OpenThisFolderExecute(Sender: TObject); procedure Action_File_SaveAsExecute (Sender: TObject); procedure Action_File_RestoreExecute (Sender: TObject); procedure Action_File_MinimizeExecute (Sender: TObject); procedure Action_File_PropertyExecute (Sender: TObject); procedure Action_File_ExitExecute (Sender: TObject); procedure Action_FileCmd_RenameExecute (Sender: TObject); procedure Action_FileCmd_MoveExecute (Sender: TObject); procedure Action_FileCmd_CopyExecute (Sender: TObject); procedure Action_FileCmd_TrashExecute (Sender: TObject); procedure Action_List_EditExecute (Sender: TObject); procedure Action_List_DelExecute (Sender: TObject); procedure Action_List_ClearExecute (Sender: TObject); procedure Action_List_CopyExecute (Sender: TObject); procedure Action_List_PasteExecute (Sender: TObject); procedure Action_Sort_FileNameExecute (Sender: TObject); procedure Action_Play_PlayPauseExecute (Sender: TObject); procedure Action_Play_ReplayExecute (Sender: TObject); procedure Action_Play_NextExecute (Sender: TObject); procedure Action_FrameNextExecute (Sender: TObject); procedure Action_Play_SkipNextExecute (Sender: TObject); procedure Action_PlayRate_10Execute (Sender: TObject); procedure Action_Play_MuteExecute (Sender: TObject); procedure Action_Zoom_100Execute (Sender: TObject); procedure Action_Zoom_UpExecute(Sender: TObject); procedure Action_Zoom_WallvideoExecute (Sender: TObject); procedure Action_Zoom_FullScreenExecute (Sender: TObject); procedure Action_Zoom_KeepAspectExecute (Sender: TObject); procedure Action_Zoom_AspectStandardExecute(Sender: TObject); procedure Action_Zoom_CaptureExecute (Sender: TObject); procedure Action_Opt_LargeIconExecute (Sender: TObject); procedure Action_Help_VersionInfoExecute(Sender: TObject); procedure Action_List_FolderNameExecute(Sender: TObject); procedure MenuItem_OpenHistoryClick (Sender: TObject); procedure MenuItem_OpenHistoryDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure MenuItem_MeasureItem (Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); procedure MenuItem_DrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure PopupMenu_MainPopup (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy (Sender: TObject); procedure FormKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure ComboBox_PlaylistSelect (Sender: TObject); procedure ComboBox_PlaylistDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure DShow_PlayerDblClick (Sender: TObject); procedure DShow_PlayerMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure DShow_PlayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure DShow_PlayerMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure DShow_PlayerResize (Sender: TObject); procedure DShow_PlayerMouseWheel (Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure DShow_PlayerExit (Sender: TObject); procedure DShow_PlayerMediaClosed (Sender: TObject); procedure DShow_PlayerMediaEnded (Sender: TObject); procedure DShow_PlayerMediaOpen (Sender: TObject); procedure DShow_PlayerMediaPaused (Sender: TObject); procedure DShow_PlayerMediaPlay (Sender: TObject); procedure DShow_PlayerMediaStart (Sender: TObject); procedure DShow_PlayerMediaStopped (Sender: TObject); procedure Grid_VideoDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure TrackBar_SeekMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TrackBar_SeekMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure TrackBar_SeekMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TrackBar_VolumeChange (Sender: TObject); procedure Timer_TimeTimer (Sender: TObject); procedure Timer_IsPlayTimer(Sender: TObject); procedure Timer_GetFileTimer(Sender: TObject); procedure ApplicationEvents1Message (var Msg: tagMSG; var Handled: Boolean); procedure ApplicationEvents1ActionExecute(Action: TBasicAction; var Handled: Boolean); procedure ApplicationEvents1Minimize (Sender: TObject); procedure ApplicationEvents1Restore (Sender: TObject); procedure MyMessagePanel1TextChange (Sender: TObject; Text: WideString); procedure Action_Opt_TimeVerboseExecute(Sender: TObject); procedure Action_Debug_WindowExecute(Sender: TObject); procedure Action_Debug_EventExecute(Sender: TObject); procedure Action_Debug_EnumFiltersExecute(Sender: TObject); procedure Action_Debug_EnumSytemFiltersExecute(Sender: TObject); procedure Action_Debug_SaveAsGRFExecute(Sender: TObject); procedure Action_FileCmd_CopyAsExecute(Sender: TObject); procedure Action_FileCmd_MoveAsExecute(Sender: TObject); private { Private 宣言 } {$IFDEF ICONSIZE} FBitmap_ImageList : TBitmap; {$ENDIF} {$IFDEF VMR} FvmVmMode : TMyVmMode; {$ENDIF} FPlayer : TMyDirectShowPlayer; FDisallowExts : TMyWStrings; FbDelete : Boolean; FbMediaEnded : Boolean; FfMediaTime : TRefTime; FiEndTime : DWORD; //レジューム用 FiResumeIndex : Integer; FfResumePosition : TRefTime; //リスト読み込み時の状況表示 FsGetFileName : WideString; FiGetFileCount : Integer; FiMuteImageIndex : Integer; //マウスジェスチャ用 FptMouseGesture : TPoint; //掴んで移動 FptDragMove : TPoint; //ソート用 FiSort : Integer; //最小化時タスクバーがフラッシュするのを防ぐため FhSubPlayerMsgHwnd : HWND; //送る FSendTo : TMySendTo; //タスクバーのメニュー FTaskBarMenu : TMyTaskBarMenu; //クリップボード監視 FhNextHandle : HWND; procedure FEntryClipboardViewer; procedure FRemoveClipboardViewer; procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD; procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN; procedure WMDisplayChange(var Msg: TMessage); message WM_DISPLAYCHANGE; procedure WMDropFiles (var Msg: TWMDropFiles); message WM_DROPFILES; procedure WMSysCommand (var Msg: TWMSysCommand); message WM_SYSCOMMAND; procedure FAdjustVideoWindow; procedure FOnVideoSizeChange(Sender: TObject; iWidth, iHeight: Word); procedure FDoMediaEnded; procedure FAddList(AList: TMyWStrings); procedure FAddOpenHistory(AList: TMyWStrings; AMenuItem: TMenuItem); overload; procedure FAddOpenHistory(sFileName: WideString; AMenuItem: TMenuItem); overload; procedure FCreateSubForm; procedure FDeleteMessage(sMsg: WideString); procedure FDispCount(iCount: Integer; sFileName: WideString); function FGetIniDir: WideString; procedure FHidePanel; function FIsFullScreen: Boolean; function FIsFunc: Boolean; procedure FResetFullScreen; procedure FResetWallvideo; procedure FSeek(fPos: TRefTime); procedure FSendMessagePanel(sMsg: WideString); procedure FSetFullScreen(bValue: Boolean); procedure FSetVideoSize; procedure FShowBottomPanel; procedure FShowPanel; procedure FShowTopPanel; procedure FOpen; overload; procedure FOpen(sFile: WideString); overload; function FSubFormExists: Boolean; //タスクバーの追加メニュー procedure FSetTaskBarCaption(AMenuItem: TMenuItem; var sCaption: WideString); procedure FRecreateTaskBarMenu(Sender: TObject); //設定ファイル function FLoadIni: Boolean; procedure FSaveIni; protected procedure WndProc(var Msg: TMessage); override; public { Public 宣言 } procedure WMAppCommand(var Msg: TMessage); message WM_APPCOMMAND; procedure BeginFunc; procedure EndFunc; procedure DoCapture(sFile: WideString; iPos: Integer); procedure DeleteItem(iIndex: Integer); function FileRename(sFile: WideString): Integer; function FileMove (sFile: WideString): Integer; function FileCopy (sFile: WideString): Integer; function FileTrash (sFile: WideString): Integer; procedure OpenProperty(iIndex: Integer); procedure Play(iIndex: Integer); procedure Stop; procedure ResetCount; procedure SetCaption(AForm: TForm; sCaption: WideString); end; var App_CheaPlayer : TApp_CheaPlayer; G_MainForm : TApp_CheaPlayer; implementation uses {$IFDEF _DEBUG} myDebug, {$ENDIF} myDebugDShow, ActiveX, BaseClass, Clipbrd, CommCtrl, DSUtil, MultiMon, ShellAPI, myApp, myBmpCaptureEx, myClipbrd, myControl, // myCustomExt, myDragAndDrop, myFile, myFileStrings, myGraphic, myHelpVersionInfo, myHintWindow, myIniFile, myList, myMonitor, myMenu, myMessageBox, myMultiMedia, myNum, myParam, myShortCut, mySize, myString, myTag, myWallvideo, myWindow, list, sub; {$R *.dfm} const F_ciEndInterval = 1000; F_ciImageInterval = 10000; const F_ciMENUIDMFIRST = 100; const F_csRESUMEEXT = '.resume.m3u8'; //レジュームのテンポラリリスト { const F_csSENDTOFOLDER = 'SendTo'; //送るメニューの送り先のリンクファイル格納フォルダ F_csSENDTOEXT : array[0..1]of WideString = ('.bat', '.lnk'); } const F_csATOM_DOFUNCTION = 'atom_formenabled'; //何らかの処理を行っている最中にフォームの操作を行って欲しくない場合にカウンターとしてATOMを使う時の文字列 //------------------------------------------------------------------------------ //クリップボード監視ルーチン procedure TApp_CheaPlayer.FEntryClipboardViewer; begin FhNextHandle := SetClipboardViewer(Handle); if (FhNextHandle = 0) and (GetLastError <> 0) then begin {エラーだったら} //クリップボードの更新チェックの登録処理に失敗した場合の処理 //ShowMessage('クリップボードの更新チェックの登録処理に失敗しました'); end; end; procedure TApp_CheaPlayer.FRemoveClipboardViewer; begin //クリップボード監視処理の破棄 ChangeClipboardChain(Handle, FhNextHandle); end; procedure TApp_CheaPlayer.WMDrawClipboard(var Msg: TWMDrawClipboard); //クリップボード更新フック //更新された後に流れてくる。 //アプリが立ち上がった瞬間も流れる begin inherited; if (FhNextHandle <> 0) then begin //次の監視ウィンドウへメッセージ送信 SendMessage(FhNextHandle, WM_DRAWCLIPBOARD, 0, 0); end; Action_List_Paste.Enabled := Clipboard.HasFormat(CF_TEXT); end; procedure TApp_CheaPlayer.WMChangeCBChain(var Msg: TWMChangeCBChain); begin if (Msg.Remove = FhNextHandle) then begin //クリップボードをフックしている次のウィンドウがフックを解除した FhNextHandle := Msg.Next; end; if (FhNextHandle <> 0) then begin //次のビューアへメッセージ送信 SendMessage(FhNextHandle, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next); end; end; //------------------------------------------------------------------------------ procedure TApp_CheaPlayer.WndProc(var Msg: TMessage); begin case Msg.Msg of WM_INITMENU :begin if (Msg.WParam = wParam(MainMenu_Main.Handle)) then begin PopupMenu_MainPopup(nil); end; end; end; inherited WndProc(Msg); end; procedure TApp_CheaPlayer.WMDropFiles(var Msg: TWMDropFiles); var i : Integer; l_Drop : TMyDropFiles; ls_File : WideString; l_MediaList : TMyWStrings; begin BeginFunc; try l_Drop := TMyDropFiles.Create(Msg, Self); try l_MediaList := nil; try l_MediaList := TMyWStrings.Create; for i := 0 to l_Drop.Count -1 do begin ls_File := l_Drop.Files[i]; if (gfnbFileExists(ls_File)) or (gfnbFolderExists(ls_File)) then begin l_MediaList.Add(ls_File); end; end; if (l_MediaList.Count > 0) then begin Dialog_File_OpenFile.Files.Assign(l_MediaList); Action_File_OpenFileExecute(nil); end; finally l_MediaList.Free; end; finally l_Drop.Free; end; finally EndFunc; end; end; //------------------------------------------------------------------------------ function TApp_CheaPlayer.FGetIniDir: WideString; begin Result := gfnsMyVideoPathGet; if (Result = '') then begin Result := gfnsMyMusicPathGet; end; if (Result = '') then begin Result := gfnsMyDocumentsPathGet; end; end; procedure TApp_CheaPlayer.FormCreate(Sender: TObject); var l_List : TMyWStrings; {$IFDEF ICONSIZE} i : Integer; l_Bitmap : TBitmap; {$ENDIF} begin {$IFDEF _DEBUG} // myDebug.gpcMessageModeSet(True); MenuItem_Debug.Visible := True; {$ELSE} MenuItem_Debug.Visible := False; {$ENDIF} G_MainForm := Self; Self.Icon := Application.Icon; FPlayer := DShow_Player; SetCaption(Self, gfnsProductNameGet); FPlayer.Use_ffdShow := True; {$IFDEF VMR} if (myWindow.gfniOSMajorVersionGet >= 6) then begin FvmVmMode := vmVMR9; end else begin FvmVmMode := vmVMR7; end; FPlayer.Renderer := FvmVmMode; {$ENDIF} {$IFDEF ICONSIZE} Action_Opt_LargeIcon.Visible := True; FBitmap_ImageList := TBitmap.Create; FBitmap_ImageList.Height := ImageList1.Height; FBitmap_ImageList.Width := ImageList1.Width * ImageList1.Count; l_Bitmap := TBitmap.Create; try l_Bitmap.Width := ImageList1.Width; l_Bitmap.Height := ImageList1.Height; l_Bitmap.Canvas.Brush.Color := clFuchsia; for i := 0 to ImageList1.Count -1 do begin l_Bitmap.Canvas.FillRect(Rect(0, 0, l_Bitmap.Width, l_Bitmap.Height)); ImageList1.GetBitmap(i, l_Bitmap); BitBlt( FBitmap_ImageList.Canvas.Handle, i * l_Bitmap.Width, 0, l_Bitmap.Width, l_Bitmap.Height, l_Bitmap.Canvas.Handle, 0, 0, SRCCOPY ); end; finally l_Bitmap.Free; end; {$ELSE} Action_Opt_LargeIcon.Visible := False; {$ENDIF} FPlayer.OnVideoSizeChange := FOnVideoSizeChange; FfMediaTime := -1; FiEndTime := 0; FbDelete := False; FbMediaEnded := False; ComboBox_Playlist.Items.ObjectsFree := True; FDisallowExts := TMyWStrings.Create; with FDisallowExts do begin //HTML Add('.css'); Add('.js'); Add('.htm'); Add('.html'); Add('.xml'); //Help Add('.chm'); Add('.h1?'); Add('.hlp'); //テキスト Add('.doc'); Add('.ini'); Add('.log'); Add('.txt'); { //画像 Add('.bmp'); Add('.cur'); Add('.gif'); Add('.jpg'); Add('.jpeg'); Add('.ico'); Add('.png'); Add('.tif'); Add('.tiff'); } //バイナリ Add('.bin'); Add('.dat'); Add('.db'); Add('.sys'); //実行ファイル Add('.bat'); Add('.cmd'); Add('.com'); Add('.dll'); Add('.exe'); Add('.ocx'); Add('.pif'); Add('.scr'); Add('.vbx'); Add('.tvpid'); end; Label_Size.Caption := ''; Label_Time.Caption := ''; FptMouseGesture := Point(MAXINT, MAXINT); FptDragMove := Point(MAXINT, MAXINT); Panel_Control.DoubleBuffered := True; // Self.Color := gfniOverlayColorGet; Self.Color := clBlack; Self.ClientWidth := 480; Self.ClientHeight := Trunc(Self.ClientWidth * (360 / 640)) + Panel_Top.Height + Panel_Bottom.Height; // FPlayer.Renderer := vmFriendlyVideoRenderer; FPlayer.SendToBack; FPlayer.ParentColor := True; FSetVideoSize; FiResumeIndex := -1; Dialog_File_OpenFile.InitialDir := FGetIniDir; Dialog_File_OpenFolder.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_File_OpenThisFolder.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_FileCmd_MoveAs.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_FileCmd_CopyAs.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_FileCmd_Move.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_FileCmd_Copy.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_Debug_SaveAsGRF.InitialDir := Dialog_File_OpenFile.InitialDir; Dialog_FileCmd_MoveAs.Filter := Dialog_File_OpenFile.Filter; Dialog_FileCmd_CopyAs.Filter := Dialog_File_OpenFile.Filter; App_CheaPlayerList := TApp_CheaPlayerList.Create(Self); //送る FSendTo := TMySendTo.Create(Self); FSendTo.AddMenuItem(MenuItem_SendTo); FSendTo.AddMenuItem(MenuItem_PSendTo); FSendTo.CreateSendToMenu; ToolBar_Control.AutoSize := True; FiMuteImageIndex := Action_Play_Mute.ImageIndex; Action_List_ClearExecute(nil); //クリップボード監視 FEntryClipboardViewer; // Dialog_File_OpenFile.Filter := gfnsDialogFileterExtAddAllKind(Dialog_File_OpenFile.Filter, 'すべてのメディア'); // Dialog_FileCmdRename.Filter := gfnsDialogFileterExtAddAllKind(Dialog_FileCmdRename.Filter, 'すべてのメディア'); //拡張子のカスタマイズ // myCustomExt.gpcCustomExtLoadIni; Tag := 1; if not(FLoadIni) then begin end; Action_Play_MuteExecute(nil); Dialog_FileCmd_Rename.Filter := Dialog_File_OpenFile.Filter; gpcPopupShortCutClear(PopupMenu_Main); gpcPopupShortCutClear(PopupMenu_List); gpcPopupShortCutClear(PopupMenu_Zoom); FTaskBarMenu := TMyTaskBarMenu.Create( PopupMenu_Main, FSetTaskBarCaption, ); PopupMenu_MainPopup(nil); FSendTo.OnMenuCreated := FRecreateTaskBarMenu; DragAcceptFiles(Self.Handle, True); //サブフォーム作成 FCreateSubForm; // ShowWindow(Self.Handle, SW_HIDE); // FShowForm; // Tag := 1; Self.Show; myApp.gpcFormBringToFront(Self); if (ParamW.ShiftCount >= 1) then begin FAddList(ParamW.ShiftParams); end else begin if (Action_Opt_Resume.Checked) and (FiResumeIndex >= 0) then begin l_List := TMyWStrings.Create; try l_List.Add(gfnsFileExtChange(gfnsExeNameGet, F_csRESUMEEXT)); if (l_List.Count > 0) then begin FAddList(l_List); end; finally l_List.Free; end; FPlayer.Play; end; end; end; procedure TApp_CheaPlayer.FormClose(Sender: TObject; var Action: TCloseAction); begin // Tag := 0; // FStop; // FPlayer.Close; FPlayer.Debug := False; {$IFDEF ICONSIZE} FBitmap_ImageList.Free; {$ENDIF} //フルスクリーン状態であった場合元に戻す Action_Zoom_FullScreenExecute(nil); end; procedure TApp_CheaPlayer.FormDestroy(Sender: TObject); begin if (Tag = 0) then begin Exit; end; Tag := 0; FPlayer.Debug := False; DragAcceptFiles(Self.Handle, False); FPlayer.Pause; FSaveIni; Stop; FPlayer.Close; FResetWallvideo; FreeAndNil(FTaskBarMenu); FDisallowExts.Free; //クリップボード監視を解除 FRemoveClipboardViewer; // FreeAndNil(SendTo); FSendMessagePanel('/CLOSE'); end; procedure TApp_CheaPlayer.WMDisplayChange(var Msg: TMessage); //TScreenのMonitorsプロパティがディスプレイの変更に追随しない不具合の回避のため。 begin Self.Monitor; end; procedure TApp_CheaPlayer.Action_File_ExitExecute(Sender: TObject); begin Close; end; procedure TApp_CheaPlayer.Stop; begin if (FPlayer.MediaAssigned) then begin FPlayer.FadeOut; FPlayer.Stop; end; FfMediaTime := -1; FiEndTime := 0; end; procedure TApp_CheaPlayer.Play(iIndex: Integer); begin if (gfnbIsInsideRange(iIndex, 0, ComboBox_Playlist.Items.Count -1)) then begin ComboBox_Playlist.ItemIndex := iIndex; // ComboBox_PlaylistSelect(nil); FOpen; end else begin gpcShowMessage(WideFormat('インデックス指定エラー'#13'%d', [iIndex])); end; end; procedure TApp_CheaPlayer.Action_Play_PlayPauseExecute(Sender: TObject); //再生/一時停止 begin if (DShow_Player.PlayState = gciPLAYSTATE_PLAYING) then begin DShow_Player.Pause; end else begin DShow_Player.Play; end; end; procedure TApp_CheaPlayer.Action_Play_ReplayExecute(Sender: TObject); begin if (DShow_Player.MediaAssigned) then begin DShow_Player.FadeOut; DShow_Player.Replay; if not(Action_Play_Mute.Checked) then begin DShow_Player.FadeIn(TrackBar_Volume.Position); end; end; end; procedure TApp_CheaPlayer.Action_Play_NextExecute(Sender: TObject); //前へ/次へ var li_OldIndex : Integer; li_NewIndex : Integer; begin if (ComboBox_Playlist.Items.Count > 0) then begin li_OldIndex := ComboBox_Playlist.ItemIndex; if (Action_Opt_Random.Checked) then begin //ランダム(シャッフルではない) if (ComboBox_Playlist.Items.Count <= 1) then begin li_NewIndex := 0; end else begin repeat li_NewIndex := Random(ComboBox_Playlist.Items.Count); until (li_NewIndex <> li_OldIndex); end; end else begin if (Sender = Action_Play_Back) then begin li_NewIndex := gfniNumLoop(li_OldIndex -1, 0, ComboBox_Playlist.Items.Count -1); end else if (Sender = Action_Play_Next) then begin li_NewIndex := gfniNumLoop(li_OldIndex +1, 0, ComboBox_Playlist.Items.Count -1); end else begin Exit; end; end; ComboBox_Playlist.ItemIndex := li_NewIndex; FOpen; // ComboBox_PlaylistSelect(nil); end else begin //リストのクリアではなく後始末の処理のため Action_List_ClearExecute(nil); end; end; procedure TApp_CheaPlayer.MenuItem_MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin myMenu.MenuItem_MeasureItem(Sender, ACanvas, Width, Height); end; procedure TApp_CheaPlayer.MenuItem_DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin myMenu.MenuItem_AdvancedDrawItem(Sender, ACanvas, ARect, State); end; procedure TApp_CheaPlayer.MenuItem_OpenHistoryDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); const lci_MARGIN = 6; var l_Rect : TRect; ls_File : WideString; begin l_Rect := ARect; with ACanvas do begin FillRect(l_Rect); Inc(l_Rect.Left, lci_MARGIN); ls_File := gfnsAnsiToWideEx(TMenuItem(Sender).Hint); //キャプションでないのがミソ DrawTextW(Handle, PWideChar(ls_File), -1, l_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); end; end; procedure TApp_CheaPlayer.MenuItem_OpenHistoryClick(Sender: TObject); var l_MenuItem : TMenuItem; ls_Item : WideString; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); ls_Item := gfnsAnsiToWideEx(TMenuItem(Sender).Hint); if (l_MenuItem.GetParentMenu = PopupMenu_File_OpenFile) then begin //開くの履歴 Dialog_File_OpenFile.Files.Clear; Dialog_File_OpenFile.FileName := ls_Item; Action_File_OpenFileExecute(nil); end else if (l_MenuItem.GetParentMenu = PopupMenu_File_OpenFolder) then begin //フォルダを開くの履歴 Dialog_File_OpenFolder.Folders.Clear; Dialog_File_OpenFolder.Folders.Add(ls_Item); Action_File_OpenFolderExecute(nil); end else if (l_MenuItem.GetParentMenu = PopupMenu_File_OpenThisFolder) then begin //フォルダを開くの履歴 Dialog_File_OpenThisFolder.Folders.Clear; Dialog_File_OpenThisFolder.Folders.Add(ls_Item); Action_File_OpenThisFolderExecute(nil); end; end; procedure TApp_CheaPlayer.FDispCount(iCount: Integer; sFileName: WideString); //ファイル取得中の表示 begin FiGetFileCount := iCount; FsGetFileName := sFileName; end; procedure TApp_CheaPlayer.Timer_GetFileTimer(Sender: TObject); //ファイル取得中の表示 begin if (FsGetFileName <> '') then begin Self.Caption := Format('[%d] %s', [FiGetFileCount, FsGetFileName]); end else begin // Self.Caption := ''; SetCaption(Self, gfnsFileNameGet(FPlayer.FileName)); end; end; procedure TApp_CheaPlayer.FAddList(AList: TMyWStrings); var li_Count : Integer; l_List : TMyMediaStrings; // l_Exts : TStrings; // i : Integer; begin li_Count := ComboBox_Playlist.Items.Count; l_List := TMyMediaStrings.Create; try l_List.DisallowExt.Assign(FDisallowExts.AnsiStrings); l_List.OnDispCount := FDispCount; l_List.IsAppend := True; { l_Exts := TStringList.Create; try gpcDialogFilterExtToStrings(Dialog_File_OpenFile.Filter, l_Exts); for i := l_Exts.Count -1 downto 0 do begin if (l_Exts[i] = '*.*') then begin l_Exts.Delete(i); end else begin l_Exts[i] := gfnsFileExtGet(l_Exts[i]); end; end; l_List.AllowExtAdd(l_Exts); finally l_Exts.Free; end; } Timer_GetFile.Enabled := True; l_List.GetList(AList); Timer_GetFile.Enabled := False; if (l_List.Count = 0) then begin if (FiResumeIndex < 0) then begin gpcShowMessage('取得ファイルがありませんでした'); SetCaption(Self, gfnsProductNameGet); end; Exit; end; ComboBox_Playlist.Items.AddStrings(l_List); ResetCount; PopupMenu_MainPopup(nil); if (FiResumeIndex >= 0) then begin ComboBox_Playlist.ItemIndex := gfniNumLimit(FiResumeIndex, 0, ComboBox_Playlist.Items.Count -1); FOpen; // ComboBox_PlaylistSelect(nil); FiResumeIndex := -1; end else if (Action_Opt_Random.Checked) then begin ComboBox_Playlist.ItemIndex := Random(l_List.Count) + li_Count; FOpen; // ComboBox_PlaylistSelect(nil); end else begin ComboBox_Playlist.ItemIndex := li_Count -1; Action_Play_NextExecute(Action_Play_Next); end; finally l_List.Free; end; end; const F_ciHISTORYCOUNT = 10; procedure TApp_CheaPlayer.FAddOpenHistory(AList: TMyWStrings; AMenuItem: TMenuItem); var i : Integer; begin for i := AList.Count -1 downto 0 do begin FAddOpenHistory(AList[i], AMenuItem); end; end; procedure TApp_CheaPlayer.FAddOpenHistory(sFileName: WideString; AMenuItem: TMenuItem); var i : Integer; ls_File : WideString; ls_Name : String; ls_Caption : AnsiString; begin if (sFileName = '') then begin Exit; end; ls_File := WideUpperCase(sFileName); //履歴に同じファイルがあれば一番上にもっていくために削除しておく for i := AMenuItem.Count -1 downto 0 do begin if (WideUpperCase(gfnsAnsiToWideEx(AMenuItem[i].Hint)) = ls_File) then begin AMenuItem[i].Free; end; end; //空いている名前を取得する ls_Name := gfnsAvailableName('OpenHistory'); ls_Caption := gfnsWideToAnsiEx(sFileName); //頭に挿入 AMenuItem.Insert(0, NewItem( ls_Caption, //Caption 0, //ShortCut False, //Checked True, //Enabled MenuItem_OpenHistoryClick, //OnClickイベント 0, //HelpContext ls_Name //Name )); with AMenuItem[0] do begin Hint := gfnsWideToAnsiEx(sFileName); OnAdvancedDrawItem := MenuItem_OpenHistoryDrawItem; OnMeasureItem := MenuItem_MeasureItem; end; if (AMenuItem.Count > F_ciHISTORYCOUNT) then begin //最後の履歴を削除 AMenuItem[AMenuItem.Count-1].Free; end; end; procedure TApp_CheaPlayer.Action_File_OpenFileExecute(Sender: TObject); //開く var i : Integer; ls_File : WideString; begin BeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin Dialog_File_OpenFile.InitialDir := FGetIniDir; Dialog_File_OpenFile.FileName := ''; end else if not(gfnbFolderExists(Dialog_File_OpenFile.InitialDir)) then begin Dialog_File_OpenFile.InitialDir := gfnsExistsFolderGet(Dialog_File_OpenFile.InitialDir); end; if (Sender = nil) or (Dialog_File_OpenFile.Execute) then begin Dialog_File_OpenFile.InitialDir := gfnsFilePathGet(Dialog_File_OpenFile.FileName); FAddList(Dialog_File_OpenFile.Files); for i := 0 to Dialog_File_OpenFile.Files.Count -1 do begin ls_File := Dialog_File_OpenFile.Files[i]; if (gfnbFolderExists(ls_File)) then begin //フォルダの履歴に追加 FAddOpenHistory(ls_File, PopupMenu_File_OpenFolder.Items); end else if (gfnbFileExists(ls_File)) then begin //ファイルの履歴に追加 FAddOpenHistory(ls_File, PopupMenu_File_OpenFile.Items); end; end; end; finally EndFunc; end; end; procedure TApp_CheaPlayer.Action_File_OpenFolderExecute(Sender: TObject); begin BeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin Dialog_File_OpenFolder.InitialDir := FGetIniDir; end else if not(gfnbFolderExists(Dialog_File_OpenFolder.InitialDir)) then begin Dialog_File_OpenFolder.InitialDir := gfnsExistsFolderGet(Dialog_File_OpenFolder.InitialDir); end; if (Sender = nil) or (Dialog_File_OpenFolder.Execute) then begin Dialog_File_OpenFolder.InitialDir := gfnsFilePathGet(Dialog_File_OpenFolder.FolderName); FAddList(Dialog_File_OpenFolder.Folders); //開いた履歴に追加 FAddOpenHistory(Dialog_File_OpenFolder.FolderName, PopupMenu_File_OpenFolder.Items); end; finally EndFunc; end; end; procedure TApp_CheaPlayer.Action_File_OpenThisFolderExecute(Sender: TObject); //選択フォルダ中のファイルのみ開く var l_Files : TMyWStrings; lh_File : THandle; lr_Info : TWin32FindDataW; i: Integer; begin BeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin Dialog_File_OpenThisFolder.InitialDir := FGetIniDir; end else if not(gfnbFolderExists(Dialog_File_OpenThisFolder.InitialDir)) then begin Dialog_File_OpenThisFolder.InitialDir := gfnsExistsFolderGet(Dialog_File_OpenThisFolder.InitialDir); end; if (Sender = nil) or (Dialog_File_OpenThisFolder.Execute) then begin Dialog_File_OpenThisFolder.InitialDir := gfnsFilePathGet(Dialog_File_OpenThisFolder.FolderName); //選択フォルダ内のファイルのみリストアップ l_Files := nil; try l_Files := TMyWStrings.Create; for i := 0 to Dialog_File_OpenThisFolder.Folders.Count -1 do begin lh_File := Windows.FindFirstFileW(PWideChar(gfnsStrEndFit(Dialog_File_OpenThisFolder.Folders[i], '\') + '*.*'), lr_Info); if (lh_File <> INVALID_HANDLE_VALUE) then begin try repeat if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin l_Files.Add(gfnsStrEndFit(Dialog_File_OpenThisFolder.Folders[i], '\') + lr_Info.cFileName); end; Application.ProcessMessages; until not(Windows.FindNextFileW(lh_File, lr_Info)); finally Windows.FindClose(lh_File); end; end; end; FAddList(l_Files); //開いた履歴に追加 FAddOpenHistory(Dialog_File_OpenThisFolder.FolderName, PopupMenu_File_OpenThisFolder.Items); finally l_Files.Free; end; end; finally EndFunc; end; end; procedure TApp_CheaPlayer.Action_List_FolderNameExecute(Sender: TObject); begin ComboBox_Playlist.Refresh; end; procedure TApp_CheaPlayer.Action_List_EditExecute(Sender: TObject); begin G_PlaylistForm.PopupMenu_PlaylistPopup(nil); G_PlaylistForm.Action_Play_ItemIndexExecute(nil); if (ComboBox_Playlist.ItemIndex >= 0) then begin G_PlaylistForm.ListBox_Playlist.ItemIndex := ComboBox_Playlist.ItemIndex; end else begin G_PlaylistForm.ListBox_Playlist.ItemIndex := 0; end; G_PlaylistForm.ListBox_PlayListClick(nil); G_PlaylistForm.Show; gpcFormBringToFront(G_PlaylistForm); end; procedure TApp_CheaPlayer.DeleteItem(iIndex: Integer); //リストのiIndexのファイルを削除 var lb_Stop : Boolean; begin lb_Stop := (ComboBox_Playlist.ItemIndex = iIndex); if (lb_Stop) then begin Stop; end; if (iIndex < 0) then begin //0未満の指定なら現在再生中のアイテムを削除 if (ComboBox_Playlist.ItemIndex >= 0) then begin ComboBox_Playlist.Items.Delete(ComboBox_Playlist.ItemIndex); end; end else begin ComboBox_Playlist.Items.Delete(iIndex); end; if (lb_Stop) then begin ComboBox_Playlist.ItemIndex := iIndex -1; Action_Play_NextExecute(Action_Play_Next); end; end; procedure TApp_CheaPlayer.Action_List_DelExecute(Sender: TObject); //リストから再生中のファイルを削除 var li_Index : Integer; li_Ret : Integer; begin BeginFunc; try li_Index := ComboBox_Playlist.ItemIndex; if (Sender <> nil) then begin li_Ret := gfniMessageBoxYesNo('再生中のファイルをリストから削除します'#13'よろしいですか'); end else begin li_Ret := ID_YES; end; if (li_Ret = ID_YES) then begin FbDelete := True; DeleteItem(li_Index); FbDelete := False; end; finally EndFunc; end; ResetCount; end; procedure TApp_CheaPlayer.Action_List_ClearExecute(Sender: TObject); //リストクリア begin if (Sender = nil) or (gfniMessageBoxYesNo('リストをクリアします'#13'よろしいですか') = ID_YES) then begin DShow_Player.Close; ComboBox_Playlist.Items.Clear; ResetCount; if (Action_Zoom_Wallvideo.Checked) then begin Action_Zoom_WallvideoExecute(nil); end else if (Action_Zoom_FullScreen.Checked) or (Action_Zoom_MaxScreen.Checked) then begin Action_Zoom_FullScreenExecute(nil); end; end; end; procedure TApp_CheaPlayer.FDeleteMessage(sMsg: WideString); begin if (sMsg = '') then begin Action_List_DelExecute(nil); Exit; end; sMsg := sMsg + #13 + 'リストから削除しますか'; case gfniMessageBoxYesNoCancel(sMsg) of ID_YES :begin Action_List_DelExecute(nil); end; ID_NO :begin Action_Play_NextExecute(Action_Play_Next); end; else //ID_CANCEL begin FPlayer.Close; if not(FIsFunc) then begin G_PlaylistForm.ListBox_PlayList.Refresh; end; end; end; end; procedure TApp_CheaPlayer.FOpen; begin if (ComboBox_Playlist.ItemIndex < 0) then begin ComboBox_Playlist.ItemIndex := 0; end; FOpen(ComboBox_Playlist.Items[ComboBox_Playlist.ItemIndex]); end; procedure TApp_CheaPlayer.FOpen(sFile: WideString); var ls_Msg : WideString; begin BeginFunc; try Stop; if not(FPlayer.Open(sFile)) then begin if (Action_Opt_ConfirmErr.Checked) then begin ls_Msg := WideFormat('%s'#13'は開けません', [sFile]); end else begin ls_Msg := ''; end; FDeleteMessage(ls_Msg); Exit; end; finally EndFunc; end; end; procedure TApp_CheaPlayer.ComboBox_PlaylistSelect(Sender: TObject); //ファイル選択→再生 begin if (ComboBox_Playlist.Items.Count = 0) or (FisFunc) // or (Tag = 0) then begin Exit; end; if (ComboBox_Playlist.ItemIndex < 0) then begin ComboBox_Playlist.ItemIndex := 0; end; FOpen(ComboBox_Playlist.Items[ComboBox_Playlist.ItemIndex]); end; procedure TApp_CheaPlayer.DShow_PlayerMediaOpen(Sender: TObject); var ls_Msg : WideString; begin G_PlaylistForm.ItemIndexRefresh; if (FPlayer.Length = 0) then begin if (Action_Opt_ConfirmErr.Checked) then begin ls_Msg := WideFormat('%s'#13'は長さが0です。', [FPlayer.FileName]); end else begin ls_Msg := ''; end; if (FPlayer.MediaHasVideo) then begin if not(Action_Opt_AllowImage.Checked) then begin FDeleteMessage(ls_Msg); Exit; end; end else begin FDeleteMessage(ls_Msg); Exit; end; end; FSendTo.Arg := FPlayer.FileName; TrackBar_Seek.Max := FPlayer.Length; TrackBar_Seek.Position := 0; //アスペクト比保持 //ファイルを読み込んでからでないデスクトップがフラッシュしてしまう。 Action_Zoom_KeepAspectExecute(nil); //再生速度セット Action_PlayRate_10Execute(nil); //音量調整 Action_Play_MuteExecute(nil); Action_Zoom_WallvideoExecute(nil); Action_Zoom_FullScreenExecute(nil); //再生開始 if (FfResumePosition > 0) then begin //レジューム再生 if (FPlayer.Length > 0) and (FfResumePosition >= FPlayer.Duration) then begin FfResumePosition := 0; Action_Play_NextExecute(Action_Play_Next); Exit; end; FPlayer.CurrentPosition := FfResumePosition; TrackBar_Seek.Position := FPlayer.Position; FfResumePosition := 0; end else begin Action_Play_ReplayExecute(nil); end; end; procedure TApp_CheaPlayer.SetCaption(AForm: TForm; sCaption: WideString); var ls_Caption : WideString; ls_Title : WideString; ls_Hint : WideString; l_Tag : TMyTag; begin //タイトルバーにファイル名を表示 ls_Caption := sCaption; ls_Title := gfnsProductNameGet; if (AForm = Self) then begin if (DShow_Player.MediaAssigned) then begin l_Tag := TMyTag2.Create(DShow_Player.FileName); try ls_Hint := l_Tag.Title; if (l_Tag.Album <> '') then begin ls_Hint := WideFormat('%s'#$D'%s', [ls_Hint, l_Tag.Album]); end; if (l_Tag.Artist <> '') then begin ls_Hint := WideFormat('%s'#$D'%s', [ls_Hint, l_Tag.Artist]); end; { if (l_Tag.Composer <> '') then begin ls_Hint := WideFormat('%s'#$D'%s', [ls_Hint, l_Tag.Composer]); end; if (l_Tag.Writer <> '') then begin ls_Hint := WideFormat('%s'#$D'%s', [ls_Hint, l_Tag.Writer]); end; if (l_Tag.Conductor <> '') then begin ls_Hint := WideFormat('%s'#$D'%s', [ls_Hint, l_Tag.Conductor]); end; } finally l_Tag.Free; end; end else begin ls_Hint := ''; end; Panel_Top.Hint := gfnsWideToAnsiEx(DShow_Player.FileName); Panel_Bottom.Hint := gfnsWideToAnsiEx(ls_Hint); end; {$IFDEF UNICODEFORM} SetWindowText(AForm.Handle, PAnsiChar(PWideChar(ls_Caption))); // SetWindowTextW(AForm.Handle, PWideChar(ls_Caption)); {$ELSE} AForm.Caption := gfnsWideToAnsi(ls_Caption); {$ENDIF} {$IFDEF UNICODEAPP} SetWindowText(Application.Handle, PAnsiChar(PWideChar(ls_Title))); {$ELSE} Application.Title := gfnsWideToAnsi(ls_Title); {$ENDIF} end; procedure TApp_CheaPlayer.DShow_PlayerMediaStart(Sender: TObject); begin SetCaption(Self, gfnsFileNameGet(FPlayer.FileName)); FbMediaEnded := False; DShow_PlayerMediaPlay(nil); end; procedure TApp_CheaPlayer.FDoMediaEnded; begin //myDebug.gpcDebug([FbMediaEnded, FbDelete]); if (FbMediaEnded) or (FbDelete) then begin Exit; end; FbMediaEnded := True; Timer_Time.Enabled := False; //再生が終わりに来た //連続再生 if (ComboBox_Playlist.Items.Count = 0) then begin //後処理のため Action_List_ClearExecute(nil); end else begin //myDebug.gpcDebug('MediaEnded'); Action_Play_NextExecute(Action_Play_Next); end; FbMediaEnded := False; end; procedure TApp_CheaPlayer.DShow_PlayerMediaEnded(Sender: TObject); begin FDoMediaEnded; end; procedure TApp_CheaPlayer.DShow_PlayerMediaPlay(Sender: TObject); begin Timer_Time.Enabled := True; end; procedure TApp_CheaPlayer.DShow_PlayerMediaPaused(Sender: TObject); begin Timer_Time.Enabled := False; Timer_TimeTimer(nil); end; procedure TApp_CheaPlayer.DShow_PlayerMediaStopped(Sender: TObject); begin Timer_Time.Enabled := False; Timer_Time.Tag := 1; TrackBar_Seek.Position := 0; Timer_Time.Tag := 0; end; procedure TApp_CheaPlayer.DShow_PlayerMediaClosed(Sender: TObject); begin DShow_PlayerMediaStopped(nil); Label_Size.Caption := ''; Label_Time.Caption := ''; SetCaption(Self, gfnsProductNameGet); //フルスクリーン状態であった場合元に戻すため // Action_ZoomFullScreenExecute(nil); PopupMenu_MainPopup(nil); end; procedure TApp_CheaPlayer.FSendMessagePanel(sMsg : WideString); begin gpcMessagePanelSend(sMsg, FhSubPlayerMsgHwnd); end; procedure TApp_CheaPlayer.MyMessagePanel1TextChange(Sender: TObject; Text: WideString); var i : Integer; l_Param : TMyParam; l_Option : TMyParamOption; begin {$IFDEF _DEBUG} { if (Pos('/TIME:', Text) = 0) then begin myDebug.gpcDebug(Text); end; } {$ENDIF} l_Param := TMyParam.Create(Text); try for i := 0 to l_Param.Count -1 do begin l_Option := l_Param.OptionParam[i]; if (l_Option.CompareOption('TO_SUBPLAYER')) then begin //メッセージの送り先 FhSubPlayerMsgHwnd := l_Option.ValueInt; end; end; finally l_Param.Free; end; end; procedure TApp_CheaPlayer.DShow_PlayerResize(Sender: TObject); begin //ビデオのサイズ取得 if (DShow_Player.MediaHasVideo) then begin Label_Size.Caption := Format('%dx%d %sfps [%dx%d %.2f:1]', [ DShow_Player.VideoWidth, DShow_Player.VideoHeight, DShow_Player.FrameRateString, DShow_Player.ClientWidth, DShow_Player.ClientHeight, DShow_Player.ClientWidth / DShow_Player.ClientHeight ]); { Label_Size.Hint := Format('%s [%dx%d %.2f:1]', [ Label_Size.Caption, DShow_Player.ClientWidth, DShow_Player.ClientHeight, DShow_Player.ClientWidth / DShow_Player.ClientHeight ]); } end else begin Label_Size.Caption := ''; end; end; procedure TApp_CheaPlayer.FSetFullScreen(bValue: Boolean); var li_Style : Longint; begin li_Style := GetWindowLong(Handle, GWL_STYLE); //ウィンドウスタイル if (bValue) then begin //タイトルバー、ある状態からない状態へ if ((li_Style and WS_CAPTION) <> 0) then Dec(li_Style, WS_CAPTION); if ((li_Style and WS_DLGFRAME) <> 0) then Dec(li_Style, WS_DLGFRAME); if ((li_Style and WS_THICKFRAME) <> 0) then Dec(li_Style, WS_THICKFRAME); SetWindowLong(Handle, GWL_STYLE, li_Style); end else begin //タイトルバー、ない状態からある状態へ SetWindowLong(Handle, GWL_STYLE, li_Style or WS_CAPTION or WS_DLGFRAME or WS_THICKFRAME); end; SetWindowPos(Self.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); //メニューバー if (bValue) then begin Self.Menu := nil; end else begin Self.Menu := MainMenu_Main; end; end; procedure TApp_CheaPlayer.FSetVideoSize; begin if (FIsFullScreen) then begin Exit; end; DShow_Player.SetBounds( 0, Panel_Top.Height, Self.ClientWidth, Self.ClientHeight - Panel_Top.Height - Panel_Bottom.Height ); DShow_PlayerResize(nil); end; procedure TApp_CheaPlayer.Action_Zoom_UpExecute(Sender: TObject); function _ZoomGet(const iWidth: Integer; const bShift: Boolean): Integer; begin if (bShift) then begin Result := 1; end else begin Result := gfniNumLimit(iWidth div 10, 2, Screen.WorkAreaWidth div 10); end; end; function _RectGet: TRect; begin Result := gfnrcRectMove(ClientRect, Point(Self.ClientOrigin.X, Self.ClientOrigin.Y)); end; const lci_ZOOM = 12; lci_MAX = 5; lci_MIN = 5; var li_Zoom : Integer; li_Left : Integer; li_Top : Integer; li_Width : Integer; li_Height : Integer; li_ClientWidth : Integer; li_ClientHeight : Integer; lpt_Pos : TPoint; lrc_Rect : TRect; l_Monitor : TMonitor; begin // if (FbThrough) if (Action_Zoom_FullScreen.Checked) or (Action_Zoom_MaxScreen.Checked) then begin Exit; end; // FbThrough := True; BeginFunc; try if (Sender = Action_Zoom_UP) then begin //拡大 li_Zoom := 1; end else if (Sender = Action_Zoom_DOWN) then begin //縮小 li_Zoom := -1; end else begin li_Zoom := 0; end; lrc_Rect := _RectGet; li_ClientWidth := ClientWidth; li_ClientHeight := ClientHeight - Panel_Top.Height - Panel_Bottom.Height; if (FPlayer.MediaHasVideo) and (gfnbKeyState(VK_CONTROL)) then begin if not(Action_Zoom_Wallvideo.Checked) then begin //映像のみの部分拡大・縮小 if (gfnbKeyState(VK_SHIFT)) then begin li_Width := FPlayer.Width + (li_Zoom * 1); end else begin li_Width := FPlayer.Width + gfniRound(li_Zoom * (lci_ZOOM / 100)); end; li_Width := li_Width + (li_Zoom * (_ZoomGet(li_Width, gfnbKeyState(VK_SHIFT)))); li_Height := FPlayer.HeightFromWidth(li_Width); if (li_Width <= li_ClientWidth * lci_MAX) // 幅の5倍まで and (li_Height <= li_ClientHeight * lci_MAX) // 高さの5倍まで and (li_Width >= li_ClientWidth div lci_MIN) // 幅の1/5まで and (li_Height >= li_ClientHeight div lci_MIN) // 高さ1/5まで then begin lrc_Rect := gfnrcMinRect([lrc_Rect, gfnrcOriginRect(FPlayer)]); lrc_Rect := gfnrcOriginRect(FPlayer); lpt_Pos := gfnptMousePosGet; if (PtInRect(lrc_Rect, lpt_Pos)) then begin //DShow_Playerのクライアント位置 li_Left := lpt_Pos.X - FPlayer.ClientOrigin.X; li_Top := lpt_Pos.Y - FPlayer.ClientOrigin.Y; li_Left := FPlayer.Left - (gfniRound(li_Left * (li_Width / FPlayer.Width)) - li_Left); li_Top := FPlayer.Top - (gfniRound(li_Top * (li_Height / FPlayer.Height)) - li_Top); end else begin li_Left := FPlayer.Left; li_Top := FPlayer.Top; end; FPlayer.SetBounds(li_Left, li_Top, li_Width, li_Height); end; end; end else begin //フォームを含めた通常の拡大・縮小 if (gfnbKeyState(VK_SHIFT)) then begin li_Width := li_ClientWidth + (li_Zoom * 1); end else begin li_Width := li_ClientWidth + gfniRound(li_Zoom * (lci_ZOOM / 100)); end; li_Width := li_Width + (li_Zoom * (_ZoomGet(li_Width, gfnbKeyState(VK_SHIFT)))); if (FPlayer.MediaHasVideo) then begin { if ((Sender = actOpt_OpenOriginalSize) and (actOpt_OpenOriginalSize.Checked)) then begin //オリジナルサイズ li_Width := plyMedia.VideoWidth; li_Height := plyMedia.VideoHeight; end else } if (Sender = Action_Zoom_100) then begin //100% li_Width := FPlayer.VideoWidth; li_Height := FPlayer.VideoHeight; end else if (Sender = Action_Zoom_50) then begin li_Width := FPlayer.VideoWidth div 2; li_Height := FPlayer.VideoHeight div 2; end else if (Sender = Action_Zoom_200) then begin li_Width := FPlayer.VideoWidth * 2; li_Height := FPlayer.VideoHeight * 2; end else begin li_Height := FPlayer.HeightFromWidth(li_Width); end; end else begin //映像無しの時とメディアが読み込まれていない時 li_Height := Trunc(li_Width * (li_ClientHeight / li_ClientWidth)); end; li_Height := li_Height + (Height - li_ClientHeight); li_Width := li_Width + (Width - li_ClientWidth); if (li_Width < Constraints.MinWidth) then begin li_Width := Constraints.MinWidth; end; if (li_Height < Constraints.MinHeight) then begin li_Height := Constraints.MinHeight; end; l_Monitor := gfnMonitorGet(gfnptMousePosGet); Constraints.MaxHeight := gfniRectHeight(l_Monitor.WorkareaRect); Constraints.MaxWidth := gfniRectWidth (l_Monitor.WorkareaRect); if (li_Width > Constraints.MaxWidth) then begin li_Width := Constraints.MaxWidth; end; if (li_Height > Constraints.MaxHeight) then begin li_Height := Constraints.MaxHeight; end; Self.SetBounds(Left, Top, li_Width, li_Height); if (FPlayer.Width <> ClientWidth) or (FPlayer.Height <> ClientHeight - Panel_Top.Height - Panel_Bottom.Height) then begin FSetVideoSize; // DShow_PlayerResize(nil); end; end; //Application.ProcessMessages; Sleep(1); finally EndFunc; end; // FbThrough := False; end; procedure TApp_CheaPlayer.Action_Zoom_100Execute(Sender: TObject); //ビデオ等倍表示 var li_FWidth : Integer; li_FHeight : Integer; li_Width : Integer; li_Height : Integer; begin if not(DShow_Player.MediaHasVideo) or (Action_Zoom_FullScreen.Checked) or (Action_Zoom_MaxScreen.Checked) then begin Exit; end; //フレーム＆タイトルバー＆メニューなどのサイズ li_FWidth := Width - ClientWidth; li_FHeight := Height - ClientHeight; //ビデオ表示領域のサイズ if (Sender = Action_Zoom_200) then begin //2倍 li_Width := DShow_Player.VideoWidth * 2; li_Height := DShow_Player.VideoHeight * 2; end else if (Sender = Action_Zoom_50) then begin //半分のサイズ li_Width := DShow_Player.VideoWidth div 2; li_Height := DShow_Player.VideoHeight div 2; end else if (Sender = Action_Zoom_100) then begin //等倍 li_Width := DShow_Player.VideoWidth; li_Height := DShow_Player.VideoHeight; end else begin li_Width := ClientWidth; li_Height := Trunc(ClientWidth * (DShow_Player.VideoHeight / DShow_Player.VideoWidth)); end; SetBounds(Left, Top, li_Width + li_FWidth, li_Height + li_FHeight + Panel_Top.Height + Panel_Bottom.Height); end; procedure TApp_CheaPlayer.Action_Zoom_AspectStandardExecute(Sender: TObject); var li_Height: Integer; begin if (Sender = Action_Zoom_AspectStandard) then begin li_Height := Trunc(ClientWidth * (3/4)); end else if (Sender = Action_Zoom_AspectHiVision) then begin li_Height := Trunc(ClientWidth * (9/16)); end else if (Sender = Action_Zoom_AspectEVista) then begin li_Height := Trunc(ClientWidth * (3/5)); end else if (Sender = Action_Zoom_AspectAVista) then begin li_Height := Trunc(ClientWidth / 1.85); end else if (Sender = Action_Zoom_AspectWideScope) then begin li_Height := Trunc(ClientWidth / 2.35); end else begin if (DShow_Player.MediaHasVideo) then begin li_Height := Trunc(ClientWidth * (DShow_Player.VideoHeight / DShow_Player.VideoWidth)); end else begin li_Height := 0; end; end; if (li_Height > 0) then begin ClientHeight := li_Height + Panel_Top.Height + Panel_Bottom.Height; end; end; //処理の開始・終了 function TApp_CheaPlayer.FIsFunc: Boolean; begin Result := (FindAtom(F_csATOM_DOFUNCTION) <> 0); end; procedure TApp_CheaPlayer.BeginFunc; begin Screen.Cursor := crHourGlass; AddAtom(F_csATOM_DOFUNCTION); //操作を無効にする // ActionList1.State := asSuspended; //Actionが外れはしないが反映されなくなる Self.Enabled := False; G_PlaylistForm.Enabled := Self.Enabled; DragAcceptFiles(Self.Handle, Self.Enabled); end; procedure TApp_CheaPlayer.EndFunc; var l_Atom : ATOM; begin //Atomがあるか確認 l_Atom := FindAtom(F_csATOM_DOFUNCTION); if (l_Atom = 0) then begin //なかった //通常はあるはずなのでないということはどこかで間違っている gpcShowMessage('エラー'#13'BeginFuncとFEndFuncが対で呼ばれていない'); end else begin //あった DeleteAtom(l_Atom); l_Atom := FindAtom(F_csATOM_DOFUNCTION); end; if (l_Atom = 0) then begin //操作を無効にしていたのを戻す // ActionList1.State := asNormal; Self.Enabled := True; G_PlaylistForm.Enabled := Self.Enabled; DragAcceptFiles(Self.Handle, Self.Enabled); // ResetCount; Screen.Cursor := crDefault; end; end; procedure TApp_CheaPlayer.ApplicationEvents1ActionExecute(Action: TBasicAction; var Handled: Boolean); begin Handled := FIsFunc; end; procedure TApp_CheaPlayer.ResetCount; var li_TopIndex : Integer; begin // if (FindAtom(F_csATOM_DOFUNCTION) <> 0) then { if (FIsFunc) then begin //何らかの処理中なら抜ける。 Exit; end; } li_TopIndex := G_PlaylistForm.ListBox_PlayList.TopIndex; G_PlaylistForm.ListBox_PlayList.Count := ComboBox_Playlist.Items.Count; li_TopIndex := gfniNumLimit(li_TopIndex, 0, G_PlaylistForm.ListBox_PlayList.Items.Count); G_PlaylistForm.ListBox_PlayList.TopIndex := li_TopIndex; G_PlaylistForm.ListBox_PlayList.Refresh; end; { procedure TApp_CheaPlayer.FShowForm; begin if (gfnbIsFadeAnimate) then begin AnimateWindow(Self.Handle, 200, AW_BLEND or AW_ACTIVATE); end; Self.Repaint; Self.Show; end; procedure TApp_CheaPlayer.FHideForm; begin if (gfnbIsFadeAnimate) then begin AnimateWindow(Self.Handle, 200, AW_BLEND or AW_HIDE); end; Self.Hide; end; } procedure TApp_CheaPlayer.FShowTopPanel; //ツールバー表示 //コントロールバー非表示 begin if (Application.Terminated) then begin Exit; end; if (gfnbIsFadeAnimate) then begin //コントロールをスライドして表示・非表示させる if (Panel_Bottom.Visible) then begin AnimateWindow(Panel_Bottom.Handle, 100, AW_VER_POSITIVE or AW_HIDE); end; if not(Panel_Top.Visible) then begin AnimateWindow(Panel_Top.Handle, 100, AW_VER_POSITIVE); Panel_Top.Repaint; end; end; Panel_Bottom.Hide; Panel_Top.Show; end; procedure TApp_CheaPlayer.FShowBottomPanel; //コントロールバー表示 //ツールバー非表示 begin if (Application.Terminated) then begin Exit; end; if (gfnbIsFadeAnimate) then begin if (Panel_Top.Visible) then begin AnimateWindow(Panel_Top.Handle, 100, AW_VER_NEGATIVE or AW_HIDE); end; if not(Panel_Bottom.Visible) then begin AnimateWindow(Panel_Bottom.Handle, 100, AW_VER_NEGATIVE); Panel_Bottom.Repaint; end; end; Panel_Top.Hide; Panel_Bottom.Show; end; procedure TApp_CheaPlayer.FShowPanel; //ツールバー、コントロールパーの表示 begin if (Application.Terminated) then begin Exit; end; if (gfnbIsFadeAnimate) then begin if not(Panel_Bottom.Visible) then begin AnimateWindow(Panel_Bottom.Handle, 100, AW_VER_POSITIVE); end; if not(Panel_Top.Visible) then begin AnimateWindow(Panel_Top.Handle, 100, AW_VER_NEGATIVE); end; end; Panel_Bottom.Show; Panel_Top.Show; end; procedure TApp_CheaPlayer.FHidePanel; //ツールバー、コントロールパーの非表示 begin if (Application.Terminated) then begin Exit; end; if not(FIsFullScreen) then begin Exit; end; if (gfnbIsFadeAnimate) then begin if (Panel_Top.Visible) then begin AnimateWindow(Panel_Top.Handle, 100, AW_VER_NEGATIVE or AW_HIDE); end; if (Panel_Bottom.Visible) then begin AnimateWindow(Panel_Bottom.Handle, 100, AW_VER_POSITIVE or AW_HIDE); end; end; Panel_Bottom.Hide; Panel_Top.Hide; end; procedure TApp_CheaPlayer.DShow_PlayerExit(Sender: TObject); var l_WinControl : TWinControl; begin if (Application.Terminated) then begin Exit; end; l_WinControl := Screen.ActiveControl; if (FIsFullScreen) // and not(gfnbIsActiveControl([TrackBar_Seek, TrackBar_Volume, ComboBox_Playlist])) and (l_WinControl <> TrackBar_Seek) and (l_WinControl <> ComboBox_Playlist) and (l_WinControl <> TrackBar_Volume) then begin FHidePanel; end; end; procedure TApp_CheaPlayer.ApplicationEvents1Minimize(Sender: TObject); begin if (ComboBox_Playlist.Items.Count = 0) or (Action_Zoom_Wallvideo.Checked) then begin Exit; end; if (FSubFormExists) then begin DShow_Player.DisplayWindow := gfnhToplevelWindowGet(FhSubPlayerMsgHwnd); end; end; procedure TApp_CheaPlayer.ApplicationEvents1Restore(Sender: TObject); begin if (Action_Zoom_Wallvideo.Checked) then begin Exit; end; DShow_Player.DisplayWindow := DShow_Player.Handle; FResetWallvideo; end; procedure TApp_CheaPlayer.FCreateSubForm; //サブフォーム作成 begin gpcExecuteWait(gfnsExeNameGet, Format('/SUBPLAYER /FROM:%d', [MyMessagePanel1.Handle])); end; function TApp_CheaPlayer.FSubFormExists: Boolean; begin if not(IsWindow(FhSubPlayerMsgHwnd)) then begin FCreateSubForm; end; Result := IsWindow(FhSubPlayerMsgHwnd); end; procedure TApp_CheaPlayer.FResetWallvideo; begin //壁紙ビデオ解除 if not(IsIconic(Application.Handle)) then begin DShow_Player.DisplayWindow := DShow_Player.Handle; end; DShow_Player.ResetWallvideo; FSetVideoSize; DShow_Player.Anchors := [akLeft, akTop, akRight, akBottom]; DShow_PlayerResize(nil); PopupMenu_MainPopup(nil); end; procedure TApp_CheaPlayer.Action_Zoom_WallvideoExecute(Sender: TObject); var lrc_Rect : TRect; lh_Window : HWND; begin if (Action_Zoom_Wallvideo.Checked) and (DShow_Player.MediaHasVideo) then begin //壁紙ビデオ if (FSubFormExists) then begin lh_Window := gfnhToplevelWindowGet(FhSubPlayerMsgHwnd); lrc_Rect := gfnrcMonitorRectGet(Self.Handle); gpcSetBounds( lh_Window, lrc_Rect.Left{ + gfniRectWidth (lrc_Rect) div 2}, lrc_Rect.Top { + gfniRectHeight(lrc_Rect) div 2}, 0, 0 ); DShow_Player.DisplayWindow := lh_Window; DShow_Player.SetWallvideo; {$IFDEF VMR} if (myWindow.gfniOSMajorVersionGet >= 6) then begin if (DShow_Player.Renderer <> vmOverlayMixer) then begin FfResumePosition := DShow_Player.CurrentPosition; DShow_Player.FadeOut; DShow_Player.Stop; DShow_Player.Renderer := vmOverlayMixer; DShow_Player.Play; end; end; {$ENDIF} end; end else begin //壁紙ビデオではない {$IFDEF VMR} if (myWindow.gfniOSMajorVersionGet >= 6) then begin if (DShow_Player.Renderer = vmOverlayMixer) then begin FfResumePosition := DShow_Player.CurrentPosition; DShow_Player.FadeOut; DShow_Player.Stop; DShow_Player.Renderer := FvmVmMode; DShow_Player.Play; end; end; {$ENDIF} FResetWallvideo; end; end; procedure TApp_CheaPlayer.FResetFullScreen; begin //フルスクリーン解除 if (Self.WindowState <> wsNormal) then begin Self.WindowState := wsNormal; FSetVideoSize; DShow_Player.Anchors := [akLeft, akTop, akRight, akBottom]; FSetFullScreen(False); FShowPanel; end; end; procedure TApp_CheaPlayer.Action_Zoom_FullScreenExecute(Sender: TObject); //フルスクリーンモード。 var li_Left : Integer; li_Top : Integer; li_Width : Integer; li_Height : Integer; begin if (DShow_Player.MediaHasVideo) then begin if (Action_Zoom_FullScreen.Checked) or (Action_Zoom_MaxScreen.Checked) then begin if (DShow_Player.DisplayWindow <> DShow_Player.Handle) then begin // if not(IsIconic(Application.Handle)) then begin //壁紙ビデオだった FResetWallvideo; end; end; //フルスクリーンへ DShow_Player.Hide; Panel_Top.Hide; Panel_Bottom.Hide; FSetFullScreen(True); DShow_Player.Anchors := []; Self.WindowState := wsMaximized; if (Action_Zoom_FullScreen.Checked) then begin DShow_Player.SetBounds(0, 0, Self.ClientWidth, Self.ClientHeight); end else begin gpcMaxVideoSizeCalc( Rect(0, 0, DShow_Player.VideoWidth, DShow_Player.VideoHeight), Self.ClientWidth, Self.ClientHeight, li_Left, li_Top, li_Width, li_Height ); DShow_Player.SetBounds(li_Left, li_Top, li_Width, li_Height); end; DShow_Player.Show; Panel_Top.SetBounds(0, 0, ClientWidth, Panel_Top.Height); Panel_Bottom.SetBounds(0, ClientHeight - Panel_Bottom.Height, ClientWidth, Panel_Bottom.Height); end else begin FResetFullScreen; end; end else begin FResetFullScreen; end; DShow_PlayerResize(nil); PopupMenu_MainPopup(nil); end; procedure TApp_CheaPlayer.DShow_PlayerDblClick(Sender: TObject); begin if (Action_Zoom_FullScreen.Checked) then begin Action_Zoom_FullScreen.Checked := False; end else if (Action_Zoom_MaxScreen.Checked) then begin Action_Zoom_MaxScreen.Checked := False; end else if (Action_Zoom_Wallvideo.Checked) then begin Action_Zoom_Wallvideo.Checked := False; Action_Zoom_WallvideoExecute(nil); Exit; end else begin if (gfnbKeyState(VK_SHIFT)) then begin Action_Zoom_FullScreen.Checked := True; end else begin Action_Zoom_MaxScreen.Checked := True; end; end; Action_Zoom_FullScreenExecute(Action_Zoom_FullScreen); Action_Zoom_FullScreen.Tag := 1; end; procedure TApp_CHeaPlayer.FAdjustVideoWindow; var li_Left : Integer; li_Top : Integer; l_Rect : TRect; begin li_Left := FPlayer.Left; li_Top := FPlayer.Top; l_Rect := Self.ClientRect; Inc(l_Rect.Top, Panel_Top.Height); Dec(l_Rect.Bottom, Panel_Bottom.Height); if (FPlayer.Width >= gfniRectWidth(l_Rect)) then begin if (FPlayer.BoundsRect.Right <= l_Rect.Right) then li_Left := li_Left + l_Rect.Right - FPlayer.BoundsRect.Right; if (FPlayer.BoundsRect.Bottom <= l_Rect.Bottom) then li_Top := li_Top + l_Rect.Bottom - FPlayer.BoundsRect.Bottom; if (FPlayer.BoundsRect.Left >= l_Rect.Left) then li_Left := li_Left + l_Rect.Left - FPlayer.BoundsRect.Left; if (FPlayer.BoundsRect.Top >= l_Rect.Top) then li_Top := li_Top + l_Rect.Top - FPlayer.BoundsRect.Top; end else begin if (FPlayer.BoundsRect.Right >= l_Rect.Right) then li_Left := li_Left + l_Rect.Right - FPlayer.BoundsRect.Right; if (FPlayer.BoundsRect.Bottom >= l_Rect.Bottom) then li_Top := li_Top + l_Rect.Bottom - FPlayer.BoundsRect.Bottom; if (FPlayer.BoundsRect.Left <= l_Rect.Left) then li_Left := li_Left + l_Rect.Left - FPlayer.BoundsRect.Left; if (FPlayer.BoundsRect.Top <= l_Rect.Top) then li_Top := li_Top + l_Rect.Top - FPlayer.BoundsRect.Top; end; FPlayer.SetBounds(li_Left, li_Top, FPlayer.Width, FPlayer.Height); end; procedure TApp_CheaPlayer.DShow_PlayerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_Point : TPoint; l_WinControl : TWinControl; begin if (Button = mbLeft) then begin //移動 if (FIsFullScreen) then begin if (Action_Zoom_FullScreen.Tag <> 0) then begin Action_Zoom_FullScreen.Tag := 0; Exit; end; l_Point := Self.ScreenToClient(FPlayer.ClientToScreen(Point(X, Y))); if (PtInRect(Panel_Top.BoundsRect, l_Point)) then begin FShowTopPanel; end else if (PtInRect(Panel_Bottom.BoundsRect, l_Point)) then begin FShowBottomPanel; end else begin FHidePanel; end; end else begin //ウィンドウモードのビデオ。 if (ssShift in Shift) then begin Action_Play_PlayPauseExecute(nil); end else if (Sender is TWinControl) then begin //移動 if (ssCtrl in Shift) then begin l_WinControl := FPlayer; end else begin l_WinControl := Self; end; FptDragMove := gfnptMousePosGet; FptDragMove.X := FptDragMove.X - l_WinControl.Left; FptDragMove.Y := FptDragMove.Y - l_WinControl.Top; end; end; end else if (Button = mbRight) then begin FptMouseGesture := gfnptMousePosGet; end; end; procedure TApp_CheaPlayer.DShow_PlayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var l_Point : TPoint; l_WinControl : TWinControl; begin if not(FIsFullScreen) and (FptDragMove.X <> MAXINT) and (FptDragMove.Y <> MAXINT) and (Sender is TWinControl) then begin l_Point := gfnptMousePosGet; if (ssCtrl in Shift) then begin l_WinControl := FPlayer; end else begin l_WinControl := Self; end; gpcControlMove(l_WinControl, l_Point.X - FptDragMove.X, l_Point.Y - FptDragMove.Y); end; end; procedure TApp_CheaPlayer.DShow_PlayerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lpt_Pos : TPoint; ls_Compas : WideString; l_Action : TAction; begin FptDragMove := Point(MAXINT, MAXINT); if (Button = mbLeft) then begin if (ssCtrl in Shift) then begin FAdjustVideoWindow; end; end else if (Button = mbMiddle) then begin if (Action_Zoom_Capture.Enabled) then begin Action_Zoom_CaptureExecute(nil); end; end else if (Button = mbRight) and ((FptMouseGesture.X <> MAXINT) or (FptMouseGesture.Y <> MAXINT)) then begin lpt_Pos := gfnptMousePosGet; ls_Compas := gfnsCompasGet(FptMouseGesture, lpt_Pos); FptMouseGesture := Point(MAXINT, MAXINT); if (ls_Compas = '') then begin PopupMenu_Main.Popup(lpt_Pos.X, lpt_Pos.Y); end else begin if (ls_Compas = '上') then begin l_Action := Action_Play_PlayPause; end else if (ls_Compas = '下') then begin l_Action := Action_Play_Replay; end else if (ls_Compas = '左') then begin l_Action := Action_Play_Back; end else if (ls_Compas = '右') then begin l_Action := Action_Play_Next; end else begin l_Action := nil; end; if (l_Action <> nil) then begin l_Action.Execute; end; end; end; end; procedure TApp_CheaPlayer.Action_Zoom_KeepAspectExecute(Sender: TObject); //アスペクト比保持。 begin DShow_Player.KeepAspect := Action_Zoom_KeepAspect.Checked; end; procedure TApp_CheaPlayer.DoCapture(sFile: WideString; iPos: Integer); //ビデオ映像をキャプチャ begin { if (gfnbKeyState(VK_CONTROL)) and not(gfnbKeyState(VK_SHIFT)) then begin DShow_Player.Pause; end; } DShow_Player.Pause; Action_Zoom_Capture.Enabled := False; try myBmpCaptureEx.CreateForm(Self); myBmpCaptureEx.Capture(sFile, iPos); myBmpCaptureEx.ShowForm; finally Action_Zoom_Capture.Enabled := True; end; end; procedure TApp_CheaPlayer.Action_Zoom_CaptureExecute(Sender: TObject); //ビデオ映像をキャプチャ begin if not(DShow_Player.MediaHasVideo) then begin Exit; end; DoCapture(DShow_Player.FileName, DShow_Player.Position); end; procedure TApp_CheaPlayer.Action_Opt_TimeVerboseExecute(Sender: TObject); begin Timer_TimeTimer(nil); end; procedure TApp_CheaPlayer.Timer_TimeTimer(Sender: TObject); const lci_VERBOSETIME_PREC = 3; var lf_Time : TRefTime; begin if not(FPlayer.MediaAssigned) then begin Timer_Time.Enabled := False; Exit; end; Timer_Time.Tag := 1; if (Action_Opt_TimeVerbose.Checked) then begin Label_Time.Caption := Format('%s/%s ', [gfnsSecToTimeStr(FPlayer.CurrentPosition, lci_VERBOSETIME_PREC), gfnsSecToTimeStr(FPlayer.Duration, lci_VERBOSETIME_PREC)]); end else begin Label_Time.Caption := Format('%s/%s ', [gfnsSecToTimeStr(FPlayer.Position), gfnsSecToTimeStr(FPlayer.Length)]); end; //スクリーンセーバー、モニター電源OFFをキャンセル SetThreadExecutionState(ES_DISPLAY_REQUIRED); mouse_event(MOUSEEVENTF_MOVE, 0, 0, 0, 0); if (TrackBar_Seek.ThumbHold = False) and (TrackBar_Seek.Tag = 0) then begin //トラックバーのスライダーを触っていなかったらスライダーを現在位置に移動させる。 TrackBar_Seek.Position := FPlayer.Position; end; if (FPlayer.Duration > 0) then begin lf_Time := FPlayer.CurrentPosition; if (lf_Time >= FPlayer.Duration) then begin FDoMediaEnded; end else begin { if (FfMediaTime >= lf_Time) then begin //静止画や何らかの理由で途中で再生が止まったままの場合への対処 //myDebug.gpcDebug([FfMediaTime, Windows.GetTickCount, FiEndTime + F_ciEndInterval]); if (Windows.GetTickCount > FiEndTime + F_ciEndInterval) then begin //Beep; FDoMediaEnded; end; end else begin FfMediaTime := lf_Time; FiEndTime := Windows.GetTickCount; end; } end; end else begin if (FfMediaTime < 0) then begin FfMediaTime := 1; FiEndTime := Windows.GetTickCount; end else begin if (Windows.GetTickCount > FiEndTime + F_ciImageInterval) then begin FDoMediaEnded; end; end; end; Timer_Time.Tag := 0; end; procedure TApp_CheaPlayer.FSeek(fPos: TRefTime); begin TrackBar_Seek.Tag := 1; TrackBar_Seek.Position := Trunc(fPos); if (DShow_Player.MediaAssigned) then begin DShow_Player.FadeOut; DShow_Player.CurrentPosition := fPos; //myDebug.gpcDebug(fPos); FfMediaTime := fPos; if not(Action_Play_Mute.Checked) then begin DShow_Player.FadeIn(TrackBar_Volume.Position); end; end; TrackBar_Seek.Tag := 0; end; procedure TApp_CheaPlayer.TrackBar_SeekMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then begin if (PtInRect(TrackBar_Seek.ThumbRect, Point(X, Y))) then begin TrackBar_Seek.Tag := 1; end; end else begin TrackBar_Seek.Tag := 0; ReleaseCapture; end; end; procedure TApp_CheaPlayer.TrackBar_SeekMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var li_Width : Integer; li_Center : Integer; li_Start : Integer; li_End : Integer; li_Pos : Integer; lrc_Rect : TRect; begin if (TrackBar_Seek.Max > TrackBar_Seek.Min) then begin if (gfnbKeyState(VK_LBUTTON)) and (TrackBar_Seek.ThumbHold) then begin li_Pos := TrackBar_Seek.Position; TrackBar_Seek.Hint := Format('%s秒', [gfnsSecToTimeStr(li_Pos)]); end else begin lrc_Rect := TrackBar_Seek.SeekRect; if (X < lrc_Rect.Left) then begin TrackBar_Seek.Hint := Action_Play_SkipBack.Hint; end else if (X > lrc_Rect.Right) then begin TrackBar_Seek.Hint := Action_Play_SkipNext.Hint; end else begin li_Center := gfniRoundUp(gfniRectWidth(TrackBar_Seek.ThumbRect) / 2); //スライダーボタンの幅の中心 li_Width := TrackBar_Seek.SeekWidth; //スライダーのスライドする正味のボックスの幅 li_Start := TrackBar_Seek.SeekRect.Left + li_Center; if (X >= li_Start) then begin li_End := lrc_Rect.Right - li_Center; if (X <= li_End) then begin li_Pos := Trunc((X - li_Start) / (li_Width - li_Center * 2) * (TrackBar_Seek.Max - TrackBar_Seek.Min)); end else begin li_Pos := TrackBar_Seek.Max; end; end else begin li_Pos := TrackBar_Seek.Min; end; TrackBar_Seek.Hint := Format('%s秒', [gfnsSecToTimeStr(li_Pos)]); end; end; Application.ActivateHint(gfnptMousePosGet); end else begin TrackBar_Seek.Hint := ''; end; end; procedure TApp_CheaPlayer.TrackBar_SeekMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var li_Width : Integer; li_Center : Integer; li_Start : Integer; li_End : Integer; // li_Pos : Integer; lf_Pos : TRefTime; lrc_Rect : TRect; begin if (Button = mbLeft) then begin lrc_Rect := TrackBar_Seek.SeekRect; //スライダのRect if (TrackBar_Seek.Tag = 1) then begin //つまみを掴んで移動した FSeek(TrackBar_Seek.Position);//TrackBar_SeekChange(nil); end else begin if (X < lrc_Rect.Left) then begin //トラックバーの左端をクリックした Action_Play_SkipNextExecute(Action_Play_SkipBack); end else if (X > lrc_Rect.Right) then begin //トラックバーの右端をクリックした Action_Play_SkipNextExecute(Action_Play_SkipNext); end else begin //トラックバーのつまみのない場所をクリックした li_Center := gfniRoundUp(gfniRectWidth(TrackBar_Seek.ThumbRect) / 2); //スライダーボタンの幅の中心 li_Width := TrackBar_Seek.SeekWidth; //スライダーのスライドする正味のボックスの幅 li_Start := lrc_Rect.Left + li_Center; if (X >= li_Start) then begin li_End := lrc_Rect.Right - li_Center; if (X <= li_End) then begin lf_Pos := (X - li_Start) / (li_Width - li_Center * 2) * (TrackBar_Seek.Max - TrackBar_Seek.Min); // li_Pos := Trunc(lf_Pos); end else begin lf_Pos := TrackBar_Seek.Max; end; end else begin lf_Pos := TrackBar_Seek.Min; end; //TrackBar_Seek.Position := li_Pos; //TrackBar_SeekChange(nil); FSeek(lf_Pos); end; end; TrackBar_Seek.Tag := 0; end; end; //-------- procedure TApp_CheaPlayer.Action_Play_SkipNextExecute(Sender: TObject); //スキップ const lci_SMALLSKIP = 1; lci_NORMALSKIP = 30; lci_LARGESKIP = 90; var li_Skip : Integer; begin if (FindAtom(F_csATOM_DOFUNCTION) <> 0) then begin Exit; end; BeginFunc; try if not(DShow_Player.MediaAssigned) then begin Exit; end; if (gfnbKeyState(VK_SHIFT)) and (gfnbKeyState(VK_CONTROL)) then begin //Shift+Ctrl li_Skip := Trunc(DShow_Player.Duration / 10); //長さの1/10 end else if (gfnbKeyState(VK_CONTROL)) then begin //Ctrl li_Skip := lci_SMALLSKIP; end else if (gfnbKeyState(VK_SHIFT)) then begin //Shift li_Skip := lci_LARGESKIP; end else begin li_Skip := lci_NORMALSKIP; end; if (Sender = Action_Play_SkipNext) then begin //li_Skipのまま end else if (Sender = Action_Play_SkipBack) then begin li_Skip := -li_Skip; end else begin li_Skip := 0; end; if (li_Skip <> 0) then begin if (DShow_Player.MediaAssigned) then begin Timer_Time.Enabled := False; //TrackBar_Seek.Position := TrackBar_Seek.Position + li_Skip; //TrackBar_SeekChange(nil); FSeek(TrackBar_Seek.Position + li_Skip); Timer_Time.Enabled := True; end; end; finally EndFunc; end; end; function TApp_CheaPlayer.FIsFullScreen: Boolean; begin Result := DShow_Player.MediaHasVideo and (Action_Zoom_FullScreen.Checked or Action_Zoom_MaxScreen.Checked); end; //--- フレーム移動 --- procedure TApp_CheaPlayer.Action_FrameNextExecute(Sender: TObject); var li_Step : Integer; begin if (Sender = Action_Play_FrameBack) then begin li_Step := -1; end else if (Sender = Action_Play_FrameNext) then begin li_Step := 1; end else begin li_Step := 0; end; if (DShow_Player.MediaAssigned) then begin DShow_Player.Pause; if (DShow_Player.AvgTimePerFrame = 0) then begin Exit; end; DShow_Player.Step(li_Step); end else begin FSendMessagePanel(Format('/STEP:%d', [li_Step])); end; end; //-------- //--- 再生速度変更 --- procedure TApp_CheaPlayer.Action_PlayRate_10Execute(Sender: TObject); //wmv,wma,amazonのmp3は再生速度の変更はできない var lf_Rate : Double; i : Integer; begin if (Sender is TAction) then begin TAction(Sender).Checked := True; end; if not(DShow_Player.MediaAssigned) then begin Exit; end; lf_Rate := 1.0; for i := 0 to MenuItem_PlayRate.Count -1 do begin if (MenuItem_PlayRate.Items[i].Checked) then begin lf_Rate := StrToFloatDef(MenuItem_PlayRate.Items[i].Caption, 1.0); Break; end; end; DShow_Player.PlayRate := lf_Rate; end; //-------- procedure TApp_CheaPlayer.actNop(Sender: TObject); begin // end; procedure TApp_CheaPlayer.ComboBox_PlaylistDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); const lci_MARGIN = 2; var ls_File : WideString; begin with ComboBox_Playlist.Canvas do begin FillRect(Rect); ls_File := ComboBox_Playlist.Items[Index]; if not(Action_List_FolderName.Checked) then begin ls_File := gfnsFileNameGet(ls_File); end; ls_File := WideFormat('%d: %s', [Index +1, ls_FIle]); Inc(Rect.Left, lci_MARGIN); DrawTextW(Handle, PWideChar(ls_File), -1, Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); end; end; procedure TApp_CheaPlayer.Action_Play_MuteExecute(Sender: TObject); begin if (Action_Play_Mute.Checked) then begin Action_Play_Mute.ImageIndex := FiMuteImageIndex +1; DShow_Player.Volume := 0; end else begin Action_Play_Mute.ImageIndex := FiMuteImageIndex; DShow_Player.Volume := TrackBar_Volume.Position; end; end; procedure TApp_CheaPlayer.TrackBar_VolumeChange(Sender: TObject); begin end; //------------------------------------------------------------------------------ //IniFile const lcsSECT_BOUNDS = 'Bounds'; lcsSECT_LIST = 'List'; lcsKEY_LIST_MAINFOLDERNAME = 'Main_FolderName'; lcsKEY_LIST_LISTFOLDERNAME = 'List_FolderName'; lcsSECT_FINDHISTORY = 'FindHistory'; lcsSECT_PLAY = 'Play'; lcsKEY_PLAYMUTE = 'Mute'; lcsKEY_PLAYVOLUME = 'Volume'; lcsSECT_ZOOM = 'Zoom'; lcsKEY_ZOOMFULLSCREEN = 'FullScreen'; lcsKEY_ZOOMWALLVIDEO = 'Wallvideo'; lcsKEY_ZOOMMAXSCREEN = 'MaxScreen'; lcsKEY_ZOOMKEEPASPECT = 'KeepAspect'; lcsSECT_DIALOG = 'Dialog'; lcsKEY_DIALOG_FILE_OPENFILE = 'OpenFile'; lcsKEY_DIALOG_FILE_OPENFOLDER = 'OpenFolder'; lcsKEY_DIALOG_FILE_OPENTHISFOLDER = 'OpenThisFolder'; lcsKEY_DIALOG_FILECMD_MOVE = 'FileCmdMove'; lcsKEY_DIALOG_FILECMD_COPY = 'FileCmdCopy'; lcsKEY_DIALOG_DEBUG_SAVEASGRF = 'DebugSaveAsGRF'; lcsSECT_OPT = 'Option'; lcsKEY_OPT_RANDOM = 'Random'; lcsKEY_OPT_TIMEVERBOSE = 'TimeVerbose'; lcsKEY_OPT_ALLOWIMAGE = 'AllowImage'; lcsKEY_OPT_LARGEICON = 'LargeIcon'; lcsSECT_RESUME = 'RESUME'; lcsKEY_RESUME = 'Resume'; lcsKEY_RESUME_INDEX = 'Index'; lcsKEY_RESUME_TIME = 'Time'; lcsSECT_HISTORY_OPENFILE = 'OpenFileHistory'; lcsSECT_HISTORY_OPENFOLDER = 'OpenFolderHistory'; lcsSECT_HISTORY_OPENTHISFOLDER = 'OpenThisFolderHistory'; //IniFile function TApp_CheaPlayer.FLoadIni: Boolean; procedure _ReadHistory(AIniFile: TMyIniFile; sSection: WideString; APopupMenu: TPopupMenu); var l_History : TMyWStrings; begin if (AIniFile.SectionExists(sSection)) then begin l_History := TMyWStrings.Create; try AIniFile.ReadSectionText(sSection, l_History); FAddOpenHistory(l_History, APopupMenu.Items); finally l_History.Free; end; end; end; const lci_MINWIDTH = 32; lci_MINHEIGHT = 32; var l_IniFile : TMyIniFile; l_List : TMyWStrings; ls_File : WideString; begin Result := False; //Shift+Ctrl起動で設定を読み込まない。 if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Exit; end; l_IniFile := TMyIniFile.Create; try with l_IniFile do begin if (gfnbKeyState(VK_SHIFT)) then begin //[Shift]併用でメインモニターで起動 // Self.SetBounds(75, 75, Self.Width, Self.Height); end else begin SetMonitorBoundsRect(lcsSECT_BOUNDS, Self); SetMonitorBoundsRect(lcsSECT_BOUNDS, G_PlaylistForm); end; //[List] Action_List_FolderName.Checked := ReadBool(lcsSECT_LIST, lcsKEY_LIST_MAINFOLDERNAME, Action_List_FolderName.Checked); G_PlaylistForm.Action_List_FolderName.Checked := ReadBool(lcsSECT_LIST, lcsKEY_LIST_LISTFOLDERNAME, G_PlaylistForm.Action_List_FolderName.Checked); l_List := TMyWStrings.Create; try //[Find] ReadSectionText(lcsSECT_FINDHISTORY, l_List); if (l_List.Count > 0) then begin gpcListTrimBottom(l_List); l_List.Reverse; G_PlaylistForm.AddFindHistory(G_PlaylistForm.PopupMenu_FindHistory.Items, l_List); end; finally l_List.Free; end; //[Play] Action_Play_Mute.Checked := ReadBool (lcsSECT_PLAY, lcsKEY_PLAYMUTE, Action_Play_Mute.Checked); TrackBar_Volume.Position := ReadInteger(lcsSECT_PLAY, lcsKEY_PLAYVOLUME, TrackBar_Volume.Position); //[Zoom] Action_Zoom_KeepAspect.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_ZOOMKEEPASPECT, Action_Zoom_KeepAspect.Checked); Action_Zoom_Wallvideo.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_ZOOMWALLVIDEO, Action_Zoom_Wallvideo.Checked); Action_Zoom_FullScreen.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_ZOOMFULLSCREEN, Action_Zoom_FullScreen.Checked); Action_Zoom_MaxScreen.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_ZOOMMAXSCREEN, Action_Zoom_MaxScreen.Checked); //[Dialog] Dialog_File_OpenFile.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILE_OPENFILE, Dialog_File_OpenFile.InitialDir); Dialog_File_OpenFolder.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILE_OPENFOLDER, Dialog_File_OpenFolder.InitialDir); Dialog_File_OpenThisFolder.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILE_OPENTHISFOLDER, Dialog_File_OpenThisFolder.InitialDir); Dialog_FileCmd_Move.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILECMD_MOVE, Dialog_FileCmd_Move.InitialDir); Dialog_FileCmd_Copy.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILECMD_COPY, Dialog_FileCmd_Copy.InitialDir); Dialog_Debug_SaveAsGRF.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DIALOG_DEBUG_SAVEASGRF, Dialog_Debug_SaveAsGRF.InitialDir); //[Option] Action_Opt_Random.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_RANDOM, Action_Opt_Random.Checked); Action_Opt_TimeVerbose.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_TIMEVERBOSE, Action_Opt_TimeVerbose.Checked); Action_Opt_AllowImage.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_ALLOWIMAGE, Action_Opt_AllowImage.Checked); Action_Opt_LargeIcon.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_LARGEICON, Action_Opt_LargeIcon.Checked); //[Resume] Action_Opt_Resume.Checked := ReadBool(lcsSECT_RESUME, lcsKEY_RESUME, Action_Opt_Resume.Checked); if (Action_Opt_Resume.Checked) and (gfniParamCount = 0) then begin ls_File := gfnsFileExtChange(gfnsExeNameGet, F_csRESUMEEXT); if (gfnbFileExists(ls_File)) then begin FiResumeIndex := ReadInteger(lcsSECT_RESUME, lcsKEY_RESUME_INDEX, -1); FfResumePosition := Trunc(ReadInteger(lcsSECT_RESUME, lcsKEY_RESUME_TIME, 0)); end; end else begin FiResumeIndex := -1; FfResumePosition := 0; end; _ReadHistory(l_IniFile, lcsSECT_HISTORY_OPENFILE, PopupMenu_File_OpenFile); _ReadHistory(l_IniFile, lcsSECT_HISTORY_OPENFOLDER, PopupMenu_File_OpenFolder); _ReadHistory(l_IniFile, lcsSECT_HISTORY_OPENTHISFOLDER, PopupMenu_File_OpenThisFolder); FSendTo.LoadIni(l_IniFile); end; finally l_IniFile.Free; end; Result := True; end; //設定保存 procedure TApp_CheaPlayer.FSaveIni; procedure _WriteHistory(AIniFile: TMyIniFile; sSection: WideString; APopupMenu: TPopupMenu); var l_History : TMyWStrings; i : Integer; begin l_History := TMyWStrings.Create; try for i := 0 to APopupMenu.Items.Count-1 do begin l_History.Add(gfnsAnsiToWideEx(APopupMenu.Items[i].Hint)); end; AIniFile.WriteSectionText(sSection, l_History); finally l_History.Free; end; end; var l_IniFile : TMyIniFile; l_List : TMyWStrings; ls_File : WideString; i : Integer; begin //Shift+Ctrl起動で設定を書き込まない。 if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Exit; end; l_IniFile := TMyIniFile.Create; try with l_IniFile do begin //[Bounds] WriteBoundsRect(lcsSECT_BOUNDS, Self); WriteBoundsRect(lcsSECT_BOUNDS, G_PlaylistForm); //[List] WriteBool(lcsSECT_LIST, lcsKEY_LIST_MAINFOLDERNAME, Action_List_FolderName.Checked); WriteBool(lcsSECT_LIST, lcsKEY_LIST_LISTFOLDERNAME, G_PlaylistForm.Action_List_FolderName.Checked); //検索履歴 if (G_PlaylistForm.PopupMenu_FindHistory.Items.Count > 0) then begin l_List := TMyWStrings.Create; try for i := 0 to G_PlaylistForm.PopupMenu_FindHistory.Items.Count -1 do begin l_List.Add(gfnsAnsiToWideEx(G_PlaylistForm.PopupMenu_FindHistory.Items[i].Hint)); end; WriteSectionText(lcsSECT_FINDHISTORY, l_List); finally l_List.Free; end; end; //[Play] WriteBool (lcsSECT_PLAY, lcsKEY_PLAYMUTE, Action_Play_Mute.Checked); WriteInteger(lcsSECT_PLAY, lcsKEY_PLAYVOLUME, TrackBar_Volume.Position); //[Zoom] WriteBool(lcsSECT_ZOOM, lcsKEY_ZOOMKEEPASPECT, Action_Zoom_KeepAspect.Checked); WriteBool(lcsSECT_ZOOM, lcsKEY_ZOOMWALLVIDEO, Action_Zoom_Wallvideo.Checked); WriteBool(lcsSECT_ZOOM, lcsKEY_ZOOMFULLSCREEN, Action_Zoom_FullScreen.Checked); WriteBool(lcsSECT_ZOOM, lcsKEY_ZOOMMAXSCREEN, Action_Zoom_MaxScreen.Checked); //[Dialog] WriteString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILE_OPENFILE, Dialog_File_OpenFile.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILE_OPENFOLDER, Dialog_File_OpenFolder.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILE_OPENTHISFOLDER, Dialog_File_OpenThisFolder.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILECMD_MOVE, Dialog_FileCmd_Move.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_DIALOG_FILECMD_COPY, Dialog_FileCmd_Copy.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_DIALOG_DEBUG_SAVEASGRF, Dialog_Debug_SaveAsGRF.InitialDir); //[Option] WriteBool(lcsSECT_OPT, lcsKEY_OPT_RANDOM, Action_Opt_Random.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPT_TIMEVERBOSE, Action_Opt_TimeVerbose.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPT_ALLOWIMAGE, Action_Opt_AllowImage.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPT_LARGEICON, Action_Opt_LargeIcon.Checked); //[Resume] WriteBool (lcsSECT_RESUME, lcsKEY_RESUME, Action_Opt_Resume.Checked); if (Action_Opt_Resume.Checked) then begin WriteInteger(lcsSECT_RESUME, lcsKEY_RESUME_INDEX, ComboBox_Playlist.ItemIndex); WriteInteger(lcsSECT_RESUME, lcsKEY_RESUME_TIME, Trunc(FPlayer.CurrentPosition)); if (Action_Opt_Resume.Checked) then begin ls_File := gfnsFileExtChange(gfnsExeNameGet, F_csRESUMEEXT); if (ComboBox_Playlist.Items.Count > 0) then begin ComboBox_Playlist.Items.SaveToFile(ls_File, cdUTF_8N); end else if (gfnbFileExists(ls_File)) then begin gpcFileTrash(ls_File); end; end; end else begin WriteInteger(lcsSECT_RESUME, lcsKEY_RESUME_INDEX, -1); WriteInteger(lcsSECT_RESUME, lcsKEY_RESUME_TIME, -1); end; _WriteHistory(l_IniFile, lcsSECT_HISTORY_OPENFILE, PopupMenu_File_OpenFile); _WriteHistory(l_IniFile, lcsSECT_HISTORY_OPENFOLDER, PopupMenu_File_OpenFolder); _WriteHistory(l_IniFile, lcsSECT_HISTORY_OPENTHISFOLDER, PopupMenu_File_OpenThisFolder); FSendTo.SaveIni(l_IniFile); try UpdateFile; except end; end; finally l_IniFile.Free; end; end; procedure TApp_CheaPlayer.PopupMenu_MainPopup(Sender: TObject); begin if (Application.Terminated) then begin Exit; end; FHidePanel; //再生 Action_Play_PlayPause.Enabled := DShow_Player.MediaAssigned; Action_Play_Replay.Enabled := Action_Play_PlayPause.Enabled; Action_Play_SkipBack.Enabled := Action_Play_PlayPause.Enabled; Action_Play_SkipNext.Enabled := Action_Play_PlayPause.Enabled; Action_Play_Back.Enabled := {Action_Play_PlayPause.Enabled and} (ComboBox_Playlist.Items.Count >= 1); Action_Play_Next.Enabled := Action_Play_Back.Enabled; Action_Play_FrameBack.Enabled := Action_Play_PlayPause.Enabled; Action_Play_FrameNext.Enabled := Action_Play_FrameBack.Enabled; //ズーム Action_Zoom_100.Enabled := DShow_Player.MediaHasVideo and (Action_Zoom_FullScreen.Checked = False) and (Action_Zoom_MaxScreen.Checked = False) ; Action_Zoom_50.Enabled := Action_Zoom_100.Enabled; Action_Zoom_200.Enabled := Action_Zoom_100.Enabled; Action_Zoom_Fit.Enabled := Action_Zoom_100.Enabled; Action_Zoom_AspectStandard.Enabled := Action_Zoom_100.Enabled; Action_Zoom_AspectHiVision.Enabled := Action_Zoom_100.Enabled; Action_Zoom_AspectEVista.Enabled := Action_Zoom_100.Enabled; Action_Zoom_AspectAVista.Enabled := Action_Zoom_100.Enabled; Action_Zoom_AspectWideScope.Enabled := Action_Zoom_100.Enabled; Action_Zoom_Capture.Enabled := DShow_Player.MediaHasVideo; //リスト Action_List_Del.Enabled := (ComboBox_Playlist.ItemIndex >= 0);//Action_PlayPlayPause.Enabled; Action_List_Clear.Enabled := (ComboBox_Playlist.Items.Count > 0); Action_List_Copy.Enabled := Action_List_Clear.Enabled; Action_List_Paste.Enabled := Clipboard.HasFormat(CF_TEXT); Action_File_SaveAs.Enabled := Action_List_Clear.Enabled; //ソート Action_Sort.Enabled := (ComboBox_Playlist.Items.Count > 0); Action_Sort_FileName.Enabled := Action_Sort.Enabled; Action_Sort_Path.Enabled := Action_Sort.Enabled; Action_Sort_Name.Enabled := Action_Sort.Enabled; Action_Sort_Ext.Enabled := Action_Sort.Enabled; Action_Sort_Shuffle.Enabled := Action_Sort.Enabled; Action_File_Property.Enabled := Action_List_Del.Enabled; TrackBar_Seek.Enabled := Action_Play_PlayPause.Enabled; Action_FileCmd.Enabled := Action_File_Property.Enabled; FSendTo.MenuItemState; end; procedure TApp_CheaPlayer.Action_File_SaveAsExecute(Sender: TObject); //リストを保存 var lsl_List : TMyWStrings; i : Integer; begin Self.Enabled := False; try if (Dialog_Save.Execute) then begin if (WideLowerCase(gfnsFileExtGet(Dialog_Save.FileName)) <> '.m3u8') then begin Dialog_Save.FileName := gfnsStrEndFit(Dialog_Save.FileName, '.m3u8'); end; Dialog_Save.InitialDir := gfnsFilePathGet(Dialog_Save.FileName); if (gfnbFileExists(Dialog_Save.FileName)) then begin if not(gfniMessageBoxYesNo(WideFormat('%s'#13'は既に存在します。上書きしますか?', [Dialog_Save.FileName])) = ID_YES) then begin Exit; end; end; lsl_List := TMyWStrings.Create; try for i := 0 to ComboBox_Playlist.Items.Count -1 do begin //相対パスで保存 lsl_List.Add(gfnsRelativePathGet(ComboBox_Playlist.Items[i], Dialog_Save.InitialDir)); end; //M3U8で保存 gpcSaveM3u8(lsl_List, Dialog_Save.FileName, False); finally lsl_List.Free; end; end; finally Self.Enabled := True; end; end; procedure TApp_CheaPlayer.Action_List_CopyExecute(Sender: TObject); var ls_WorkFile : WideString; begin if (ComboBox_Playlist.Items.Count > 0) then begin gpcStrToClipboard(ComboBox_Playlist.Items.Text); if (gfnbKeyState(VK_CONTROL)) then begin ls_WorkFile := gfnsFileExtChange(gfnsExeNameGet, '.txt'); ComboBox_Playlist.Items.SaveToFile(ls_WorkFile, cdUTF_8); if (gfnbFileExists(ls_WorkFile)) then begin gpcExecute(ls_WorkFile); end; end; end; end; procedure TApp_CheaPlayer.Action_List_PasteExecute(Sender: TObject); var l_List : TMyWStrings; begin if (Clipboard.HasFormat(CF_TEXT)) then begin BeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin DShow_Player.Close; Action_Zoom_FullScreenExecute(nil); end; l_List := TMyWStrings.Create; try l_List.Text := gfnsStrFromClipboard; FAddList(l_List); finally l_List.Free; end; finally EndFunc; end; end; end; procedure TApp_CheaPlayer.OpenProperty(iIndex: Integer); var ls_File : WideString; begin ls_File := ComboBox_Playlist.Items[iIndex]; if (gfnbKeyState(VK_SHIFT)) then begin gpcExploreOpen(gfnsFilePathGet(ls_File)); end else begin //エクスプローラのプロパティページ gpcPropertyPageOpen(WideFormat('"%s"', [ls_File])); // App_MediaProperty := TApp_MediaProperty.Create(Self); end; end; procedure TApp_CheaPlayer.Action_File_PropertyExecute(Sender: TObject); begin if (ComboBox_Playlist.ItemIndex < 0) then begin Exit; end; OpenProperty(ComboBox_Playlist.ItemIndex); end; procedure TApp_CHeaPlayer.WMAppCommand(var Msg: TMessage); //http://ja.efreedom.com/Question/1-2458730/How-to-Detect-Forward-and-Back-Mouse-Button-Events-in-Delphi //http://www.blackcatlab.com/article.php/ProgramingFAQ_del0077 begin case GET_APPCOMMAND_LPARAM(Msg.LParam) of APPCOMMAND_VOLUME_MUTE :begin Action_Play_Mute.Checked := not(Action_Play_Mute.Checked); Action_Play_MuteExecute(nil); end; // APPCOMMAND_VOLUME_DOWN = 9; // APPCOMMAND_VOLUME_UP = 10; APPCOMMAND_MEDIA_PLAY_PAUSE :begin Action_Play_PlayPauseExecute(nil); end; APPCOMMAND_BROWSER_STOP, APPCOMMAND_MEDIA_STOP :begin Stop; end; APPCOMMAND_BROWSER_FORWARD, APPCOMMAND_MEDIA_NEXTTRACK :begin //進む Action_Play_NextExecute(Action_Play_Next); Msg.Result := 1; end; APPCOMMAND_BROWSER_BACKWARD, APPCOMMAND_MEDIA_PREVIOUSTRACK :begin //戻る Action_Play_NextExecute(Action_Play_Back); Msg.Result := 1; end; end; end; procedure TApp_CheaPlayer.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure _Execute(AAction: TAction); begin AAction.OnExecute(AAction); end; begin // Action_Play_PlayPause.Tag := 0; if (ssCtrl in Shift) then begin case Key of VK_O : _Execute(Action_File_OpenFile); VK_F : _Execute(Action_File_OpenFolder); VK_C : _Execute(Action_List_Copy); VK_V : _Execute(Action_List_Paste); end; end; case Key of VK_DELETE : _Execute(Action_List_Del); VK_SPACE : _Execute(Action_Play_PlayPause); VK_BACK : _Execute(Action_Play_Replay); VK_PRIOR : _Execute(Action_Play_Back); VK_NEXT : _Execute(Action_Play_Next); VK_LEFT : _Execute(Action_Play_SkipBack); VK_RIGHT : _Execute(Action_Play_SkipNext); VK_Z :begin if (ssShift in Shift) then begin if (ssCtrl in Shift) then begin // Shft+Ctrl+Z _Execute(Action_Zoom_200); end else begin // Shift+Z _Execute(Action_Zoom_50); end; end else if (ssCtrl in Shift) then begin // Z _Execute(Action_Zoom_100); end; end; end; end; procedure TApp_CheaPlayer.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin if ((Screen.ActiveControl = ComboBox_Playlist) and (ComboBox_Playlist.DroppedDown = False)) or (Screen.ActiveControl = TrackBar_Seek) then begin Handled := True; end; end; procedure TApp_CheaPlayer.Grid_VideoDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin DShow_Player.Canvas.Brush.Color := DShow_Player.Color; DShow_Player.Canvas.FillRect(Rect); end; procedure TApp_CheaPlayer.DShow_PlayerMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var l_SkipAction : TAction; l_ZoomAction : TAction; begin if (WheelDelta < 0) then begin l_SkipAction := Action_Play_SkipNext; l_ZoomAction := Action_Zoom_Down; end else begin l_SkipAction := Action_Play_SkipBack; l_ZoomAction := Action_Zoom_Up; end; if (ssRight in Shift) then begin //巻き戻し FptMouseGesture := Point(MAXINT, MAXINT); l_SkipAction.OnExecute(l_SkipAction); end else begin Action_Zoom_UpExecute(l_ZoomAction); end; Handled := True; end; //------------------------------------------------------------------------------ //送る type T_TaskBarMenu = class(TObject) private FhMenuHandle : HMENU; public constructor Create(hMenuHandle: HMENU); destructor Destroy; override; end; { T_TaskBarMenu } constructor T_TaskBarMenu.Create(hMenuHandle: HMENU); begin inherited Create; FhMenuHandle := hMenuHandle; end; destructor T_TaskBarMenu.Destroy; begin DestroyMenu(FhMenuHandle); inherited Destroy; end; type T_TaskBarMenuItem = class(TObject) private FhParentMenu : HMENU; FMenuItem : TMenuItem; function FGetMenuItemID: UINT; public constructor Create(AMenuItem: TMenuItem; hParentMenu: HMENU); property MenuItem : TMenuItem read FMenuItem; property MenuItemID : UINT read FGetMenuItemID; property ParentMenu : HMENU read FhParentMenu; end; constructor T_TaskBarMenuItem.Create(AMenuItem: TMenuItem; hParentMenu: HMENU); begin inherited Create; FhParentMenu := hParentMenu; FMenuItem := AMenuItem; end; function T_TaskBarMenuItem.FGetMenuItemID: UINT; begin Result := FMenuItem.Command; end; procedure TApp_CheaPlayer.FSetTaskBarCaption(AMenuItem: TMenuItem; var sCaption: WideString); begin if (Pos('__MenuItem_PSendTo', AMenuItem.Name) > 0) then begin sCaption := gfnsAnsiToWideEx(gfnsFileNameGet(AMenuItem.Hint)); end; end; procedure TApp_CheaPlayer.FRecreateTaskBarMenu(Sender: TObject); begin if (FTaskBarMenu <> nil) then begin FreeAndNil(FTaskBarMenu); end; FTaskBarMenu := TMyTaskBarMenu.Create( PopupMenu_Main, FSetTaskBarCaption, ); PopupMenu_MainPopup(nil); end; //------------------------------------------------------------------------------ procedure TApp_CheaPlayer.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); begin if (Msg.hwnd = Application.Handle) then begin case Msg.message of WM_SYSCOMMAND :begin FTaskBarMenu.Execute(Msg.wParam); end; end; end; end; procedure TApp_CheaPlayer.WMSysCommand(var Msg: TWMSysCommand); begin case (Msg.CmdType and $FFF0) of SC_MAXIMIZE :begin Action_File_Restore.Enabled := True; inherited; end; else begin inherited; end; end; end; procedure TApp_CheaPlayer.Action_File_RestoreExecute(Sender: TObject); //元のサイズに戻す begin Application.Restore; Action_File_Restore.Enabled := IsIconic(Application.Handle) or (Self.WindowState = wsMaximized); Action_File_Minimize.Enabled := True; end; procedure TApp_CheaPlayer.Action_File_MinimizeExecute(Sender: TObject); //最小化 begin Application.Minimize; Action_File_Restore.Enabled := True; Action_File_Minimize.Enabled := False; end; //名前の変更 function TApp_CheaPlayer.FileRename(sFile: WideString): Integer; var i : Integer; li_ErrCode : Integer; ls_Path : WideString; ls_CmpFile : WideString; ls_Msg : WideString; lb_ReadOnly : Boolean; l_List : TMyWStrings; begin l_List := ComboBox_Playlist.Items; lb_ReadOnly := gfnbFileIsReadOnly(sFile); if (lb_ReadOnly) then begin //名前を変更しようとしているファイルが読み取り専用だった Result := gfniMessageBoxYesNoCancel(WideFormat('名前を変更しようとしているファイル'#13'%s'#13'には読み取り専用属性がついています。名前を変更しますか', [sFile])); if (Result <> ID_YES) then begin //以降の処理を行わない Exit; end; end; Result := ID_NO; Dialog_FileCmd_Rename.FileName := sFile; Dialog_FileCmd_Rename.InitialDir := gfnsFilePathGet(sFile); Dialog_FileCmd_Rename.FilterIndex := gfniFilterIndexGet(Dialog_FileCmd_Rename.Filter, gfnsFileExtGet(sFile)); Dialog_FileCmd_Rename.Owner := Screen.ActiveForm; if (Dialog_FileCmd_Rename.Execute) then begin Result := ID_YES; ls_CmpFile := WideUpperCase(sFile); if (WideUpperCase(Dialog_FileCmd_Rename.FileName) = ls_CmpFile) then begin if (Dialog_FileCmd_Rename.FileName <> sFile) then begin //同じファイル名だけれども大文字小文字が違う場合は許可。 Result := ID_YES; //AIU end else begin //大文字小文字含めて同じファイル名なので不許可。 Result := ID_NO; gpcShowMessage(WideFormat('%s'#13'ファイル名が同じです', [sFile])); //以降の処理を行わない Exit; end; end else begin //違うファイル名 if not(gfnbIsEqualFileExt(ls_CmpFile, Dialog_FileCmd_Rename.FileName)) then begin //拡張子が違う Result := gfniMessageBoxYesNoCancel(WideFormat('%s → %s'#13#13'拡張子を変更すると、ファイルが使えなくなる可能性があります。'#13'変更しますか?', [gfnsFileExtGet(sFile), gfnsFileExtGet(Dialog_FileCmd_Rename.FileName)])); if (Result <> ID_YES) then begin //以降の処理を行わない Exit; end; end; //変更しようとしているファイルのパス名を取得 ls_Path := gfnsFilePathGet(Dialog_FileCmd_Rename.FileName); if (gfnbFileExists(Dialog_FileCmd_Rename.FileName)) then begin //変更しようとしているファイル名のファイルが存在している if (gfnbFileIsReadOnly(Dialog_FileCmd_Rename.FileName)) then begin Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'は既に存在し読み取り専用属性がついています'#13'上書きしますか', [Dialog_FileCmd_Rename.FileName])); end else begin Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'は既に存在します'#13'上書きしますか', [Dialog_FileCmd_Rename.FileName])); end; end else if not(gfnbFolderExists(ls_Path)) then begin //フォルダ作成 if (gfnbFolderCreate(ls_Path)) then begin Result := ID_YES; //AIU end else begin gpcShowMessage(WideFormat('%s'#13'フォルダの作成に失敗しました', [ls_Path])); Result := ID_NO; //以降の処理を行わない Exit; end; end; end; if (Result = ID_YES) then begin //ストップさせないとリネームできない if (DShow_Player.FileName = sFile) then begin if (DShow_Player.MediaAssigned) then begin // DShow_Player.Pause; FfResumePosition := DShow_Player.CurrentPosition; FiResumeIndex := ComboBox_Playlist.ItemIndex; Stop; end; end; if (lb_ReadOnly) then begin if not(gfnbFileReadOnlyReset(sFile)) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('変更前のファイル'#13'%s'#13'の読み取り専用属性の解除ができませんでした'#13'名前の変更はできません', [sFile])); //以降の処理を行わない Exit; end; end; if (gfnbFileIsReadOnly(Dialog_FileCmd_Rename.FileName)) then begin lb_ReadOnly := True; if not(gfnbFileReadOnlyReset(Dialog_FileCmd_Rename.FileName)) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('変更後のファイル'#13'%s'#13'の読み取り専用属性の解除ができませんでした'#13'名前の変更はできません', [Dialog_FileCmd_Rename.FileName])); //以降の処理を行わない Exit; end; end; //変更ファイル名が既に存在していたら上書き if (MoveFileExW(PWideChar(sFile), PWideChar(Dialog_FileCmd_Rename.FileName), MOVEFILE_REPLACE_EXISTING or MOVEFILE_COPY_ALLOWED)) then begin l_List.BeginUpdate; try for i := l_List.Count -1 downto 0 do begin if (WideUpperCase(l_List[i]) = ls_CmpFile) then begin l_List[i] := Dialog_FileCmd_Rename.FileName; end; end; finally l_List.EndUpdate; end; if (lb_ReadOnly) then begin if not(gfnbFileReadOnlySet(Dialog_FileCmd_Rename.FileName)) then begin //読み取り専用属性をセットできなかった。 //ここに来ることは恐らくない。 gpcShowMessage(WideFormat('%s'#13'名前の変更はできましたが読み取り専用属性をセットできませんでした', [Dialog_FileCmd_Rename.FileName])); end; end; end else begin li_ErrCode := GetLastError; case (li_ErrCode) of ERROR_ACCESS_DENIED: ls_Msg := 'ほかの人またはプログラムによって使用されています。'#13'ファイルを使用している可能性があるプログラムをすべて閉じてから、やり直してください。'; ERROR_WRITE_PROTECT: ls_Msg := 'メディアが書き込み禁止になっています。'; else ls_Msg := WideFormat('エラーコード %d', [li_ErrCode]); end; gpcShowMessage(WideFormat('%s'#13'の名前を変更できませんでした'#13#13'%s', [sFile, ls_Msg])); end; if (FiResumeIndex >= 0) then begin ComboBox_Playlist.ItemIndex := FiResumeIndex; FiResumeIndex := -1; // ComboBox_PlaylistSelect(nil); FOpen; end; end; end; end; procedure TApp_CheaPlayer.Action_FileCmd_RenameExecute(Sender: TObject); begin if (ComboBox_Playlist.ItemIndex < 0) then begin Exit; end; BeginFunc; try if (FileRename(DShow_Player.FileName) = ID_YES) then begin Action_Sort_FileNameExecute(nil); end; finally EndFunc; end; end; //MoveFileWithProgressW, CopyFileExW実行中に定期的に呼び出されるコールバックルーチン function CopyProgressRoutine( iTotalFileSize: int64; iTotalBytesTransferred: int64; iStreamSize: int64; iStreamBytesTransferred: int64; dwStreamNumber: DWORD; dwCallbackReason: DWORD; hSourceFile: THandle; hDestinationFile: THandle; lpData: Pointer ): DWORD; stdcall; begin // myDebug.gpcDebug(iTotalFileSize); //lpDataにはメッセージを格納してある必要がある if (iTotalFileSize > 0) then begin App_CheaPlayer.ProgressBar_FileCmd.Position := Trunc(iTotalBytesTransferred / iTotalFileSize * 100); end else begin App_CheaPlayer.ProgressBar_FileCmd.Position := App_CheaPlayer.ProgressBar_FileCmd.Max; end; Application.ProcessMessages; Result := PROGRESS_CONTINUE; end; //移動 function TApp_CheaPlayer.FileMove(sFile: WideString): Integer; //移動 var i : Integer; li_ErrCode : Integer; ls_MoveFrom : WideString; ls_MoveTo : WideString; ls_Path : WideString; ls_CmpFile : WideString; ls_Msg : AnsiString; lb_ReadOnly : Boolean; l_List : TMyWStrings; begin l_List := ComboBox_Playlist.Items; lb_ReadOnly := False; ls_MoveFrom := sFile; ls_Path := gfnsStrEndFit(Dialog_FileCmd_Move.FolderName, '\'); //AIU ls_MoveTo := ls_Path + gfnsFileNameGet(ls_MoveFrom); if (WideUpperCase(ls_MoveFrom) = WideUpperCase(ls_MoveTo)) then begin //同じフォルダならエラー gpcShowMessage(WideFormat('%s'#13'同じフォルダを指定することはできません', [Dialog_FileCmd_Move.FolderName])); Result := ID_NO; //以降の処理を行わない Exit; end; if (gfnbFileIsReadOnly(ls_MoveFrom)) then begin //移動しようとしているファイルが読み取り専用だった Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'移動しようとしているファイルには読み取り専用属性がついています。移動しますか', [ls_MoveFrom])); if (Result <> ID_YES) then begin //以降の処理を行わない Exit; end; end; Result := ID_YES; if (gfnbFileExists(ls_MoveTo)) then begin if (gfnbFileIsReadOnly(ls_MoveTo)) then begin Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'移動先のフォルダには既に同名のファイルが存在し、更に読み取り専用属性がついています'#13'上書きしますか', [ls_MoveTo])); end else begin Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'移動先のフォルダには既に同名のファイルが存在します'#13'上書きしますか', [ls_MoveTo])); end; end else if not(gfnbFolderExists(ls_Path)) then begin //ディレクトリ作成 if not(gfnbFolderCreate(ls_Path)) then begin //作成失敗 gpcShowMessage(WideFormat('%s'#13'フォルダの作成に失敗しました'#13'移動はできません', [ls_Path])); Result := ID_NO; end; end; if (Result <> ID_YES) then begin //以降の処理を行わない Exit; end; //ストップさせないとリネームできない if (DShow_Player.FileName = sFile) then begin if (DShow_Player.MediaAssigned) then begin // DShow_Player.Pause; FfResumePosition := DShow_Player.CurrentPosition; FiResumeIndex := ComboBox_Playlist.ItemIndex; Stop; end; end; if (gfnbFileIsReadOnly(ls_MoveFrom)) then begin lb_ReadOnly := True; if not(gfnbFileReadOnlyReset(ls_MoveFrom)) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('%s'#13'移動元ファイルの読み取り専用属性の解除ができませんでした'#13'移動はできません', [ls_MoveFrom])); //以降の処理を行わない Exit; end; end; if (gfnbFileIsReadOnly(ls_MoveTo)) then begin lb_ReadOnly := True; if not(gfnbFileReadOnlyReset(ls_MoveTo)) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('%s'#13'移動先ファイルの読み取り専用属性の解除ができませんでした'#13'移動はできません', [ls_MoveTo])); //以降の処理を行わない Exit; end; end; //MoveFileWithProgressWは同じドライブでの移動の場合コールバックルーチンを呼ばない if (WideUpperCase(gfnsFileDriveGet(ls_MoveFrom)) = WideUpperCase(gfnsFileDriveGet(ls_MoveTo))) then begin ProgressBar_FileCmd.Position := ProgressBar_FileCmd.Max; end else begin ProgressBar_FileCmd.Position := ProgressBar_FileCmd.Min; end; ProgressBar_FileCmd.Show; try //移動先に同名ファイルがあった場合上書き if (MoveFileWithProgressW(PWideChar(ls_MoveFrom), PWideChar(ls_MoveTo), @CopyProgressRoutine, nil, MOVEFILE_REPLACE_EXISTING or MOVEFILE_COPY_ALLOWED)) then begin ls_CmpFile := WideUpperCase(ls_MoveFrom); l_List.BeginUpdate; try for i := l_List.Count -1 downto 0 do begin if (WideUpperCase(l_List[i]) = ls_CmpFile) then begin //移動なので元のファイルはなくなる。よってリスト中のすべての元ファイルは新しいファイル名に書き換え。 l_List[i] := ls_MoveTo; end; end; finally l_List.EndUpdate; end; if (lb_ReadOnly) then begin if not(gfnbFileReadOnlySet(ls_MoveTo)) then begin //読み取り専用属性をセットできなかった。 //ここに来ることは恐らくない。 gpcShowMessage(WideFormat('%s'#13'ファイルの移動はできましたが読み取り専用属性をセットできませんでした', [ls_MoveTo])); end; end; end else begin //移動失敗 li_ErrCode := GetLastError; case (li_ErrCode) of ERROR_ACCESS_DENIED: ls_Msg := 'ほかの人またはプログラムによって使用されています。'#13'ファイルを使用している可能性があるプログラムをすべて閉じてから、やり直してください。'; ERROR_WRITE_PROTECT: ls_Msg := '移動先のメディアは書き込み禁止になっています。'; //移動する前に書込み禁止属性をはずしているのでこのエラーは恐らく起きない。 else ls_Msg := WideFormat('エラーコード %d', [li_ErrCode]); end; gpcShowMessage(WideFormat('%s'#13'移動できませんでした'#13#13'%s', [ls_MoveFrom, ls_Msg])); end; if (FiResumeIndex >= 0) then begin ComboBox_Playlist.ItemIndex := FiResumeIndex; FiResumeIndex := -1; // ComboBox_PlaylistSelect(nil); FOpen; end; finally ProgressBar_FileCmd.Hide; end; end; procedure TApp_CheaPlayer.Action_FileCmd_MoveExecute(Sender: TObject); var li_Index : Integer; ls_File : WideString; begin li_Index := ComboBox_Playlist.ItemIndex; ls_File := ComboBox_Playlist.Items[li_Index]; if (gfnbKeyState(VK_SHIFT)) then begin Dialog_FileCmd_Move.InitialDir := FGetIniDir; end else if not(gfnbFolderExists(Dialog_FileCmd_Move.InitialDir)) then begin //フォルダが存在しなかった //フォルダが存在するまでサブフォルダを削っていく Dialog_FileCmd_Move.InitialDir := gfnsExistsFolderGet(Dialog_FileCmd_Move.InitialDir); end; Dialog_FileCmd_Move.Owner := Screen.ActiveForm; if (Dialog_FileCmd_Move.Execute) then begin Dialog_FileCmd_Move.InitialDir := Dialog_FileCmd_Move.FolderName; BeginFunc; try if (FileMove(ls_File) = ID_YES) then begin Action_Sort_FileNameExecute(nil); end; finally EndFunc; end; end; end; procedure TApp_CheaPlayer.Action_FileCmd_MoveAsExecute(Sender: TObject); var // li_Index : Integer; ls_File : WideString; begin // li_Index := ComboBox_Playlist.ItemIndex; ls_File := ComboBox_Playlist.Items[ComboBox_Playlist.ItemIndex]; if (gfnbKeyState(VK_SHIFT)) then begin Dialog_FileCmd_MoveAs.InitialDir := FGetIniDir; end else if not(gfnbFolderExists(Dialog_FileCmd_MoveAs.InitialDir)) then begin //フォルダが存在しなかった //フォルダが存在するまでサブフォルダを削っていく Dialog_FileCmd_MoveAs.InitialDir := gfnsExistsFolderGet(Dialog_FileCmd_MoveAs.InitialDir); end; if (Dialog_FileCmd_MoveAs.Execute) then begin Dialog_FileCmd_MoveAs.InitialDir := gfnsFilePathGet(Dialog_FileCmd_MoveAs.FileName); BeginFunc; try if (FileMove(ls_File) = ID_YES) then begin Action_Sort_FileNameExecute(nil); end; finally EndFunc; end; end; end; function TApp_CheaPlayer.FileCopy(sFile: WideString): Integer; //コピー var ls_CopyFrom : WideString; ls_CopyTo : WideString; ls_Path : WideString; li_ErrCode : Integer; lb_ReadOnly : Boolean; //コピー後リストのファイル名を変えるならコメントアウトを外す //{$DEFINE COPYRENAME} {$IFDEF COPYRENAME} i : Integer; ls_CmpFile : WideString; l_List : TMyWStrings; {$ENDIF} begin {$IFDEF COPYRENAME} l_List := ListBox_BmpList.Items; {$ENDIF} lb_ReadOnly := False; ls_CopyFrom := sFile; ls_Path := gfnsStrEndFit(Dialog_FileCmd_Copy.FolderName, '\'); //AIU ls_CopyTo := ls_Path + gfnsFileNameGet(ls_CopyFrom); if (WideUpperCase(ls_CopyFrom) = WideUpperCase(ls_CopyTo)) then begin //同じフォルダならエラー gpcShowMessage(WideFormat('%s'#13'同じフォルダを指定することはできません', [Dialog_FileCmd_Copy.FolderName])); Result := ID_NO; Exit; end else begin Result := ID_YES; end; if (gfnbFileExists(ls_CopyTo)) then begin if (gfnbFileIsReadOnly(ls_CopyTo)) then begin lb_ReadOnly := True; Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'コピー先のフォルダには既に同名のファイルが存在し、更に読み取り専用属性がついています'#13'上書きしますか', [ls_CopyTo])); end else begin Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'コピー先のフォルダには既に同名のファイルが存在します'#13'上書きしますか', [ls_CopyTo])); end; end else if not(gfnbFolderExists(ls_Path)) then begin //ディレクトリ作成 if not(gfnbFolderCreate(ls_Path)) then begin //作成失敗 gpcShowMessage(WideFormat('%s'#13'フォルダの作成に失敗しました'#13'ファイルコピーはできません', [ls_Path])); Result := ID_NO; end; end; if (Result <> ID_YES) then begin Exit; end; if (lb_ReadOnly) then begin if not(gfnbFileReadOnlyReset(ls_CopyTo)) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('%s'#13'コピー先ファイルの読み取り専用属性の解除ができませんでした'#13'コピーはできません', [ls_CopyTo])); //以降の処理を行わない Exit; end; end; //MoveFileWithProgressWは同じドライブでの移動の場合コールバックルーチンを呼ばない if (WideUpperCase(gfnsFileDriveGet(ls_CopyFrom)) = WideUpperCase(gfnsFileDriveGet(ls_CopyTo))) then begin ProgressBar_FileCmd.Position := ProgressBar_FileCmd.Max; end else begin ProgressBar_FileCmd.Position := ProgressBar_FileCmd.Min; end; ProgressBar_FileCmd.Show; try if (CopyFileExW(PWideChar(ls_CopyFrom), PWideChar(ls_CopyTo), @CopyProgressRoutine, nil, nil, 0)) then begin {$IFDEF COPYRENAME} ls_CmpFile := WideUpperCase(ls_CopyFrom); for i := l_List.Count -1 downto 0 do begin if (WideUpperCase(l_List[i]) = ls_CmpFile) then begin l_List[i] := ls_CopyTo; end; end; {$ENDIF} end else begin //コピー失敗 li_ErrCode := GetLastError; case (li_ErrCode) of ERROR_ACCESS_DENIED: begin gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13'%s'#13'がほかの人またはプログラムによって使用されています。'#13'ファイルを使用している可能性があるプログラムをすべて閉じてから、やり直してください。', [ls_CopyTo])); end; ERROR_WRITE_PROTECT: begin gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13'移動先のメディア %s は書き込み禁止になっています。', [ls_CopyFrom, gfnsFileDriveGet(ls_CopyTo)])); end; ERROR_REQUEST_ABORTED: begin //中止。 gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13'コピーは中止されました', [ls_CopyFrom])); end; else begin gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13#13'エラーコード %d', [ls_CopyFrom, li_ErrCode])); end; end; end; finally ProgressBar_FileCmd.Hide; end; end; procedure TApp_CheaPlayer.Action_FileCmd_CopyExecute(Sender: TObject); var li_Index : Integer; ls_File : WideString; begin li_Index := ComboBox_Playlist.ItemIndex; ls_File := ComboBox_Playlist.Items[li_Index]; if (gfnbKeyState(VK_SHIFT)) then begin Dialog_FileCmd_Copy.InitialDir := gfnsMyDocumentsPathGet; end else if not(gfnbFolderExists(Dialog_FileCmd_Copy.InitialDir)) then begin Dialog_FileCmd_Copy.InitialDir := gfnsExistsFolderGet(Dialog_FileCmd_Copy.InitialDir); end; Dialog_FileCmd_Copy.Owner := Screen.ActiveForm; if (Dialog_FileCmd_Copy.Execute) then begin Dialog_FileCmd_Copy.InitialDir := Dialog_FileCmd_Copy.FolderName; BeginFunc; try FileCopy(DShow_Player.FileName); finally EndFunc; end; end; end; procedure TApp_CheaPlayer.Action_FileCmd_CopyAsExecute(Sender: TObject); begin // end; //ごみ箱へ function TApp_CheaPlayer.FileTrash(sFile: WideString): Integer; var i: Integer; lr_FileOp : TSHFileOpStructW; l_List : TMyWStrings; begin l_List := ComboBox_Playlist.Items; if not(gfnbFileExists(sFile)) then begin //ファイルが存在しなかった。 Result := ID_YES; //リストから削除するためにID_NOにはしない //Exit; NG! //後半でリストから削除するためにExitはしない end else begin if (gfnbFileIsReadOnly(sFile)) then begin //削除ファイルが読み取り専用だった Result := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'削除しようとしているファイルには読み取り専用属性がついています'#13'削除しますか', [sFile])); if (Result = ID_YES) then begin if not(gfnbFileReadOnlyReset(sFile)) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('%s'#13'読み取り専用属性の解除ができませんでした'#13'削除はできません', [sFile])); //以降の処理を行わない Exit; end; end else begin //以降の処理を行わない Exit; end; end; Result := ID_YES; sFile := WideUpperCase(sFile); if (WideUpperCase(DShow_Player.FileName) = sFile) then begin //停止させないと削除できない if (DShow_Player.MediaAssigned) then begin // DShow_Player.Pause; FiResumeIndex := ComboBox_Playlist.ItemIndex; Stop; end; end; //http://lupin.client.jp/delphi/index.html#2 //ゴミ箱へ FillChar(lr_FileOp, SizeOf(lr_FileOp), 0); with lr_FileOp do begin Wnd := Self.Handle; wFunc := FO_DELETE; pFrom := PWideChar(sFile + #0); pTo := nil; fFlags := FOF_ALLOWUNDO + FOF_NOCONFIRMATION; fAnyOperationsAborted := False; hNameMappings := nil; end; SHFileOperationW(lr_FileOp); end; //リスト中のすべてのls_Fileを削除する。 if (Result = ID_YES) then begin l_List.BeginUpdate; try for i := l_List.Count -1 downto 0 do begin //ゴミ箱へは送れなかったものもリストから削除はする。 if (WideUpperCase(l_List[i]) = sFile) then begin l_List.Delete(i); end; end; ResetCount; finally l_List.EndUpdate; end; if (FiResumeIndex >= 0) then begin ComboBox_Playlist.ItemIndex := FiResumeIndex; //ComboBox_PlaylistSelect(nil); FOpen; FiResumeIndex := -1; end; end; end; procedure TApp_CheaPlayer.Action_FileCmd_TrashExecute(Sender: TObject); var ls_File : WideString; begin if (ComboBox_Playlist.ItemIndex < 0) then begin Exit; end; ls_File := DShow_Player.FileName; if (gfniMessageBoxYesNo(WideFormat('%s'#13'このファイルをメディアから削除します'#13'よろしいですか', [ls_File]), 'ファイル削除', MB_DEFBUTTON2) = ID_YES) then begin BeginFunc; try FileTrash(ls_File); finally EndFunc; end; end; end; procedure TApp_CheaPlayer.Action_Sort_FileNameExecute(Sender: TObject); function _MakCaption(sCaption: String; iSort: Integer): String; var li_Pos : Integer; ls_Marker : String; begin li_Pos := Pos(' ', sCaption); if (li_Pos > 0) then begin Result := Copy(sCaption, 1, li_Pos -1); end else begin Result := sCaption; end; if (Abs(FiSort) = iSort) then begin if (FiSort > 0) then begin ls_Marker := ' ▲'; end else if (FiSort < 0) then begin ls_Marker := ' ▼'; end else begin ls_Marker := ''; end; Result := Result + ls_Marker; end; end; procedure _DoSort(iSort: Integer; fnAscend, fnDescend: TMyWStringsSortCompare); begin if (Abs(FiSort) = iSort) then begin FiSort := -FiSort; end else begin FiSort := iSort; end; ComboBox_Playlist.Items.BeginUpdate; try if (FiSort >= 0) then begin ComboBox_Playlist.Items.CustomSort(fnAscend); end else begin ComboBox_Playlist.Items.CustomSort(fnDescend); end; finally ComboBox_Playlist.Items.EndUpdate; end; end; const lci_SORT_NONE = 0; lci_SORT_SHUFFLE = 1; lci_SORT_FILENAME = 2; lci_SORT_PATH = 3; lci_SORT_NAME = 4; lci_SORT_EXT = 5; var l_List : TMyFileStrings; ls_File : WideString; i : Integer; begin BeginFunc; G_PlaylistForm.ListBox_PlayList.Items.BeginUpdate; try if (Sender = Action_Sort_FileName) then begin _DoSort(lci_SORT_FILENAME, gfniSortFuncFileNameAscending, gfniSortFuncFileNameDescending); end else if (Sender = Action_Sort_Path) then begin _DoSort(lci_SORT_PATH, gfniSortFuncMediaPathAscending, gfniSortFuncMediaPathDescending); end else if (Sender = Action_Sort_Name) then begin _DoSort(lci_SORT_NAME, gfniSortFuncMediaNameAscending, gfniSortFuncMediaNameDescending); end else if (Sender = Action_Sort_Ext) then begin _DoSort(lci_SORT_EXT, gfniSortFuncMediaExtAscending, gfniSortFuncMediaExtDescending); end else if (Sender = Action_Sort_Shuffle) then begin FiSort := lci_SORT_SHUFFLE; ComboBox_Playlist.Items.BeginUpdate; l_List := TMyFileStrings.Create(ComboBox_Playlist.Items.RawStrings); try l_List.Shuffle; finally l_List.Free; ComboBox_Playlist.Items.EndUpdate; end; end else begin FiSort := lci_SORT_NONE; end; Action_Sort_FileName.Caption := _MakCaption(Action_Sort_FileName.Caption, lci_SORT_FILENAME); Action_Sort_Path.Caption := _MakCaption(Action_Sort_Path.Caption, lci_SORT_PATH); Action_Sort_Name.Caption := _MakCaption(Action_Sort_Name.Caption, lci_SORT_NAME); Action_Sort_Ext.Caption := _MakCaption(Action_Sort_Ext.Caption, lci_SORT_EXT); if (Sender = nil) then begin Exit; end; ls_File := WideUpperCase(DShow_Player.FileName); for i := 0 to ComboBox_Playlist.Items.Count -1 do begin if (WideUpperCase(ComboBox_Playlist.Items[i]) = ls_File) then begin ComboBox_Playlist.ItemIndex := i; Exit; end; end; //該当するファイルがなかった。 //ここにくることはないはず gpcShowMessage('ソートエラー'); finally G_PlaylistForm.ListBox_PlayList.Items.EndUpdate; G_PlaylistForm.Refresh; EndFunc; end; end; procedure TApp_CheaPlayer.Action_Opt_LargeIconExecute(Sender: TObject); {$IFDEF ICONSIZE} var i : Integer; l_Bitmap : TBitmap; li_Count : Integer; {$ENDIF} begin {$IFDEF ICONSIZE} li_Count := ImageList1.Count; l_Bitmap := TBitmap.Create; try ImageList1.Clear; if (Action_Opt_LargeIcon.Checked) then begin ImageList1.Width := 32; ImageList1.Height := 32; end else begin ImageList1.Width := 16; ImageList1.Height := 16; end; l_Bitmap.Width := ImageList1.Width; l_Bitmap.Height := ImageList1.Height; l_Bitmap.Canvas.Brush.Color := clFuchsia; if (ImageList1.Height mod FBitmap_ImageList.Height <> 0) then begin SetStretchBltMode(l_Bitmap.Canvas.Handle, HALFTONE); SetBrushOrgEx(l_Bitmap.Canvas.Handle, 0, 0, nil); end; for i := 0 to li_Count -1 do begin l_Bitmap.Canvas.FillRect(Rect(0, 0, l_Bitmap.Width, l_Bitmap.Height)); StretchBlt( l_Bitmap.Canvas.Handle, 0, 0, l_Bitmap.Width, l_Bitmap.Height, FBitmap_ImageList.Canvas.Handle, i * FBitmap_ImageList.Width div li_Count, 0, FBitmap_ImageList.Width div li_Count, FBitmap_ImageList.Height, SRCCOPY ); ImageList1.AddMasked(l_Bitmap, clFuchsia); end; finally l_Bitmap.Free; end; ToolBar_Main.AutoSize := False; ToolBar_Main.ButtonWidth := 1; ToolBar_Main.ButtonHeight := 1; ToolBar_Main.AutoSize := True; if (Action_Opt_LargeIcon.Checked) then begin Panel_Seek.Height := Panel_Seek.Height * 2; TrackBar_Seek.ThumbLength := TrackBar_Seek.ThumbLength * 2; end else begin TrackBar_Seek.ThumbLength := TrackBar_Seek.ThumbLength div 2; Panel_Seek.Height := Panel_Seek.Height div 2; end; ToolBar_Control.AutoSize := False; ToolBar_Control.ButtonWidth := 1; ToolBar_Control.ButtonHeight := 1; ToolBar_Control.AutoSize := True; App_CheaPlayerList.ToolBar_PlayList.AutoSize := False; App_CheaPlayerList.ToolBar_PlayList.ButtonWidth := 1; App_CheaPlayerList.ToolBar_PlayList.ButtonHeight := 1; App_CheaPlayerList.ToolBar_PlayList.AutoSize := True; // Panel_Top.Height := ToolBar_Main.Height + ComboBox_Playlist.Height + 3; // Action_Opt_LargeIconExecute(nil); Panel_Bottom.Height := ToolBar_Main.Height + TrackBar_Seek.Height; FSendTo.IconWidth := ImageList1.Width; FSendTo.IconHeight := ImageList1.Height; FSendTo.CreateSendToMenu; {$ENDIF} end; procedure TApp_CheaPlayer.Timer_IsPlayTimer(Sender: TObject); begin Timer_IsPlay.Enabled := False; if (DShow_Player.PlayState = gciPLAYSTATE_PLAYING) or (DShow_Player.PlayState = gciPLAYSTATE_PAUSED) then begin Exit; end; TrackBar_Seek.Position := TrackBar_Seek.Position; FSeek(DShow_Player.CurrentPosition); end; procedure TApp_CheaPlayer.FOnVideoSizeChange(Sender: TObject; iWidth, iHeight: Word); //Windows 7でサブモニター上に表示させていると連続再生がうまくいかない場合があることへの対処 begin if (Timer_IsPlay.Enabled) or (DShow_Player.PlayState = gciPLAYSTATE_PLAYING) or (DShow_Player.PlayState = gciPLAYSTATE_PAUSED) then begin Exit; end; Timer_IsPlay.Enabled := True; end; procedure TApp_CheaPlayer.Action_Help_VersionInfoExecute(Sender: TObject); begin gpcVersionInfoCreate; { gpcVersionInfoMemoSet( 'ウィンドウの親子関係をクラス名のインデントで表現'#13 + '上にいくほど手前のウィンドウ'#13#13 + '太字はマウス下にある一番手前のウィンドウ'#13 + '打ち消し表示はマウス位置にかからないウィンドウ'#13 + '淡色表示は非可視のウィンドウ'#13#13 + WideFormat('「%s」でマウス位置にかからないウィンドウを非表示に', [gfnsShortCutTextErase(actWindow_PtInRect.Caption)]) + #13 + WideFormat('「%s」で更に非可視ウィンドウを非表示に', [gfnsShortCutTextErase(actWindow_Visible.Caption)]) ); } gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/tool/minfo/simple/help/'); gpcVersionInfoShowModal; gpcVersionInfoRelease; end; procedure TApp_CheaPlayer.Action_Debug_WindowExecute(Sender: TObject); begin myDebugDShow.gpcDS_SetForeground; end; procedure TApp_CheaPlayer.Action_Debug_EventExecute(Sender: TObject); begin FPlayer.Debug := Action_Debug_Event.Checked; end; procedure TApp_CheaPlayer.Action_Debug_EnumFiltersExecute(Sender: TObject); //FilterGraphに接続されているフィルターをピンを列挙 begin myDebugDShow.gpcDS_ShowMsg(StripHotKey(Action_Debug_EnumFilters.Caption)); myDebugDShow.gpcDS_EnumFilters(FPlayer.GraphBuilder); myDebugDShow.gpcDS_SetForeground; end; procedure TApp_CheaPlayer.Action_Debug_EnumSytemFiltersExecute(Sender: TObject); { *** カテゴリ名 *** フレンドリ名 / 説明 [デバイスパス] } begin myDebugDShow.gpcDS_ShowMsg(StripHotKey(Action_Debug_EnumFilters.Caption)); myDebugDShow.gpcDS_EnumSytemDeviceFilter; myDebugDShow.gpcDS_SetForeground; end; procedure TApp_CheaPlayer.Action_Debug_SaveAsGRFExecute(Sender: TObject); //GraphEdit用ファイル書き出し begin Dialog_Debug_SaveAsGRF.Options := Dialog_Debug_SaveAsGRF.Options + [ofOverwritePrompt]; if (Dialog_Debug_SaveAsGRF.Execute) then begin FPlayer.SaveGraphFile(Dialog_Debug_SaveAsGRF.FileName); end; end; end.