unit main; {$DEFINE DEBUG} interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls, ExtCtrls, Dialogs, ActnList, Menus, AppEvnts, Buttons, ComCtrls, DirectShow9, Grids, ImgList, OleCtrls, ShellAPI, ToolWin, myDShow, myFileDialog, myFolderDialog, myLabel, myMessagePanel, mySendTo, myTaskBarMenu, myTrackBar, myWStrings, list; {$R CustomFileDialog.RES} //brcc32 CustomFileDialog.RC type TApp_MEDIAPlayer = class(TForm) ActionList_Main: TActionList; actSpc: TAction; Action_FileOpenFile: TAction; Action_FileOpenFolder: TAction; Action_FileOpenThisFolder: TAction; Action_FileSaveAs: TAction; Action_FileProperty: TAction; Action_FileExit: TAction; actList_OpenAdd: TAction; actList_Disp: TAction; actList_Del: TAction; actList_SaveRelativePath: TAction; Action_ListReadTagNewest: TAction; Action_FileCmdRename: TAction; Action_FileCmdMoveAs: TAction; Action_FileCmdCopyAs: TAction; Action_FileCmdMove: TAction; Action_FileCmdCopy: TAction; Action_FileCmdTrash: TAction; actPlay_PlayPause: TAction; actPlay_Replay: TAction; actPlay_Back: TAction; actPlay_Next: TAction; actPlay_SkipBack: TAction; actPlay_SkipNext: TAction; actPlay_FrameBack: TAction; actPlay_FrameNext: TAction; actPlay_FrameBack10: TAction; actPlay_FrameNext10: TAction; actPlay_FrameBack1Sec: TAction; actPlay_FrameNext1Sec: TAction; actPlay_FrameCapturePause: TAction; actPlay_FrameCaptureBack: TAction; actPlay_FrameCaptureNext: TAction; actPlay_Repeat: TAction; actPlay_RepeatAll: TAction; actPlay_RepeatOne: TAction; actPlay_RepeatAB: TAction; actPlay_RepeatAB_Start: TAction; actPlay_RepeatAB_End: TAction; actPlay_RepeatAB_Reset: TAction; actPlay_Rate: TAction; actPlay_Rate_20: TAction; actPlay_Rate_17: TAction; actPlay_Rate_15: TAction; actPlay_Rate_13: TAction; actPlay_Rate_11: TAction; actPlay_Rate_10: TAction; actPlay_Rate_09: TAction; actPlay_Rate_08: TAction; actPlay_Rate_07: TAction; actPlay_Rate_06: TAction; actPlay_Rate_05: TAction; actPlay_Rate_01: TAction; actPlay_Mute: TAction; actPlay_Volume: TAction; actPlay_Balance: TAction; actZoom_50: TAction; actZoom_100: TAction; actZoom_200: TAction; actZoom_Up: TAction; actZoom_Down: TAction; actZoom_Fit: TAction; actZoom_FullScreen: TAction; actZoom_MaxZoom: TAction; Action_ZoomSelectVideoRenderer: TAction; Action_ZoomVideoRenderer: TAction; Action_ZoomOverlayMixer: TAction; Action_ZoomVMR7: TAction; Action_ZoomVMR9: TAction; actZoom_AspectStandard: TAction; actZoom_AspectHiVision: TAction; actZoom_AspectEVista: TAction; actZoom_AspectAVista: TAction; actZoom_AspectWideScope: TAction; actZoom_Capture: TAction; actOpt_OpenOriginalSize: TAction; actOpt_KeepAspect: TAction; actDisp_InfoPanel: TAction; actDisp_TimeVerbose: TAction; actOpt_Resume: TAction; actOpt_Random: TAction; actOpt_AllowScreenSaver: TAction; actOpt_AllowExt: TAction; actOpt_AllowDuplication: TAction; actOpt_NotSaveIni: TAction; actCustom_Setting: TAction; actCustom_ToolBar: TAction; actCustom_Menu: TAction; actCustom_ShortCut: TAction; actMenu_Main: TAction; actMenu_ZoomUpDown: TAction; actMenu_WindowList: TAction; Action_HelpVersionInfo: TAction; Action_Debug_DispEvent: TAction; actTest_DispTestForm: TAction; actTest_EnumPins: TAction; actTest_SeekCapability: TAction; actTest_TimeFormatSupported: TAction; actTest_CreateGrfFile: TAction; actTest_LoadGrfFile: TAction; actTest_DXVersionInfo: TAction; actTest_EnumSystemFilter: TAction; actList_ReadTag: TAction; actTest_MediaDet: TAction; actTest_DDCaps: TAction; Action_List_LibDBTune: TAction; actOpt_OpenFit: TAction; ActionList_Exclude: TActionList; Action_FileCmd: TAction; Action_SendTo: TAction; Action_OptNotLoadIni: TAction; mnuMain: TMainMenu; mniFile: TMenuItem; mniFile_OpenFile: TMenuItem; mniFile_OpenFolder: TMenuItem; mniFile_OpenThisFolder: TMenuItem; mniList_OpenAdd: TMenuItem; mniFile_Line1: TMenuItem; mniList_Save: TMenuItem; mniList_SaveRelativePath: TMenuItem; mniFile_Line2: TMenuItem; mniList_Disp: TMenuItem; mniList_Del: TMenuItem; mniFile_Line3: TMenuItem; mniSendTo: TMenuItem; mniFileCmd: TMenuItem; mniFileCmd_Rename: TMenuItem; mniFileCmd_MoveAs: TMenuItem; mniFileCmd_CopyAs: TMenuItem; mniFileCmd_Move: TMenuItem; mniFileCmd_Copy: TMenuItem; mniFileCmd_Line1: TMenuItem; MenuItem_FileCmdRemoveFromHDD: TMenuItem; mniFile_Property: TMenuItem; mniHelp_VersionInfo: TMenuItem; mniFile_Exit: TMenuItem; mniPlay: TMenuItem; mniPlay_PlayPause: TMenuItem; mniPlay_Replay: TMenuItem; mniPlay_Back: TMenuItem; mniPlay_Next: TMenuItem; mniPlay_Line1: TMenuItem; mniPlay_SkipNext: TMenuItem; mniPlay_SkipBack: TMenuItem; mniPlay_Line2: TMenuItem; mniPlay_Repeat: TMenuItem; mniPlay_RepeatAll: TMenuItem; mniPlay_RepeatOne: TMenuItem; mniPlay_RepeatAB: TMenuItem; mniPlay_RepeatLine1: TMenuItem; mniPlay_RepeatAB_Start: TMenuItem; mniPlay_RepeatAB_End: TMenuItem; mniPlay_RepeatLine2: TMenuItem; mniPlay_RepeatAB_Reset: TMenuItem; mniPlay_Rate: TMenuItem; mniPlay_Rate_20: TMenuItem; mniPlay_Rate_17: TMenuItem; mniPlay_Rate_15: TMenuItem; mniPlay_Rate_13: TMenuItem; mniPlay_Rate_11: TMenuItem; mniPlay_Rate_10: TMenuItem; mniPlay_Rate_09: TMenuItem; mniPlay_Rate_08: TMenuItem; mniPlay_Rate_07: TMenuItem; mniPlay_Rate_06: TMenuItem; mniPlay_Rate_05: TMenuItem; mniPlay_Line3: TMenuItem; mniPlay_Mute: TMenuItem; mniPlay_Volume: TMenuItem; mniPlay_Balance: TMenuItem; mniZoom: TMenuItem; mniZoom_50: TMenuItem; mniZoom_100: TMenuItem; mniZoom_200: TMenuItem; mniZoom_Line1: TMenuItem; mniZoom_Up: TMenuItem; mniZoom_Down: TMenuItem; mniZoom_Fit: TMenuItem; mniZoom_Line2: TMenuItem; mniZoom_FullScreen: TMenuItem; mniZoom_MaxZoom: TMenuItem; mniDisp_Info: TMenuItem; mniDisp_TimeVerbose: TMenuItem; mniPDisp_TimeVerbose: TMenuItem; mniOpt: TMenuItem; mniOpt_VideoOriginalSize: TMenuItem; mniOpt_ScreenSaver: TMenuItem; mniOpt_Random: TMenuItem; mniOpt_Line1: TMenuItem; mniOpt_AllowDuplication: TMenuItem; mniOpt_Line2: TMenuItem; mniCustom_Setting: TMenuItem; mniCustom_Menu: TMenuItem; mniCustom_ToolBar: TMenuItem; mniCustom_ShortCut: TMenuItem; //ポップアップメニュー mnuPopup: TPopupMenu; MenuItem_PFile: TMenuItem; mniPFile_OpenFile: TMenuItem; mniPFile_OpenFolder: TMenuItem; mniPFile_OpenThisFolder: TMenuItem; mniPList_OpenAdd: TMenuItem; MenuItem_PFile_Line1: TMenuItem; mniPList_Save: TMenuItem; mniPList_SaveRelativePath: TMenuItem; mniPFile_Line2: TMenuItem; mniPList_Disp: TMenuItem; MenuItem_PPlay: TMenuItem; mniPPlay_PlayPause: TMenuItem; mniPPlay_Replay: TMenuItem; mniPPlay_Back: TMenuItem; mniPPlay_Next: TMenuItem; mniPPlay_Line1: TMenuItem; mniPPlay_SkipNext: TMenuItem; mniPPlay_SkipBack: TMenuItem; mniPPlay_Line2: TMenuItem; mniPPlay_Repeat: TMenuItem; mniPPlay_RepeatAll: TMenuItem; mniPPlay_RepeatOne: TMenuItem; mniPPlay_RepeatAB: TMenuItem; mniPPlay_RepeatLine1: TMenuItem; mniPPlay_RepeatAB_Start: TMenuItem; mniPPlay_RepeatAB_End: TMenuItem; mniPPlay_RepeatAB_Reset: TMenuItem; mniPPlay_RepeatLine2: TMenuItem; mniPPlay_Rate: TMenuItem; mniPPlay_Rate_20: TMenuItem; mniPPlay_Rate_17: TMenuItem; mniPPlay_Rate_15: TMenuItem; mniPPlay_Rate_13: TMenuItem; mniPPlay_Rate_11: TMenuItem; mniPPlay_Rate_10: TMenuItem; mniPPlay_Rate_09: TMenuItem; mniPPlay_Rate_08: TMenuItem; mniPPlay_Rate_07: TMenuItem; mniPPlay_Rate_06: TMenuItem; mniPPlay_Rate_05: TMenuItem; mniPPlay_Line3: TMenuItem; mniPPlay_Mute: TMenuItem; mniPPlay_Volume: TMenuItem; mniPPlay_Balance: TMenuItem; MenuItem_PZoom: TMenuItem; mniPZoom_50: TMenuItem; mniPZoom_100: TMenuItem; mniPZoom_200: TMenuItem; mniPZoom_Line1: TMenuItem; mniPZoom_Up: TMenuItem; mniPZoom_Down: TMenuItem; mniPZoom_Fit: TMenuItem; mniPZoom_Line2: TMenuItem; mniPZoom_FullScreen: TMenuItem; mniPZoom_MaxZoom: TMenuItem; mniPOpt_OpenOriginalSize: TMenuItem; mniOpt_KeepAspect: TMenuItem; MenuItem_POpt: TMenuItem; mniPOpt_Random: TMenuItem; mniPOpt_ScreenSaver: TMenuItem; mniPOpt_NotSaveIni: TMenuItem; mniPOpt_Line1: TMenuItem; mniPOpt_AllowDuplication: TMenuItem; mniPDisp_Info: TMenuItem; mniPOpt_Line2: TMenuItem; mniPCustom_Setting: TMenuItem; mniPCustom_Menu: TMenuItem; mniPCustom_ToolBar: TMenuItem; mniPCustom_ShortCut: TMenuItem; MenuItem_PMain_Line1: TMenuItem; mniPSendTo: TMenuItem; mniPFileCmd: TMenuItem; mniPFileCmd_Rename: TMenuItem; mniPFileCmd_MoveAs: TMenuItem; mniPFileCmd_CopyAs: TMenuItem; mniPFileCmd_Move: TMenuItem; mniPFileCmd_Copy: TMenuItem; mniPFileCmd_Line1: TMenuItem; MenuItem_PFileCmdTrash: TMenuItem; MenuItem_PMain_Line2: TMenuItem; MenuItem_PHelp_VersionInfo: TMenuItem; mniPFile_Property: TMenuItem; MenuItem_PFile_Line2: TMenuItem; MenuItem_PFile_Exit: TMenuItem; mnuZoom_UpDown: TPopupMenu; mniToolZoom_50: TMenuItem; mniToolZoom_100: TMenuItem; mniToolZoom_200: TMenuItem; mniToolZoom_Line1: TMenuItem; mniToolZoom_Fit: TMenuItem; mnuPlay_Repeat: TPopupMenu; mniPPPlay_RepeatAll: TMenuItem; mniPPPlay_RepeatOne: TMenuItem; mniPPPlay_RepeatAB: TMenuItem; mniPPPlay_RepeatLine1: TMenuItem; mniPPPlay_RepeatAB_A: TMenuItem; mniPPPlay_RepeatAB_B: TMenuItem; mniPPPlay_RepeatLine2: TMenuItem; mniPPPlay_RepeatAB_Reset: TMenuItem; //再生速度、ツールバー用 mnuPlay_Rate: TPopupMenu; mniPRate_20: TMenuItem; mniPRate_17: TMenuItem; mniPRate_15: TMenuItem; mniPRate_13: TMenuItem; mniPRate_11: TMenuItem; mniPRate_10: TMenuItem; mniPRate_09: TMenuItem; mniPRate_08: TMenuItem; mniPRate_07: TMenuItem; mniPRate_06: TMenuItem; mniPRate_05: TMenuItem; //時間表示用メニュー mnuTime: TPopupMenu; mniPTime_TimeVerbose: TMenuItem; mnuFile_HistoryOpenFile: TPopupMenu; mnuFile_HistoryOpenFolder: TPopupMenu; mnuFile_HistoryOpenThisFolder: TPopupMenu; //ツールバー pnlTop: TPanel; //コントロールボタン、シークバー pnlBottom: TPanel; shpBottom: TShape; ToolBar_Play: TToolBar; btnPlay_PlayPause: TToolButton; btnPlay_Replay: TToolButton; btnPlay_Back: TToolButton; btnPlay_Next: TToolButton; btnToolPlay_Spc1: TToolButton; btnPlay_Mute: TToolButton; pnlSeek: TPanel; pnlOpenFile_CustomBase: TPanel; chkFileDialog_List_OpenAdd: TCheckBox; pnlSaveList_CustomBase: TPanel; chkList_SaveRelativePath: TCheckBox; ApplicationEvents1: TApplicationEvents; MyMessagePanel1: TMyMessagePanel; Timer_SeekBar: TTimer; Timer_Frame: TTimer; Timer_Time: TTimer; Timer_Control: TTimer; Timer_GetFile: TTimer; dlgOpenFolder: TMyOpenFolderDialog; dlgOpenThisFolder: TMyOpenFolderDialog; dlgOpenFile: TMyOpenFileDialog; dlgSaveList: TMySaveFileDialog; dlgFileCmd_Rename: TMySaveFileDialog; dlgFileCmd_FileMoveAs: TMySaveFileDialog; dlgFileCmd_FileCopyAs: TMySaveFileDialog; dlgFileCmd_FileMove: TMyOpenFolderDialog; dlgFileCmd_FileCopy: TMyOpenFolderDialog; dlgSelectGrfFile: TMySaveFileDialog; Image_Main: TImageList; ImageList3: TImageList; mnuCustomize_ToolBar: TPopupMenu; mniPPCustom_ToolBar: TMenuItem; mnuWindow: TPopupMenu; mnuFile: TPopupMenu; mniPPFile_OpenFile: TMenuItem; mniPPFile_OpenFolder: TMenuItem; mniPPFile_Line1: TMenuItem; mniPPList_OpenAdd: TMenuItem; mniPPFile_OpenThisFolder: TMenuItem; ToolBar_Main: TToolBar; btnSpc_0: TToolButton; btnToolFile_OpenFile: TToolButton; btnToolFile_OpenFolder: TToolButton; btnToolFile_OpenThisFolder: TToolButton; btnToolFile_SaveList: TToolButton; btnToolFile_Property: TToolButton; btnToolSearch: TToolButton; btnToolSearch_Title: TToolButton; btnToolSearch_Artist: TToolButton; btnToolSearch_Album: TToolButton; btnToolSearch_Writer: TToolButton; btnToolSearch_Composer: TToolButton; btnToolSearch_Conductor: TToolButton; btnToolSearch_SelectSite: TToolButton; btnToolFile_Exit: TToolButton; btnSpc_1: TToolButton; btnToolList_OpenAdd: TToolButton; btnToolList_SaveRelativePath: TToolButton; btnToolList_Disp: TToolButton; btnToolList_Del: TToolButton; btnToolFildCmd_Rename: TToolButton; btnToolFildCmd_MoveAs: TToolButton; btnToolFildCmd_CopyAs: TToolButton; btnToolFildCmd_Move: TToolButton; btnToolFildCmd_Copy: TToolButton; btnToolFildCmd_Trash: TToolButton; btnToolSendTo_OpenFolder: TToolButton; btnToolSendTo_SelProgram: TToolButton; btnToolSendTo_Regist: TToolButton; btnToolSendTo_Property: TToolButton; btnSpc_2: TToolButton; btnToolPlay_Rate: TToolButton; btnToolPlay_Rate_20: TToolButton; btnToolPlay_Rate_17: TToolButton; btnToolPlay_Rate_15: TToolButton; btnToolPlay_Rate_13: TToolButton; btnToolPlay_Rate_11: TToolButton; btnToolPlay_Rate_10: TToolButton; btnToolPlay_Rate_09: TToolButton; btnToolPlay_Rate_08: TToolButton; btnToolPlay_Rate_07: TToolButton; btnToolPlay_Rate_06: TToolButton; btnToolPlay_Rate_05: TToolButton; btnToolPlay_Repeat: TToolButton; btnToolPlay_RepeatAll: TToolButton; btnToolPlay_Repeat1: TToolButton; btnToolPlay_RepeatAB: TToolButton; btnToolPlay_RepeatAB_Start: TToolButton; btnToolPlay_RepeatAB_End: TToolButton; btnToolPlay_RepeatAB_Reset: TToolButton; btnToolZoom_50: TToolButton; btnToolZoom_100: TToolButton; btnToolZoom_200: TToolButton; btnToolZoom_Up: TToolButton; btnToolZoom_Down: TToolButton; btnToolZoom_Fit: TToolButton; btnToolZoom_FullScreen: TToolButton; btnToolZoom_MaxZoom: TToolButton; btnSpc_3: TToolButton; btnToolOpt_OpenOriginal: TToolButton; btnToolOpt_Random: TToolButton; btnToolOpt_AllowScreenSaver: TToolButton; btnToolDisp_Info: TToolButton; btnToolDisp_TimeVerbose: TToolButton; btnToolCustom_Setting: TToolButton; btnToolCustom_Menu: TToolButton; btnToolCustom_ToolBar: TToolButton; btnToolCustom_ShortCut: TToolButton; btnToolMenu_Popup: TToolButton; btnToolMenu_ZoomUpDown: TToolButton; btnToolWindow_WindowList: TToolButton; btnToolHelp_VersionInfo: TToolButton; mniSearch: TMenuItem; mniSearch_SelectSite: TMenuItem; mniSearch_Line1: TMenuItem; mniSearch_Conductor: TMenuItem; mniSearch_Composer: TMenuItem; mniSearch_Writer: TMenuItem; mniSearch_Album: TMenuItem; mniSearch_Artist: TMenuItem; mniSearch_Title: TMenuItem; mniPSearch: TMenuItem; mniPSearch_SelectSite: TMenuItem; mniPSearch_Line2: TMenuItem; mniPSearch_Conductor: TMenuItem; mniPSearch_Composer: TMenuItem; mniPSearch_Writer: TMenuItem; mniPSearch_Album: TMenuItem; mniPSearch_Artist: TMenuItem; mniPSearch_Title: TMenuItem; barVolume: TMyTrackBar; barBalance: TMyTrackBar; shpBottom_2: TShape; mnuVolume: TPopupMenu; mniPPPlay_Mute: TMenuItem; mniPPPlay_Volume: TMenuItem; mniPPPlay_Balance: TMenuItem; mniZoom_Line3: TMenuItem; mniOpt_OpenFit: TMenuItem; MenuItem_Debug: TMenuItem; mniTest_EnumPins: TMenuItem; mniZoom_VideoRenderer: TMenuItem; mniZoom_VMROld: TMenuItem; mniZoom_VMR7: TMenuItem; mniZoom_VMR9: TMenuItem; MenuItem_DebugDispEvent: TMenuItem; MenuItem_DebugLine1: TMenuItem; MenuItem_DebugDispDebugForm: TMenuItem; mniPlay_Line4: TMenuItem; mniPlay_FrameNext: TMenuItem; mniPlay_FrameBack: TMenuItem; mniTest_SeekCapability: TMenuItem; mniTest_DDCaps: TMenuItem; mniTest_TimeFormatSupported: TMenuItem; mniOpt_Resume: TMenuItem; mniOpt_NotSaveIni: TMenuItem; mniOpt_AllowExt: TMenuItem; mniPZoom_Line3: TMenuItem; mniPOpt_KeepAspect: TMenuItem; mniPOpt_Resume: TMenuItem; mniPPRate_01__: TMenuItem; mniPRate_01: TMenuItem; mniPPRate_01: TMenuItem; mniPOpt_AllowExt: TMenuItem; mniToolZoom_Line2: TMenuItem; mniPPOpt_KeepAspect: TMenuItem; mniPPZoom_AspectStandard: TMenuItem; mniPPZoom_AspectHiVision: TMenuItem; mniPPZoom_AspectEVista: TMenuItem; mniPPZoom_AspectAVista: TMenuItem; mniPPZoom_AspectWideScope: TMenuItem; mniPDisp_TimeFormatFrame: TMenuItem; mniZoom_Line4: TMenuItem; mniZoom_Copy: TMenuItem; mniPZoom_Line4: TMenuItem; mniPZoom_Copy: TMenuItem; mniTest_MediaDet: TMenuItem; mniPZoom_VideoRenderer: TMenuItem; mniPZoom_VMR7: TMenuItem; mniPZoom_VMR9: TMenuItem; mniPZoom_VMROld: TMenuItem; mniPOpt_OpenFit: TMenuItem; Timer_Aspect: TTimer; Label_VideoSize: TMyLabel; pnlInfo: TPanel; btnToolPlay_Spc3: TToolButton; ToolButton8: TToolButton; ToolButton6: TToolButton; btnToolList_TagInfo: TToolButton; ToolButton9: TToolButton; Shape1: TShape; LabelTitle_FileName: TMyLabel; LabelTitle_Title: TMyLabel; LabelTitle_Artist: TMyLabel; LabelTitle_Album: TMyLabel; LabelTitle_FileInfo: TMyLabel; Label_FileInfo: TMyLabel; Label_FileName: TMyLabel; Label_Title: TMyLabel; Label_Artist: TMyLabel; Label_Album: TMyLabel; PaintBox1: TPaintBox; btnToolOpt_KeepAspect: TToolButton; MenuItem_List_LibDBTune: TMenuItem; Panel_Seek: TPanel; TrackBar_Seek: TMyTrackBar; PopupMenu_Frame: TPopupMenu; ToolButton13: TToolButton; ToolButton14: TToolButton; ToolButton15: TToolButton; ToolButton16: TToolButton; ToolButton19: TToolButton; btnPlay_FrameBack: TToolButton; btnPlay_FrameNext: TToolButton; ToolButton3: TToolButton; ToolButton11: TToolButton; ToolButton18: TToolButton; ToolButton24: TToolButton; ToolButton25: TToolButton; ToolButton26: TToolButton; ToolButton32: TToolButton; ToolButton33: TToolButton; MenuItemFrame_Play_FrameBack: TMenuItem; MenuItemFrame_Play_FrameNext: TMenuItem; MenuItemFrame_Play_FrameBack10: TMenuItem; MenuItemFrame_Play_Next10: TMenuItem; MenuItemFrame_Play_FrameBack05Sec: TMenuItem; MenuItemFrame_Play_FrameNext05Sec: TMenuItem; MenuItemFrame_Play_Line1: TMenuItem; MenuItemFrame_Play_Line2: TMenuItem; mniZoom_OverlayMixer: TMenuItem; mniPZoom_OverlayMixer: TMenuItem; GraphEdit1: TMenuItem; GraphEdit2: TMenuItem; DirectX1: TMenuItem; EnumMoniker1: TMenuItem; MenuItem_FileCmdTrash: TMenuItem; MenuItem_PFileCmdRemoveFromHDD: TMenuItem; ToolButton40: TToolButton; lblTime: TMyLabel; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; Action_FileCmdRemoveFromHDD: TAction; Action_ZoomWallvideo: TAction; MenuItem_ZoomWallvideo: TMenuItem; MenuItem_PZoomWallvideo: TMenuItem; ToolButton_ZoomWallvideo: TToolButton; Timer_IsPlay: TTimer; Action_ZoomEVR: TAction; MenuItem_ZoomEVR: TMenuItem; MenuItem_PZoomEVR: TMenuItem; Action_Opt_Use_ffdshow: TAction; MenuItem_OptUse_ffdshow: TMenuItem; MenuItem_DebugLine2: TMenuItem; MenuItem_Help: TMenuItem; MenuItem_Zoom_SelectAspect: TMenuItem; MenuItem_Zoom_AspectStandard: TMenuItem; MenuItem_Zoom_AspectHiVision: TMenuItem; MenuItem_Zoom_AspectAVista: TMenuItem; MenuItem_Zoom_AspectEVista: TMenuItem; MenuItem_Zoom_AspectWideScope: TMenuItem; MenuItem_PZoom_SelectAspect: TMenuItem; MenuItem_PZoom_AspectWideScope: TMenuItem; MenuItem_PZoom_AspectAVista: TMenuItem; MenuItem_PZoom_AspectEVista: TMenuItem; MenuItem_PZoom_AspectHiVision: TMenuItem; MenuItem_PZoom_AspectStandard: TMenuItem; L1: TMenuItem; MenuItem_List_Line1: TMenuItem; MenuItem_PList: TMenuItem; MenuItem_PList_LibDBTune: TMenuItem; MenuItem_POpt_Use_ffdshow: TMenuItem; mniPlay_Rate_50: TMenuItem; mniPlay_Rate_100: TMenuItem; N1001: TMenuItem; N501: TMenuItem; N1002: TMenuItem; N502: TMenuItem; actPlay_Rate_100: TAction; actPlay_Rate_50: TAction; E1: TMenuItem; M1: TMenuItem; F1: TMenuItem; P1: TMenuItem; N1: TMenuItem; N2: TMenuItem; SelectAll1: TMenuItem; E2: TMenuItem; N3: TMenuItem; N4: TMenuItem; SelectAll2: TMenuItem; M2: TMenuItem; N5: TMenuItem; P2: TMenuItem; F2: TMenuItem; Action_Debug_MessageMode: TAction; MenuItem_Debug_MessageMode: TMenuItem; procedure actNop (Sender: TObject); procedure actNop_Nop(Sender: TObject); procedure Action_FileOpenFileExecute (Sender: TObject); procedure Action_FileOpenFolderExecute (Sender: TObject); procedure Action_FileOpenThisFolderExecute (Sender: TObject); procedure Action_FileSaveAsExecute (Sender: TObject); procedure Action_FilePropertyExecute (Sender: TObject); procedure actFile_MaximizeExecute (Sender: TObject); procedure Action_FileExitExecute (Sender: TObject); procedure Action_FileCmdRenameExecute (Sender: TObject); procedure Action_FileCmdMoveAsExecute (Sender: TObject); procedure Action_FileCmdCopyAsExecute (Sender: TObject); procedure Action_FileCmdMoveExecute (Sender: TObject); procedure Action_FileCmdCopyExecute (Sender: TObject); procedure Action_FileCmdTrashExecute (Sender: TObject); procedure actList_OpenAddExecute (Sender: TObject); procedure actList_DispExecute (Sender: TObject); procedure actList_DelExecute (Sender: TObject); procedure actList_ReadTagExecute (Sender: TObject); procedure actPlay_PlayPauseExecute (Sender: TObject); procedure actPlay_ReplayExecute (Sender: TObject); procedure actPlay_NextExecute (Sender: TObject); procedure actPlay_SkipNextExecute (Sender: TObject); procedure actPlay_FrameNextExecute (Sender: TObject); procedure actPlay_FrameCaptureBackExecute (Sender: TObject); procedure actPlay_FrameCaptureNextExecute (Sender: TObject); procedure actPlay_FrameCapturePauseExecute (Sender: TObject); procedure actPlay_Rate_10Execute (Sender: TObject); procedure actPlay_RepeatExecute (Sender: TObject); procedure actPlay_RepeatAllExecute (Sender: TObject); procedure actPlay_RepeatOneExecute (Sender: TObject); procedure actPlay_RepeatABExecute (Sender: TObject); procedure actPlay_RepeatAB_StartExecute (Sender: TObject); procedure actPlay_RepeatAB_EndExecute (Sender: TObject); procedure actPlay_RepeatAB_ResetExecute (Sender: TObject); procedure actPlay_MuteExecute (Sender: TObject); procedure actPlay_VolumeExecute (Sender: TObject); procedure actPlay_BalanceExecute (Sender: TObject); procedure actZoom_UpExecute (Sender: TObject); procedure actZoom_FullScreenExecute (Sender: TObject); procedure actZoomPos_LeftTopExecute (Sender: TObject); procedure actZoom_AspectStandardExecute (Sender: TObject); procedure actZoom_CaptureExecute (Sender: TObject); procedure Action_ZoomVideoRendererExecute (Sender: TObject); procedure actDisp_ToolBarExecute (Sender: TObject); procedure actDisp_TimeVerboseExecute (Sender: TObject); procedure actOpt_KeepAspectExecute (Sender: TObject); procedure actOpt_RandomExecute (Sender: TObject); procedure actOpt_AllowDuplicationExecute (Sender: TObject); procedure actOpt_AllowExtExecute (Sender: TObject); procedure actCustom_SettingExecute (Sender: TObject); procedure actCustom_MenuExecute (Sender: TObject); procedure actCustom_ToolBarExecute (Sender: TObject); procedure actCustom_ShortCutExecute (Sender: TObject); procedure actMenu_MainExecute (Sender: TObject); procedure actMenu_WindowListExecute (Sender: TObject); procedure Action_HelpVersionInfoExecute (Sender: TObject); procedure actTest_DispTestFormExecute (Sender: TObject); procedure actTest_EnumPinsExecute (Sender: TObject); procedure actTest_SeekCapabilityExecute (Sender: TObject); procedure actTest_DDCapsExecute (Sender: TObject); procedure actTest_TimeFormatSupportedExecute(Sender: TObject); procedure actTest_MediaDetExecute (Sender: TObject); procedure Action_List_LibDBTuneExecute (Sender: TObject); procedure actTest_CreateGrfFileExecute (Sender: TObject); procedure actTest_LoadGrfFileExecute (Sender: TObject); procedure actTest_DXVersionInfoExecute (Sender: TObject); procedure actTest_EnumSystemFilterExecute (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy (Sender: TObject); // procedure FormCanResize (Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); procedure FormResize (Sender: TObject); procedure FormActivate (Sender: TObject); procedure FormDblClick (Sender: TObject); procedure FormKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure mnuPopupPopup (Sender: TObject); procedure mnuPlay_RatePopup (Sender: TObject); procedure mnuPlay_RepeatPopup (Sender: TObject); procedure mnuWindowPopup (Sender: TObject); procedure mniWindow_WindowListClick (Sender: TObject); procedure mniHistory_FolderClick (Sender: TObject); procedure mniHistory_FolderDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); // procedure mniAdvancedDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); // procedure MenuItem_MeasureItem (Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); procedure btnPlay_FrameBackMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnPlay_FrameBackMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnToolSearchMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure barSeekScroll (Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: 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_SeekMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure barVolumeChange (Sender: TObject); procedure barBalanceChange (Sender: TObject); procedure barVolumeMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure barBalanceMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure lblTimeDblClick (Sender: TObject); // procedure celDispInfoDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure celDispInfoMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); // procedure plyMediaMouseDown (Sender: TObject; nButton, nShiftState: Smallint; fX, fY: Integer); procedure plyMediaMouseMove (Sender: TObject; nButton, nShiftState: Smallint; fX, fY: Integer); procedure plyMediaOnMediaOpen (Sender: TObject); procedure plyMediaOnMediaStart (Sender: TObject); procedure plyMediaOnMediaEnded (Sender: TObject); procedure plyMediaOnMediaStopped(Sender: TObject); procedure plyMediaOnMediaClosed (Sender: TObject); procedure plyMediaOnMediaPaused (Sender: TObject); procedure plyMediaOnMediaPlay (Sender: TObject); procedure plyMediaOnMediaError (Sender: TObject); procedure plyMediaOnMediaDeleted(Sender: TObject); procedure plyMediaOnMediaEvent (Sender: TObject; iEventCode: Longint; iParam1, iParam2: Longint); procedure Timer_SeekBarTimer(Sender: TObject); procedure Timer_TimeTimer (Sender: TObject); procedure Timer_ControlTimer(Sender: TObject); procedure Timer_FrameTimer (Sender: TObject); procedure Timer_GetFileTimer(Sender: TObject); procedure Timer_AspectTimer (Sender: TObject); procedure ApplicationEvents1Minimize (Sender: TObject); procedure ApplicationEvents1Restore (Sender: TObject); procedure ApplicationEvents1Exception(Sender: TObject; E: Exception); procedure ApplicationEvents1Message (var Msg: tagMSG; var Handled: Boolean); procedure MyMessagePanel1TextChange (Sender: TObject; Text: WideString); procedure Action_ZoomWallvideoExecute(Sender: TObject); procedure Timer_IsPlayTimer(Sender: TObject); procedure Action_Opt_Use_ffdshowExecute(Sender: TObject); procedure Action_Debug_MessageModeExecute(Sender: TObject); private { Private 宣言 } F_bIsPlayer : Boolean; //プレイヤーかプレイリストかで処理を振り分けるときの判定用 F_bThrough : Boolean; //処理しきれないマウスイベントをスルーする F_ptMouse : TPoint; //マウスジェスチャー用　 F_bOpenFit : Boolean; //開く時フォームの高さをビデオに合わせるかどうか //リストアップの表示用 F_bFileListing : Boolean; //ファイル取得中か F_iGetFileCount : Integer; //取得したファイル数 F_sGetFileName : WideString; //取得したファイル(表示用) F_iFormEnableCount : Integer; //FormSetEnabledのカウンタ //レジューム用 F_iResumeIndex : Integer; F_fResumePosition : TRefTime; F_rcForm : TRect; //コマンドラインオプションで開始時間を指定するために必要 F_fStartTime : Extended; //コマ送り F_iPlay_Frame : Integer; //A-Bリピート F_fRepeatStart : Double; F_fRepeatEnd : Double; //ツールバー画像のインデックス F_iPlay_MuteIndex : Integer; F_iList_AddIndex : Integer; F_iOpt_RandomIndex : Integer; //壁紙ビデオ用 //壁紙ビデオとビデオで最小化する時にタスクバーがフラッシュしないようにするため必要 FhSubPlayerMsgHwnd : HWND; //送る FSendTo : TMySendTo; //タスクバーのメニュー FTaskBarMenu : TMyTaskBarMenu; procedure FRecreateTaskBarMenu; procedure MyMenuReset(AMenu: TMenu); procedure MyMenuItemVisibleChange(AMenuItem: TMenuItem; bVisible: Boolean); procedure FCreateSubForm; function FSubFormExists: Boolean; procedure FResetWallvideo; procedure F_Renamed(sOld, sNew: WideString); procedure F_SetCompact(bFlag: Boolean); procedure F_SetBounds(iLeft, iTop, iWidth, iHeight: Integer); procedure F_DispCount(Count: Integer; FileName: WideString); procedure F_GetFileList(slFiles: TMyWStrings; bAddHistory: Boolean = True); procedure F_AddFileHistory(mnuHistory: TMenu; sFile: WideString); overload; procedure F_AddFileHistory(mnuHistory: TMenu; slList: TMyWStrings); overload; procedure F_GetInfo; function F_GetIsPlayer: Boolean; procedure F_SetABPosition(fPos: Extended); procedure FLoadIni; procedure FSaveIni; procedure WMApp (var Msg: TMessage); message WM_APP; procedure WMSysCommand (var Msg: TWMSysCommand); message WM_SYSCOMMAND; procedure WMPowerBroadcast (var Msg: TMessage); message WM_POWERBROADCAST; procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; procedure WMDisplayChange (var Msg: TMessage); message WM_DISPLAYCHANGE; procedure F_PropertyStartWrite (Sender: TObject; sFile: WideString); procedure F_PropertyEndWrite (Sender: TObject; sFile: WideString); procedure F_PropertyCancelWrite(Sender: TObject; sFile: WideString); procedure F_MonitorPreChange(Sender: TObject); procedure F_MonitorEndChange(Sender: TObject); procedure F_OnSearchChange(Sender: TObject); procedure FOnVideoSizeChange(Sender: TObject; iWidth, iHeight: Word); procedure FSetCaption(AMenuItem: TMenuItem; var sCaption: WideString); protected procedure WndProc(var Msg: TMessage); override; public { Public 宣言 } plyMedia: TMyDSPlayer; //読み込み可能な拡張子のリスト。削除は出来ない。 DefAllowExtList : TStrings; DefDisallowExtList : TStrings; //------------------------------------------------------------------------------ //準汎用フォーム用 //ツールバー procedure SetToolButtonMenu(AToolButton: TToolButton; AAction: TAction); //------------------------------------------------------------------------------ procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; function FileDelete(iIndex: Integer; bDialog: Boolean): Boolean; function FileMoveAs(iIndex: Integer; bDialog: Boolean): Boolean; procedure FileProperty(sFile: WideString); function FileRename(iIndex: Integer): Boolean; function FileSaveAs(iIndex: Integer; bDialog: Boolean): Boolean; procedure ResetCount; procedure ResetVideoWindow; function SetFormEnabled(bEnabled: Boolean): Integer; procedure ShowNormalWindow; property IsPlayer: Boolean read F_GetIsPlayer write F_bIsPlayer; end; var //------------------------------------------------------------------------------ //準汎用フォーム用 G_MainForm: TApp_MEDIAPlayer; G_ActionList: TActionList; //------------------------------------------------------------------------------ App_MEDIAPlayer: TApp_MEDIAPlayer; G_sAllowDuplication: WideString; const G_csAPPTITLE = 'minfo'; G_csAPPMUTEXNAME = 'dgdo19dkg?Idodxx'; {$R *.dfm} implementation uses {$IFDEF DEBUG} myDebug, myDebugWMP, MMSystem, {$ENDIF} ActiveX, Clipbrd, CommCtrl, DirectDraw, DirectSound, DSUtil, myApp, myBmpCaptureEx, myControl, myDebugDShow, myDragAndDrop, myDShowType, myFile, myFileStrings, myGraphic, myGrid, myHintWindow, myIniFile, myList, myMenu, myMessageBox, myMultimedia, myMonitor, // myMultiMonitor, myNum, myParam, mySearch, myShortCut, mySize, myString, myTag, myWallvideo, myWindow, //------------------------------------------------------------------------------ //準汎用フォーム用 custom_base, custom_menu, custom_toolbar, custom_shortcut, custom_help, //------------------------------------------------------------------------------ libman, sub; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.FRecreateTaskBarMenu; begin FreeAndNil(FTaskBarMenu); FTaskBarMenu := TMyTaskBarMenu.Create(mnuPopup, FSetCaption); mnuPopupPopup(nil); end; procedure TApp_MEDIAPlayer.MyMenuReset(AMenu: TMenu); begin FRecreateTaskBarMenu; end; procedure TApp_MEDIAPlayer.MyMenuItemVisibleChange(AMenuItem: TMenuItem; bVisible: Boolean); begin AMenuItem.Visible := bVisible; FRecreateTaskBarMenu; end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.SetToolButtonMenu(AToolButton: TToolButton; AAction: TAction); //ツールバー var l_PopupMenu, l_DropdownMenu: TPopupMenu; begin //TToolButtonのPopupMenuとDropdownMenuはAutoPopupプロパティはTrueでないとならない l_PopupMenu := nil; l_DropdownMenu := nil; if (AAction = nil) or (AAction = actSpc) then begin AToolButton.Style := tbsSeparator; AToolButton.Width := 8; //ファイル end else if (AAction = Action_FileOpenFolder) then begin AToolButton.Style := tbsDropDown; l_PopupMenu := mnuFile_HistoryOpenFolder; l_DropdownMenu := l_PopupMenu; end else if (AAction = Action_FileOpenFile) then begin AToolButton.Style := tbsDropDown; l_PopupMenu := mnuFile_HistoryOpenFile; l_DropdownMenu := l_PopupMenu; //再生 end else if (AAction = actPlay_PlayPause) then begin l_PopupMenu := mnuPlay_Rate; l_DropdownMenu := l_PopupMenu; end else if (AAction.Category = actPlay_Rate.Category) then begin l_PopupMenu := mnuPlay_Rate; l_DropdownMenu := l_PopupMenu; end else if (AAction.Category = actPlay_Repeat.Category) then begin l_PopupMenu := mnuPlay_Repeat; l_DropdownMenu := l_PopupMenu; //ズーム end else if (AAction = actMenu_ZoomUpDown) then begin l_PopupMenu := mnuZoom_UpDown; l_DropdownMenu := l_PopupMenu; end else if (AAction = actMenu_WindowList) then begin l_PopupMenu := mnuWindow; l_DropdownMenu := l_PopupMenu; end; AToolButton.PopupMenu := l_PopupMenu; AToolButton.DropdownMenu := l_DropdownMenu; mnuPopupPopup(nil); end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.FSetCaption(AMenuItem: TMenuItem; var sCaption: WideString); begin if (Pos('__mniPSendTo', AMenuItem.Name) > 0) then begin sCaption := gfnsAnsiToWideEx(gfnsFileNameGet(AMenuItem.Hint)); end; end; //------------------------------------------------------------------------------ //タスクバーのメニュー拡張 const FciMENU_DISPEDIT = 202; //情報パネル const FciROW_FILENAME = 0; FciROW_TITLE = 1; FciROW_ARTIST = 2; FciROW_ALBUM = 3; FciROW_FILEINFO = 4; //DrawCellのマージン const FciMARGIN = 2; //グリッドの左右マージン const lcsCAPTUREEXT = '.capture.bmp'; //ビデオ画像キャプチャ用のテンポラリファイル lcsRESUMEEXT = '.resume.m3u8'; //レジュームのテンポラリリスト lcsWALLPAPEREXT = '.wallpaper.bmp'; //壁紙にセットするオーバーレイ用壁紙 const //開くの履歴の数 lciHISTORY = 10; const lcsSENDTO = 'SendTo'; //送るメニューの送り先のリンクファイル格納フォルダ //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.F_DispCount(Count: Integer; FileName: WideString); //ファイル取得中の表示 begin F_iGetFileCount := Count; F_sGetFileName := FileName; end; procedure TApp_MEDIAPlayer.Timer_GetFileTimer(Sender: TObject); //ファイル取得中の表示 begin if (F_sGetFileName <> '') then begin Self.Caption := Format('[%d] %s', [F_iGetFileCount, gfnsWideToAnsi(F_sGetFileName)]); G_PlaylistForm.Caption := Self.Caption; end else begin Self.Caption := ''; G_PlaylistForm.Timer_StatusReset.Enabled := True; end; end; procedure TApp_MEDIAPlayer.F_MonitorPreChange(Sender: TObject); //モニター情報が変わったとき begin if (plyMedia.MediaAssigned) then begin if (plyMedia.MediaHasVideo) then begin //壁紙ビデオやフルスクリーン状態だと動作が心もとないので戻しておく mniZoom_FullScreen.Tag := 0; mniZoom_MaxZoom.Tag := 0; if (actZoom_FullScreen.Checked) then begin mniZoom_FullScreen.Tag := 1; actZoom_FullScreen.Checked := False; actZoom_FullScreenExecute(nil); end else if (actZoom_MaxZoom.Checked) then begin mniZoom_MaxZoom.Tag := 1; actZoom_MaxZoom.Checked := False; actZoom_FullScreenExecute(nil); end; if (mniZoom_FullScreen.Tag = 1) or (mniZoom_MaxZoom.Tag = 1) then begin plyMedia.Pause; F_iResumeIndex := plyMedia.ItemIndex; //レジューム再生・リストのインデックス F_fResumePosition := plyMedia.CurrentPosition; //レジューム再生・再生ポジション plyMedia.Stop; end; end; end; end; procedure TApp_MEDIAPlayer.F_MonitorEndChange(Sender: TObject); begin if (F_iResumeIndex >= 0) then begin // gpcShowMessage('モニター情報が変更されたため、一旦停止します'); if not(actPlay_Mute.Checked) then begin end; plyMedia.Play(plyMedia.FileName); if (mniZoom_FullScreen.Tag = 1) then begin mniZoom_FullScreen.Tag := 0; end else if (mniZoom_MaxZoom.Tag = 1) then begin mniZoom_MaxZoom.Tag := 0; end; end; end; procedure TApp_MEDIAPlayer.WMDisplayChange(var Msg: TMessage); var i : Integer; l_Form : TForm; begin //TScreenのMonitorsプロパティがディスプレイの変更に追随しない不具合の回避のため Self.Monitor; F_MonitorPreChange(Self); for i := 0 to Screen.FormCount -1 do begin l_Form := Screen.Forms[i]; if (l_Form = App_MEDIAPlayer) or (l_Form = App_MEDIAPlaylist) or (l_Form = App_TOOLBmpCaptureEx) or (l_Form = App_CustomBaseForm) then begin myMonitor.gpcFormSetBound(l_Form); end; end; F_MonitorEndChange(Self); end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.MyMessagePanel1TextChange(Sender: TObject; Text: WideString); const lci_OPENFILE = 0; lci_OPENFOLDER = 1; lci_OPENTHISFOLDER = 2; var lsl_OpenFile, lsl_OpenFolder, lsl_OpenThisFolder: TMyWStrings; i, k : Integer; li_OpenMode : Integer; lf_Rate : Extended; lf_List : array of Extended; l_Message : TMyParam; l_Option : TMyParamOption; lb_Add : Boolean; begin // if (Tag = 0) then Exit; //AIU if (Application.Terminated) then begin Exit; end; lsl_OpenFile := TMyWStrings.Create; lsl_OpenFolder := TMyWStrings.Create; lsl_OpenThisFolder := TMyWStrings.Create; l_Message := TMyParam.Create(Text); try if (l_Message.OptionExists('rename')) then begin //リネームされた F_Renamed(l_Message.UnOptStr[1], l_Message.UnOptStr[2]); end else begin // li_OpenMode := lci_OPENFILE; for i := 0 to l_Message.Count-1 do begin l_Option := l_Message.OptionParam[i]; if (l_Option.IsOption) then begin if (l_Option.CompareOption('TO_SUBPLAYER')) then begin //メッセージの送り先 FhSubPlayerMsgHwnd := l_Option.ValueInt; end else { if (l_Option.CompareOption('DELETELIST')) then begin //リストから削除 actList_DelExecute(nil); end else if (l_Option.CompareOption('LENGTH')) then begin lb_Popup := True; FfMediaDuration := l_Option.ValueFloat; FfMediaPosition := 0; TrackBar_Seek.MAX := Trunc(FfMediaDuration); TrackBar_Seek.Position := Trunc(FfMediaPosition); end else if (l_Option.CompareOption('MEDIAEND')) then begin Action_PlayNextExecute(Action_PlayNext); end else if (l_Option.CompareOption('MediaAssigned')) then begin lb_Popup := True; FbMediaAssigned := l_Option.CompareValue('ON'); end else if (l_Option.CompareOption('MediaHasVideo')) then begin lb_Popup := True; FbMediaHasVideo := l_Option.CompareValue('ON'); end else if (l_Option.CompareOption('PAUSED')) then begin lb_Popup := True; FiPlayState := gciPLAYSTATE_PAUSED; end else if (l_Option.CompareOption('PLAYING')) then begin lb_Popup := True; FiPlayState := gciPLAYSTATE_PLAYING; end else if (l_Option.CompareOption('RESTART')) then begin lb_Restart := True; end else if (l_Option.CompareOption('SEEK')) then begin lb_Seek := True; FfResumePos := l_Option.ValueFloat; FfMediaPosition := FfResumePos; end else if (l_Option.CompareOption('STOPPED')) then begin lb_Popup := True; FiPlayState := gciPLAYSTATE_STOPPED; Grid_PlayMediaStopped(nil); end else if (l_Option.CompareOption('TIME')) then begin FfMediaPosition := l_Option.ValueFloat; Timer1Timer(nil); end else } (* /OPEN[ ファイル...] /FOLDER[ フォルダ...] /THISFOLDER[ フォルダ...] /SAVELIST[:プレイリストファイル名] /PROPERTY /MINIMIZE /RESTORE /EXIT /RENAME /MOVEAS /COPYAS /MOVE /COPY /TRASH /ADD:{ON|OFF} /RELATIVEPATH:{ON|OFF} /LIST /PLAY /REPLAY /BACK /NEXT /SKIPBACK /SKIP /FRAMEBACK /FRAMENEXT /START:[ms] //ミリ秒 /STARTSEC:[s] //秒 /STARTTIME:[time code] //タイムコード ex)1:00 /RATE:{3|2|1.7|1.5|1.3|1.1|1|0.9|0.8|0.7|0.6|0.5} /MUTE:{ON|OFF} /VOLUME:{0..100} /BALANCE:{-100..100} /SEEK:[ms] //先頭からの時間(ミリ秒) /SEEKSEC:[s] //先頭からの秒数 /SEEKTIME:[time code] //タイムコード ex)1:00 /WALLVIDEO:{ON|OFF} /FULLSCREEN:{ON|OFF} /MAXZOOM:{ON|OFF} /ZOOMNORMAL:{ON|OFF} /50% /100% /200% /FIT /UP /DOWN /ORIGINALSIZE:{ON|OFF} /SCREENSAVER:{OFF|ON} //他と違ってスクリーンセーバー抑止は/SCREENSAVER:OFFとする /RANDOM:{ON|OFF} /GAPLESS:{ON|OFF} /VIDEOGAPLESS:{ON|OFF} /TIMEVERBOSE:{ON|OFF} /LOADINI:{ON|OFF} //設定ファイルを読み込むか /SAVEINI:{ON|OFF} //終了時設定ファイルを書き込むか /PROPERTY_ONWAITWRITE:FileName /PROPERTY_ONSTARTWRITE:FileName /PROPERTY_ONENDWRITE:HWND:FileName /PROPERTY_ONCANCELWRITE:HWND:FileName /WINDOWPOPUP:X,Y *) if (l_Option.OptionText = 'OPEN') then begin li_OpenMode := lci_OPENFILE; end else if (l_Option.OptionText = 'FOLDER') then begin li_OpenMode := lci_OPENFOLDER; end else if (l_Option.OptionText = 'THISFOLDER') then begin li_OpenMode := lci_OPENTHISFOLDER; end else if (l_Option.OptionText = 'PROPERTY') then begin Action_FilePropertyExecute(nil); end else if (l_Option.OptionText = 'EXIT') then begin Action_FileExitExecute(nil); end else if (l_Option.OptionText = 'RENAME') then begin Action_FileCmdRenameExecute(nil); end else if (l_Option.OptionText = 'MOVEAS') then begin Action_FileCmdMoveAsExecute(nil); end else if (l_Option.OptionText = 'COPYAS') then begin Action_FileCmdCopyAsExecute(nil); end else if (l_Option.OptionText = 'MOVE') then begin Action_FileCmdMoveExecute(nil); end else if (l_Option.OptionText = 'COPY') then begin Action_FileCmdCopyExecute(nil); end else if (l_Option.OptionText = 'TRASH') then begin Action_FileCmdTrashExecute(nil); //編集フォーム end else if (l_Option.OptionText = 'ADD') then begin actList_OpenAdd.Checked := (l_Option.ValueText = 'ON'); actList_OpenAddExecute(nil); end else if (l_Option.OptionText = 'RELATIVEPATH') then begin actList_SaveRelativePath.Checked := (l_Option.ValueText = 'ON'); end else if (l_Option.OptionText = 'LISTSAVE') then begin //プレイリスト保存 dlgSaveList.FileName := l_Option.ValueString; Action_FileSaveAsExecute(nil); end else if (l_Option.OptionText = 'LISTDISP') then begin actList_DispExecute(nil); end else if (l_Option.OptionText = 'LISTDEL') then begin actList_DelExecute(nil); //再生 end else if (l_Option.OptionText = 'PLAY') then begin actPlay_PlayPauseExecute(nil); end else if (l_Option.OptionText = 'REPLAY') then begin actPlay_RePlayExecute(nil); end else if (l_Option.OptionText = 'BACK') then begin actPlay_NextExecute(actPlay_Back); end else if (l_Option.OptionText = 'NEXT') then begin actPlay_NextExecute(actPlay_Next); end else if (l_Option.OptionText = 'SKIPBACK') then begin actPlay_SkipNextExecute(actPlay_SkipBack); end else if (l_Option.OptionText = 'SKIPNEXT') then begin actPlay_SkipNextExecute(actPlay_SkipNext); end else if (l_Option.OptionText = 'RATE') then begin // '/Rate:'の後には1.5や0.5などの倍率を表す数値がある SetLength(lf_List, mnuPlay_Rate.Items.Count); for k := 0 to High(lf_List) do begin lf_List[k] := StrToFloat(mnuPlay_Rate.Items[k].Caption); end; lf_Rate := gfnfNumNearest(l_Option.ValueFloat, lf_List); actPlay_Rate_10Execute(FindComponent(Format('actPlay_Rate_%.2d', [Trunc(lf_Rate * 10)]))); end else if (l_Option.OptionText = 'FRAMEBACK') then begin F_iPlay_Frame := -1; Timer_FrameTimer(nil); end else if (l_Option.OptionText = 'FRAMENEXT') then begin F_iPlay_Frame := 1; Timer_FrameTimer(nil); end else if (l_Option.OptionText = 'START') then begin //開始時間(ミリ秒) F_fStartTime := l_Option.ValueFloat / 1000; end else if (l_Option.OptionText = 'STARTSEC') then begin //開始時間(秒) F_fStartTime := l_Option.ValueInt; end else if (l_Option.OptionText = 'STARTTIME') then begin //開始時間(タイムコード) ex)1:00 F_fStartTime := gfniTimeStrToSec(l_Option.ValueString); end else if (l_Option.OptionText = 'SEEK') then begin //シークポジション if (plyMedia.MediaAssigned) then begin plyMedia.CurrentPosition := l_Option.ValueFloat; // / 1000; end; end else if (l_Option.OptionText = 'SEEKSEC') then begin //シークポジション plyMedia.Position := l_Option.ValueInt; end else if (l_Option.OptionText = 'STARTTIME') then begin //シークポジション(タイムコード) ex)1:00 plyMedia.Position := gfniTimeStrToSec(l_Option.ValueString); end else if (l_Option.OptionText = 'MUTE') then begin //ミュート actPlay_Mute.Checked := (l_Option.ValueText = 'ON'); actPlay_MuteExecute(nil); end else if (l_Option.OptionText = 'VOLUME') then begin //ボリューム plyMedia.Volume := gfniNumLimit(l_Option.ValueInt, 0, 100); end else if (l_Option.OptionText = 'BALANCE') then begin //バランス plyMedia.Balance := gfniNumLimit(l_Option.ValueInt, -100, 100); //ズーム end else if (l_Option.OptionText ='50%') then begin actZoom_UpExecute(actZoom_50); end else if (l_Option.OptionText = '100%') then begin actZoom_UpExecute(actZoom_100); end else if (l_Option.OptionText = '200%') then begin actZoom_UpExecute(actZoom_200); end else if (l_Option.OptionText = 'UP') then begin actZoom_UpExecute(actZoom_Up); end else if (l_Option.OptionText = 'DOWN') then begin actZoom_UpExecute(actZoom_Down); end else if (l_Option.OptionText = 'FIT') then begin actZoom_UpExecute(nil); end else if (l_Option.ValueText ='FULLSCREEN') then begin //フルスクリーン actZoom_FullScreen.Checked := (l_Option.ValueText = 'ON'); actZoom_FullScreenExecute(actZoom_FullScreen); end else if (l_Option.OptionText = 'MAXZOOM') then begin //拡大フルスクリーン actZoom_MaxZoom.Checked := (l_Option.ValueText = 'ON'); actZoom_FullScreenExecute(actZoom_MaxZoom); end else if (l_Option.OptionText = 'ZOOMNORMAL') then begin //ノーマル(ウィンドウモード) if (actZoom_FullScreen.Checked) then begin actZoom_FullScreen.Checked := False; actZoom_FullScreenExecute(actZoom_FullScreen); end else if (actZoom_MaxZoom.Checked) then begin actZoom_MaxZoom.Checked := False; actZoom_FullScreenExecute(actZoom_MaxZoom); end; //オプション end else if (l_Option.OptionText = '/ORIGINALSIZE') then begin actOpt_OpenOriginalSize.Checked := (l_Option.ValueText = 'ON'); end else if (l_Option.OptionText = 'SCREENSAVER') then begin actOpt_AllowScreenSaver.Checked := (l_Option.ValueText = 'ON'); end else if (l_Option.OptionText ='RESUME') then begin actOpt_Resume.Checked := (l_Option.ValueText = 'ON'); end else if (l_Option.OptionText ='RANDOM') then begin actOpt_Random.Checked := (l_Option.ValueText = 'ON'); actOpt_RandomExecute(nil); //設定ファイルを読み込まない、、がここに来るのは設定ファイルを読み込ん //だ後なのでここに書いても意味はない end else if (l_Option.OptionText = 'LOADINI') then begin Action_OptNotLoadIni.Checked := (l_Option.ValueText = 'OFF'); end else if (l_Option.OptionText = 'SAVEINI') then begin actOpt_NotSaveIni.Checked := (l_Option.ValueText = 'OFF'); end else if (l_Option.OptionText = 'ALLOWDUPLICATION') then begin actOpt_AllowDuplication.Checked := (l_Option.ValueText = 'ON'); actOpt_AllowDuplication.OnExecute(nil); end else if (l_Option.OptionText = 'INFO') then begin actDisp_InfoPanel.Checked := (l_Option.ValueText = 'ON'); actDisp_InfoPanel.OnExecute(nil); end else if (l_Option.OptionText = 'TIMEVERBOSE') then begin actDisp_TimeVerbose.Checked := (l_Option.ValueText = 'ON'); actDisp_TimeVerboseExecute(nil); // end else if (l_Option.OptionText = 'PROPERTY_ONWAITWRITE') then begin // F_PropertyWaitWrite(nil, l_Option.OptionValue); end else if (l_Option.OptionText = 'PROPERTY_ONSTARTWRITE') then begin F_PropertyStartWrite(nil, l_Option.ValueString); end else if (l_Option.OptionText = 'PROPERTY_ONENDWRITE') then begin F_PropertyEndWrite(nil, l_Option.ValueString); end else if (l_Option.OptionText = 'PROPERTY_ONCANCELWRITE') then begin F_PropertyCancelWrite(nil, l_Option.ValueString); // end else if (l_Option.OptionText = 'WINDOWPOPUP') then begin // end; end else begin case (li_OpenMode) of lci_OPENFOLDER : lsl_OpenFolder.Add (l_Option.ParamString); lci_OPENTHISFOLDER : lsl_OpenThisFolder.Add(l_Option.ParamString); else lsl_OpenFile.Add (l_Option.ParamString); end; end; end; SetFormEnabled(False); try //ファイル取得 //myDebug.gpcDebug(lsl_OpenFile.Count); if (lsl_OpenFile.Count > 0) then begin if (gfnbKeyState(VK_SHIFT)) then begin //サブフォルダのファイルをリストアップしない dlgOpenFolder.Folders.Assign(lsl_OpenFile); Action_FileOpenThisFolderExecute(nil); end else begin F_GetFileList(lsl_OpenFile, True); end; end; lb_Add := actList_OpenAdd.Checked; actList_OpenAdd.Checked := True; //フォルダ if (lsl_OpenFolder.Count > 0) then begin if (gfnbKeyState(VK_SHIFT)) then begin //サブフォルダのファイルをリストアップしない dlgOpenFolder.Folders.Assign(lsl_OpenFolder); Action_FileOpenThisFolderExecute(nil); end else begin F_GetFileList(lsl_OpenFolder); end; end; //選択フォルダのみ if (lsl_OpenThisFolder.Count > 0) then begin dlgOpenFolder.Folders.Assign(lsl_OpenThisFolder); Action_FileOpenThisFolderExecute(nil); end; actList_OpenAdd.Checked := lb_Add; finally SetFormEnabled(True); end; end; finally lsl_OpenFile.Free; lsl_OpenFolder.Free; lsl_OpenThisFolder.Free; l_Message.Free; end; MyMessagePanel1.Tag := 0; //メッセージの循環を防ぐため end; { procedure TApp_MEDIAInfoPlayer.WmDeviceChange(var Msg: TMessage); //http://homepage3.nifty.com/m-and-i/tips/devicechange.htm //http://support.microsoft.com/kb/163503/ja //http://katamari.jp/soulware/index.php/post/getting_device_notification function lfns_FirstDriveFromMask(iMask: Integer): String; //ドライブの取得 var i: Integer; begin for i := 0 to 25 do begin if ((iMask and 1) > 0) then begin Result := Chr(i + Ord('A')) + ':'; Break; end; iMask := iMask shr 1; end; end; type DEV_BROADCAST_VOLUME = record dbcv_size: Integer; dbcv_devicetype: Integer; dbcv_reserved: Integer; dbcv_unitmask: Integer; dbcv_flags: ShortInt; end; const DBT_DEVNODES_CHANGED = $0007; //デバイスノードが変化しました DBT_CONFIGCHANGED = $0018; //デバイス構成が変化しました DBT_DEVICEARRIVAL = $8000; //デバイスが挿入され使用可能になりました DBT_DEVICEQUERYREMOVE = $8001; //デバイスの削除を要求されました DBT_DEVICEQUERYREMOVEFAILED = $8002; //デバイス削除要求がキャンセルされました DBT_DEVICEREMOVECOMPLETE = $8004; //デバイスが削除されました DBT_DEVICEREMOVEPENDING = $8003; //デバイスが削除されようとしています。拒否することはできません DBT_DEVICETYPESPECIFIC = $8005; //デバイス固有のイベント DBT_DEVTYP_VOLUME = $2; DBTF_MEDIA = $1; var lp_Volume: ^DEV_BROADCAST_VOLUME; begin //CDが取り出されたらstopさせようと思ったのだけれど、エラーの方が早くて間に合わない inherited; //Exit; if (Msg.LParam <> 0) then begin lp_Volume := Pointer(Msg.LParam); if (Msg.WParam = DBT_DEVICEREMOVECOMPLETE) and (lp_Volume.dbcv_devicetype = DBT_DEVTYP_VOLUME) and ((lp_Volume.dbcv_flags and DBTF_MEDIA) > 0) then begin plyMedia.controls.stop; end; end; end; } //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.WMDropFiles(var Msg: TWMDROPFILES); //ドラッグアンドドロップ var l_Drop: TMyDropFiles; begin l_Drop := TMyDropFiles.Create(Msg, Self); try F_GetFileList(l_Drop.Files, True); finally l_Drop.Free; end; end; { procedure TApp_MEDIAInfoPlayer.WMDisplayChange(var Msg: TMessage); var lrc_Rect: TRect; begin if (plyMedia.MediaHasVideo and actZoom_WallVideo.Checked) then begin lrc_Rect := plyMedia.BoundsRect; plyMedia.SetBounds(Rect(-2, -2, 2, 2)); plyMedia.SetBounds(lrc_Rect); end; end; } procedure TApp_MEDIAPlayer.WMPowerBroadcast(var Msg: TMessage); begin if (Msg.WParam = PBT_APMSUSPEND) then begin //停止する plyMedia.Pause; F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; plyMedia.Stop; gpcWallVideoFree; Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; end; end; procedure TApp_MEDIAPlayer.WMQueryEndSession(var Msg: TWMQueryEndSession); //http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm begin // Close; FormDestroy(Self); Msg.Result := 1; end; { procedure TApp_MEDIAPlayer.F_GridClassProc(var Msg: TMessage); var l_Msg: TMessage; begin if (Msg.Msg = WM_MOUSEWHEEL) then begin FillChar(l_Msg, SizeOf(l_Msg), 0); if (TWMMouseWheel(Msg).WheelDelta > 0) then begin l_Msg.WParamLo := SB_LINEUP; end else begin l_Msg.WParamLo := SB_LINEDOWN; end; l_Msg.Result :=0; SendMessage(celDispInfo.Handle, WM_VSCROLL, l_Msg.WParam, l_Msg.LParam); end else begin F_GridOriginProc(Msg); end; end; } procedure TApp_MEDIAPlayer.WMApp(var Msg: TMessage); var lpt_Pos : TPoint; begin // lpt_Pos := Point(Integer(Msg.LParamHi), Integer(Msg.LParamLo)); lpt_Pos := gfnptMousePosGet; if (Msg.WParam = WPARAM(dlgOpenFile.Handle)) then begin //ファイル/開く // dlgOpenFile.ShowMonitorCenter(Point(Msg.LParamHi, Msg.LParamLo)); dlgOpenFile.ShowMonitorCenter(lpt_Pos); { end else if (Msg.WParam = WPARAM(dlgOpenFolder.Handle)) then begin //ファイル/フォルダを開く dlgOpenFolder.ShowMonitorCenter(lpt_Pos); end else if (Msg.WParam = WPARAM(dlgOpenThisFolder.Handle)) then begin //ファイル/選択フォルダのみ開く dlgOpenThisFolder.ShowMonitorCenter(lpt_Pos); } end else if (Msg.WParam = WPARAM(dlgSaveList.Handle)) then begin //リスト/リストに名前をつけて保存 dlgSaveList.ShowMonitorCenter(lpt_Pos); end else if (Msg.WParam = WPARAM(dlgFileCmd_Rename.Handle)) then begin //ファイル操作/名前の変更 dlgFileCmd_Rename.ShowMonitorCenter(lpt_Pos); end else if (Msg.WParam = WPARAM(dlgFileCmd_FileMoveAs.Handle)) then begin //ファイル操作/名前をつけて移動 dlgFileCmd_FileMoveAs.ShowMonitorCenter(lpt_Pos); end else if (Msg.WParam = WPARAM(dlgFileCmd_FileCopyAs.Handle)) then begin //ファイル操作/名前をつけてコピー dlgFileCmd_FileCopyAs.ShowMonitorCenter(lpt_Pos); { end else if (Msg.WParam = WPARAM(dlgFileCmd_FileMove.Handle)) then begin //ファイル操作/移動 dlgFileCmd_FileMove.ShowMonitorCenter(lpt_Pos); end else if (Msg.WParam = WPARAM(dlgFileCmd_FileCopy.Handle)) then begin //ファイル操作/コピー dlgFileCmd_FileCopy.ShowMonitorCenter(lpt_Pos); } end; end; procedure TApp_MEDIAPlayer.WMSysCommand(var Msg: TWMSysCommand); begin //myDebug.gpcDebugAdd('WMSysCommand', Msg.CmdType); case (Msg.CmdType and $FFF0) of //SC_MAXIMIZE, 61490 :begin if (plyMedia.MediaHasVideo and not(actZoom_MaxZoom.Checked)) then begin actZoom_MaxZoom.Checked := True; actZoom_FullScreenExecute(nil); end else begin inherited; end; end; 61587 :begin //アイコンクリック actMenu_MainExecute(nil); end; { SC_MINIMIZE :begin actFile_MinimizeExecute(nil); Msg.Result := 1; end; SC_MAXIMIZE :begin actFile_Restore.Enabled := True; inherited; end; SC_RESTORE :begin if (AlphaBlend) then begin actFile_RestoreExecute(nil); end else begin inherited; end; end; } else begin inherited; end; end; end; //============================================================================== procedure TApp_MEDIAPlayer.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); begin if (Msg.hwnd = Application.Handle) then begin if (Msg.message = WM_SYSCOMMAND) then begin if (Msg.wParam = FciMENU_DISPEDIT) then begin actList_DispExecute(nil); end else begin FTaskBarMenu.Execute(Msg.wParam); end; end; end; end; //フォーム作成 procedure TApp_MEDIAPlayer.FormCreate(Sender: TObject); var l_Monitor : TMonitor; l_VideoDecoder : IBaseFilter; l_AudioDecoder : IBaseFilter; begin {$IFDEF DEBUG} // myDebug.gpcMessageModeSet(True); {$ENDIF} DefAllowExtList := TStringList.Create; with DefAllowExtList do begin {*} Add('.avi'); {*} Add('.cda'); {*} Add('.m3u'); {*} Add('.m3u8'); {*} Add('.mid'); {*} Add('.mp3'); {*} Add('.wav'); {*} Add('.wma'); {*} Add('.wmv'); end; DefDisallowExtList := TStringList.Create; with DefDisallowExtList do begin { Add('.bmp'); Add('.gif'); Add('.jpe'); Add('.jpeg'); Add('.png'); Add('.tif'); Add('.tiff'); } Add('.bin'); Add('.cur'); Add('.dat'); Add('.db'); Add('.iso'); Add('.doc'); Add('.log'); Add('.inf'); Add('.ini'); Add('.txt'); Add('.cng'); Add('.hlp'); Add('.htm'); Add('.html'); Add('.css'); Add('.xml'); Add('.pdf'); Add('.cgi'); Add('.pl'); Add('.bas'); Add('.frm'); Add('.vbw'); Add('.c'); Add('.cpp'); Add('.h'); Add('.hpp'); Add('.inc'); Add('.cs'); Add('.js'); Add('.dfm'); Add('.dpr'); Add('.res'); Add('.rc'); Add('.pas'); Add('.dcu'); Add('.lib'); Add('.obj'); Add('.7z'); Add('.cab'); Add('.gz'); Add('.lzh'); Add('.zip'); Add('.bat'); Add('.com'); Add('.dll'); Add('.exe'); Add('.pif'); end; //EVRはVista以上 Action_ZoomEVR.Enabled := (gfniOSMajorVersionGet >= 6); Action_ZoomEVR.Visible := False; plyMedia := TMyDSPlayer.Create(Self); with plyMedia do begin Name := 'plyMedia'; Parent := Self; // Windows.SetParent(plyMedia.Handle, Self.Handle); SetBounds(ClientRect); SendToBack; Color := $100010; DisallowExt.Assign(DefDisallowExtList); AllowExt.Assign(DefAllowExtList); AllowExt.Add('.divx'); AllowExt.Add('.flv'); AllowExt.Add('.fll'); AllowExt.Add('.mkv'); AllowExt.Add('.mov'); AllowExt.Add('.mp4'); AllowExt.Add('.mpeg'); AllowExt.Add('.mpg'); AllowExt.Add('.pls'); AllowExt.Add('.wpl'); OnDblClick := FormDblClick; OnKeyDown := FormKeyDown; OnKeyUp := FormKeyUp; OnMouseDown := FormMouseDown; OnMouseUp := FormMouseUp; OnMouseMove := celDispInfoMouseMove; OnMouseWheel := FormMouseWheel; OnMediaOpen := plyMediaOnMediaOpen; OnMediaStart := plyMediaOnMediaStart; OnMediaEnded := plyMediaOnMediaEnded; OnMediaStopped := plyMediaOnMediaStopped; OnMediaPaused := plyMediaOnMediaPaused; OnMediaPlay := plyMediaOnMediaPlay; OnMediaError := plyMediaOnMediaError; OnMediaDeleted := plyMediaOnMediaDeleted; OnMediaEvent := plyMediaOnMediaEvent; OnVideoSizeChange := FOnVideoSizeChange; Items.OnDispCount := F_DispCount; Items.Exists := False; end; try Action_Opt_Use_ffdshow.Enabled := (CreateBaseFilter(l_VideoDecoder, CLSID_LegacyAmFilterCategory, 'ffdshow Video Decoder') = S_OK) and (CreateBaseFilter(l_AudioDecoder, CLSID_LegacyAmFilterCategory, 'ffdshow Audio Decoder') = S_OK) ; finally l_VideoDecoder := nil; l_AudioDecoder := nil; end; pnlInfo.DoubleBuffered := True; pnlSeek.DoubleBuffered := True; dlgOpenFile.InitialDir := gfnsMyDocumentsPathGet; dlgOpenFolder.InitialDir := gfnsMyDocumentsPathGet; dlgOpenThisFolder.InitialDir := gfnsMyDocumentsPathGet; dlgSaveList.InitialDir := gfnsMyDocumentsPathGet; dlgFileCmd_FileMoveAs.InitialDir := gfnsMyDocumentsPathGet; dlgFileCmd_FileCopyAs.InitialDir := gfnsMyDocumentsPathGet; dlgFileCmd_FileMove.InitialDir := gfnsMyDocumentsPathGet; dlgFileCmd_FileCopy.InitialDir := gfnsMyDocumentsPathGet; dlgSelectGrfFile.InitialDir := gfnsMyDocumentsPathGet; l_Monitor := gfnMonitorGet(gfnptMousePosGet); SetBounds(l_Monitor.Left + 75, l_Monitor.Top + 75, 640, 480); F_MonitorPreChange(nil); F_ptMouse := Point(MAXINT, MAXINT); F_bThrough := False; F_bFileListing := False; F_iResumeIndex := -1; F_fResumePosition := 0; F_fRepeatStart := 0; F_fRepeatEnd := 0; // Self.Color := clBlack; Self.Color := $100010; Self.Caption := gfnsProductNameGet; mnuPlay_Rate.Tag := actPlay_Rate_10.Tag; F_iPlay_MuteIndex := actPlay_Mute.ImageIndex; F_iList_AddIndex := actList_OpenAdd.ImageIndex; F_iOpt_RandomIndex := actOpt_Random.ImageIndex; btnPlay_FrameBack.ImageIndex := actPlay_FrameBack.ImageIndex; btnPlay_FrameNext.ImageIndex := actPlay_FrameNext.ImageIndex; //準汎用フォーム用 G_MainForm := Self; G_ActionList := ActionList_Main; G_sHelpURL := 'http://drang.s4.xrea.com/program/tool/minfo/help/'; //リスト編集フォーム App_MEDIAPlaylist := TApp_MEDIAPlaylist.Create(Self); gpcCreateCustomBaseForm(Self); App_CustomBaseForm.lstAllowExt.Items.Assign(plyMedia.AllowExt); //サブフォーム作成 FCreateSubForm; // gpcExecute(gfnsExeNameGet, Format('/SUBPLAYER /FROM:%d', [MyMessagePanel1.Handle])); //------------------------------------------------------------------------------ //準汎用フォーム用 //メニュー gpcCreateMenuForm; App_CustomMenu.AddMenu('プレイヤー・メインメニュー', mnuMain); App_CustomMenu.AddMenu('プレイヤー・ポップアップメニュー', mnuPopup); App_CustomMenu.AddMenu('プレイリスト・ポップアップメニュー', G_PlaylistForm.mnuPlaylist); App_CustomMenu.AddMenu('プレイリスト・ソートメニュー', G_PlaylistForm.mnuSort); App_CustomMenu.AddMenu('プレイリスト・検索欄/編集メニュー', G_PlaylistForm.mnuEdit); App_CustomMenu.OnMenuReset := MyMenuReset; App_CustomMenu.OnMenuItemVisibleChange := MyMenuItemVisibleChange; //ツールバー pnlTop.Height := ToolBar_Main.ButtonHeight +1; btnToolSearch.Visible := False; btnToolSearch_Title.Visible := False; btnToolSearch_Artist.Visible := False; btnToolSearch_Album.Visible := False; btnToolSearch_Writer.Visible := False; btnToolSearch_Composer.Visible := False; btnToolSearch_Conductor.Visible := False; btnToolSearch_SelectSite.Visible := False; with G_PlaylistForm do begin btnSpc_0.Visible := False; btnToolFile_OpenThisFolder.Visible := False; // btnToolFile_SaveAs.Visible := False; btnToolSendTo_OpenFolder.Visible := False; btnToolSendTo_SelProgram.Visible := False; btnToolSendTo_Regist.Visible := False; btnToolSendTo_Property.Visible := False; // btnToolList_OpenShuffle.Visible := False; btnToolList_SaveRelativePath.Visible := False; end; gpcCreateToolBarForm(Self); App_CustomToolBar.AddToolBar('プレイヤーのツールバー', ToolBar_Main); App_CustomToolBar.AddToolBar('プレイヤーのコントロールバー', ToolBar_Play); App_CustomToolBar.AddToolBar('プレイリストのツールバー', G_PlaylistForm.ToolBar_Playlist); //ショートカット gpcSetInitShortCut(ActionList_Main); gpcSetInitMouseGesture( actPlay_PlayPause, //上 actPlay_Replay, //下 actPlay_Back, //左 actPlay_Next //右 ); //------------------------------------------------------------------------------ TrackBar_Seek.Align := alClient; lblTime.Caption := ''; Label_VideoSize.Caption := ''; FSendTo := TMySendTo.Create(Self); FSendTo.AddMenuItem(mniSendTo); FSendTo.AddMenuItem(mniPSendTo); // FSendTo.AddMenuItem(App_MEDIAPlaylist.mniPSendTo); FSendTo.CreateSendToMenu; SetFormEnabled(False); try Tag := 1; //この位置でないと起動時のレジューム再生でフルスクリーンがうまくいかない。 FLoadIni; Action_Opt_Use_ffdshowExecute(nil); //ショートカットへのドラッグアンドドロップに対応 if (ParamCount > 0) then begin MyMessagePanel.gpcMessagePanelUnicast(ParamW.ShiftCmdLine, MyMessagePanel1.Handle); end; finally SetFormEnabled(True); end; end; procedure TApp_MEDIAPlayer.FormClose(Sender: TObject; var Action: TCloseAction); begin Tag := 0; Timer_SeekBar.Enabled := False; Timer_Time.Enabled := False; Timer_Control.Enabled := False; Timer_Frame.Enabled := False; Timer_GetFile.Enabled := False; SetFormEnabled(False); gpcWindowRestore(Handle); if (plyMedia.MediaHasVideo) and ((actZoom_FullScreen.Checked) or (actZoom_MaxZoom.Checked)) then begin actZoom_FullScreenExecute(nil); end; plyMedia.Volume := 0; if (gfnbIsFadeAnimate) then begin // AnimateWindow(Handle, 200, AW_BLEND or AW_HIDE); end; gpcShowWindow(Self, False); end; //破棄 procedure TApp_MEDIAPlayer.FormDestroy(Sender: TObject); //var // i: Integer; // li_Time: DWORD; // l_Property: TMediaProperty_Form; begin // G_PlaylistForm.GetTag(False); if (Tag <> 0) then begin Close; end; plyMedia.Pause; gpcWallVideoFree; FSaveIni; DefAllowExtList.Free; DefDisallowExtList.Free; FTaskBarMenu.Free; gpcMenuItemFree(mnuFile_HistoryOpenFile); gpcMenuItemFree(mnuFile_HistoryOpenFolder); gpcMenuItemFree(mnuFile_HistoryOpenThisFolder); gpcMenuItemFree(mniSendTo); gpcMenuItemFree(mniPSendTo); gpcMenuItemFree(G_PlaylistForm.MenuItem_PSendTo); { //プロパティフォームの開放 for i := Screen.CustomFormCount-1 downto 0 do begin if (Screen.CustomForms[i] is TMediaProperty_Form) then begin l_Property := TMediaProperty_Form(Screen.CustomForms[i]); if (l_Property.IsWriting) then begin Application.Title := Format('タグ情報書き込み中...%s', [gfnsWideToAnsi(l_Property.FileName)]); end; li_Time := GetTickCount; while (l_Property.IsWriting) and ((GetTickCount - li_Time) < 10000) do begin //10秒かかったらループを抜ける Sleep(100); Application.ProcessMessages; end; l_Property.actFile_TagCancelExecute(nil); //AIU l_Property.Free; // l_Property.Close; end; end; } plyMedia.Close; end; { procedure TApp_MEDIAPlayer.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); var li_MenuHeight: Integer; begin if (Visible) then begin li_MenuHeight := gfniMenuBarHeightGet(Self); if (F_iMenuHeight < 0) then begin F_iMenuHeight := li_MenuHeight; end; if (li_MenuHeight <> F_iMenuHeight) then begin F_iMenuHeight := li_MenuHeight; end; end; end; } procedure TApp_MEDIAPlayer.FormResize(Sender: TObject); var li_Top, li_Bottom: Integer; begin if (pnlTop.Visible) then begin li_Top := pnlTop.Height; end else begin li_Top := 0; end; if (pnlBottom.Visible) then begin li_Bottom := pnlBottom.Height; end else begin li_Bottom := 0; end; if (plyMedia.MediaHasVideo) then begin if (actZoom_FullScreen.Checked) or (actZoom_MaxZoom.Checked) or (plyMedia.Items.Count = 0) then begin //ビデオ領域なし pnlInfo.Top := li_Top; end else begin if (actDisp_InfoPanel.Checked) then begin plyMedia.SetBounds(0, li_Top, ClientWidth, ClientHeight - li_Top - li_Bottom - pnlInfo.Height); pnlInfo.Top := li_Top + plyMedia.Height; end else begin plyMedia.SetBounds(0, li_Top, ClientWidth, ClientHeight - li_Top - li_Bottom); end; end; // Label_VideoSize.Caption := Format('%dx%d %.2f:1 [%dx%d]', [plyMedia.Width, plyMedia.Height, (plyMedia.Width / plyMedia.Height), plyMedia.VideoWidth, plyMedia.VideoHeight]); Label_VideoSize.Caption := Format('%dx%d %.2f:1', [plyMedia.Width, plyMedia.Height, (plyMedia.Width / plyMedia.Height)]); end else begin pnlInfo.Top := li_Top; end; end; procedure TApp_MEDIAPlayer.FormDblClick(Sender: TObject); begin if (actZoom_FullScreen.Checked) then begin actZoom_FullScreen.Checked := False; end else if (actZoom_MaxZoom.Checked) then begin actZoom_MaxZoom.Checked := False; end else begin actZoom_FullScreen.Checked := True; end; actZoom_FullScreenExecute(nil); end; //--- ホイール ----------------------------------------------------------------- procedure TApp_MEDIAPlayer.FormMouseWheel(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 := actPlay_SkipNext; l_ZoomAction := actZoom_Down; end else begin l_SkipAction := actPlay_SkipBack; l_ZoomAction := actZoom_Up; end; if (ssRight in Shift) then begin //巻き戻し actPlay_SkipNextExecute(l_SkipAction); end else begin actZoom_UpExecute(l_ZoomAction); end; Handled := True; end; //--- 拡大・縮小 --------------------------------------------------------------- procedure TApp_MEDIAPlayer.FCreateSubForm; //サブフォーム作成 begin gpcExecuteWait(gfnsExeNameGet, Format('/SUBPLAYER /FROM:%d', [MyMessagePanel1.Handle])); end; function TApp_MEDIAPlayer.FSubFormExists: Boolean; begin if not(IsWindow(FhSubPlayerMsgHwnd)) then begin FCreateSubForm; end; Result := IsWindow(FhSubPlayerMsgHwnd); end; procedure TApp_MEDIAPlayer.FResetWallvideo; begin //壁紙ビデオ解除 if not(IsIconic(Application.Handle)) then begin plyMedia.DisplayWindow := plyMedia.Handle; end; plyMedia.ResetWallvideo; // FSetVideoSize; // Grid_Play.Anchors := [akLeft, akTop, akRight, akBottom]; // Grid_PlayResize(nil); // PopupMenu_MainPopup(nil); end; procedure TApp_MEDIAPlayer.Action_ZoomWallvideoExecute(Sender: TObject); var lrc_Rect : TRect; lh_Window : HWND; begin if (Action_ZoomWallvideo.Checked) and (plyMedia.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 ); plyMedia.DisplayWindow := lh_Window; if (myWindow.gfniOSMajorVersionGet > 5) then begin if (plyMedia.Renderer <> vmOverlayMixer) then begin F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; plyMedia.Stop; plyMedia.Renderer := vmOverlayMixer; plyMedia.Play; end; end; plyMedia.SetWallvideo; end; end else begin //壁紙ビデオではない if (myWindow.gfniOSMajorVersionGet > 5) then begin if (Action_ZoomOverlayMixer.Checked) then begin if (plyMedia.Renderer <> vmOverlayMixer) then begin plyMedia.Renderer := vmOverlayMixer; end; end else begin if (plyMedia.Renderer = vmOverlayMixer) then begin F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; plyMedia.Stop; if (Action_ZoomVideoRenderer.Checked) then begin plyMedia.Renderer := vmVideoRenderer; end else if (Action_ZoomVMR7.Checked) then begin plyMedia.Renderer := vmVMR7; end else if (Action_ZoomVMR9.Checked) then begin plyMedia.Renderer := vmVMR9; end else if (Action_ZoomEVR.Checked) then begin plyMedia.Renderer := vmEVR; end; plyMedia.Play; end; end; end; FResetWallvideo; end; end; procedure TApp_MEDIAPlayer.ResetVideoWindow; begin if (gfnhParentWindowGet(plyMedia.Handle) <> Self.Handle) then begin Windows.SetParent(plyMedia.Handle, Self.Handle); plyMedia.SendToBack; end; if (plyMedia.MediaHasVideo) then begin gpcShowWindow(plyMedia, True); plyMedia.Visible := True; end else begin plyMedia.Visible := False; end; actDisp_ToolBarExecute(nil); end; procedure TApp_MEDIAPlayer.ShowNormalWindow; //音声メディア、ノーマルモードのビデオウィンドウ begin // plyMedia.MinimizeCancel := False; ResetVideoWindow; if (IsIconic(Application.Handle)) then begin ApplicationEvents1Minimize(nil); end else begin if (plyMedia.MediaHasVideo) then begin actZoom_UpExecute(nil); gpcShowWindow(plyMedia, True); plyMedia.Visible := True; end else begin // gpcWallVideoFree; end; gpcWallVideoFree; end; end; procedure TApp_MEDIAPlayer.actZoom_FullScreenExecute(Sender: TObject); //フルスクリーン var // l_Monitor : TMyMonitorItem; l_Monitor : TMonitor; li_Width : Integer; li_Height : Integer; lpt_Pos : TPoint; lrc_Rect : TRect; begin if (plyMedia.MediaHasVideo) //メディアはビデオ and (actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked) //フルスクリーンもしくは拡大フルスクリーン and not(IsIconic(Application.Handle)) //最小化していない and (Tag <> 0) //終了時には元に戻すため and not(Application.Terminated) then begin Timer_Control.Enabled := True; if (actZoom_FullScreen.Tag = 0) then begin F_rcForm := Self.BoundsRect; Hide; F_SetCompact(True); //タイトルバー、メニューバーなしにするため gpcWindowStyleDel(Self.Handle, WS_THICKFRAME); end; actZoom_FullScreen.Tag := 1; //フルスクリーンモードの目印 // plyMedia.MinimizeCancel := True; // l_Monitor := Monitors[Monitors.MonitorIndex(Handle)]; l_Monitor := gfnMonitorGet(Handle); Constraints.MaxHeight := gfniRectHeight(l_Monitor.WorkareaRect); Constraints.MaxWidth := gfniRectWidth (l_Monitor.WorkareaRect); SetWindowPos(Handle, 0, l_Monitor.Left, l_Monitor.Top, l_Monitor.Width, l_Monitor.Height, {SWP_NOSIZE or} SWP_NOZORDER {or SWP_SHOWWINDOW}); if (actZoom_FullScreen.Checked) then begin //普通のフルスクリーン plyMedia.SetBounds(ClientRect); end else if (actZoom_MaxZoom.Checked) then begin //余白のないフルスクリーン li_Width := gfniRectWidth(l_Monitor.WorkAreaRect); li_Height := plyMedia.HeightFromWidth(li_Width); if (li_Height < gfniRectHeight(l_Monitor.WorkAreaRect)) then begin li_Height := gfniRectHeight(l_Monitor.WorkAreaRect); li_Width := plyMedia.WidthFromHeight(li_Height); end; //画面の中央に表示するように lrc_Rect := gfnrcRectCenter(l_Monitor.WorkareaRect, Rect(0, 0, li_Width, li_Height)); lpt_Pos := Self.ClientOrigin; plyMedia.SetBounds(lrc_Rect.Left - lpt_Pos.X, lrc_Rect.Top - lpt_Pos.Y, li_Width, li_Height); end; Show; end else begin //フルスクリーンから元に戻す if (actZoom_FullScreen.Tag = 1) then begin Hide; F_SetCompact(False); gpcWindowStyleAdd(Self.Handle, WS_THICKFRAME); BoundsRect := F_rcForm; end; actZoom_UpExecute(nil); // actZoom_UpExecute(actOpt_OpenOriginalSize); FormResize(nil); Show; actZoom_FullScreen.Tag := 0; //フルスクリーンモードの目印 end; mnuPopupPopup(nil); actDisp_ToolBarExecute(nil); plyMediaMouseMove(nil, 0, 0, 0, 0); //引数は適当でよい end; //------------------------------------------------------------------------------ //拡大・縮小 procedure TApp_MEDIAPlayer.actZoomPos_LeftTopExecute(Sender: TObject); //ズーム基点の選択 begin TAction(Sender).Checked := True; end; procedure TApp_MEDIAPlayer.F_SetCompact(bFlag: Boolean); var li_Style: Longint; begin li_Style := GetWindowLong(Handle, GWL_STYLE); //ウィンドウスタイル // Hide; //タイトルバー if (bFlag) 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); SetWindowLong(Handle, GWL_STYLE, li_Style); end else begin if ((li_Style and WS_CAPTION) = 0) and ((li_Style and WS_DLGFRAME) = 0) then begin //タイトルバーがない状態からある状態へ SetWindowLong(Handle, GWL_STYLE, li_Style or WS_CAPTION or WS_DLGFRAME); end; end; SetWindowPos(Self.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //メニューバー if (bFlag) then begin Self.Menu := nil; end else begin Self.Menu := mnuMain; end; end; procedure TApp_MEDIAPlayer.F_SetBounds(iLeft, iTop, iWidth, iHeight: Integer); const lci_MINVIDEO = 120; var li_MinHeight: Integer; begin li_MinHeight := 0; if (pnlInfo.Visible) then begin Inc(li_MinHeight, pnlInfo.Height + pnlTop.Height + pnlBottom.Height); end; if (li_MinHeight > 0) then begin Inc(li_MinHeight, Height - ClientHeight); end; if (plyMedia.MediaHasVideo) and (actZoom_FullScreen.Checked = False) and (actZoom_MaxZoom.Checked = False) and (plyMedia.Items.Count > 0) then begin Inc(li_MinHeight, lci_MINVIDEO); Constraints.MinHeight := li_MinHeight; end else begin Constraints.MinHeight := li_MinHeight; Constraints.MaxHeight := Constraints.MinHeight; end; if (F_bOpenFit) then begin SetBounds(iLeft, iTop, iWidth, iHeight); end else begin F_bOpenFit := True; end; end; procedure TApp_MEDIAPlayer.actDisp_ToolBarExecute(Sender: TObject); var lb_FullScreen: Boolean; li_Height: Integer; begin Constraints.MinHeight := 0; Constraints.MaxHeight := 0; lb_FullScreen := (plyMedia.MediaHasVideo and (actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked)); li_Height := 0; //コントロールバー if (lb_FullScreen) then begin pnlBottom.Visible := False; end else begin Inc(li_Height, pnlBottom.Height); pnlBottom.Visible := True; end; //情報バー if ( (actDisp_InfoPanel.Checked) //情報パネル表示 or (plyMedia.Items.Count = 0) //リストが空 or not(plyMedia.MediaHasVideo) //音声メディア ) //のどれかの条件と and not(lb_FullScreen) //フルスクリーンでない時に情報パネルを表示 then begin Inc(li_Height, pnlInfo.Height); pnlInfo.Visible := True; end else begin pnlInfo.Visible := False; end; //ビデオ if (plyMedia.MediaHasVideo) and (actZoom_FullScreen.Checked = False) and (actZoom_MaxZoom.Checked = False) then begin if (plyMedia.Items.Count > 0) then begin //ビデオ表示あり Inc(li_Height, plyMedia.HeightFromWidth(ClientWidth)); end; end; pnlTop.Height := ToolBar_Main.Height +1; if (pnlInfo.Visible) then begin if not(plyMedia.MediaHasVideo) then begin //ツールバーと情報パネルがくっついている状態。 //黒い線が二本連なり見た目が良くないので一本減らす。 pnlTop.Height := ToolBar_Main.Height; end; end; //ツールバー if (lb_FullScreen) then begin pnlTop.Visible := False; end else begin Inc(li_Height, pnlTop.Height); pnlTop.Visible := True; end; if (pnlInfo.Visible) then begin pnlInfo.Top := pnlBottom.Top - pnlInfo.Height; { if (pnlTop.Visible) then begin pnlInfo.Top := pnlTop.Height; end else begin pnlInfo.Top := 0; end; } end; if not(lb_FullScreen) then begin F_SetBounds(Left, Top, Width, li_Height + (Height - ClientHeight)); end; end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.actZoom_UpExecute(Sender: TObject); function lfni_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 lfnrc_RectGet: TRect; begin // if (actDisp_HideControl.Checked) then begin // Result := Rect(0, pnlTop.Height, ClientWidth, ClientHeight - pnlBottom.Height); // Result := gfnrcRectMove(Result, Point(Self.ClientOrigin.X, Self.ClientOrigin.Y + pnlTop.Height)); // end else begin Result := ClientRect; Result := gfnrcRectMove(Result, Self.ClientOrigin); // end; end; const lci_ZOOM = 12; lci_MAX = 20; lci_MIN = 5; var li_Zoom : Integer; li_Left : Integer; li_Top : Integer; li_Width : Integer; li_Height : Integer; lpt_Pos : TPoint; lrc_Rect : TRect; l_Monitor : TMonitor; begin if (F_bThrough) or (actZoom_FullScreen.Checked) or (actZoom_MaxZoom.Checked) or (G_PlaylistForm.edtToolFind_Find.Focused) then begin Exit; end; F_bThrough := True; if (Sender = actZoom_UP) then begin //拡大 li_Zoom := 1; end else if (Sender = actZoom_DOWN) then begin //縮小 li_Zoom := -1; end else begin li_Zoom := 0; end; lrc_Rect := lfnrc_RectGet; if (plyMedia.MediaHasVideo) and (gfnbKeyState(VK_CONTROL)) then begin //映像のみの部分拡大・縮小 if (gfnbKeyState(VK_SHIFT)) then begin li_Width := plyMedia.Width + (li_Zoom * 1); end else begin li_Width := plyMedia.Width + gfniRound(li_Zoom * (lci_ZOOM / 100)); end; li_Width := li_Width + (li_Zoom * (lfni_ZoomGet(li_Width, gfnbKeyState(VK_SHIFT)))); li_Height := plyMedia.HeightFromWidth(li_Width); if (li_Width <= plyMedia.VideoWidth * lci_MAX) // 20倍まで and (li_Height <= plyMedia.VideoHeight * lci_MAX) // 20倍まで and (li_Width >= plyMedia.VideoWidth div lci_MIN) // 1/5まで and (li_Height >= plyMedia.VideoHeight div lci_MIN) // 1/5まで then begin lrc_Rect := gfnrcMinRect([lrc_Rect, gfnrcOriginRect(plyMedia)]); lpt_Pos := gfnptMousePosGet; if (PtInRect(lrc_Rect, lpt_Pos)) then begin //plyMediaのクライアント位置 li_Left := lpt_Pos.X - plyMedia.ClientOrigin.X; li_Top := lpt_Pos.Y - plyMedia.ClientOrigin.Y; li_Left := plyMedia.Left - (gfniRound(li_Left * (li_Width / plyMedia.Width)) - li_Left); li_Top := plyMedia.Top - (gfniRound(li_Top * (li_Height / plyMedia.Height)) - li_Top); end else begin li_Left := plyMedia.Left; li_Top := plyMedia.Top; end; plyMedia.SetBounds(li_Left, li_Top, li_Width, li_Height); end; end else begin //フォームを含めた通常の拡大・縮小 if (gfnbKeyState(VK_SHIFT)) then begin li_Width := ClientWidth + (li_Zoom * 1); end else begin li_Width := ClientWidth + gfniRound(li_Zoom * (lci_ZOOM / 100)); end; li_Width := li_Width + (li_Zoom * (lfni_ZoomGet(li_Width, gfnbKeyState(VK_SHIFT)))); if (plyMedia.MediaHasVideo) and (plyMedia.Items.Count > 0) then begin if ((Sender = actOpt_OpenOriginalSize) and (actOpt_OpenOriginalSize.Checked)) or (Sender = actZoom_100) then begin //オリジナルサイズ li_Width := plyMedia.VideoWidth; li_Height := plyMedia.VideoHeight; end else if (Sender = actZoom_50) then begin li_Width := plyMedia.VideoWidth div 2; li_Height := plyMedia.VideoHeight div 2; end else if (Sender = actZoom_200) then begin li_Width := plyMedia.VideoWidth * 2; li_Height := plyMedia.VideoHeight * 2; end else if (actOpt_KeepAspect.Checked) or (Sender = actZoom_Fit) then begin //メディアのオリジナルのアスペクト比から高さを算出 li_Height := plyMedia.HeightFromWidth(li_Width); end else begin //現在の幅と高さの比から算出 li_Height := ClientHeight - pnlTop.Height - pnlBottom.Height; if (pnlInfo.Visible) then begin Dec(li_Height, pnlInfo.Height); end; li_Height := Trunc(li_Width * (li_Height / ClientWidth)); // li_Height := gfniRound(li_Width * (li_Height / ClientWidth)); end; end else begin //映像無しの時とメディアが読み込まれていない時 li_Height := pnlInfo.Height; end; li_Width := li_Width + (Width - ClientWidth); li_Height := li_Height + (Height - ClientHeight); //タイトルバーと枠をプラス if (pnlInfo.Visible) and (plyMedia.MediaHasVideo) then begin Inc(li_Height, pnlInfo.Height); end; Inc(li_Height, pnlTop.Height); Inc(li_Height, pnlBottom.Height); 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; F_SetBounds(Left, Top, li_Width, li_Height); // if (plyMedia.Width <> gfniRectWidth(lrc_Rect)) or (plyMedia.Height <> gfniRectHeight(lrc_Rect)) then begin FormResize(nil); // end; end; //Application.ProcessMessages; Sleep(1); F_bThrough := False; end; procedure TApp_MEDIAPlayer.actOpt_KeepAspectExecute(Sender: TObject); //アスペクト比を保持 begin plyMedia.KeepAspect := actOpt_KeepAspect.Checked; end; procedure TApp_MEDIAPlayer.actPlay_SkipNextExecute(Sender: TObject); //スキップ const lci_SMALLSKIP = 1; lci_NORMALSKIP = 30; lci_LARGESKIP = 90; var li_Skip: Integer; lf_Pos: Extended; begin if (F_bThrough) then Exit; F_bThrough := True; F_ptMouse := Point(MAXINT, MAXINT); //ポップアップメニュー抑止 if (plyMedia.MediaAssigned) then begin if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then begin //Shift+Ctrl li_Skip := Trunc(plyMedia.Length / 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 = actPlay_SkipNext) then begin //li_Skipのまま end else if (Sender = actPlay_SkipBack) then begin li_Skip := -li_Skip; end else begin li_Skip := 0; end; if (li_Skip <> 0) then begin Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; lf_Pos := plyMedia.CurrentPosition; F_SetABPosition(lf_Pos + li_Skip); Timer_SeekBarTimer(Timer_SeekBar); // Timer_SeekBar.Enabled := True; // Timer_Time.Enabled := Timer_SeekBar.Enabled; end; end; Application.ProcessMessages; F_bThrough := False; end; //--- ファイル ----------------------------------------------------------------- procedure TApp_MEDIAPlayer.ResetCount; begin if (plyMedia.Items.Count = 0) then begin Timer_SeekBar.Enabled := False; Timer_Time.Enabled := False; Timer_Frame.Enabled := False; lblTime.Caption := ''; TrackBar_Seek.Position := 0; TrackBar_Seek.Max := 0; TrackBar_Seek.Enabled := False; F_GetInfo; actDisp_ToolBarExecute(nil); end; mnuPopupPopup(nil); end; function TApp_MEDIAPlayer.SetFormEnabled(bEnabled: Boolean): Integer; begin if (bEnabled) then begin Dec(F_iFormEnableCount); end else begin Inc(F_iFormEnableCount); end; Result := F_iFormEnableCount; if (bEnabled and (F_iFormEnableCount > 0)) or ((bEnabled = False) and (F_iFormEnableCount > 1)) then begin Exit; end; DragAcceptFiles(Self.Handle, bEnabled); DragAcceptFiles(G_PlaylistForm.Handle, bEnabled); gpcAppFormEnabled({[Self, G_PlaylistForm],} bEnabled); //myDebug.gpcDebug(gfnhActiveFormGet, Screen.ActiveForm.Name); if (bEnabled) then begin if (gfnhActiveFormGet = Self.Handle) or ((gfnhActiveFormGet = Application.Handle) and (Screen.ActiveForm = Self)) then begin if (gfnhParentWindowGet(plyMedia.Handle) = Self.Handle) then begin Windows.SetFocus(plyMedia.Handle); end; end; end; end; //リストアップ procedure TApp_MEDIAPlayer.F_GetFileList(slFiles: TMyWStrings; bAddHistory: Boolean = True); //slList中のファイルやフォルダ中のファイルをリストアップしてプレイリストにセットする var lsl_Files : TMyMediaStrings; i : Integer; li_Index : Integer; li_Count : Integer; ls_Ext : WideString; ls_File : WideString; l_Tag : TMyTag; begin //ファイル取得中は新たなファイルの取得はキャンセルする if (F_bFileListing) then begin Beep; //myFileProgress.gpcSetMessage('ファイル取得中です。追加処理はキャンセルされます。'); Exit; end; lsl_Files := nil; try F_bFileListing := True; lsl_Files := TMyMediaStrings.Create; lsl_Files.Assign(slFiles); //実行可能ファイルであればSendToフォルダにコピー、もしくはショートカットを作成。 //↑は意図しないショートカットが作成されてしまうことがあるためコメントアウト if (lsl_Files.Count > 0) then begin for i := lsl_Files.Count-1 downto 0 do begin ls_Ext := WideLowerCase(gfnsFileExtGet(lsl_Files[i])); if (gfnbFileExists(lsl_Files[i])) and (gfnbIsIncludeList(ls_Ext, [ '.bat', '.com', '.exe', '.lnk', '.pif' ])) then begin // RegistSendTo(lsl_Files[i]); lsl_Files.Delete(i); end; end; end; if (lsl_Files.Count > 0) then begin if (actList_OpenAdd.Checked) then begin //リストに追加 li_Count := plyMedia.Items.Count; plyMedia.Items.IsAppend := True; end else begin plyMedia.Items.IsAppend := False; plyMedia.Close; li_Count := 0; end; G_PlaylistForm.ReadTagFromLib(False); Timer_GetFile.Enabled := True; plyMedia.Items.OnDispCount := F_DispCount; plyMedia.Items.Exists := False; if (plyMedia.Items.GetList(lsl_Files)) then begin li_Index := 0; Timer_GetFile.Enabled := False; if (plyMedia.Items.Count > 0) then begin if (F_iResumeIndex > -1) then begin //レジューム li_Index := F_iResumeIndex; end else begin if (bAddHistory) then begin //履歴に追加。 for i := 0 to lsl_Files.Count-1 do begin if (gfnbFolderExists(lsl_Files[i])) then begin F_AddFileHistory(mnuFile_HistoryOpenFolder, lsl_Files[i]); end else if (gfnbFileExists(lsl_Files[i])) then begin F_AddFileHistory(mnuFile_HistoryOpenFile, lsl_Files[i]); end; end; end; if (actList_OpenAdd.Checked) then begin //リストに追加。 if (actOpt_Random.Checked) then begin li_Index := li_Count + Random(plyMedia.Items.Count - li_Count); end else begin li_Index := li_Count; end; end else begin //リストを置き換え。 //ランダム再生の場合があるのでli_Index := 0;とはしない。 li_Index := plyMedia.NextItemIndex(0); end; end; end; G_PlaylistForm.ResetCount(True); if (plyMedia.Count = 0) then begin //取得ファイルがなかった。 if (IsWindowVisible(Self.Handle)) and (Self.Visible) then begin gpcShowMessage('取得するファイルがありませんでした') end; end else begin for i := li_Count to plyMedia.Count-1 do begin //リストにユニークな番号を振る。 //ソートの後の表示用。 ls_File := plyMedia.Items[i]; l_Tag := TMyTag(plyMedia.Items.Objects[i]); l_Tag.Tag := i; end; if (li_Index < 0) then begin li_Index := 0; G_PlaylistForm.ResetCount(True); end; if (li_Index >= 0) then begin TrackBar_Seek.Enabled := False; Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; if (F_iResumeIndex > -1) then begin plyMedia.Play(li_Index); end else begin plyMedia.Open(li_Index); plyMedia.Replay; end; end; end; end; Timer_GetFile.Enabled := False; G_PlaylistForm.Timer_StatusResetTimer(nil); Self.Caption := ''; //タグを取得する。 G_PlaylistForm.TagDone := False; if (actList_ReadTag.Checked) then begin G_PlaylistForm.ReadTagFromLib(True); end; end; finally lsl_Files.Free; F_bFileListing := False; end; end; //フォルダ履歴描画。 procedure TApp_MEDIAPlayer.mniHistory_FolderDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); begin with ACanvas do begin if (Selected) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else begin Brush.Color := clMenu; Font.Color := clMenuText; end; FillRect(ARect); Inc(ARect.Left, FciMARGIN); DrawTextW(Handle, PWideChar(gfnsAnsiToWideEx(TMenuItem(Sender).Caption)), -1, ARect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); end; end; { //開くの履歴をクリック procedure TApp_MEDIAPlayer.mniHistory_FileClick(Sender: TObject); var l_MenuItem: TMenuItem; lsl_Item: TMyWStrings; begin l_MenuItem := TMenuItem(Sender); lsl_Item := TMyWStrings(F_slOpenList[l_MenuItem.MenuIndex]); F_AddFileHistory(lsl_Item); lsl_Item := TMyWStrings(F_slOpenList[0]); //選択したメニューは一番上に上がっている dlgOpenFile.Files.Clear; dlgOpenFile.Files.Assign(lsl_Item); actFile_OpenFileExecute(nil); end; //開くの履歴に追加 procedure TApp_MEDIAPlayer.F_AddFileHistory(slFiles: TMyWStrings); var i: Integer; ls_Caption: AnsiString; ls_Text: WideString; lsl_List, lsl_Item: TMyWStrings; begin lsl_List := TMyWStrings.Create; lsl_List.Assign(slFiles); for i := lsl_List.Count-1 downto 0 do begin if (lsl_List[i] = '') then begin //念のため空行を削除 lsl_List.Delete(i); end; end; //履歴に同じフォルダがあれば一番上にもっていくために削除しておく ls_Text := WideUpperCase(slFiles.Text); for i := F_slOpenList.Count -1 downto 0 do begin lsl_Item := TMyWStrings(F_slOpenList[i]); if (ls_Text = WideUpperCase(lsl_Item.Text)) then begin lsl_Item.Free; F_slOpenList.Delete(i); end; end; //保存件数を越えたら最後のアイテムを削除 if (F_slOpenList.Count >= lciHISTORY) then begin TMyWStrings(F_slOpenList[F_slOpenList.Count-1]).Free; F_slOpenList.Delete(F_slOpenList.Count-1); end; F_slOpenList.Insert(0, lsl_List); gpcMenuItemFree(mnuHistory_OpenFile); for i := 0 to F_slOpenList.Count-1 do begin lsl_Item := TMyWStrings(F_slOpenList[i]); if (lsl_Item.Count = 0) then begin Continue; end else if (lsl_Item.Count = 1) then begin ls_Caption := lsl_Item[0]; end else begin //複数ファイル ls_Caption := WideFormat('%s...(他%dﾌｧｲﾙ)', [lsl_Item[0], lsl_Item.Count]); end; mnuHistory_OpenFile.Items.Add( NewItem( gfnsWideToAnsiEx(ls_Caption), //Caption 0, //ShortCut False, //Checked True, //Enabled mniHistory_FileClick, //OnClickイベント 0, //HelpContext Format('mniHistory_OpenFile_%d', [i]) //Name ) ); mnuHistory_OpenFile.Items[mnuHistory_OpenFile.Items.Count-1].OnDrawItem := mniHistory_FolderDrawItem; end; end; } //開く procedure TApp_MEDIAPlayer.Action_FileOpenFileExecute(Sender: TObject); begin SetFormEnabled(False); try if (GetActiveWindow = G_PlaylistForm.Handle) then begin dlgOpenFile.Owner := G_PlaylistForm; end else begin dlgOpenFile.Owner := Self; end; dlgOpenFile.FilterIndex := gfniFilterIndexGet(dlgOpenFile.Filter, gfnsFileExtGet(dlgOpenFile.FileName)); if (Sender = nil) or (dlgOpenFile.Execute) then begin dlgOpenFile.InitialDir := gfnsFilePathGet(dlgOpenFile.FileName); F_GetFileList(dlgOpenFile.Files, True); end; finally SetFormEnabled(True); end; end; //フォルダ選択履歴に追加 procedure TApp_MEDIAPlayer.mniHistory_FolderClick(Sender: TObject); var l_Menu : TMenu; l_MenuItem : TMenuItem; ls_File : WideString; begin l_MenuItem := TMenuItem(Sender); l_Menu := l_MenuItem.GetParentMenu; ls_File := gfnsAnsiToWideEx(l_MenuItem.Caption); F_AddFileHistory(l_Menu, ls_File); if (l_Menu = mnuFile_HistoryOpenFile) then begin dlgOpenFile.Files.Clear; dlgOpenFile.Files.Add(ls_File); Action_FileOpenFileExecute(nil); end else if (l_Menu = mnuFile_HistoryOpenFolder) then begin dlgOpenFolder.Folders.Clear; dlgOpenFolder.Folders.Add(ls_File); Action_FileOpenFolderExecute(nil); end else if (l_Menu = mnuFile_HistoryOpenThisFolder) then begin dlgOpenThisFolder.Folders.Clear; dlgOpenThisFolder.Folders.Add(ls_File); Action_FileOpenThisFolderExecute(nil); end; end; //フォルダを開く procedure TApp_MEDIAPlayer.Action_FileOpenFolderExecute(Sender: TObject); begin SetFormEnabled(False); try if (GetActiveWindow = G_PlaylistForm.Handle) then begin dlgOpenFolder.Owner := G_PlaylistForm; end else begin dlgOpenFolder.Owner := Self; end; if (Sender = nil) or (dlgOpenFolder.Execute) then begin dlgOpenFolder.InitialDir := gfnsFilePathGet(dlgOpenFolder.FolderName); F_GetFileList(dlgOpenFolder.Folders); end; finally SetFormEnabled(True); end; end; procedure TApp_MEDIAPlayer.F_AddFileHistory(mnuHistory: TMenu; sFile: WideString); var i: Integer; ls_Name : AnsiString; ls_File : WideString; begin if (sFile = '') then begin Exit; end; ls_File := WideUpperCase(gfnsStrEndCut(sFile, '\')); //履歴に同じファイルがあれば一番上にもっていくために削除しておく for i := mnuHistory.Items.Count -1 downto 0 do begin if (WideUpperCase(gfnsStrEndCut(gfnsAnsiToWideEx(mnuHistory.Items[i].Caption), '\')) = ls_File) then begin mnuHistory.Items[i].Free; end; end; //空いている名前を取得する ls_Name := gfnsAvailableName(Copy(mnuHistory.Name, 4, MAXINT)); //頭に挿入 mnuHistory.Items.Insert(0, NewItem( gfnsWideToAnsiEx(gfnsMenuUnderlineErase(sFile)), //Caption 0, //ShortCut False, //Checked True, //Enabled mniHistory_FolderClick, //OnClickイベント 0, //HelpContext ls_Name //Name )); mnuHistory.Items[0].OnDrawItem := mniHistory_FolderDrawItem; if (mnuHistory.Items.Count > lciHISTORY) then begin //最後の履歴を削除 mnuHistory.Items[mnuHistory.Items.Count-1].Free; //NG mnuHistory.Items.Delete(mnuHistory.Items.Count-1); //Deleteではないことに注意 end; end; procedure TApp_MEDIAPlayer.F_AddFileHistory(mnuHistory: TMenu; slList: TMyWStrings); var i: Integer; begin for i := slList.Count-1 downto 0 do begin F_AddFileHistory(mnuHistory, slList[i]); end; end; //選択フォルダのみ開く procedure TApp_MEDIAPlayer.Action_FileOpenThisFolderExecute(Sender: TObject); var lsl_Dir: TMyWStrings; lh_File: THandle; lr_Info: TWin32FindDataW; begin SetFormEnabled(False); try if (GetActiveWindow = G_PlaylistForm.Handle) then begin dlgOpenThisFolder.Owner := G_PlaylistForm; end else begin dlgOpenThisFolder.Owner := Self; end; if (Sender = nil) or (dlgOpenThisFolder.Execute) then begin F_AddFileHistory(mnuFile_HistoryOpenThisFolder, dlgOpenThisFolder.FolderName); dlgOpenThisFolder.InitialDir := gfnsFilePathGet(dlgOpenThisFolder.FolderName); lsl_Dir := TMyWStrings.Create; try lh_File := FindFirstFileW(PWideChar(dlgOpenThisFolder.FolderName + '\*.*'), lr_Info); if (lh_File <> INVALID_HANDLE_VALUE) then begin repeat if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin lsl_Dir.Add(gfnsStrEndFit(dlgOpenThisFolder.FolderName, '\') + lr_Info.cFileName); end; Application.ProcessMessages; until not(FindNextFileW(lh_File, lr_Info)); Windows.FindClose(lh_File); end; F_GetFileList(lsl_Dir, False); finally lsl_Dir.Free; end; end; finally SetFormEnabled(True); end; end; //終了 procedure TApp_MEDIAPlayer.Action_FileExitExecute(Sender: TObject); begin Close; end; //--- メディアプレーヤーイベント ----------------------------------------------- { procedure TApp_MEDIAPlayer.F_pcErrFile(const sWMsg, sWFile: WideString); var ls_Msg: WideString; begin Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; plyMedia.Pause; // ls_Msg := WideFormat('%s'#13'%s', [sWFile, sWMsg]); ls_Msg := WideFormat('%s'#13'%s'#13#13'%s', [gfnsFileDirGet(sWFile), gfnsFileNameGet(sWFile), sWMsg]); if (plyMedia.MediaAssigned) then begin ls_Msg := WideFormat('%s'#13'メディアをリストから削除しますか', [ls_Msg]); case (gfniMessageBoxYesNoCancel(ls_Msg)) of ID_YES:begin plyMedia.Items.Delete(plyMedia.ItemIndex); end; ID_NO:begin plyMedia.Next; end; else begin plyMedia.Stop; end; end; end else begin gpcShowMessage(ls_Msg); plyMedia.Stop; end; end; } //WindowsMediaPlayerのエラー procedure TApp_MEDIAPlayer.ApplicationEvents1Exception(Sender: TObject; E: Exception); var ls_Msg: WideString; begin {$IFDEF DEBUG} myDebug.gpcDebugAdd('ApplicationException', E.Message); {$ENDIF} if (plyMedia.MediaAssigned) then begin plyMedia.Stop; end; if (Sender = plyMedia) then begin ls_Msg := WideFormat('メディアプレイヤーのエラーです'#13'%s', [E.Message]); end else begin ls_Msg := WideFormat('アプリケーションのエラーです'#13'%s', [E.Message]); end; gpcShowMessage(ls_Msg, 'エラー'); Timer_SeekBar.Enabled := False; Timer_Time.Enabled := False; Timer_Frame.Enabled := False; lblTime.Caption := ''; TrackBar_Seek.Position := 0; TrackBar_Seek.Max := 0; TrackBar_Seek.Enabled := False; F_GetInfo; actDisp_ToolBarExecute(nil); end; (* //情報描画 procedure TApp_MEDIAPlayer.celDispInfoDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var lrc_Rect: TRect; ls_Value: WideString; begin with celDispInfo.Canvas do begin Font.Assign(celDispInfo.Font); Brush.Color := celDispInfo.Color; lrc_Rect := Rect; FillRect(lrc_Rect); Inc(lrc_Rect.Left, FciMARGIN); Inc(lrc_Rect.Top); if (ACol = 0) then begin Dec(lrc_Rect.Right, FciMARGIN); DrawTextW(Handle, PWideChar(WideString(celDispInfo.Cells[ACol, ARow])), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); end else begin if (plyMedia.Count > 0) then begin case (ARow) of // FciROW_FILENAME: ls_Value := plyMedia.MediaName; //ファイル名 FciROW_FILENAME: ls_Value := plyMedia.FileName; //ファイル名 FciROW_FILEINFO: begin //ファイル情報 ls_Value := WideFormat('%s %s秒', [plyMedia.FileSizeString, plyMedia.MediaLengthString]); // if (plyMedia.network.bitRate > 0) then begin // ls_Value := WideFormat('%s %dKbps', [ls_Value, (plyMedia.network.bitRate div 1000)]); // end; if (plyMedia.MediaHasVideo) then begin //精度指定子をつける場合WideFormatにしてはいけない ls_Value := WideString(Format('%s %dx%d %s', [ls_Value, plyMedia.VideoWidth, plyMedia.VideoHeight, celDispInfo.Cells[ACol, ARow]])); end else begin ls_Value := WideString(Format('%s %s', [ls_Value, celDispInfo.Cells[ACol, ARow]])); end; end; FciROW_TITLE: ls_Value := plyMedia.MediaTitle; //タイトル FciROW_ARTIST: ls_Value := plyMedia.MediaArtist; //アーティスト FciROW_ALBUM: ls_Value := plyMedia.MediaAlbum; //アルバム end; DrawTextW(Handle, PWideChar(ls_Value), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER); end; end; { if (ARow = 0) then begin if not(plyMedia.MediaHasVideo) or ((plyMedia.MediaHasVideo) and (actZoom_Wall.Checked)) then begin Pen.Color := clBtnShadow; MoveTo(Rect.Left, Rect.Top); LineTo(Rect.Right, Rect.Top); end; end; } end; end; *) procedure TApp_MEDIAPlayer.F_GetInfo; begin // // celDispInfo.Repaint; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaOpen(Sender: TObject); begin Application.ProcessMessages; //これがないとリストの表示が更新されない場合がある。 FSendTo.Arg := plyMedia.FileName; TrackBar_Seek.Max := plyMedia.Length; TrackBar_Seek.Enabled := True; //時間表示の幅をセット actDisp_TimeVerboseExecute(nil); actPlay_FrameBack.Enabled := False; //plyMedia.MediaHasVideo; actPlay_FrameNext.Enabled := actPlay_FrameBack.Enabled; actZoom_Capture.Enabled := plyMedia.MediaHasVideo; if (F_iResumeIndex >= 0) then begin //レジューム再生 if (plyMedia.Length > 0) and (F_fResumePosition >= plyMedia.Duration) then begin plyMedia.Stop; plyMedia.Next; Exit; end; plyMedia.CurrentPosition := F_fResumePosition; TrackBar_Seek.Position := plyMedia.Position; F_iResumeIndex := -1; F_fResumePosition := 0; end else if (F_fStartTime > 0.0) and (F_fStartTime <= plyMedia.Duration) then begin plyMedia.CurrentPosition := F_fStartTime; end else begin F_fStartTime := 0.0; end; //再生速度。引数にnilを与えるとルーチン内で現在の設定に変換される。 actPlay_Rate_10Execute(nil); F_bOpenFit := True; Action_ZoomWallvideoExecute(nil); if (actZoom_FullScreen.Checked) or (actZoom_MaxZoom.Checked) then begin actZoom_FullScreenExecute(nil); end else if (plyMedia.MediaHasVideo) then begin F_bOpenFit := ( (actOpt_OpenFit.Checked) or (Self.ClientHeight <= (pnlTop.Height + pnlBottom.Height + pnlInfo.Height)) ); actOpt_KeepAspectExecute(nil); ResetVideoWindow; if (actOpt_OpenOriginalSize.Checked) then begin actZoom_UpExecute(actOpt_OpenOriginalSize); end else if (actOpt_OpenFit.Checked) then begin actZoom_UpExecute(nil); end; plyMedia.Visible := True; end else begin //音声メディア plyMedia.Visible := False; actDisp_ToolBarExecute(nil); end; Label_VideoSize.Visible := plyMedia.MediaHasVideo; //ヒント Self.Hint := gfnsWideToAnsiEx(plyMedia.MediaTitle); if (plyMedia.MediaArtist <> '') then begin Self.Hint := Self.Hint + #13 + gfnsWideToAnsiEx(plyMedia.MediaArtist); end; if (plyMedia.MediaAlbum <> '') then begin Self.Hint := Self.Hint + #13 + gfnsWideToAnsiEx(plyMedia.MediaAlbum); end; Label_FileName.Caption := plyMedia.FileName; Label_Title.Caption := plyMedia.MediaTitle; Label_Artist.Caption := plyMedia.MediaArtist; Label_Album.Caption := plyMedia.MediaAlbum; if (actPlay_Mute.Checked) then begin actPlay_MuteExecute(nil); end else begin actPlay_VolumeExecute(nil); end; actPlay_BalanceExecute(nil); mnuPopupPopup(nil); //情報取得 F_GetInfo; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaStart(Sender: TObject); begin if (plyMedia.ItemIndex >= 0) then begin Application.Title := gfnsWideToAnsi(WideFormat('%s', [plyMedia.MediaTitle])); if (plyMedia.MediaArtist <> '') then begin Self.Caption := Application.Title + ' / ' + gfnsWideToAnsi(plyMedia.MediaArtist); end else begin Self.Caption := Application.Title; end; end else begin Application.Title := G_csAPPTITLE; Self.Caption := Application.Title; end; G_PlaylistForm.mnuPlaylistPopup(nil); G_PlaylistForm.celPlaylist.Repaint; if (plyMedia.MediaHasVideo) and ((plyMedia.Renderer = vmVideoRenderer) or (plyMedia.Renderer = vmOverlayMixer)) and (plyMedia.KeepAspect) then begin plyMedia.Resize; end; plyMediaOnMediaPlay(Sender); end; procedure TApp_MEDIAPlayer.plyMediaOnMediaEnded(Sender: TObject); begin if (IsIconic(Application.Handle)) then begin ApplicationEvents1Minimize(nil); end; if (plyMedia.Count >= 1) then begin if (plyMedia.RepeatMode = rmAll) and (plyMedia.Count > 1) then begin plyMedia.Next; end else begin //リストに1曲のみ、あるいは1曲リピート、あるいはA-B間リピート。 if not(plyMedia.Replay) then begin plyMedia.Stop; end; //plyMedia.Play(plyMedia.ItemIndex); end; end else begin //ここには本来こないはず。 plyMedia.Stop; end; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaClosed(Sender: TObject); begin // plyMediaOnMediaStopped(Sender); end; procedure TApp_MEDIAPlayer.plyMediaOnMediaStopped(Sender: TObject); begin // TrackBar_Seek.Position := 0; TrackBar_Seek.Enabled := False; Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaPaused(Sender: TObject); begin // Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaPlay(Sender: TObject); begin // if (IsIconic(Application.Handle)) then begin ApplicationEvents1Minimize(Self); end; Timer_SeekBar.Enabled := True; Timer_Time.Enabled := Timer_SeekBar.Enabled; end; procedure TApp_MEDIAPlayer.Timer_IsPlayTimer(Sender: TObject); begin Timer_IsPlay.Enabled := False; if (plyMedia.PlayState = gciPLAYSTATE_PLAYING) or (plyMedia.PlayState = gciPLAYSTATE_PAUSED) then begin Exit; end; TrackBar_Seek.Position := TrackBar_Seek.Position; F_SetABPosition(TrackBar_Seek.Position); end; procedure TApp_MEDIAPlayer.FOnVideoSizeChange(Sender: TObject; iWidth, iHeight: Word); begin if (Timer_IsPlay.Enabled) or (plyMedia.PlayState = gciPLAYSTATE_PLAYING) or (plyMedia.PlayState = gciPLAYSTATE_PAUSED) then begin Exit; end; Timer_IsPlay.Enabled := True; end; //メディアエラーで削除 procedure TApp_MEDIAPlayer.plyMediaOnMediaError(Sender: TObject); var li_Index : Integer; li_Ret : Integer; l_Selection : TGridRect; begin li_Index := plyMedia.ItemIndex; li_Ret := gfniMessageBoxYesNoCancel(WideFormat('%s'#13'は再生できません。リストから削除しますか', [plyMedia.Items[li_Index]])); case li_Ret of ID_YES :begin //再生できないファイルをリストから削除。 //タグ取得を中断する。 G_PlaylistForm.ReadTagFromLib(False); l_Selection := G_PlaylistForm.celPlaylist.DataSelection; plyMedia.Items.Delete(li_Index); plyMedia.Play(gfniNumLoop(li_Index, 0, plyMedia.Count-1)); if (li_Index < l_Selection.Top) then begin Dec(l_Selection.Top); end; if (li_Index < l_Selection.Bottom) then begin Dec(l_Selection.Bottom); end; G_PlaylistForm.celPlaylist.DataSelection := l_Selection; G_PlaylistForm.ResetCount(False); //中断したタグ取得を再開する。 G_PlaylistForm.RestartReadTagFromLib; end; ID_NO :begin //再生できないファイルをリストから削除せず次を再生。 plyMedia.Next; end; ID_CANCEL :begin //何もしない。 end; end; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaDeleted(Sender: TObject); //削除された begin if (plyMedia.Count = 0) then begin //表示の更新 Self.Caption := gfnsProductNameGet; Timer_TimeTimer(nil); end; if (G_PlaylistForm.Enabled) then begin G_PlaylistForm.ResetCount(True); end; end; procedure TApp_MEDIAPlayer.plyMediaOnMediaEvent(Sender: TObject; iEventCode: Longint; iParam1, iParam2: Longint); begin if (Action_Debug_DispEvent.Checked) then begin myDebugDShow.gpcDS_MediaEvent(iEventCode, iParam1, iParam2); end; end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.ApplicationEvents1Minimize(Sender: TObject); //最小化 //何もしないと最小化した跡に背景がRGB(16,0,16)の所にビデオがオーバーレイされる begin { plyMedia.DisplayWindow := gfnhToplevelWindowGet(FhSubPlayerMsgHwnd); if not(actZoom_Wallvideo.Checked) then begin // plyMedia.Minimize; plyMedia.DisplayWindow := gfnhToplevelWindowGet(FhSubPlayerMsgHwnd); plyMedia.SetBounds(0, 0, 2, 2); end; } if (plyMedia.Items.Count = 0) or (Action_ZoomWallvideo.Checked) then begin Exit; end; if (FSubFormExists) then begin plyMedia.DisplayWindow := gfnhToplevelWindowGet(FhSubPlayerMsgHwnd); end; end; procedure TApp_MEDIAPlayer.ApplicationEvents1Restore(Sender: TObject); //元のサイズに戻す begin { plyMedia.DisplayWindow := plyMedia.Handle; if (actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked) then begin actZoom_FullScreenExecute(nil); end else begin FormResize(nil); gpcShowWindow(plyMedia, True); mnuPopupPopup(nil); end; } if (Action_ZoomWallvideo.Checked) then begin Exit; end; plyMedia.DisplayWindow := plyMedia.Handle; FResetWallvideo; end; procedure TApp_MEDIAPlayer.actNop(Sender: TObject); begin //Dummy end; procedure TApp_MEDIAPlayer.actNop_Nop(Sender: TObject); begin //F_SetCommandMenuもなし // end; //ヘルプ procedure TApp_MEDIAPlayer.Action_HelpVersionInfoExecute(Sender: TObject); begin gpcCreateHelpForm; gpcSetTabSheet('help'); { // ShowMessage(Format(Application.Title + ' Ver: %s', [gfnsFileVersionGet])); gpcVersionInfoCreate; gpcVersionInfoTitleSet(G_csAPPTITLE); gpcVersionInfoURLSet('http://cult-drang.com/program/tool/minfo/help/index.html'); gpcVersionInfoShowModal; gpcVersionInfoRelease; } end; //------------------------------------------------------------------------------ //再生 procedure TApp_MEDIAPlayer.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); //連続入力が必要なもの //var // i : Integer; // l_Action : TAction; begin //何故か方向キーが取れない { case Key of VK_UP : myDebug.gpcDebug('↑'); VK_DOWN : myDebug.gpcDebug('↓'); VK_LEFT : myDebug.gpcDebug('←'); VK_RIGHT : myDebug.gpcDebug('→'); else begin myDebug.gpcDebug(Key); end; end; } //メディアプレーヤーの専用キーに対応 //専用キーはグローバル if (actPlay_PlayPause.Tag = 0) then begin case Key of 176..179 :begin actPlay_PlayPause.Tag := 1; case (Key) of 179: begin actPlay_PlayPauseExecute(nil); end; 178: begin plyMedia.Stop; gpcWallVideoFree; end; 177: actPlay_NextExecute(actPlay_Back); 176: actPlay_NextExecute(actPlay_Next); end; Key := 0; end; end; end; if (gfnhActiveFormGet <> Self.Handle) then begin Exit; end; if (ssAlt in Shift) then begin Exit; end; { for i := 0 to G_ShortCutList.Count-1 do begin if (Key = T_ShortCutAction(G_ShortCutList.Items[i]).Key) then begin l_Action := T_ShortCutAction(G_ShortCutList.Items[i]).Action; if (l_Action = actZoom_Up) or (l_Action = actZoom_Down) or (l_Action = actPlay_FrameBack) or (l_Action = actPlay_FrameNext) then begin l_Action.OnExecute(l_Action); end; // Key := 0; Exit; end; end; } end; procedure TApp_MEDIAPlayer.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var i: Integer; l_Action: TAction; begin actPlay_PlayPause.Tag := 0; if (gfnhActiveFormGet <> Self.Handle) then begin Exit; end; if (Key = VK_APPS) then begin actMenu_MainExecute(nil); Key := 0; end else begin if not(ssAlt in Shift) then begin for i := 0 to G_ShortCutList.Count-1 do begin if (Key = T_ShortCutAction(G_ShortCutList.Items[i]).Key) then begin l_Action := T_ShortCutAction(G_ShortCutList.Items[i]).Action; if (l_Action.AutoCheck) then begin l_Action.Checked := not(l_Action.Checked); end; l_Action.OnExecute(l_Action); Key := 0; Exit; end; end; end; end; end; procedure TApp_MEDIAPlayer.actPlay_PlayPauseExecute(Sender: TObject); //再生/一時停止 begin if (gfnbKeyState(VK_SHIFT)) then begin plyMedia.Stop; gpcWallVideoFree; Exit; end; if (plyMedia.PlayState = gciPLAYSTATE_PLAYING) then begin plyMedia.Pause; end else if (plyMedia.PlayState = gciPLAYSTATE_PAUSED) then begin plyMedia.Play; end else if (plyMedia.Items.Count > 0) then begin plyMedia.Play(plyMedia.NextItemIndex(0)); end; end; procedure TApp_MEDIAPlayer.actPlay_ReplayExecute(Sender: TObject); //リプレイ begin plyMedia.Replay; end; procedure TApp_MEDIAPlayer.actPlay_NextExecute(Sender: TObject); //次へ進む/前へ戻る begin if (Sender = actPlay_Next) then begin plyMedia.Next; end else if (Sender = actPlay_Back) then begin plyMedia.Prev; end else begin // plyMedia.Play; end; end; procedure TApp_MEDIAPlayer.actPlay_RepeatAllExecute(Sender: TObject); //全曲リピート begin plyMedia.RepeatMode := rmAll; actPlay_RepeatExecute(Sender); end; procedure TApp_MEDIAPlayer.actPlay_RepeatOneExecute(Sender: TObject); //1曲リピート begin plyMedia.RepeatMode := rmOne; actPlay_RepeatExecute(Sender); end; procedure TApp_MEDIAPlayer.actPlay_RepeatABExecute(Sender: TObject); //A-Bリピート begin plyMedia.RepeatMode := rmOne; actPlay_RepeatExecute(Sender); end; procedure TApp_MEDIAPlayer.actPlay_RepeatExecute(Sender: TObject); var l_Action: TAction; begin l_Action := TAction(Sender); l_Action.Checked := True; mniPlay_Repeat.Tag := l_Action.Tag; //TActionのAutoCheckをTrueにすると同じメニューをチェックするとチェックが消えてしまうため以下の処理が必要 mniPlay_Repeat.Items[mniPlay_Repeat.Tag].Checked := True; mniPPlay_Repeat.Items[mniPlay_Repeat.Tag].Checked := True; mnuPlay_Repeat.Items[mniPlay_Repeat.Tag].Checked := True; if not(actPlay_RepeatAB.Checked) then begin actPlay_RepeatAB_ResetExecute(nil); end; actPlay_Repeat.ImageIndex := l_Action.ImageIndex; ReleaseCapture; end; procedure TApp_MEDIAPlayer.mnuPlay_RepeatPopup(Sender: TObject); //リピートメニューポップアップ begin actPlay_RepeatAB_Start.Enabled := actPlay_RepeatAB.Checked; actPlay_RepeatAB_End.Enabled := actPlay_RepeatAB_Start.Enabled; actPlay_RepeatAB_Reset.Enabled := actPlay_RepeatAB_Start.Enabled; end; procedure TApp_MEDIAPlayer.F_SetABPosition(fPos: Extended); begin fPos := gfnfNumLimit(fPos, 0, plyMedia.Duration); plyMedia.CurrentPosition := fPos; if (actPlay_RepeatAB.Checked) and (F_fRepeatStart >= 0.0) and (F_fRepeatEnd > 0.0) then begin if (fPos < F_fRepeatStart) then begin F_fRepeatStart := fPos; TrackBar_Seek.SelStart := Trunc(F_fRepeatStart); end else if (fPos > F_fRepeatEnd) then begin F_fRepeatEnd := fPos; TrackBar_Seek.SelEnd := Trunc(F_fRepeatEnd); end; end; end; procedure TApp_MEDIAPlayer.actPlay_RepeatAB_StartExecute(Sender: TObject); begin F_fRepeatStart := plyMedia.CurrentPosition; TrackBar_Seek.SelStart := TrackBar_Seek.Position; if (TrackBar_Seek.SelEnd < TrackBar_Seek.SelStart) then begin TrackBar_Seek.SelEnd := TrackBar_Seek.Max; end; end; procedure TApp_MEDIAPlayer.actPlay_RepeatAB_EndExecute(Sender: TObject); begin F_fRepeatEnd := plyMedia.CurrentPosition; TrackBar_Seek.SelEnd := TrackBar_Seek.Position; if (TrackBar_Seek.SelStart > TrackBar_Seek.SelEnd) then begin TrackBar_Seek.SelStart := 0; end; end; procedure TApp_MEDIAPlayer.actPlay_RepeatAB_ResetExecute(Sender: TObject); begin F_fRepeatStart := 0; F_fRepeatEnd := 0; TrackBar_Seek.SelStart := 0; TrackBar_Seek.SelEnd := 0; end; //------------------------------------------------------------------------------ function TApp_MEDIAPlayer.F_GetIsPlayer: Boolean; begin if (IsIconic(Application.Handle)) then begin //最小化されている時はプレーヤーの処理とする Result := True; end else if (Self.AlphaBlend) then begin Result := F_bIsPlayer; end else begin //プレイリストがアクティブでなければプレーヤーの処理とする Result := (gfnhActiveFormGet <> G_PlaylistForm.Handle); end; end; { procedure TApp_MEDIAPlayer.MenuItem_MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin myMenu.MenuItem_MeasureItem(Sender, ACanvas, Width, Height); end; procedure TApp_MEDIAPlayer.mniAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin myMenu.MenuItem_AdvancedDrawItem(Sender, ACanvas, ARect, State); end; } //メインメニュー //http://www2.big.or.jp/~osamu/Delphi/Tips/key.cgi?key=29#0066.txt procedure TApp_MEDIAPlayer.WndProc(var Msg: TMessage); begin if (Msg.Msg = WM_INITMENU) and (Msg.WParam = wParam(Menu.Handle)) then begin mnuPopupPopup(nil); end; inherited WndProc(Msg); end; procedure TApp_MEDIAPlayer.mnuPopupPopup(Sender: TObject); begin //二重起動を許すかどうか actOpt_AllowDuplication.Checked := gfnbFileExists(g_sAllowDuplication); actPlay_PlayPause.Enabled := plyMedia.Items.Count > 0; actPlay_Replay.Enabled := actPlay_PlayPause.Enabled; actPlay_SkipNext.Enabled := actPlay_PlayPause.Enabled; actPlay_SkipBack.Enabled := actPlay_PlayPause.Enabled; actPlay_Back.Enabled := plyMedia.Items.Count > 1; actPlay_Next.Enabled := actPlay_Back.Enabled; actPlay_FrameNext.Enabled := plyMedia.MediaHasVideo and plyMedia.CanStep; actPlay_FrameBack.Enabled := actPlay_FrameNext.Enabled; actZoom_100.Enabled := plyMedia.MediaHasVideo and not(actZoom_FullScreen.Checked) and not(actZoom_MaxZoom.Checked) ; actZoom_50.Enabled := actZoom_100.Enabled; actZoom_200.Enabled := actZoom_100.Enabled; actZoom_Fit.Enabled := actZoom_100.Enabled; // actZoom_Capture.Enabled := plyMedia.MediaHasVideo; if (mniFile.Tag = -1) then begin // if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた mniFile.Tag := 0; mniList_Disp.Caption := 'プレイヤーを表示(&P)'; G_PlaylistForm.actFile_Property.Enabled := (plyMedia.Items.Count > 0) and (G_PlaylistForm.celPlaylist.SelectRowCount > 0); G_PlaylistForm.actFileCmd_Rename.Enabled := G_PlaylistForm.actFile_Property.Enabled; G_PlaylistForm.actFileCmd_MoveAs.Enabled := G_PlaylistForm.actFile_Property.Enabled; G_PlaylistForm.actFileCmd_CopyAs.Enabled := G_PlaylistForm.actFile_Property.Enabled; G_PlaylistForm.actFileCmd_Move.Enabled := G_PlaylistForm.actFile_Property.Enabled; G_PlaylistForm.actFileCmd_Copy.Enabled := G_PlaylistForm.actFile_Property.Enabled; G_PlaylistForm.actFileCmd_Trash.Enabled := G_PlaylistForm.actFile_Property.Enabled; end else begin mniList_Disp.Caption := 'リストを表示(&L)'; end; actList_Del.Enabled := plyMedia.MediaAssigned; //ファイル Action_FileProperty.Enabled := (plyMedia.Items.Count > 0); // and (plyMedia.ItemIndex > -1); Action_FileSaveAs.Enabled := Action_FileProperty.Enabled; //ファイル操作 Action_FileCmd.Enabled := Action_FileProperty.Enabled; Action_FileCmdRename.Enabled := Action_FileCmd.Enabled; Action_FileCmdMoveAs.Enabled := Action_FileCmd.Enabled; Action_FileCmdCopyAs.Enabled := Action_FileCmd.Enabled; Action_FileCmdMove.Enabled := Action_FileCmd.Enabled; Action_FileCmdCopy.Enabled := Action_FileCmd.Enabled; Action_FileCmdRemoveFromHDD.Enabled := Action_FileCmd.Enabled; Action_FileCmdTrash.Enabled := Action_FileCmd.Enabled; //ネット検索 G_PlaylistForm.mnuInfoPopup(nil); gpcSetMenuDefault(mniSearch_SelectSite); gpcSetMenuDefault(mniPSearch_SelectSite); actOpt_NotSaveIni.Visible := actOpt_NotSaveIni.Checked or gfnbKeyState(VK_SHIFT); end; procedure TApp_MEDIAPlayer.mnuPlay_RatePopup(Sender: TObject); begin { if (plyMedia.settings.isAvailable['Rate']) then begin actPlay_Rate.Enabled := True; end else begin actPlay_Rate.Enabled := False; end; actPlay_Rate_30.Enabled := actPlay_Rate.Enabled; actPlay_Rate_20.Enabled := actPlay_Rate.Enabled; actPlay_Rate_17.Enabled := actPlay_Rate.Enabled; actPlay_Rate_15.Enabled := actPlay_Rate.Enabled; actPlay_Rate_13.Enabled := actPlay_Rate.Enabled; actPlay_Rate_11.Enabled := actPlay_Rate.Enabled; actPlay_Rate_10.Enabled := actPlay_Rate.Enabled; actPlay_Rate_09.Enabled := actPlay_Rate.Enabled; actPlay_Rate_08.Enabled := actPlay_Rate.Enabled; actPlay_Rate_07.Enabled := actPlay_Rate.Enabled; actPlay_Rate_06.Enabled := actPlay_Rate.Enabled; actPlay_Rate_05.Enabled := actPlay_Rate.Enabled; } end; procedure TApp_MEDIAPlayer.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); function lfnrc_RectGet: TRect; begin Result := Self.ClientRect; Inc(Result.Top, pnlTop.Height); Dec(Result.Bottom, pnlBottom.Height); if (pnlInfo.Visible) then begin Dec(Result.Bottom, pnlInfo.Height); end; end; var lrc_Rect: TRect; li_Left, li_Top: Integer; begin if (Button = mbLeft) then begin //移動 if ((actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked) and plyMedia.MediaHasVideo) then begin //何もしない end else begin //ウィンドウモードのビデオ。 if (ssCtrl in Shift) then begin // ReleaseCapture; // SendMessage(plyMedia.Handle, WM_SYSCOMMAND, WPARAM(SC_SIZE or 9), 0); plyMedia.SendToBack; li_Left := plyMedia.Left; li_Top := plyMedia.Top; lrc_Rect := lfnrc_RectGet; if (plyMedia.Width >= gfniRectWidth(lrc_Rect)) then begin if (plyMedia.BoundsRect.Right <= lrc_Rect.Right) then li_Left := li_Left + lrc_Rect.Right - plyMedia.BoundsRect.Right; if (plyMedia.BoundsRect.Bottom <= lrc_Rect.Bottom) then li_Top := li_Top + lrc_Rect.Bottom - plyMedia.BoundsRect.Bottom; if (plyMedia.BoundsRect.Left >= lrc_Rect.Left) then li_Left := li_Left + lrc_Rect.Left - plyMedia.BoundsRect.Left; if (plyMedia.BoundsRect.Top >= lrc_Rect.Top) then li_Top := li_Top + lrc_Rect.Top - plyMedia.BoundsRect.Top; end else begin if (plyMedia.BoundsRect.Right >= lrc_Rect.Right) then li_Left := li_Left + lrc_Rect.Right - plyMedia.BoundsRect.Right; if (plyMedia.BoundsRect.Bottom >= lrc_Rect.Bottom) then li_Top := li_Top + lrc_Rect.Bottom - plyMedia.BoundsRect.Bottom; if (plyMedia.BoundsRect.Left <= lrc_Rect.Left) then li_Left := li_Left + lrc_Rect.Left - plyMedia.BoundsRect.Left; if (plyMedia.BoundsRect.Top <= lrc_Rect.Top) then li_Top := li_Top + lrc_Rect.Top - plyMedia.BoundsRect.Top; end; plyMedia.SetBounds(li_Left, li_Top, plyMedia.Width, plyMedia.Height); end else if (ssShift in Shift) then begin actPlay_PlayPauseExecute(nil); end else begin // gpcDragMove(Handle); end; end; end else begin // if not((actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked) and plyMedia.MediaHasVideo) then begin // SetForegroundWindow(Handle); // end; if (Button = mbRight) then begin //ビデオが映っていると二回右マウスアップイベントが発生するので一度マウスアップ //イベントを捨てる。そのためのフラグとしてTagを利用 mnuPopup.Tag := 1; //fYにはマイナスの値が入ってたりして使いづらいのでスクリーン座標で統一する F_ptMouse := gfnptMousePosGet; end; end; end; procedure TApp_MEDIAPlayer.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const lci_BARMARGIN = 16; var lpt_Pos : TPoint; ls_Compas : WideString; l_Action : TAction; begin ReleaseCapture; if (Button = mbLeft) then begin // plyMedia.SetFocus; Windows.SetFocus(plyMedia.Handle); end else if (Button = mbMiddle) then begin if (actZoom_Capture.Enabled) then begin actZoom_CaptureExecute(nil); end; end else if (Button = mbRight) and ((F_ptMouse.X <> MAXINT) or (F_ptMouse.Y <> MAXINT)) then begin lpt_Pos := gfnptMousePosGet; ls_Compas := gfnsCompasGet(F_ptMouse, lpt_Pos); F_ptMouse := Point(MAXINT, MAXINT); if (ls_Compas = '') then begin mnuPopup.Popup(lpt_Pos.X, lpt_Pos.Y); end else begin if (ls_Compas = '上') then begin l_Action := G_GestureUp; end else if (ls_Compas = '下') then begin l_Action := G_GestureDown; end else if (ls_Compas = '左') then begin l_Action := G_GestureLeft; end else if (ls_Compas = '右') then begin l_Action := G_GestureRight end else begin l_Action := nil; end; if (l_Action <> nil) then begin l_Action.Execute; { if (l_Action.AutoCheck) then begin l_Action.Checked := not(l_Action.Checked); end; l_Action.OnExecute(l_Action); } end; end; end; end; (* procedure TApp_MEDIAPlayer.plyMediaMouseDown(Sender: TObject; nButton, nShiftState: Smallint; fX, fY: Integer); function lfnrc_RectGet: TRect; begin Result := ClientRect; { if not(actDisp_HideControl.Checked) then begin if (actDisp_ToolBar.Checked) then Inc(Result.Top, pnlTop.Height); if (actDisp_ControlBar.Checked) then Dec(Result.Bottom, pnlBottom.Height); end; } if (actDisp_InfoPanel.Checked) or (actZoom_FullScreen.Checked) or (actZoom_MaxZoom.Checked) then begin Dec(Result.Bottom, pnlInfo.Height); end; end; var lrc_Rect : TRect; li_Left, li_Top : Integer; begin if (plyMedia.MediaHasVideo) then begin Windows.SetFocus(plyMedia.Handle); end; if (nButton = VK_LBUTTON) then begin //移動 if not((actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked) and plyMedia.MediaHasVideo) then begin if (gfnbKeyState(VK_CONTROL)) then begin SendMessage(plyMedia.Handle, WM_SYSCOMMAND, WPARAM(SC_SIZE or 9), 0); plyMedia.SendToBack; li_Left := plyMedia.Left; li_Top := plyMedia.Top; lrc_Rect := lfnrc_RectGet; if (plyMedia.Width >= gfniRectWidth(lrc_Rect)) then begin if (plyMedia.BoundsRect.Right <= lrc_Rect.Right) then li_Left := li_Left + lrc_Rect.Right - plyMedia.BoundsRect.Right; if (plyMedia.BoundsRect.Bottom <= lrc_Rect.Bottom) then li_Top := li_Top + lrc_Rect.Bottom - plyMedia.BoundsRect.Bottom; if (plyMedia.BoundsRect.Left >= lrc_Rect.Left) then li_Left := li_Left + lrc_Rect.Left - plyMedia.BoundsRect.Left; if (plyMedia.BoundsRect.Top >= lrc_Rect.Top) then li_Top := li_Top + lrc_Rect.Top - plyMedia.BoundsRect.Top; end else begin if (plyMedia.BoundsRect.Right >= lrc_Rect.Right) then li_Left := li_Left + lrc_Rect.Right - plyMedia.BoundsRect.Right; if (plyMedia.BoundsRect.Bottom >= lrc_Rect.Bottom) then li_Top := li_Top + lrc_Rect.Bottom - plyMedia.BoundsRect.Bottom; if (plyMedia.BoundsRect.Left <= lrc_Rect.Left) then li_Left := li_Left + lrc_Rect.Left - plyMedia.BoundsRect.Left; if (plyMedia.BoundsRect.Top <= lrc_Rect.Top) then li_Top := li_Top + lrc_Rect.Top - plyMedia.BoundsRect.Top; end; plyMedia.SetBounds(li_Left, li_Top, plyMedia.Width, plyMedia.Height); end else if (gfnbKeyState(VK_SHIFT)) then begin actPlay_PlayPauseExecute(nil); end else begin gpcDragMove(Handle); end; end; end else begin // if not((actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked) and plyMedia.MediaHasVideo) then begin // SetForegroundWindow(Handle); // end; if (nButton = VK_RBUTTON) then begin //ビデオが映っていると二回右マウスアップイベントが発生するので一度マウスアップ //イベントを捨てる。そのためのフラグとしてTagを利用 mnuPopup.Tag := 1; //fYにはマイナスの値が入ってたりして使いづらいのでスクリーン座標で統一する F_ptMouse := gfnptMousePosGet; end; end; end; *) //コントロールを隠す procedure TApp_MEDIAPlayer.plyMediaMouseMove(Sender: TObject; nButton, nShiftState: Smallint; fX, fY: Integer); begin plyMedia.Perform(CM_CURSORCHANGED, 0, 0); celDispInfoMouseMove(Sender, [], 0, 0); //引数は適当でよい end; procedure TApp_MEDIAPlayer.celDispInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var lpt_Pos : TPoint; lrc_Top, lrc_Bottom : TRect; begin if (plyMedia.MediaHasVideo and (actZoom_FullScreen.Checked or actZoom_MaxZoom.Checked)) then begin //隠したコントロールを表示する lpt_Pos := gfnptMousePosGet; lrc_Top := gfnrcClientOriginRect(Self); lrc_Bottom := lrc_Top; lrc_Top.Bottom := lrc_Top.Top + pnlTop.Height; lrc_Bottom.Top := lrc_Bottom.Bottom - pnlBottom.Height; if (PtInRect(lrc_Top, lpt_Pos)) then begin AnimateWindow(pnlTop.Handle, 100, AW_VER_POSITIVE); end else begin AnimateWindow(pnlTop.Handle, 200, AW_VER_NEGATIVE or AW_HIDE); end; if (PtInRect(lrc_Bottom, lpt_Pos)) then begin AnimateWindow(pnlBottom.Handle, 200, AW_VER_NEGATIVE); end else begin AnimateWindow(pnlBottom.Handle, 200, AW_VER_POSITIVE or AW_HIDE); end; pnlTop.Visible := PtInRect(lrc_Top, lpt_Pos); pnlBottom.Visible := PtInRect(lrc_Bottom, lpt_Pos); Timer_Control.Enabled := (pnlTop.Visible or pnlBottom.Visible); end; end; //表示したコントロールを隠す procedure TApp_MEDIAPlayer.Timer_ControlTimer(Sender: TObject); var lpt_Pos: TPoint; lrc_Rect: TRect; begin if ((pnlTop.Visible) or (pnlBottom.Visible)) then begin lpt_Pos := gfnptMousePosGet; lrc_Rect := gfnrcClientOriginRect(Self); if (pnlTop.Visible) then begin lrc_Rect.Bottom := lrc_Rect.Top + pnlTop.Height; end else {(pnlControl.Visible)} begin lrc_Rect.Top := lrc_Rect.Bottom - pnlBottom.Height; end; Timer_Control.Enabled := PtInRect(lrc_Rect, lpt_Pos); if not(Timer_Control.Enabled) then begin if (pnlTop.Visible) then begin AnimateWindow(pnlTop.Handle, 200, AW_VER_NEGATIVE or AW_HIDE); end; if (pnlBottom.Visible) then begin AnimateWindow(pnlBottom.Handle, 200, AW_VER_POSITIVE or AW_HIDE); end; pnlTop.Visible := False; pnlBottom.Visible := False; end; end; end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.F_Renamed(sOld, sNew: WideString); var i: Integer; begin sOld := WideUpperCase(sOld); for i := 0 to plyMedia.Count-1 do begin if (WideUpperCase(plyMedia.Items[i]) = sOld) then begin //リネーム if (i = plyMedia.ItemIndex) then begin //現在再生中 plyMedia.Pause; F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; plyMedia.Stop; end; //ファイル名は変更済み plyMedia.Items[i] := sNew; end; end; G_PlaylistForm.celPlaylist.Repaint; if (F_iResumeIndex >= 0) then begin plyMedia.Play(F_iResumeIndex); end; end; //名前の変更 function TApp_MEDIAPlayer.FileRename(iIndex: Integer): Boolean; var i, li_Rename, li_ErrCode: Integer; ls_File, ls_CmpFile, ls_Title, ls_Msg: WideString; lb_ReadOnly: Boolean; begin ls_Title := G_csAPPTITLE + ' - ' + dlgFileCmd_Rename.Title; ls_File := plyMedia.Items[iIndex]; Result := False; lb_ReadOnly := gfnbFileIsReadOnly(ls_File); if (lb_ReadOnly) then begin //名前を変更しようとしているファイルが読み取り専用だった if (gfniMessageBoxYesNo(WideFormat('名前を変更しようとしているファイル'#13'%s'#13'には読み取り専用属性がついています。名前を変更しますか', [ls_File]), ls_Title) = ID_YES) then begin gfnbFileAttrSet(ls_File, gfniFileAttrGet(ls_File) - FILE_ATTRIBUTE_READONLY); if ((gfniFileAttrGet(ls_File) and FILE_ATTRIBUTE_READONLY) <> 0) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('%s'#13'の読み取り専用属性の解除ができませんでした'#13'名前の変更はできません', [ls_File]), ls_Title); //以降の処理を行わない Exit; end; end else begin //以降の処理を行わない Exit; end; end; li_Rename := ID_NO; if (GetActiveWindow = G_PlaylistForm.Handle) then begin dlgFileCmd_Rename.Owner := G_PlaylistForm; end else begin dlgFileCmd_Rename.Owner := Self; end; dlgFileCmd_Rename.FileName := ls_File; dlgFileCmd_Rename.InitialDir := gfnsFilePathGet(ls_File); dlgFileCmd_Rename.FilterIndex := gfniFilterIndexGet(dlgFileCmd_Rename.Filter, gfnsFileExtGet(ls_File)); if (dlgFileCmd_Rename.Execute) then begin li_Rename := ID_YES; ls_CmpFile := WideUpperCase(ls_File); if (WideUpperCase(dlgFileCmd_Rename.FileName) = ls_CmpFile) then begin if (dlgFileCmd_Rename.FileName <> ls_File) then begin //同じファイル名だけれども大文字小文字が違う場合は許可 li_Rename := ID_YES; //保険 end else begin //そうでなければ不許可 li_Rename := ID_NO; end; end else begin //違うファイル名 if not(gfnbIsEqualFileExt(ls_CmpFile, dlgFileCmd_Rename.FileName)) then begin //拡張子が変わった li_Rename := gfniMessageBoxYesNo(WideFormat('%s → %s'#13#13'拡張子を変更すると、ファイルが使えなくなる可能性があります。'#13'変更しますか?', [gfnsFileExtGet(ls_File), gfnsFileExtGet(dlgFileCmd_Rename.FileName)]), ls_Title); end else if (gfnbFileExists(dlgFileCmd_Rename.FileName)) then begin if (gfnbFileExists(dlgFileCmd_Rename.FileName)) then begin if (gfnbFileIsReadOnly(dlgFileCmd_Rename.FileName)) then begin li_Rename := gfniMessageBoxYesNo(WideFormat(#13'%s'#13'は既に存在し読み取り専用属性がついています。解除して上書きしますか', [dlgFileCmd_Rename.FileName]), ls_Title); if (li_Rename = ID_YES) then begin //移動先が読み取り専用だったら移動後も読み取り専用にする lb_ReadOnly := True; gfnbFileAttrSet(dlgFileCmd_Rename.FileName, gfniFileAttrGet(dlgFileCmd_Rename.FileName) - FILE_ATTRIBUTE_READONLY); if ((gfniFileAttrGet(dlgFileCmd_Rename.FileName) and FILE_ATTRIBUTE_READONLY) <> 0) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない li_Rename := ID_NO; gpcShowMessage(WideFormat('%s'#13'の読み取り専用属性の解除ができませんでした'#13'名前の変更はできません', [ls_File]), ls_Title); end; end; end else begin li_Rename := gfniMessageBoxYesNo(WideFormat('%s'#13'は既に存在します。上書きしますか', [dlgFileCmd_Rename.FileName]), ls_Title); end; { if (li_Rename = ID_YES) and (gfnbIsIncludeList(dlgFileCmd_Rename.FileName, plyMedia.Items)) and (gfniMessageBoxYesNoCancel(WideFormat('%s'#13'が再生リスト中にあります。削除しますか', [dlgFileCmd_Rename.FileName]), ls_Title) then begin end; } end else if not(gfnbFolderExists(gfnsFilePathGet(dlgFileCmd_Rename.FileName))) then begin //ディレクトリ作成 //OptionsにofNoChangeDirがあればここには来ないと思われる if (gfnbFolderCreate(gfnsFilePathGet(dlgFileCmd_Rename.FileName))) then begin //成功なら処理を続けるためID_YESにする li_Rename := ID_YES; end; end; end; end; if (li_Rename = ID_YES) then begin //ストップさせないとリネームできない if (plyMedia.ItemIndex = iIndex) then begin plyMedia.Pause; F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; plyMedia.Stop; end; //変更ファイル名が既に存在していたら上書き if (MoveFileExW(PWideChar(ls_File), PWideChar(dlgFileCmd_Rename.FileName), MOVEFILE_REPLACE_EXISTING or MOVEFILE_COPY_ALLOWED)) then begin for i := plyMedia.Count -1 downto 0 do begin if (WideUpperCase(plyMedia.Items[i]) = ls_CmpFile) then begin plyMedia.Items[i] := dlgFileCmd_Rename.FileName; end; end; G_PlaylistForm.celPlaylist.Repaint; if (lb_ReadOnly) then begin gfnbFileAttrSet(dlgFileCmd_Rename.FileName, gfniFileAttrGet(dlgFileCmd_Rename.FileName) or FILE_ATTRIBUTE_READONLY); end; end else begin li_Rename := ID_NO; 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_File, ls_Msg]), ls_Title); end; { if (F_iResumeIndex >= 0) then begin plyMedia.Play(F_iResumeIndex); end; } end; end; Result := li_Rename = ID_YES; if (Result) then begin G_PlaylistForm.ResetSortMark; end; end; //名前の変更 procedure TApp_MEDIAPlayer.Action_FileCmdRenameExecute(Sender: TObject); var li_Index: Integer; begin if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた G_PlaylistForm.actFileCmd_Rename.OnExecute(nil); Exit; end; SetFormEnabled(False); try //タグ取得中止 G_PlaylistForm.ReadTagFromLib(False); li_Index := plyMedia.ItemIndex; if (FileRename(li_Index)) // and not(plyMedia.PlayState = gciPLAYSTATE_PLAYING) then begin { F_iResumePos := -1; F_iResumeIndex := -1; if (plyMedia.PlayMode <> pmRandom) then begin plyMedia.Play(gfniNumLoop(li_Index+1, 0, plyMedia.Count-1)); end else begin plyMedia.Next; end; } end; if (plyMedia.playState = gciPLAYSTATE_STOPPED) then begin plyMedia.Play(li_Index); end; finally //中断したタグ取得を再開する。 G_PlaylistForm.RestartReadTagFromLib; SetFormEnabled(True); 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 G_MainForm.Caption := Format('%d%% %s', [Trunc(iTotalBytesTransferred / iTotalFileSize * 100), AnsiString(PAnsiChar(lpData))]); end else begin G_MainForm.Caption := AnsiString(PAnsiChar(lpData)); end; if (G_PlaylistForm.Visible) then begin G_PlaylistForm.Caption := App_MEDIAPlayer.Caption; end; Application.ProcessMessages; Result := PROGRESS_CONTINUE; end; //移動 function TApp_MEDIAPlayer.FileMoveAs(iIndex: Integer; bDialog: Boolean): Boolean; var i, li_Move, li_ErrCode : Integer; ls_File, ls_CmpFile, ls_Title : WideString; ls_Msg : AnsiString; lb_ReadOnly : Boolean; l_TagValue : TMyTagValue; begin if (bDialog) then begin ls_Title := G_csAPPTITLE + ' - ' + dlgFileCmd_FileMoveAs.Title; end else begin ls_Title := G_csAPPTITLE + ' - ' + dlgFileCmd_FileMove.Title; end; ls_File := plyMedia.Items[iIndex]; Result := False; //移動元が読み取り専用だったら移動後も読み取り専用にするためのフラグ lb_ReadOnly := gfnbFileIsReadOnly(ls_File); if (lb_ReadOnly) then begin //移動元のファイルが読み取り専用だった if (gfniMessageBoxYesNo(WideFormat('移動しようとしているファイル'#13'%s'#13'には読み取り専用属性がついています。移動しますか', [ls_File]), ls_Title) = ID_YES) then begin gfnbFileAttrSet(ls_File, gfniFileAttrGet(ls_File) - FILE_ATTRIBUTE_READONLY); if ((gfniFileAttrGet(ls_File) and FILE_ATTRIBUTE_READONLY) <> 0) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない gpcShowMessage(WideFormat('%s'#13'の読み取り専用属性の解除ができませんでした'#13'移動はできません', [ls_File]), ls_Title); //以降の処理を行わない Exit; end; end else begin //以降の処理を行わない Exit; end; end; li_Move := ID_NO; if (GetActiveWindow = G_PlaylistForm.Handle) then begin dlgFileCmd_FileMoveAs.Owner := G_PlaylistForm; end else begin dlgFileCmd_FileMoveAs.Owner := Self; end; if (bDialog) then begin dlgFileCmd_FileMoveAs.FileName := ls_File; dlgFileCmd_FileMoveAs.FilterIndex := gfniFilterIndexGet(dlgFileCmd_FileMoveAs.Filter, gfnsFileExtGet(ls_File)); end; if not(bDialog) or (dlgFileCmd_FileMoveAs.Execute) then begin dlgFileCmd_FileMoveAs.InitialDir := gfnsFilePathGet(dlgFileCmd_FileMoveAs.FileName); ls_CmpFile := WideUpperCase(ls_File); if (WideUpperCase(dlgFileCmd_FileMoveAs.FileName) = ls_CmpFile) then begin gpcShowMessage(ls_File + #13'同じファイルを指定することはできません', ls_Title); end else begin li_Move := ID_YES; if not(gfnbIsEqualFileExt(ls_CmpFile, dlgFileCmd_FileMoveAs.FileName)) then begin //拡張子が変わった li_Move := gfniMessageBoxYesNo(WideFormat('%s → %s'#13#13'拡張子を変更すると、ファイルが使えなくなる可能性があります。'#13'変更しますか?', [gfnsFileExtGet(ls_File), gfnsFileExtGet(dlgFileCmd_FileMoveAs.FileName)]), ls_Title); end; if (li_Move = ID_YES) then begin if (gfnbFileExists(dlgFileCmd_FileMoveAs.FileName)) then begin if (gfnbFileIsReadOnly(dlgFileCmd_FileMoveAs.FileName)) then begin li_Move := gfniMessageBoxYesNo(WideFormat(#13'%s'#13'は既に存在し読み取り専用属性がついています。解除して上書きしますか', [dlgFileCmd_FileMoveAs.FileName]), ls_Title); if (li_Move = ID_YES) then begin //移動先が読み取り専用だったら移動後も読み取り専用にする lb_ReadOnly := True; gfnbFileAttrSet(dlgFileCmd_FileMoveAs.FileName, gfniFileAttrGet(dlgFileCmd_FileMoveAs.FileName) - FILE_ATTRIBUTE_READONLY); if ((gfniFileAttrGet(dlgFileCmd_FileMoveAs.FileName) and FILE_ATTRIBUTE_READONLY) <> 0) then begin //読み取り専用属性を外せない //恐らく記録メディアが書き込み禁止かファイルへの書込みのアクセス権がない li_Move := ID_NO; gpcShowMessage(WideFormat('%s'#13'の読み取り専用属性の解除ができませんでした'#13'移動はできません', [ls_File]), ls_Title); end; end; end else begin li_Move := gfniMessageBoxYesNo(WideFormat('%s'#13'は既に存在します。上書きしますか', [dlgFileCmd_FileMoveAs.FileName]), ls_Title); end; end else if not(gfnbFolderExists(dlgFileCmd_FileMoveAs.InitialDir)) then begin //ディレクトリ作成 if not(gfnbFolderCreate(dlgFileCmd_FileMoveAs.InitialDir)) then begin //作成失敗 gpcShowMessage(WideFormat('%s'#13'フォルダの作成に失敗しました'#13'移動はできません', [dlgFileCmd_FileMoveAs.InitialDir]), ls_Title); li_Move := ID_NO; end; end; end; if (li_Move = ID_YES) then begin //MoveFileWithProgressWは同じドライブでの移動の場合コールバックルーチンを呼ばないのでメッセージを出しておく ls_Msg := Format('移動 %s', [gfnsWideToAnsi(gfnsFileNameGet(ls_File))]); Self.Caption := ls_Msg; if (G_PlaylistForm.Visible) then begin G_PlaylistForm.Caption := Self.Caption; end; Application.ProcessMessages; //ストップさせないと移動できない if (plyMedia.ItemIndex = iIndex) then begin plyMedia.Pause; F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; plyMedia.Stop; end; //移動先に同名ファイルがあった場合上書き //移動中のメッセージはフォームのCaptionに表示するのでメッセージはPAnsiCharでセットする //もしフォームのCaptionがWideStringなら変える必要あり if (MoveFileWithProgressW(PWideChar(ls_File), PWideChar(dlgFileCmd_FileMoveAs.FileName), @CopyProgressRoutine, PAnsiChar(ls_Msg), MOVEFILE_REPLACE_EXISTING or MOVEFILE_COPY_ALLOWED)) then begin for i := plyMedia.Count -1 downto 0 do begin if (WideUpperCase(plyMedia.Items[i]) = ls_CmpFile) then begin //移動なので元のファイルはなくなる。よってリスト中のすべての元ファイルは新しいファイル名に書き換え plyMedia.Items[i] := dlgFileCmd_FileMoveAs.FileName; //G_PlaylistForm.GetInfo(i); //リストのTagの内容を書き換える l_TagValue := TMyTag(plyMedia.Items.Objects[i]).GetTagValue; l_TagValue.FileName := plyMedia.Items[i]; l_TagValue.FileWriteTimeInt := gfniFileWriteTimeGet(plyMedia.Items[i]); TMyTag(plyMedia.Items.Objects[i]).Assign(l_TagValue); end; end; G_PlaylistForm.celPlaylist.Repaint; if (lb_ReadOnly) then begin gfnbFileAttrSet(dlgFileCmd_FileMoveAs.FileName, gfniFileAttrGet(dlgFileCmd_FileMoveAs.FileName) or FILE_ATTRIBUTE_READONLY); end; end else begin //移動失敗 li_Move := ID_NO; 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_File, ls_Msg]), ls_Title); end; //メッセージを消去して元に戻す plyMediaOnMediaStart(nil); G_PlaylistForm.Timer_StatusResetTimer(nil); //キャプションを元に戻す end; end; end; Result := (li_Move = ID_YES); if (Result) then begin G_PlaylistForm.ResetSortMark; end; end; //移動 procedure TApp_MEDIAPlayer.Action_FileCmdMoveAsExecute(Sender: TObject); var li_Index: Integer; begin if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた G_PlaylistForm.actFileCmd_MoveAs.OnExecute(nil); Exit; end; SetFormEnabled(False); try //タグ取得中止 G_PlaylistForm.ReadTagFromLib(False); li_Index := plyMedia.ItemIndex; dlgFileCmd_FileMove.Owner := Self; if (FileMoveAs(li_Index, True)) then begin { //移動成功 F_iResumePos := -1; F_iResumeIndex := -1; if (plyMedia.PlayMode <> pmRandom) then begin plyMedia.Play(gfniNumLoop(li_Index+1, 0, plyMedia.Count-1)); end else begin plyMedia.Next; end; end else begin //移動を選択したが失敗 if (plyMedia.playState = gciPLAYSTATE_STOPPED) then begin plyMedia.Play(li_Index); end; } end; if (plyMedia.playState = gciPLAYSTATE_STOPPED) then begin plyMedia.Play(li_Index); end; finally //中断したタグ取得を再開する。 G_PlaylistForm.RestartReadTagFromLib; SetFormEnabled(True); end; end; procedure TApp_MEDIAPlayer.Action_FileCmdMoveExecute(Sender: TObject); //移動 var li_Index: Integer; begin if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた G_PlaylistForm.actFileCmd_Move.OnExecute(nil); Exit; end; SetFormEnabled(False); try //タグ取得中止 G_PlaylistForm.ReadTagFromLib(False); li_Index := plyMedia.ItemIndex; dlgFileCmd_FileMove.Owner := Self; if (dlgFileCmd_FileMove.Execute) then begin dlgFileCmd_FileMove.InitialDir := dlgFileCmd_FileMove.FolderName; if (WideUpperCase(dlgFileCmd_FileMove.FolderName) = WideUpperCase(gfnsFilePathGet(plyMedia.Items[li_Index]))) then begin //同じフォルダならエラー gpcShowMessage(WideFormat('%s'#13'同じフォルダには移動できません', [dlgFileCmd_FileMove.FolderName]), G_csAPPTITLE + ' - ' + dlgFileCmd_FileMove.Title); end else begin dlgFileCmd_FileMoveAs.FileName := dlgFileCmd_FileMove.FolderName + gfnsFileNameGet(plyMedia.Items[li_Index]); if (FileMoveAs(li_Index, False)) then begin { F_iResumePos := -1; F_iResumeIndex := -1; if (plyMedia.PlayMode <> pmRandom) then begin plyMedia.Play(gfniNumLoop(li_Index+1, 0, plyMedia.Count-1)); end else begin plyMedia.Next; end; end else begin //移動を選択したが失敗 if (plyMedia.playState = gciPLAYSTATE_STOPPED) then begin plyMedia.Play(li_Index); end; } end; // if not(plyMedia.playState = gciPLAYSTATE_PLAYING) then begin // plyMedia.Play;//(li_Play); if (plyMedia.playState = gciPLAYSTATE_STOPPED) then begin plyMedia.Play(li_Index); end; end; end; finally //中断したタグ取得を再開する。 G_PlaylistForm.RestartReadTagFromLib; SetFormEnabled(True); end; end; //保存 function TApp_MEDIAPlayer.FileSaveAs(iIndex: Integer; bDialog: Boolean): Boolean; var li_Save, li_ErrCode : Integer; ls_Folder : WideString; ls_File, ls_Title : WideString; ls_Msg : AnsiString; begin if (GetActiveWindow = G_PlaylistForm.Handle) then begin dlgFileCmd_FileCopyAs.Owner := G_PlaylistForm; end else begin dlgFileCmd_FileCopyAs.Owner := Self; end; li_Save := ID_NO; ls_File := plyMedia.Items[iIndex]; if (bDialog) then begin dlgFileCmd_FileCopyAs.FileName := ls_File; dlgFileCmd_FileCopyAs.FilterIndex := gfniFilterIndexGet(dlgFileCmd_FileCopyAs.Filter, gfnsFileExtGet(dlgFileCmd_FileCopyAs.FileName)); end; if not(bDialog) or (dlgFileCmd_FileCopyAs.Execute) then begin if (bDialog) then begin ls_Title := G_csAPPTITLE + ' - ' + dlgFileCmd_FileCopyAs.Title; end else begin ls_Title := G_csAPPTITLE + ' - ' + dlgFileCmd_FileCopy.Title; end; Self.Update; if (bDialog) then begin dlgFileCmd_FileCopyAs.InitialDir := gfnsFilePathGet(dlgFileCmd_FileCopyAs.FileName); end; if (WideUpperCase(dlgFileCmd_FileCopyAs.FileName) = WideUpperCase(ls_File)) then begin gpcShowMessage(ls_File + #13'同じファイルを指定することはできません', ls_Title); end else begin li_Save := ID_YES; ls_Folder := gfnsFilePathGet(dlgFileCmd_FileCopyAs.FileName); if (gfnbFileExists(dlgFileCmd_FileCopyAs.FileName)) then begin li_Save := gfniMessageBoxYesNo(WideFormat('%s'#13'は既に存在します。上書きしますか', [dlgFileCmd_FileCopyAs.FileName]), ls_Title); end else if not(gfnbFolderExists(ls_Folder)) then begin //ディレクトリ作成 if not(gfnbFolderCreate(ls_Folder)) then begin //作成失敗 gpcShowMessage(WideFormat('%s'#13'フォルダの作成に失敗しました'#13'ファイルコピーはできません', [dlgFileCmd_FileCopyAs.InitialDir]), ls_Title); li_Save := ID_NO; end; end; if (li_Save = ID_YES) then begin ls_Msg := Format('コピー %s', [gfnsWideToAnsi(gfnsFileNameGet(ls_File))]); if (CopyFileExW(PWideChar(ls_File), PWideChar(dlgFileCmd_FileCopyAs.FileName), @CopyProgressRoutine, PAnsiChar(ls_Msg), nil, 0)) then begin //コピー後リストのファイル名を変えるならコメントアウトを外す // plyMedia.Items[iIndex] := dlgFileCmd_FileCopyAs.FileName; // G_PlaylistForm.celPlaylist.Repaint; end else begin //コピー失敗 li_Save := ID_NO; li_ErrCode := GetLastError; case (li_ErrCode) of ERROR_ACCESS_DENIED: begin gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13'%s'#13'がほかの人またはプログラムによって使用されています。'#13'ファイルを使用している可能性があるプログラムをすべて閉じてから、やり直してください。', [ls_File, dlgFileCmd_FileCopyAs.FileName]), ls_Title); end; ERROR_WRITE_PROTECT: begin gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13'移動先のメディア %s は書き込み禁止になっています。', [ls_File, gfnsFileDriveGet(dlgFileCmd_FileCopyAs.FileName)]), ls_Title); end; ERROR_REQUEST_ABORTED: begin //中止。 //中止したのでメッセージは出さない //gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13'コピーは中止されました', [ls_File]), ls_Title); end; else begin gpcShowMessage(WideFormat('%s'#13'はコピーできませんでした'#13#13'エラーコード %d', [ls_File, li_ErrCode]), ls_Title); end; end; end; plyMediaOnMediaStart(nil); G_PlaylistForm.Timer_StatusResetTimer(nil); //キャプションを元に戻す end; end; end; Result := (li_Save = ID_YES); if (Result) then begin G_PlaylistForm.ResetSortMark; end; end; //名前をつけて保存 procedure TApp_MEDIAPlayer.Action_FileCmdCopyAsExecute(Sender: TObject); var li_Index: Integer; begin if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた G_PlaylistForm.actFileCmd_CopyAs.OnExecute(nil); Exit; end; SetFormEnabled(False); try li_Index := plyMedia.ItemIndex; FileSaveAs(li_Index, True); finally SetFormEnabled(True); end; end; procedure TApp_MEDIAPlayer.Action_FileCmdCopyExecute(Sender: TObject); //コピー var li_Index: Integer; begin if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた G_PlaylistForm.actFileCmd_Copy.OnExecute(nil); Exit; end; SetFormEnabled(False); try li_Index := plyMedia.ItemIndex; if (dlgFileCmd_FileCopy.Execute) then begin dlgFileCmd_FileCopy.InitialDir := dlgFileCmd_FileCopy.FolderName; if (WideUpperCase(dlgFileCmd_FileCopy.FolderName) = WideUpperCase(gfnsFilePathGet(plyMedia.Items[li_Index]))) then begin //同じフォルダならエラー gpcShowMessage(WideFormat('%s'#13'同じフォルダにはコピーできません', [dlgFileCmd_FileCopy.FolderName]), G_csAPPTITLE + ' - ' + dlgFileCmd_FileCopy.Title); end else begin dlgFileCmd_FileCopyAs.FileName := dlgFileCmd_FileCopy.FolderName + gfnsFileNameGet(plyMedia.Items[li_Index]); FileSaveAs(li_Index, False); end; end; finally SetFormEnabled(True); end; end; //ごみ箱へ function TApp_MEDIAPlayer.FileDelete(iIndex: Integer; bDialog: Boolean): Boolean; var // i: Integer; lh_Handle: HWND; ls_File: WideString; lr_FileOp: TSHFileOpStructW; lb_Replay: Boolean; begin Result := False; if (GetActiveWindow = G_PlaylistForm.Handle) then begin lh_Handle := G_PlaylistForm.Handle; end else begin lh_Handle := Self.Handle; end; ls_File := plyMedia.Items[iIndex]; if not(gfnbFileExists(ls_File)) then begin //ファイルが存在しなかった。 Result := True; plyMedia.Items.Delete(iIndex); Exit; end; if (bDialog = False) or (gfniMessageBoxYesNo(WideFormat('%s'#13'このファイルをメディアから削除します'#13'よろしいですか', [ls_File]), 'ファイル削除', MB_DEFBUTTON2) = ID_YES) then begin ls_File := WideUpperCase(ls_File); lb_Replay := (WideUpperCase(plyMedia.MediaFileName) = ls_File); if (lb_Replay) then begin plyMedia.Stop; end; //http://lupin.client.jp/delphi/index.html#2 //ゴミ箱へ FillChar(lr_FileOp, SizeOf(lr_FileOp), 0); with lr_FileOp do begin Wnd := lh_Handle; wFunc := FO_DELETE; pFrom := PWideChar(ls_File + #0); pTo := nil; fFlags := FOF_ALLOWUNDO + FOF_NOCONFIRMATION; fAnyOperationsAborted := False; hNameMappings := nil; end; if (SHFileOperationW(lr_FileOp) = 0) then begin Result := True; plyMedia.Items.Delete(iIndex); if (lb_Replay) then begin plyMedia.Play(plyMedia.NextItemIndex(0)); end; { plyMedia.Items.BeginUpdate; try //リスト中に複数のls_Fileが存在する可能性がある。 for i := plyMedia.Items.Count -1 downto 0 do begin //リスト中のすべてのls_Fileを削除する。 if (WideUpperCase(plyMedia.Items[i]) = ls_File) then begin plyMedia.Items.Delete(i); end; end; finally plyMedia.Items.EndUpdate; end; } end else begin //gpcShowMessage('削除できませんでした'); //削除できなかった時はエラーメッセージが出るのでこれは冗長 plyMedia.Play(iIndex); end; end; end; //ごみ箱へ procedure TApp_MEDIAPlayer.Action_FileCmdTrashExecute(Sender: TObject); var li_Index : Integer; begin if (Screen.ActiveForm = G_PlaylistForm) then begin //プレイリストから呼ばれた G_PlaylistForm.actFileCmd_Trash.OnExecute(nil); Exit; end; li_Index := plyMedia.ItemIndex; if (li_Index < 0) then begin Exit; end; SetFormEnabled(False); try //タグ取得を中止。 G_PlaylistForm.ReadTagFromLib(False); FileDelete(li_Index, True); G_PlaylistForm.ResetCount(True); finally //タグ取得を途中でやめたので再開する G_PlaylistForm.RestartReadTagFromLib; SetFormEnabled(True); end; end; procedure TApp_MEDIAPlayer.actList_OpenAddExecute(Sender: TObject); //開くときに追加 begin if (actList_OpenAdd.Checked) then begin actList_OpenAdd.ImageIndex := F_iList_AddIndex+1; end else begin actList_OpenAdd.ImageIndex := F_iList_AddIndex; end; end; procedure TApp_MEDIAPlayer.actList_ReadTagExecute(Sender: TObject); //タグ情報取得 begin G_PlaylistForm.ReadTagFromLib(actList_ReadTag.Checked); end; procedure TApp_MEDIAPlayer.actList_DispExecute(Sender: TObject); //リスト編集 var lrc_Rect: TRect; begin if (gfnFocusedFormGet = G_PlaylistForm) then begin G_PlaylistForm.actWindow_Player.OnExecute(nil); Exit; end; with G_PlaylistForm do begin if (plyMedia.ItemIndex >= 0) then begin celPlaylist.DataTopRow := plyMedia.ItemIndex; end else begin celPlaylist.DataTopRow := 0; end; celPlaylistClick(celPlayList); lrc_Rect := gfnrcRectCenter(gfnrcMonitorWorkAreaRectGet(gfnptMousePosGet), BoundsRect); SetWindowPos(G_PlaylistForm.Handle, HWND_TOP, lrc_Rect.Left, lrc_Rect.Top, Width, Height, 0); if not(G_PlaylistForm.Visible) then begin Show; end; if (G_PlaylistForm.celPlaylist.CanFocus) then begin G_PlaylistForm.celPlaylist.SetFocus; end; end; //これをやらないとメニューアイテムのダブルクリックでリストを表示させた時にプレイヤー //にフォーカスを取られてしまうことがある。 plyMedia.MessageDrain(False); end; procedure TApp_MEDIAPlayer.FormActivate(Sender: TObject); begin //↑でマウスメッセージなどを受け取らないようにしたのでここで戻す。 plyMedia.MessageDrain(True); end; procedure TApp_MEDIAPlayer.Action_FileSaveAsExecute(Sender: TObject); //リストを保存 //const // lcs_LIST_FILENAME = 'list'; var // ls_Name, // ls_DefName, ls_Ext: WideString; lsl_List: TMyWStrings; i: Integer; begin SetFormEnabled(False); try { // ls_DefName := WideFormat('%s_%.2d.m3u8', [lcs_LIST_FILENAME, F_iListFileNum]); if (F_sSaveListName <> '') then begin ls_Name := gfnsFileNameGet(F_sSaveListName); end else begin ls_Name := ''; // ls_Name := ls_DefName; end; dlgSaveList.FileName := ls_Name; } if (Sender = nil) or (dlgSaveList.Execute) then begin dlgSaveList.InitialDir := gfnsFilePathGet(dlgSaveList.FileName); lsl_List := TMyWStrings.Create; try if (actList_SaveRelativePath.Checked) then begin for i := 0 to plyMedia.Count-1 do begin lsl_List.Add(gfnsRelativePathGet(plyMedia.Items[i], dlgSaveList.InitialDir)); end; end else begin lsl_List.Assign(plyMedia.Items); end; case dlgSaveList.FilterIndex of 1: begin //M3U8 gpcSaveM3u8(lsl_List, dlgSaveList.FileName, False); end; 2: begin //M3U gpcSaveM3u(lsl_List, dlgSaveList.FileName); end; 3: begin //PLS gpcSavePls(lsl_List, dlgSaveList.FileName); end; 4: begin //WPL gpcSaveWpl(lsl_List, dlgSaveList.FileName); end; else begin ls_Ext := WideLowerCase(gfnsFileExtGet(dlgSaveList.FileName)); if (ls_Ext = '.m3u') then begin gpcSaveM3u(lsl_List, dlgSaveList.FileName); end else if (ls_Ext = '.m3u8') then begin gpcSaveM3u8(lsl_List, dlgSaveList.FileName, False); end else if (ls_Ext = '.pls') then begin gpcSavePls(lsl_List, dlgSaveList.FileName); end else if (ls_Ext = '.wpl') then begin gpcSaveWpl(lsl_List, dlgSaveList.FileName); end else begin lsl_List.SaveToFile(dlgSaveList.FileName); end; end; end; // if (gfnsFileNameGet(dlgSaveList.FileName) = ls_DefName) then Inc(F_iListFileNum); finally lsl_List.Free; end; end; finally SetFormEnabled(True); end; end; procedure TApp_MEDIAPlayer.actList_DelExecute(Sender: TObject); //リストから削除 var li_Index: Integer; lr_Selection: TGridRect; begin if (Screen.ActiveForm = G_PlaylistForm) then begin G_PlaylistForm.actListEdit_Delete.OnExecute(nil); Exit; end; SetFormEnabled(False); try li_Index := plyMedia.ItemIndex; if (gfniMessageBoxYesNo(WideFormat('%s'#13'%s'#13#13'リストから削除しますか', [plyMedia.MediaDir, plyMedia.MediaName])) = ID_YES) then begin //タグ取得を中断する。 G_PlaylistForm.ReadTagFromLib(False); lr_Selection := G_PlaylistForm.celPlaylist.DataSelection; plyMedia.Stop; plyMedia.Items.Delete(li_Index); plyMedia.Play(plyMedia.NextItemIndex(0)); if (li_Index < lr_Selection.Top) then Dec(lr_Selection.Top); if (li_Index < lr_Selection.Bottom) then Dec(lr_Selection.Bottom); G_PlaylistForm.celPlaylist.DataSelection := lr_Selection; //中断したタグ取得を再開する。 G_PlaylistForm.RestartReadTagFromLib; end; finally SetFormEnabled(True); end; end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.F_PropertyStartWrite(Sender: TObject; sFile: WideString); //プロパティ begin if (WideUpperCase(sFile) = WideUpperCase(plyMedia.MediaFileName)) then begin if (F_iResumeIndex < 0) then begin plyMedia.Pause; F_iResumeIndex := plyMedia.ItemIndex; F_fResumePosition := plyMedia.CurrentPosition; end; plyMedia.Stop; end; end; procedure TApp_MEDIAPlayer.F_PropertyEndWrite(Sender: TObject; sFile: WideString); var ls_File: WideString; begin if (plyMedia.Count > 0) and (F_iResumeIndex >= 0) then begin plyMedia.Play(F_iResumeIndex); end; ls_File := WideUpperCase(sFile); if (ls_File = WideUpperCase(plyMedia.Items[G_PlaylistForm.celPlayList.DataRow])) then begin G_PlaylistForm.celPlayListClick(G_PlaylistForm.celPlayList); end; if (ls_File = WideUpperCase(plyMedia.MediaFileName)) then begin F_GetInfo; end; end; procedure TApp_MEDIAPlayer.F_PropertyCancelWrite(Sender: TObject; sFile: WideString); begin F_PropertyEndWrite(Sender, sFile); { if (plyMedia.Count > 0) and (F_iResumeIndex >= 0) then begin plyMedia.Play; end; } end; procedure TApp_MEDIAPlayer.FileProperty(sFile: WideString); //プロパティ begin if (gfnbKeyState(VK_SHIFT)) then begin //エクスプローラのプロパティページ gpcPropertyPageOpen(WideFormat('"%s"', [sFile])); end else begin gpcExecute(gfnsExeNameGet, WideFormat('/property "%s"', [sFile])); end; end; procedure TApp_MEDIAPlayer.Action_FilePropertyExecute(Sender: TObject); begin //プロパティ if (Screen.ActiveForm = G_PlaylistForm) then begin G_PlaylistForm.actFile_Property.OnExecute(nil); end else begin FileProperty(plyMedia.MediaFileName); end; end; //タイマー procedure TApp_MEDIAPlayer.Timer_SeekBarTimer(Sender: TObject); var l_Value : TMyQualPropValue; ls_File : WideString; ls_Info : WideString; begin if (Tag = 0) then Exit; Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; if (plyMedia.Count = 0) or not(plyMedia.MediaAssigned) then begin lblTime.Caption := ''; Exit; end; if (pnlInfo.Visible) then begin ls_File := WideFormat('%s %s秒 (%s)', [plyMedia.FileSizeString, plyMedia.MediaLengthString, Copy(plyMedia.FileWriteTimeString, 1, 10)]); if (plyMedia.MediaHasVideo) then begin ls_File := Format('%s %dx%d', [ ls_File, plyMedia.VideoWidth, plyMedia.VideoHeight ]); if (plyMedia.VideoFrameRate > 0) then begin ls_Info := Format('%.2f', [plyMedia.VideoFrameRate]); end else begin ls_Info := '-'; end; l_Value := plyMedia.GetQualPropValue; if (l_Value.iAvgFrameRate > 0) or (l_Value.iFramesDrawn > 0) or (l_Value.iFramesDroppedInRenderer > 0) then begin ls_Info := WideString(Format('%.2f/%sfps %d/%dframes [%d %d %d]', [ l_Value.iAvgFrameRate / 100, //再生時平均フレームレート ls_Info, //作成時フレームレート l_Value.iFramesDrawn, //再生フレーム数 l_Value.iFramesDroppedInRenderer, //欠落フレーム数 l_Value.iJitter, //Jitter (標準偏差フレーム時間)(ミリ秒) ビデオレンダラに渡される連続フレーム間の平均時間 l_Value.iAvgSyncOffset, //平均の同期オフセット(ミリ秒) フレームの目標レンダリング時間とレンダリングが実際に開始した時間の平均時間差(ミリ秒) l_Value.iDevSyncOffset //標準偏差同期オフセット(ミリ秒) フレームの目標レンダリング時間とレンダリングが実際に開始した時間の平均時間差(標準偏差) ])); end; end else begin ls_Info := ''; end; // celDispInfo.Cells[1, FciROW_FILEINFO] := ls_Info; Label_FileInfo.Caption := ls_File + ' ' + ls_Info; end; //スクロールバーをplyMediaのPositionに合わせるかどうか if (F_bThrough) or (gfnbKeyState(VK_LBUTTON)) // or (gfnbKeyState(VK_RBUTTON)) then begin //ダミー end else begin TrackBar_Seek.Position := plyMedia.Position; end; if not(actOpt_AllowScreenSaver.Checked) then begin //スクリーンセーバー、モニター電源OFFをキャンセル SetThreadExecutionState(ES_DISPLAY_REQUIRED); mouse_event(MOUSEEVENTF_MOVE, 0, 0, 0, 0); end; if (Sender <> nil) then begin Timer_SeekBar.Enabled := True; Timer_Time.Enabled := Timer_SeekBar.Enabled; end; end; procedure TApp_MEDIAPlayer.Timer_TimeTimer(Sender: TObject); var ls_Time: String; begin if (plyMedia.Count = 0) or not(plyMedia.MediaAssigned) then begin lblTime.Caption := ''; Timer_Time.Enabled := False; Exit; end; //A-B間リピート if (actPlay_RepeatAB.Checked) then begin if (F_fRepeatEnd > 0) and (plyMedia.CurrentPosition >= F_fRepeatEnd) then begin plyMedia.CurrentPosition := F_fRepeatStart; end; end; //時間表示 //経過時間/曲の長さ if (actDisp_TimeVerbose.Checked) then begin ls_Time := Format('%s/%s', [gfnsSecToTimeStr(plyMedia.CurrentPosition, 3), gfnsSecToTimeStr(plyMedia.Duration, 3)]); end else begin ls_Time := Format('%s/%s', [gfnsSecToTimeStr(plyMedia.Position), gfnsSecToTimeStr(plyMedia.Length)]); end; if (lblTime.Caption <> ls_Time) then begin lblTime.Caption := ls_Time; end; end; procedure TApp_MEDIAPlayer.lblTimeDblClick(Sender: TObject); begin actDisp_TimeVerbose.Checked := not(actDisp_TimeVerbose.Checked); actDisp_TimeVerboseExecute(Sender); //nilだとタイマーが止まる end; procedure TApp_MEDIAPlayer.actDisp_TimeVerboseExecute(Sender: TObject); var ls_Time: WideString; begin { if not(plyMedia.MediaAssigned) then begin Exit; end; } if (plyMedia.MediaAssigned) then begin if (actDisp_TimeVerbose.Checked) then begin ls_Time := gfnsSecToTimeStr(plyMedia.Duration, 3); end else begin ls_Time := gfnsSecToTimeStr(plyMedia.Length); end; end else begin if (actDisp_TimeVerbose.Checked) then begin ls_Time := '00:00:00'; end else begin ls_Time := '00:00'; end; end; lblTime.Width := lblTime.LeftMargin + lblTime.Canvas.TextWidth(WideFormat('%s/%0:s ', [ls_Time])) + lblTime.RightMargin; Timer_SeekBarTimer(Sender); end; //シークバー procedure TApp_MEDIAPlayer.barSeekScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); var lb_Timer: Boolean; begin if (ScrollCode = scEndScroll) then begin lb_Timer := Timer_SeekBar.Enabled; Timer_SeekBar.Enabled := False; Timer_Time.Enabled := Timer_SeekBar.Enabled; if (plyMedia.MediaAssigned) then begin if not(gfnbKeyState(VK_RBUTTON)) then begin plyMedia.Position := ScrollPos; end; end else begin ScrollPos := 0; end; TrackBar_Seek.Position := ScrollPos; Timer_SeekBar.Enabled := lb_Timer; Timer_Time.Enabled := Timer_SeekBar.Enabled; end; end; procedure TApp_MEDIAPlayer.TrackBar_SeekMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var li_Width, li_Center, li_Start, li_End: Integer; li_Pos: Integer; lrc_Rect: TRect; begin if (TrackBar_Seek.Max > TrackBar_Seek.Min) then begin TrackBar_Seek.Hint := Format('%s秒', [gfnsSecToTimeStr(TrackBar_Seek.HoverPos)]); { if (gfnbKeyState(VK_LBUTTON)) then begin // li_Pos := TrackBar_Seek.Position; TrackBar_Seek.Hint := Format('%s秒', [gfnsSecToTimeStr(TrackBar_Seek.HoverPos)]); end else begin lrc_Rect := TrackBar_Seek.SeekRect; if (X < lrc_Rect.Left) then begin TrackBar_Seek.Hint := actPlay_SkipBack.Hint; end else if (X > lrc_Rect.Right) then begin TrackBar_Seek.Hint := actPlay_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_MEDIAPlayer.TrackBar_SeekMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // //myDebug.gpcDebug('Down', Button); 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_MEDIAPlayer.TrackBar_SeekMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var li_Width, li_Center, li_Start, li_End: Integer; li_Pos: Integer; lf_Pos: Extended; lrc_Rect: TRect; begin if (Button = mbLeft) then begin lrc_Rect := TrackBar_Seek.SeekRect; //スライダのRect if (TrackBar_Seek.Tag = 1) then begin //つまみを掴んで移動した F_SetABPosition(TrackBar_Seek.Position); end else begin if (X < lrc_Rect.Left) then begin //トラックバーの左端をクリックした actPlay_SkipNextExecute(actPlay_SkipBack); end else if (X > lrc_Rect.Right) then begin //トラックバーの右端をクリックした actPlay_SkipNextExecute(actPlay_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 li_Pos := TrackBar_Seek.Max; lf_Pos := li_Pos; end; end else begin li_Pos := TrackBar_Seek.Min; lf_Pos := li_Pos; end; TrackBar_Seek.Position := li_Pos; F_SetABPosition(lf_Pos); end; end; TrackBar_Seek.Tag := 0; end; end; procedure TApp_MEDIAPlayer.actPlay_MuteExecute(Sender: TObject); //ミュート begin if (actPlay_Mute.Checked) then begin actPlay_Mute.ImageIndex := F_iPlay_MuteIndex +1; plyMedia.Volume := 0; end else begin actPlay_Mute.ImageIndex := F_iPlay_MuteIndex; plyMedia.Volume := barVolume.Position; end; end; procedure TApp_MEDIAPlayer.actPlay_VolumeExecute(Sender: TObject); //ボリューム begin // FTaskBarMenu.SetCheckMenuItem(mniPPlay_Volume); barVolume.Visible := actPlay_Volume.Checked; end; procedure TApp_MEDIAPlayer.actPlay_BalanceExecute(Sender: TObject); //バランス begin barBalance.Visible := actPlay_Balance.Checked; end; procedure TApp_MEDIAPlayer.barVolumeChange(Sender: TObject); //ボリューム var l_TrackBar: TTrackBar; begin if (Sender is (TTrackBar)) then begin l_TrackBar := TTrackBar(Sender); barVolume.Position := l_TrackBar.Position; end; if (actPlay_Mute.Checked = False) then begin plyMedia.Volume := barVolume.Position; end; end; procedure TApp_MEDIAPlayer.barVolumeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var l_TrackBar: TTrackBar; begin l_TrackBar := TTrackBar(Sender); if (gfnbKeyState(VK_LBUTTON)) then begin l_TrackBar.Hint := IntToStr(l_TrackBar.Position); Application.ActivateHint(gfnptMousePosGet); end else begin l_TrackBar.Hint := ''; end; end; procedure TApp_MEDIAPlayer.barBalanceChange(Sender: TObject); //バランス var l_TrackBar: TTrackBar; begin l_TrackBar := TTrackBar(Sender); if not(gfnbKeyState(VK_LBUTTON)) and (-10 < l_TrackBar.Position) and (l_TrackBar.Position < 10) then begin l_TrackBar.Position := 0; end; barBalance.Position := l_TrackBar.Position; plyMedia.Balance := l_TrackBar.Position; // lblBalance.Caption := IntToStr(l_TrackBar.Position); end; procedure TApp_MEDIAPlayer.barBalanceMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var l_TrackBar: TTrackBar; ls_LR: String; begin l_TrackBar := TTrackBar(Sender); if (gfnbKeyState(VK_LBUTTON)) then begin if (l_TrackBar.Position < 0) then begin ls_LR := 'L '; end else if (l_TrackBar.Position > 0) then begin ls_LR := 'R '; end else begin ls_LR := ''; end; l_TrackBar.Hint := Format('%s%d', [ls_LR, Abs(l_TrackBar.Position)]); Application.ActivateHint(gfnptMousePosGet); end else begin l_TrackBar.Hint := ''; end; end; procedure TApp_MEDIAPlayer.actPlay_Rate_10Execute(Sender: TObject); //再生速度 var l_Action: TAction; begin if (Sender <> nil) then begin l_Action := TAction(Sender); end else begin l_Action := TAction(mnuPlay_Rate.Items[mnuPlay_Rate.Tag].Action); end; mnuPlay_Rate.Tag := l_Action.Tag; //TActionのAutoCheckをTrueにすると同じメニューをチェックするとチェックが消えてしまうため以下の処理が必要 mnuPlay_Rate.Items[mnuPlay_Rate.Tag].Checked := True; mniPlay_Rate.Items[mnuPlay_Rate.Tag].Checked := True; mniPPlay_Rate.Items[mnuPlay_Rate.Tag].Checked := True; actPlay_Rate.ImageIndex := l_Action.ImageIndex; // mniPlay_Rate.ImageIndex := l_Action.ImageIndex; // btnPlay_Rate.ImageIndex := l_Action.ImageIndex; // App_MEDIAInfoVideo.btnPlay_Rate.ImageIndex := l_Action.ImageIndex; plyMedia.PlayRate := StrToFloat(l_Action.Caption); // FTaskBarMenu.SetCheckMenuItem(mniPPlay_Rate); ReleaseCapture; end; //キャプチャ用コマ送り procedure TApp_MEDIAPlayer.actPlay_FrameCaptureBackExecute(Sender: TObject); begin if (gfnbKeyState(VK_SHIFT)) then begin plyMedia.CaptureStep(-5); end else begin plyMedia.CaptureStep(-1); end; end; procedure TApp_MEDIAPlayer.actPlay_FrameCaptureNextExecute(Sender: TObject); begin if (gfnbKeyState(VK_SHIFT)) then begin plyMedia.CaptureStep(+5); end else begin plyMedia.CaptureStep(+1); end; end; procedure TApp_MEDIAPlayer.actPlay_FrameCapturePauseExecute(Sender: TObject); begin plyMedia.CaptureStep(0); end; //コマ送り procedure TApp_MEDIAPlayer.btnPlay_FrameBackMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var li_Delay: DWORD; l_ToolButton : TToolButton; begin if not(Sender is TToolButton) then begin Exit; end; l_ToolButton := TToolButton(Sender); if (l_ToolButton.Action = actPlay_FrameBack) then begin F_iPlay_Frame := -1; end else if (l_ToolButton.Action = actPlay_FrameNext) then begin F_iPlay_Frame := 1; end else begin F_iPlay_Frame := 0; end; if (plyMedia.CanStep) then begin //http://mrxray.on.coocan.jp/Delphi/plSamples/S04_SystemParametersInfo_Interface.htm#03 if not(SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, @li_Delay, 0))then begin li_Delay := 250; end; Timer_Frame.Interval := (li_Delay +1) * 250; Timer_Frame.Enabled := True; end; end; procedure TApp_MEDIAPlayer.btnPlay_FrameBackMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin F_iPlay_Frame := 0; Timer_Frame.Enabled := False; end; procedure TApp_MEDIAPlayer.actPlay_FrameNextExecute(Sender: TObject); var li_Step : Integer; lf_Pos : Double; lb_Shift : Boolean; begin { Application.ProcessMessages; if (Timer_Frame.Tag = 1) then begin Exit; end; Timer_Frame.Tag := 1; } lb_Shift := gfnbKeyState(VK_SHIFT); if (Sender = actPlay_FrameBack1Sec) or (Sender = actPlay_FrameNext1Sec) then begin if (lb_Shift) then begin lf_Pos := 0.5; end else begin lf_Pos := 1 end; if (Sender = actPlay_FrameBack1Sec) then begin lf_Pos := -(lf_Pos); end; plyMedia.CurrentPosition := gfnfNumLimit(plyMedia.CurrentPosition + lf_Pos, 0, plyMedia.Duration); end else begin if (Sender = actPlay_FrameBack10) or (Sender = actPlay_FrameNext10) then begin if (lb_Shift) then begin //Shift併用で20フレーム li_Step := 20; end else begin //10フレーム li_Step := 10; end; end else begin if (lb_Shift) then begin //Shift併用で5フレーム li_Step := 5; end else begin //1フレーム li_Step := 1; end; end; if (Sender = actPlay_FrameNext) or (Sender = actPlay_FrameNext10) then begin plyMedia.Step(li_Step); end else if (Sender = actPlay_FrameBack) or (Sender = actPlay_FrameBack10) then begin plyMedia.Step(-li_Step); end else begin //不正な呼び出し end; end; Timer_SeekBarTimer(nil); Timer_TimeTimer(nil); { Timer_Frame.Tag := 0; Application.ProcessMessages; } end; procedure TApp_MEDIAPlayer.Timer_FrameTimer(Sender: TObject); //Button押しっ放しで連続入力できるように var li_KeySpeed : DWORD; begin // Timer_Frame.Enabled := False; if (Timer_Frame.Tag = 1) then begin Exit; end; Timer_Frame.Tag := 1; if (F_iPlay_Frame = 1) then begin actPlay_FrameNextExecute(actPlay_FrameNext); end else if (F_iPlay_Frame = -1) then begin actPlay_FrameNextExecute(actPlay_FrameBack); end; //http://mrxray.on.coocan.jp/Delphi/plSamples/S04_SystemParametersInfo_Interface.htm#03 if not(SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, @li_KeySpeed, 0))then begin li_KeySpeed := 100; end; Timer_Frame.Interval := 400 - (li_KeySpeed * 12); Timer_Frame.Enabled := gfnbKeyState(VK_LBUTTON); Timer_Frame.Tag := 0; end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.actOpt_RandomExecute(Sender: TObject); begin if (actOpt_Random.Checked) then begin actOpt_Random.ImageIndex := F_iOpt_RandomIndex+1; plyMedia.PlayMode := pmRandom; end else begin actOpt_Random.ImageIndex := F_iOpt_RandomIndex; plyMedia.PlayMode := pmNormal; end; end; procedure TApp_MEDIAPlayer.actOpt_AllowDuplicationExecute( Sender: TObject); //二重起動 var lsl_File: TStringList; begin if (actOpt_AllowDuplication.Checked) then begin lsl_File := TStringList.Create; try lsl_File.Append('allow duplication'); lsl_File.SaveToFile(g_sAllowDuplication); finally lsl_File.Free; end; end else begin DeleteFile(PWideChar(g_sAllowDuplication)); end; end; procedure TApp_MEDIAPlayer.actOpt_AllowExtExecute(Sender: TObject); //拡張子を限定する begin if (actOpt_AllowExt.Checked) then begin if (App_CustomBaseForm.dlgAllowExt.FilterUnicode) then begin plyMedia.AllowExt.Assign(App_CustomBaseForm.lstAllowExt.Items.AnsiExStrings); end else begin plyMedia.AllowExt.Assign(App_CustomBaseForm.lstAllowExt.Items.AnsiStrings); end; end else begin plyMedia.AllowExt.Clear; end; end; procedure TApp_MEDIAPlayer.Action_Opt_Use_ffdshowExecute(Sender: TObject); //ffdshowを優先して使用する begin plyMedia.Use_ffdShow := (Action_Opt_Use_ffdshow.Enabled and Action_Opt_Use_ffdshow.Checked); end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.actCustom_SettingExecute(Sender: TObject); //一覧設定 begin gpcSetTabSheet('Option'); end; procedure TApp_MEDIAPlayer.actCustom_MenuExecute(Sender: TObject); //メニューカスタマイズ begin gpcCreateMenuForm; gpcSetTabSheet('Menu'); end; procedure TApp_MEDIAPlayer.actCustom_ToolBarExecute(Sender: TObject); //ツールバーカスタマイズ var l_Form: TForm; begin l_Form := gfnFocusedFormGet; //myDebug.gpcDebug(l_Form.Name); gpcCreateToolBarForm(Self); gpcSetTabSheet('ToolBar'); if (l_Form = G_PlaylistForm) then begin App_CustomToolBar.lstSelToolBar.ItemIndex := 1; end else begin App_CustomToolBar.lstSelToolBar.ItemIndex := 0; end; App_CustomToolBar.lstSelToolBarSelect(nil); end; procedure TApp_MEDIAPlayer.actCustom_ShortCutExecute(Sender: TObject); //ショートカットカスタマイズ begin gpcCreateShortCutForm; gpcSetTabSheet('ShortCut'); end; //------------------------------------------------------------------------------ procedure TApp_MEDIAPlayer.actFile_MaximizeExecute(Sender: TObject); begin if (IsZoomed(Handle)) then begin WindowState := wsNormal; end else begin WindowState := wsMaximized; end; end; procedure TApp_MEDIAPlayer.actMenu_MainExecute(Sender: TObject); begin mnuPopup.Popup(Self.ClientOrigin.X, Self.ClientOrigin.Y); end; const FciPLAYER = 0; FciPLAYLIST = 1; FciOPTIONSETTING = 2; FciCUSTOMMENU = 3; FciCUSTOMTOOLBAR = 4; FciCUSTOMSHORTCUT = 5; procedure TApp_MEDIAPlayer.mnuWindowPopup(Sender: TObject); function lfnb_EnumWindowProc(hHandle: HWND; AList: TMyWStrings): Boolean; stdcall; var l_Text: WideString; begin if (IsIconic(GetWindow(hHandle, GW_OWNER))) or (IsWindowVisible(hHandle)) then begin //myDebug.gpcDebug(gfnsClassNameGet(hHandle)); if (gfnsClassNameGet(hHandle) = 'TApp_MediaProperty') then begin l_Text := gfnsUtf7ToWide(gfnsWindowTextGet(FindWindowEx(hHandle, 0, 'TMyStaticText', nil))); if (l_Text <> '') and (gfnsExeNameGet(hHandle) = gfnsExeNameGet) then begin AList.AddObject(l_Text, TObject(hHandle)); end; end; end; Result := True; end; var i: Integer; lsl_List: TMyWStrings; ls_Name: String; lb_Check: Boolean; l_MenuItem: TMenuItem; begin mnuWindow.Tag := 0; gpcMenuItemFree(mnuWindow.Items); lsl_List := TMyWStrings.Create; try EnumWindows(@lfnb_EnumWindowProc, LPARAM(lsl_List)); lsl_List.FileSort; if (lsl_List.Count > 0) then begin lsl_List.Insert(0, '-'); end; lsl_List.Insert(0, actCustom_ShortCut.Caption); lsl_List.Insert(0, actCustom_ToolBar.Caption); lsl_List.Insert(0, actCustom_Menu.Caption); lsl_List.Insert(0, actCustom_Setting.Caption); lsl_List.Insert(0, actList_Disp.Caption); lsl_List.Insert(0, 'プレイヤー(&P)'); for i := 0 to lsl_List.Count-1 do begin if (i = 0) and (Screen.ActiveForm = G_MainForm) then begin lb_Check := True; end else if (i = 1) and (Screen.ActiveForm = G_PlaylistForm) then begin lb_Check := True; end else begin lb_Check := False; end; if (lsl_List[i] <> '-') then begin ls_Name := gfnsAvailableName(mnuWindow.Items.Name); l_MenuItem := NewItem( gfnsWideToAnsiEx(gfnsFileNameGet(lsl_List[i])), //Caption 0, //ShortCut lb_Check, //Checked True, //Enabled mniWindow_WindowListClick, //OnClickイベント 0, //HelpContext ls_Name //Name ); with l_MenuItem do begin RadioItem := True; AutoCheck := True; Tag := Integer(lsl_List.Objects[i]); Hint := gfnsWideToAnsiEx(lsl_List[i]); // OnAdvancedDrawItem := mniAdvancedDrawItem; end; mnuWindow.Items.Add(l_MenuItem); end else begin mnuWindow.Items.NewBottomLine; end; end; finally lsl_List.Free; end; end; procedure TApp_MEDIAPlayer.mniWindow_WindowListClick(Sender: TObject); var l_MenuItem: TMenuItem; lh_Window: HWND; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); if (l_MenuItem.MenuIndex = FciPLAYER) then begin // if (actDisp_HideMusic.Checked) then begin // actDisp_HideMusic.Checked := False; // end; G_MainForm.BringToFront; end else if (l_MenuItem.MenuIndex = FciPLAYLIST) then begin if (G_PlaylistForm.Visible) then begin mnuWindow.Tag := 1; G_PlaylistForm.Show; G_PlaylistForm.BringToFront; end else begin actList_DispExecute(nil); end; end else if (l_MenuItem.MenuIndex = FciOPTIONSETTING) then begin actCustom_SettingExecute(nil); end else if (l_MenuItem.MenuIndex = FciCUSTOMMENU) then begin actCustom_MenuExecute(nil); end else if (l_MenuItem.MenuIndex = FciCUSTOMTOOLBAR) then begin actCustom_ToolBarExecute(nil); end else if (l_MenuItem.MenuIndex = FciCUSTOMSHORTCUT) then begin actCustom_ShortCutExecute(nil); end else begin lh_Window := HWND(l_MenuItem.Tag); if (IsIconic(lh_Window)) then begin gpcIconRestore(lh_Window); end; SetWindowPos(lh_Window, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); SetWindowPos(lh_Window, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); end; end; procedure TApp_MEDIAPlayer.actMenu_WindowListExecute(Sender: TObject); begin mnuWindow.Popup(Self.ClientOrigin.X, Self.ClientOrigin.Y); end; procedure TApp_MEDIAPlayer.btnToolSearchMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IsPlayer := True; end; procedure TApp_MEDIAPlayer.F_OnSearchChange(Sender: TObject); begin with G_PlaylistForm do begin gpcSearchMenuCreate(Self.mniSearch_SelectSite, mniSearch_SelectSiteClick); gpcSearchMenuCreate(Self.mniPSearch_SelectSite, mniSearch_SelectSiteClick); gpcSearchMenuCreate(mniPSearch_SelectSite, mniSearch_SelectSiteClick); gpcSearchMenuCreate(mniPPSearch_SelectSite, mniSearch_SelectSiteClick); gpcSearchMenuCreate(mniPPPSearch_SelectSite, mniSearch_SelectSiteClick); gpcSearchMenuCreate(mnuSearch_SelectSite.Items, mniSearch_SelectSiteClick); end; myMessagePanel.gpcMessagePanelBroadcast(WideFormat('/FROM:%d /SEARCHLIST_CHANGE:%s',[MyMessagePanel1.Handle, mySearch.G_SearchList.UrlText])); end; procedure TApp_MEDIAPlayer.actZoom_AspectStandardExecute(Sender: TObject); var li_Height, li_Add: Integer; begin // li_Add := pnlTop.Height + pnlBottom.Height; if (pnlInfo.Visible) then begin Inc(li_Add, pnlInfo.Height); end; if (Sender = actZoom_AspectStandard) then begin li_Height := Trunc(ClientWidth * (3/4)); end else if (Sender = actZoom_AspectHiVision) then begin li_Height := Trunc(ClientWidth * (9/16)); end else if (Sender = actZoom_AspectEVista) then begin li_Height := Trunc(ClientWidth * (3/5)); end else if (Sender = actZoom_AspectAVista) then begin li_Height := Trunc(ClientWidth / 1.85); end else if (Sender = actZoom_AspectWideScope) then begin li_Height := Trunc(ClientWidth / 2.35); end else begin li_Height := 0; end; if (li_Height > 0) then begin ClientHeight := li_Height + li_Add; end; end; //設定ファイル ----------------------------------------------------------------- const //設定ファイルのキー lcsSECT_BOUNDS = 'BOUNDS'; lcsKEY_VIDEOHEIGHT = 'VideoHeight'; lcsKEY_HEADERPLAYLIST = 'PlaylistHeader'; lcsKEY_HEADERHISTORYLIST = 'HistorylistHeader'; lcsSECT_LIST = 'LIST'; lcsKEY_LISTADD = 'Add'; lcsKEY_LISTSHUFFLE = 'Shuffle'; lcsKEY_ITEM = 'Item_'; lcsKEY_LISTFIND = 'Find'; lcsSECT_FINDHISTORY = 'HISTORY_FIIND'; lcsSECT_HISTORY_OPENFILE = 'HISTORY_OPENFILE'; lcsSECT_HISTORY_OPENFOLDER = 'HISTORY_OPENFOLDER'; lcsSECT_HISTORY_OPENTHISFOLDER = 'HISTORY_OPENTHISFOLDER'; lcsSECT_PLAY = 'PLAY'; lcsKEY_REPEAT = 'Repeat'; lcsKEY_REPEATSTART = 'RepeatStart'; lcsKEY_REPEATEND = 'RepeatEnd'; lcsKEY_MUTE = 'Mute'; lcsKEY_VOLUME = 'Volume'; lcsKEY_BALANCE = 'Balance'; lcsSECT_ZOOM = 'ZOOM'; lcsKEY_WALLVIDEO = 'Wallvideo'; lcsKEY_FULLSCREEN = 'FullScreen'; lcsKEY_MAXSCREEN = 'MaxScreen'; lcsKEY_ZOOMPOS = 'ZoomPosition'; // lcsKEY_MONITOR = 'MonitorIndex'; lcsKEY_RENDERER = 'Renderer'; lcsSECT_DISP = 'VIEW'; lcsKEY_TITLEBAR = 'TitleBar'; lcsKEY_MENUBAR = 'MenuBar'; lcsKEY_TOOLBAR = 'ToolBar'; lcsKEY_INFOPANEL = 'InfoPanel'; lcsKEY_CONTROLBAR = 'ControlBar'; lcsKEY_HIDECONTROL = 'HideControl'; lcsKEY_TIMEVERBOSE = 'TimeVerbose'; lcsKEY_MENUICON = 'MenuIcon'; lcsKEY_LISTFONT = 'ListFont'; lcsSECT_OPT = 'OPTION'; lcsKEY_ORIZINALSIZE = 'OriginalSize'; lcsKEY_OPENFIT = 'OpenFit'; lcsKEY_KEEPASPECT = 'KeepAspect'; lcsKEY_SCREENSAVER = 'ScreenSaver'; lcsKEY_RANDOM = 'RandomPlay'; lcsKEY_GAPLESS = 'Gapless'; lcsKEY_VIDEOGAPLESS = 'VideoGapless'; lcsKEY_READTAG = 'ReadTag'; lcsKEY_FADEIN = 'FadeIn'; lcsKEY_ALLOWEXT = 'AllowExt'; lcsKEY_USEFFDSHOW = 'Use_ffdshow'; lcsSECT_ALLOWEXT = 'ALLOWEXT'; //追加する拡張子 lcsSECT_RESUME = 'RESUME'; lcsKEY_RESUME = 'Resume'; lcsKEY_RESUMEINDEX = 'Index'; lcsKEY_RESUMETIME = 'Time'; lcsSECT_DIALOG = 'DIALOG'; lcsKEY_OPENFILE = 'OpenFile'; lcsKEY_OPENFOLDER = 'OpenFolder'; lcsKEY_OPENTHISFOLDER = 'OpenThisFolder'; lcsKEY_M3ULIST = 'ListPath'; // lcsKEY_RENAME = 'FileRename'; lcsKEY_FILEMOVEAS = 'FileMoveAs'; lcsKEY_FILECOPYAS = 'FileCopyAs'; lcsKEY_FILEMOVE = 'FileMove'; lcsKEY_FILECOPY = 'FileCopy'; lcsKEY_GRF = 'GraphEditorFile'; //読み込み procedure TApp_MEDIAPlayer.FLoadIni; procedure lpc_ReadFolderHistory(IniFile: TMyIniFile; sSection: WideString; mnuHistory: TPopupMenu); var lsl_List: TMyWStrings; begin if (IniFile.SectionExists(sSection)) then begin lsl_List := TMyWStrings.Create; try IniFile.ReadSectionText(sSection, lsl_List); F_AddFileHistory(mnuHistory, lsl_List); finally lsl_List.Free; end; end; end; var l_IniFile : TMyIniFile; i : Integer; lrc_Rect : TRect; ls_File : WideString; lsl_List : TMyWStrings; l_ExtList : TMyWStrings; l_Action : TAction; begin //Shift+Ctrl起動で設定を読み込まない。 if (Action_OptNotLoadIni.Checked) or (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin actDisp_ToolBarExecute(nil); actOpt_AllowExtExecute(nil); Exit; end; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try //------------------------------------------------------------------------------ //準汎用フォーム用 App_CustomMenu.ReadIniMenu(l_IniFile);//, [mnuPopup, G_PlaylistForm.mnuPlaylist, G_PlaylistForm.mnuSort]); App_CustomToolBar.ReadIniToolBar(l_IniFile); //, [ToolBar_Main, G_PlaylistForm.ToolBar_PlayList]); gpcReadIniShortCut(l_IniFile, ActionList_Main); //※ここでは呼ばない //[Capture] // myBmpCapture.ReadIni(l_IniFile); //------------------------------------------------------------------------------ //[Zoom] Action_ZoomWallvideo.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_WALLVIDEO, Action_ZoomWallvideo.Checked); actZoom_FullScreen.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_FULLSCREEN, actZoom_FullScreen.Checked); actZoom_MaxZoom.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_MAXSCREEN, actZoom_MaxZoom.Checked); { actZoom_FullScreen.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_FULLSCREEN, actZoom_FullScreen.Checked); if not(actZoom_FullScreen.Checked) then begin actZoom_MaxZoom.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_MAXZOOM, actZoom_MaxZoom.Checked); end; } case (ReadInteger(lcsSECT_ZOOM, lcsKEY_RENDERER, Integer(vmVMR7))) of Integer(vmVideoRenderer) :begin //旧レンダラ l_Action := Action_ZoomVideoRenderer; end; Integer(vmOverlayMixer) :begin //オーバーレイミキサー l_Action := Action_ZoomOverlayMixer; end; Integer(vmVMR9) :begin //VMR9 l_Action := Action_ZoomVMR9; end; Integer(vmEVR) :begin //EVR if (Action_ZoomEVR.Visible) then begin l_Action := Action_ZoomEVR; end else begin //デフォルトはVMR9 l_Action := Action_ZoomVMR9; end; end; else begin //デフォルトはVMR9 l_Action := Action_ZoomVMR9; end; end; Action_ZoomVideoRendererExecute(l_Action); //[Bounds] SetMonitorBoundsRect(Self); lrc_Rect := ReadBoundsRect(lcsSECT_BOUNDS, pnlInfo); pnlInfo.Height := gfniNumLimit(gfniRectHeight(lrc_Rect), pnlInfo.Constraints.MinHeight, pnlInfo.Constraints.MaxHeight); SetMonitorBoundsRect(G_PlaylistForm); //[List] actList_OpenAdd.Checked := ReadBool(lcsSECT_LIST, lcsKEY_LISTADD, actList_OpenAdd.Checked); actList_OpenAddExecute(nil); with G_PlaylistForm do begin for i := 1 to celPlaylist.ColCount-1 do begin celPlaylist.ColWidths[i] := ReadInteger(lcsSECT_LIST, WideFormat(lcsKEY_ITEM + '%d', [i]), celPlaylist.ColWidths[i]); end; case ReadInteger(lcsSECT_LIST, lcsKEY_LISTFIND, G_ciFIND_FILENAME) of G_ciFIND_MEDIAPATH: begin actFind_FindMediaNameExecute(actFind_FindMediaPath); end; G_ciFIND_FILENAME: begin actFind_FindMediaNameExecute(actFind_FindFileName); end; else begin actFind_FindMediaNameExecute(actFind_FindMediaName); end; end; lsl_List := TMyWStrings.Create; try //[Find] ReadSectionText(lcsSECT_FINDHISTORY, lsl_List); if (lsl_List.Count > 0) then begin gpcListTrimBottom(lsl_List); lsl_List.Reverse; AddFindHistory(mnuFind_FindHistory.Items, lsl_List); end; finally lsl_List.Free; end; end; //[Option] actOpt_OpenOriginalSize.Checked := ReadBool(lcsSECT_OPT, lcsKEY_ORIZINALSIZE, actOpt_OpenOriginalSize.Checked); actOpt_AllowScreenSaver.Checked := ReadBool(lcsSECT_OPT, lcsKEY_SCREENSAVER, actOpt_AllowScreenSaver.Checked); actOpt_Random.Checked := ReadBool(lcsSECT_OPT, lcsKEY_RANDOM, actOpt_Random.Checked); actOpt_RandomExecute(nil); actOpt_OpenFit.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPENFIT, actOpt_OpenFit.Checked); actOpt_KeepAspect.Checked := ReadBool(lcsSECT_OPT, lcsKEY_KEEPASPECT, actOpt_KeepAspect.Checked); actList_ReadTag.Checked := ReadBool(lcsSECT_OPT, lcsKEY_READTAG, actList_ReadTag.Checked); Action_Opt_Use_ffdshow.Checked := ReadBool(lcsSECT_OPT, lcsKEY_USEFFDSHOW, Action_Opt_Use_ffdshow.Checked); actOpt_AllowExt.Checked := ReadBool(lcsSECT_OPT, lcsKEY_ALLOWEXT, actOpt_AllowExt.Checked); if (SectionExists(lcsSECT_ALLOWEXT)) then begin l_ExtList := TMyWStrings.Create; try ReadSectionText(lcsSECT_ALLOWEXT, l_ExtList); //以下の拡張子は削除できない l_ExtList.AddStrings(DefAllowExtList); l_ExtList.InsertionSort(True); App_CustomBaseForm.lstAllowExt.Items.Assign(l_ExtList) finally l_ExtList.Free; end; end; actOpt_AllowExtExecute(nil); //[Play] actPlay_Mute.Checked := ReadBool(lcsSECT_PLAY, lcsKEY_MUTE, actPlay_Mute.Checked); actPlay_MuteExecute(nil); barVolume.Position := gfniNumLimit(ReadInteger(lcsSECT_PLAY, lcsKEY_VOLUME, barVolume.Position), barVolume.Min, barVolume.Max); barVolumeChange(barVolume); barBalance.Position := gfniNumLimit(ReadInteger(lcsSECT_PLAY, lcsKEY_BALANCE, barBalance.Position), barBalance.Min, barBalance.Max); barBalanceChange(barBalance); //[Dialog] dlgOpenFile.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_OPENFILE, dlgOpenFile.InitialDir); dlgOpenFolder.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_OPENFOLDER, dlgOpenFolder.InitialDir); dlgOpenThisFolder.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_OPENTHISFOLDER, dlgOpenThisFolder.InitialDir); dlgSaveList.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_M3ULIST, dlgSaveList.InitialDir); // dlgFileCmd_Rename.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_RENAME, dlgFileCmd_Rename.InitialDir); dlgFileCmd_FileMoveAs.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_FILEMOVEAS, dlgFileCmd_FileMoveAs.InitialDir); dlgFileCmd_FileCopyAs.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_FILECOPYAS, dlgFileCmd_FileCopyAs.InitialDir); dlgFileCmd_FileMove.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_FILEMOVE, dlgFileCmd_FileMove.InitialDir); dlgFileCmd_FileCopy.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_FILECOPY, dlgFileCmd_FileCopy.InitialDir); dlgSelectGrfFile.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_GRF, dlgSelectGrfFile.InitialDir); FSendTo.LoadIni(l_IniFile); lpc_ReadFolderHistory(l_IniFile, lcsSECT_HISTORY_OPENFILE, mnuFile_HistoryOpenFile); lpc_ReadFolderHistory(l_IniFile, lcsSECT_HISTORY_OPENFOLDER, mnuFile_HistoryOpenFolder); lpc_ReadFolderHistory(l_IniFile, lcsSECT_HISTORY_OPENTHISFOLDER, mnuFile_HistoryOpenThisFolder); //[Display] actDisp_InfoPanel.Checked := ReadBool(lcsSECT_DISP, lcsKEY_INFOPANEL, actDisp_InfoPanel.Checked); actDisp_TimeVerbose.Checked := ReadBool(lcsSECT_DISP, lcsKEY_TIMEVERBOSE, actDisp_TimeVerbose.Checked); actDisp_ToolBarExecute(nil); SetFont(lcsSECT_DISP, lcsKEY_LISTFONT, G_PlaylistForm.celPlaylist); //[SEARCH] mySearch.gpcLoadIniSearch(l_IniFile); F_OnSearchChange(nil); mySearch.G_SearchList.OnChange := F_OnSearchChange; // App_CustomBaseForm.lstSearch.Items.AddStrings(G_SearchList.Count); Show; //[Resume] actOpt_Resume.Checked := ReadBool(lcsSECT_RESUME, lcsKEY_RESUME, actOpt_Resume.Checked); if (actOpt_Resume.Checked) and (gfniParamCount = 0) then begin //レジューム ls_File := gfnsFileExtChange(gfnsExeNameGet, lcsRESUMEEXT); if (gfnbFileExists(ls_File)) then begin F_iResumeIndex := ReadInteger(lcsSECT_RESUME, lcsKEY_RESUMEINDEX, -1); F_fResumePosition := Trunc(ReadInteger(lcsSECT_RESUME, lcsKEY_RESUMETIME, 0)); lsl_List := TMyWStrings.Create; try lsl_List.Add(ls_File); F_GetFileList(lsl_List); finally lsl_List.Free; end; end; end else begin F_iResumeIndex := -1; F_fResumePosition := 0; end; finally Free; end; end; end; //書き込み procedure TApp_MEDIAPlayer.FSaveIni; procedure lpc_WriteFolderHistory(IniFile: TMyIniFile; sSection: WideString; Menu: TPopupMenu); var i: Integer; lsl_List: TMyWStrings; begin if (Menu.Items.Count > 0) then begin lsl_List := TMyWStrings.Create; try for i := 0 to Menu.Items.Count -1 do begin if (Menu.Items[i].Caption <> '') then begin lsl_List.Add(gfnsAnsiToWideEx(Menu.Items[i].Caption)); end; end; IniFile.WriteSectionText(sSection, lsl_List); finally lsl_List.Free; end; end else if (IniFile.SectionExists(sSection)) then begin IniFile.EraseSection(sSection); end; end; var l_IniFile : TMyIniFile; i : Integer; // li_Index : Integer; ls_File : WideString; lsl_List : TMyWStrings; begin //Shift+Ctrl起動で設定を書き込まない。 if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) or (actOpt_NotSaveIni.Checked) then begin Exit; end; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try //[Bounds] WriteBoundsRect(Self); WriteBoundsRect(lcsSECT_BOUNDS, pnlInfo); WriteBoundsRect(G_PlaylistForm); //[List] WriteBool(lcsSECT_LIST, lcsKEY_LISTADD, actList_OpenAdd.Checked); with G_PlaylistForm do begin for i := 1 to celPlaylist.ColCount-1 do begin WriteInteger(lcsSECT_LIST, WideFormat(lcsKEY_ITEM + '%d', [i]), celPlaylist.ColWidths[i]); end; if (actFind_FindMediaName.Checked) then begin WriteInteger(lcsSECT_LIST, lcsKEY_LISTFIND, G_ciFIND_MEDIANAME); end else if (actFind_FindMediaPath.Checked) then begin WriteInteger(lcsSECT_LIST, lcsKEY_LISTFIND, G_ciFIND_MEDIAPATH); end else begin WriteInteger(lcsSECT_LIST, lcsKEY_LISTFIND, G_ciFIND_FILENAME); end; //検索履歴 if (mnuFind_FindHistory.Items.Count > 0) then begin lsl_List := TMyWStrings.Create; try for i := 0 to mnuFind_FindHistory.Items.Count -1 do begin lsl_List.Add(gfnsAnsiToWideEx(mnuFind_FindHistory.Items[i].Caption)); end; WriteSectionText(lcsSECT_FINDHISTORY, lsl_List); finally lsl_List.Free; end; end; end; //[Play] (* if (actPlay_RepeatOne.Checked) then begin li_Index := mniPlay_RepeatOne.MenuIndex; end else if (actPlay_RepeatAB.Checked) then begin li_Index := mniPlay_RepeatAB.MenuIndex; end else {if (actPlay_RepeatAll.Checked) then} begin li_Index := mniPlay_RepeatAll.MenuIndex; end; WriteInteger(lcsSECT_PLAY, lcsKEY_REPEAT, li_Index); WriteFloat (lcsSECT_PLAY, lcsKEY_REPEATSTART, F_fRepeatStart); WriteFloat (lcsSECT_PLAY, lcsKEY_REPEATEND, F_fRepeatEnd); *) WriteBool (lcsSECT_PLAY, lcsKEY_MUTE, actPlay_Mute.Checked); WriteInteger(lcsSECT_PLAY, lcsKEY_VOLUME, barVolume.Position); WriteInteger(lcsSECT_PLAY, lcsKEY_BALANCE, barBalance.Position); //[Resume] WriteBool (lcsSECT_RESUME, lcsKEY_RESUME, actOpt_Resume.Checked); WriteInteger(lcsSECT_RESUME, lcsKEY_RESUMEINDEX, plyMedia.ItemIndex); WriteInteger(lcsSECT_RESUME, lcsKEY_RESUMETIME, Trunc(plyMedia.CurrentPosition)); if (actOpt_Resume.Checked) then begin ls_File := gfnsFileExtChange(gfnsExeNameGet, lcsRESUMEEXT); if (plyMedia.Items.Count > 0) then begin plyMedia.Items.SaveToFile(ls_File, cdUTF_8N); end else if (gfnbFileExists(ls_File)) then begin gpcFileTrash(ls_File); end; end; //[Zoom] WriteBool(lcsSECT_ZOOM, lcsKEY_WALLVIDEO, Action_ZoomWallvideo.Checked); WriteBool(lcsSECT_ZOOM, lcsKEY_FULLSCREEN, actZoom_FullScreen.Checked); WriteBool(lcsSECT_ZOOM, lcsKEY_MAXSCREEN, actZoom_MaxZoom.Checked); if (Action_ZoomVideoRenderer.Checked) then begin //旧レンダラ WriteInteger(lcsSECT_ZOOM, lcsKEY_RENDERER, Integer(vmVideoRenderer)); end else if (Action_ZoomOverlayMixer.Checked) then begin //オーバーレイミキサー WriteInteger(lcsSECT_ZOOM, lcsKEY_RENDERER, Integer(vmOverlayMixer)); end else if (Action_ZoomVMR9.Checked) then begin //VMR9 WriteInteger(lcsSECT_ZOOM, lcsKEY_RENDERER, Integer(vmVMR9)); end else begin if (Action_ZoomEVR.Checked) and (gfniOSMajorVersionGet >= 6) then begin //EVR WriteInteger(lcsSECT_ZOOM, lcsKEY_RENDERER, Integer(vmEVR)); end else begin //VMR7 WriteInteger(lcsSECT_ZOOM, lcsKEY_RENDERER, Integer(vmVMR7)); end; end; //[Option] WriteBool(lcsSECT_OPT, lcsKEY_ORIZINALSIZE, actOpt_OpenOriginalSize.Checked); WriteBool(lcsSECT_OPT, lcsKEY_SCREENSAVER, actOpt_AllowScreenSaver.Checked); WriteBool(lcsSECT_OPT, lcsKEY_RANDOM, actOpt_Random.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPENFIT, actOpt_OpenFit.Checked); WriteBool(lcsSECT_OPT, lcsKEY_KEEPASPECT, actOpt_KeepAspect.Checked); WriteBool(lcsSECT_OPT, lcsKEY_ALLOWEXT, actOpt_AllowExt.Checked); WriteBool(lcsSECT_OPT, lcsKEY_USEFFDSHOW, Action_Opt_Use_ffdshow.Checked); WriteBool(lcsSECT_OPT, lcsKEY_READTAG, actList_ReadTag.Checked); //[AllowExt] WriteSectionText(lcsSECT_ALLOWEXT, App_CustomBaseForm.lstAllowExt.Items); //[Display] WriteBool(lcsSECT_DISP, lcsKEY_INFOPANEL, actDisp_InfoPanel.Checked); WriteBool(lcsSECT_DISP, lcsKEY_TIMEVERBOSE, actDisp_TimeVerbose.Checked); WriteFont(lcsSECT_DISP, lcsKEY_LISTFONT, G_PlaylistForm.celPlaylist.Font); //[Dialog] WriteString(lcsSECT_DIALOG, lcsKEY_OPENFILE, dlgOpenFile.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_OPENFOLDER, dlgOpenFolder.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_OPENTHISFOLDER, dlgOpenThisFolder.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_M3ULIST, dlgSaveList.InitialDir); // WriteString(lcsSECT_DIALOG, lcsKEY_RENAME, dlgFileCmd_Rename.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_FILEMOVEAS, dlgFileCmd_FileMoveAs.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_FILECOPYAS, dlgFileCmd_FileCopyAs.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_FILEMOVE, dlgFileCmd_FileMove.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_FILECOPY, dlgFileCmd_FileCopy.InitialDir); WriteString(lcsSECT_DIALOG, lcsKEY_GRF, dlgSelectGrfFile.InitialDir); FSendTo.SaveIni(l_IniFile); lpc_WriteFolderHistory(l_IniFile, lcsSECT_HISTORY_OPENFILE, mnuFile_HistoryOpenFile); lpc_WriteFolderHistory(l_IniFile, lcsSECT_HISTORY_OPENFOLDER, mnuFile_HistoryOpenFolder); lpc_WriteFolderHistory(l_IniFile, lcsSECT_HISTORY_OPENTHISFOLDER, mnuFile_HistoryOpenThisFolder); //[SEARCH] mySearch.gpcSaveIniSearch(l_IniFile); //------------------------------------------------------------------------------ //準汎用フォーム用 //[Menu] App_CustomMenu.WriteIniMenu(l_IniFile);//, [mnuMain, mnuPopup, G_PlaylistForm.mnuPlayList, G_PlaylistForm.mnuSort]); //[ToolBar] App_CustomToolBar.WriteIniToolBar(l_IniFile); //, [ToolBar_Main, G_PlaylistForm.ToolBar_PlayList]); //[ShortCut] gpcWriteIniShortCut(l_IniFile); //------------------------------------------------------------------------------ try UpdateFile; except end; finally Free; end; end; end; //設定ファイル ここまで -------------------------------------------------------- // テスト ---------------------------------------------------------------------- procedure TApp_MEDIAPlayer.actTest_DispTestFormExecute(Sender: TObject); begin myDebugDShow.gpcDS_FormShow; end; procedure TApp_MEDIAPlayer.actTest_CreateGrfFileExecute(Sender: TObject); //GraphEditファイル作成k begin dlgSelectGrfFile.Options := dlgSelectGrfFile.Options + [ofOverwritePrompt]; if (dlgSelectGrfFile.Execute) then begin plyMedia.SaveGraphFile(dlgSelectGrfFile.FileName); end; end; procedure TApp_MEDIAPlayer.actTest_LoadGrfFileExecute(Sender: TObject); begin dlgSelectGrfFile.Options := dlgSelectGrfFile.Options - [ofOverwritePrompt]; if (dlgSelectGrfFile.Execute) then begin //plyMedia.LoadGraphFile(dlgSelectGrfFile.FileName); plyMedia.Play(dlgSelectGrfFile.FileName); end; end; procedure TApp_MEDIAPlayer.Action_Debug_MessageModeExecute(Sender: TObject); begin myDebugDShow.gpcDShowMessageModeSet(Action_Debug_MessageMode.Checked); end; procedure TApp_MEDIAPlayer.Action_ZoomVideoRendererExecute(Sender: TObject); var lb_Reload: Boolean; li_ItemIndex : Integer; lf_Position : TRefTime; begin if not(Sender is TAction) then begin Exit; end; li_ItemIndex := plyMedia.ItemIndex; lf_Position := plyMedia.CurrentPosition; lb_Reload := False; if (Sender = Action_ZoomVideoRenderer) then begin TAction(Sender).Checked := True; if (plyMedia.Renderer <> vmVideoRenderer) then begin lb_Reload := True; plyMedia.Renderer := vmVideoRenderer; end; end else if (Sender = Action_ZoomOverlayMixer) then begin TAction(Sender).Checked := True; if (plyMedia.Renderer <> vmOverlayMixer) then begin lb_Reload := True; plyMedia.Renderer := vmOverlayMixer; end; end else if (Sender = Action_ZoomVMR7) then begin TAction(Sender).Checked := True; if (plyMedia.Renderer <> vmVMR7) then begin lb_Reload := True; plyMedia.Renderer := vmVMR7; end; end else if (Sender = Action_ZoomVMR9) then begin TAction(Sender).Checked := True; if (plyMedia.Renderer <> vmVMR9) then begin lb_Reload := True; plyMedia.Renderer := vmVMR9; end; end else if (Sender = Action_ZoomEVR) then begin TAction(Sender).Checked := True; if (plyMedia.Renderer <> vmEVR) then begin lb_Reload := True; plyMedia.Renderer := vmEVR; end; end else begin Exit; end; if (lb_Reload) and (plyMedia.MediaHasVideo) then begin F_iResumeIndex := li_ItemIndex; F_fResumePosition := lf_Position; plyMedia.Stop; plyMedia.Play(F_iResumeIndex); end; end; procedure TApp_MEDIAPlayer.actTest_EnumPinsExecute(Sender: TObject); //ピンを列挙 begin myDebugDShow.gpcDS_ShowMsg(actTest_EnumPins.Caption); myDebugDShow.gpcDS_EnumFilters(plyMedia.GraphBuilder); myDebugDShow.gpcDS_SetForeground; end; procedure TApp_MEDIAPlayer.actTest_EnumSystemFilterExecute(Sender: TObject); { *** カテゴリ名 *** フレンドリ名 / 説明 [デバイスパス] } begin myDebugDShow.gpcDS_ShowMsg('システムデバイスを列挙'); myDebugDShow.gpcDS_EnumSytemDeviceFilter; myDebugDShow.gpcDS_SetForeground; end; procedure TApp_MEDIAPlayer.actTest_MediaDetExecute(Sender: TObject); begin myDebugDShow.gpcDS_ShowMsg('メディアディテクタからの情報を取得'); myDebugDShow.gpcDS_MediaDet(plyMedia.FileName); myDebugDShow.gpcDS_SetForeground; end; procedure TApp_MEDIAPlayer.actTest_SeekCapabilityExecute(Sender: TObject); //シーク能力表示 begin myDebugDShow.gpcDS_ShowMsg('シーク能力取得'); myDebugDShow.gpcDS_SeekingCapability(plyMedia.SeekCapability); myDebugDShow.gpcDS_ShowMsg('拡張シーク能力取得'); myDebugDShow.gpcDS_ExSeekingCapability(plyMedia.ExSeekCapability); myDebugDShow.gpcDS_SetForeground; end; procedure TApp_MEDIAPlayer.actTest_DDCapsExecute(Sender: TObject); //ハードウェアの能力取得 begin myDebugDShow.gpcDS_ShowMsg('ハードウェアの能力の取得'); myDebugDShow.gpcDS_DDCaps(plyMedia.FileName); myDebugDShow.gpcDS_SetForeground; end; procedure TApp_MEDIAPlayer.actTest_TimeFormatSupportedExecute(Sender: TObject); //サポートタイムフォーマット var l_MediaSeeking : IMediaSeeking; begin if (plyMedia.GraphBuilder <> nil) then begin plyMedia.GraphBuilder.QueryInterface(IMediaSeeking, l_MediaSeeking); try myDebugDShow.gpcDS_IsFormatSupported(l_MediaSeeking); myDebugDShow.gpcDS_SetForeground; finally l_MediaSeeking := nil; end; end; end; procedure TApp_MEDIAPlayer.Timer_AspectTimer(Sender: TObject); begin Timer_Aspect.Enabled := False; plyMedia.Resize; //myDebug.gpcDebug('OK'); end; procedure TApp_MEDIAPlayer.actZoom_CaptureExecute(Sender: TObject); { var l_Bitmap : TMyBitmap; ls_File : WideString; lb_Ctrl : Boolean; li_ErrMode : UINT; } begin if not(plyMedia.MediaHasVideo) then begin Exit; end; actZoom_Capture.Enabled := False; try myBmpCaptureEx.CreateForm(Self); myBmpCaptureEx.Capture(plyMedia.FileName, plyMedia.CurrentPosition); myBmpCaptureEx.ShowForm; finally actZoom_Capture.Enabled := True; end; Exit; { lf_Time := plyMedia.CurrentPosition; lb_Ctrl := gfnbKeyState(VK_CONTROL); l_Bitmap := TMyBitmap.Create; try if (gfnbBmpFromMedia(l_Bitmap, plyMedia.FileName, plyMedia.CurrentPosition, plyMedia.VideoWidth, plyMedia.VideoHeight)) then begin Beep; Clipboard.Assign(l_Bitmap); if (lb_Ctrl) then begin ls_File := gfnsFileExtChange(gfnsExeNameGet, lcsCAPTUREEXT); li_ErrMode := SetErrorMode(SEM_FAILCRITICALERRORS); try l_Bitmap.SaveToFile(ls_File); if (gfnbFileExists(ls_File)) then begin gpcExecuteForeground(ls_File); end; except end; SetErrorMode(li_ErrMode); end; end else begin gpcShowMessage('ビデオ画像のキャプチャに失敗しました'#13'ビデオレンダラを変更するなどしてみて下さい'); end; finally l_Bitmap.Free; end; } end; procedure TApp_MEDIAPlayer.Action_List_LibDBTuneExecute(Sender: TObject); begin libman.SlimDB; end; procedure TApp_MEDIAPlayer.actTest_DXVersionInfoExecute(Sender: TObject); var li_Ver : DWORD; ls_Ver : String; begin DSUtil.GetDXVersion(li_Ver, ls_Ver); myDebugDShow.gpcDS_ShowMsg([ls_Ver]);//, li_Ver]); end; end.