unit main; {$DEFINE _DEBUG} {$IFNDEF DEBUG} {$UNDEF _DEBUG} {$ENDIF} {$DEFINE CAPTURE_BITMAP} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, DirectShow9, Menus, ImgList, ShellAPI, ToolWin, Vcl.ActnList, Vcl.AppEvnts, Vcl.Grids, myFolderDialog, myMessagePanel, myMultimedia, myTag, myTaskBarMenu, myTrackBar, myWStrings, info_get, myLabel, Vcl.Buttons; const //再生イベントを受け取るためのユニークなメッセージ番号 WM_GRAPH_NOTIFY = (WM_APP +1); type TApp_Wallvideo = class(TForm) ActionList1: TActionList; Action_File_OpenFile: TAction; Action_File_OpenFolder: TAction; Action_File_OpenThisFolder: TAction; Action_File_Exit: TAction; Action_Play_Play: TAction; Action_Play_Pause: TAction; Action_Play_PlayPause: TAction; Action_Play_Back: TAction; Action_Play_Next: TAction; Action_Play_Stop: TAction; Action_Play_Mute: TAction; Action_List_GotoPlaying: TAction; Action_List_OpenAdd: TAction; Action_List_FolderName: TAction; Action_List_Delete: TAction; Action_List_DeletePlaying: TAction; Action_List_Clear: TAction; __Action_Sort: TAction; Action_Sort_FileName: TAction; Action_Sort_Folder: TAction; Action_Sort_Name: TAction; Action_Sort_Ext: TAction; Action_Sort_Shuffle: TAction; Action_Play_Replay: TAction; Action_Play_SkipBack: TAction; Action_Play_SkipNext: TAction; Action_Video_CaptureBitmap: TAction; Action_Video_SelectMonitor: TAction; Action_Opt_Random: TAction; Action_Opt_TaskTray: TAction; Action_Opt_StatusBar: TAction; Action_Opt_ConfirmErr: TAction; Action_Debug_CreateGrfFile: TAction; Action_Help_Help: TAction; Action_Help_VersionInfo: TAction; MainMenu1: TMainMenu; MenuItem_File: TMenuItem; MenuItem_File_OpenFile: TMenuItem; MenuItem_File_OpenFolder: TMenuItem; MenuItem_File_OpenThisFolder: TMenuItem; MenuItem_File_Line1: TMenuItem; MenuItem_Video_CaptureBitmap: TMenuItem; MenuItem_Debug_CreateGraphEdit: TMenuItem; MenuItem_File_Exit: TMenuItem; MenuItem_List: TMenuItem; MenuItem_List_OpenAdd: TMenuItem; MenuItem_List_GotoPlaying: TMenuItem; MenuItem_List_FolderName: TMenuItem; MenuItem_List_Line1: TMenuItem; MenuItem_List_Clear: TMenuItem; MenuItem_List_Delete: TMenuItem; MenuItem_List_DeletePlaying: TMenuItem; MenuItem_Find_ListUp: TMenuItem; MenuItem_Sort: TMenuItem; MenuItem_Sort_FileName: TMenuItem; MenuItem_Sort_Folder: TMenuItem; MenuItem_Sort_Name: TMenuItem; MenuItem_Sort_Ext: TMenuItem; MenuItem_Sort_Line1: TMenuItem; MenuItem_Sort_Shuffle: TMenuItem; MenuItem_Play: TMenuItem; MenuItem_Play_PlayPause: TMenuItem; MenuItem_Play_Stop: TMenuItem; MenuItem_Play_Line1: TMenuItem; MenuItem_Play_Back: TMenuItem; MenuItem_Play_Next: TMenuItem; MenuItem_Play_Line2: TMenuItem; MenuItem_Play_Mute: TMenuItem; MenuItem_Play_Line3: TMenuItem; MenuItem_Opt: TMenuItem; MenuItem_Opt_Random: TMenuItem; MenuItem_Opt_ErrConfirm: TMenuItem; MenuItem_Opt_Line1: TMenuItem; MenuItem_Opt_TaskTray: TMenuItem; MenuItem_Opt_StatusBar: TMenuItem; MenuItem_Opt_Info: TMenuItem; MenuItem_Help: TMenuItem; MenuItem_Help_Help: TMenuItem; MenuItem_Help_VersionInfo: TMenuItem; PopupMenu_Main: TPopupMenu; MenuItem_PFile: TMenuItem; MenuItem_PFile_OpenFile: TMenuItem; MenuItem_PFile_OpenFolder: TMenuItem; MenuItem_PFile_OpenThisFolder: TMenuItem; MenuItem_PFile_Line1: TMenuItem; MenuItem_PVideo_CaptureBitmap: TMenuItem; MenuItem_PDebug_CreateGraphEdit: TMenuItem; MenuItem_PList: TMenuItem; MenuItem_PList_GotoPlaying: TMenuItem; MenuItem_PList_FolderName: TMenuItem; MenuItem_PList_OpenAdd: TMenuItem; MenuItem_PList_Line1: TMenuItem; MenuItem_PList_Clear: TMenuItem; MenuItem_PList_Del: TMenuItem; MenuItem_PList_DeletePlaying: TMenuItem; MenuItem_PList_Line2: TMenuItem; MenuItem_PSort: TMenuItem; MenuItem_PSort_FileName: TMenuItem; MenuItem_PSort_Folder: TMenuItem; MenuItem_PSort_Name: TMenuItem; MenuItem_PSort_Ext: TMenuItem; MenuItem_PSort_Line1: TMenuItem; MenuItem_PSort_Shuffle: TMenuItem; MenuItem_PPlay: TMenuItem; MenuItem_PPlay_PlayPause: TMenuItem; MenuItem_PPlay_Stop: TMenuItem; MenuItem_PPlay_Line1: TMenuItem; MenuItem_PPlay_Back: TMenuItem; MenuItem_PPlay_Next: TMenuItem; MenuItem_PPlay_Line2: TMenuItem; MenuItem_PPlay_Mute: TMenuItem; MenuItem_PPlay_Line_3: TMenuItem; MenuItem_POpt: TMenuItem; MenuItem_POpt_Random: TMenuItem; MenuItem_POpt_ConfirmErr: TMenuItem; MenuItem_POpt_Line1: TMenuItem; MenuItem_POpt_Info: TMenuItem; MenuItem_POpt_TaskTray: TMenuItem; MenuItem_POpt_StatusBar: TMenuItem; MenuItem_PLine1: TMenuItem; MenuItem_PFile_Exit: TMenuItem; PopupMenu_Playlist: TPopupMenu; MenuItem_PPListFolderName: TMenuItem; MenuItem_PPListGotoPlaying: TMenuItem; MenuItem_PPList_Line1: TMenuItem; MenuItem_PPListClear: TMenuItem; MenuItem_PPListDelete: TMenuItem; MenuItem_PPListDeletePlaying: TMenuItem; PopupMenu_Sort: TPopupMenu; MenuItem_PPPSort_FileName: TMenuItem; MenuItem_PPPSort_Folder: TMenuItem; MenuItem_PPPSort_Name: TMenuItem; MenuItem_PPPSort_Ext: TMenuItem; MenuItem_PPPSort_Line1: TMenuItem; MenuItem_PPPSort_Shuffle: TMenuItem; PopupMenu_OpenFile: TPopupMenu; PopupMenu_OpenFolder: TPopupMenu; PopupMenu_OpenThisFolder: TPopupMenu; PopupMenu_SelectMonitor: TPopupMenu; ToolBar_Main: TToolBar; ToolButton_FileOpenFile: TToolButton; ToolButton_FileOpenFolder: TToolButton; ToolButton_FileOpenThisFolder: TToolButton; ToolButton_MainSpc1: TToolButton; ToolButton_List_OpenAdd: TToolButton; ToolButton_MainSpc2: TToolButton; ToolButton_MainSpc3: TToolButton; ToolButton_OptRandom: TToolButton; StatusBar_Hint: TStatusBar; Dialog_OpenFile: TOpenDialog; Dialog_OpenFolder: TMyOpenFolderDialog; Dialog_OpenThisFolder: TMyOpenFolderDialog; ImageList1: TImageList; Timer_Time: TTimer; Timer_GetFile: TTimer; TrayIcon1: TTrayIcon; MyMessagePanel1: TMyMessagePanel; ApplicationEvents1: TApplicationEvents; Action_Video_SelectMonitor_Self: TAction; Action_Find_FindDown: TAction; Action_Find_FindUp: TAction; Action_Find_FindTop: TAction; Action_Opt_ShowHint: TAction; Action_Opt_Info: TAction; __Action_Find: TAction; Action_List_Property: TAction; MenuItem_List_Line3: TMenuItem; MenuItem_List_Property: TMenuItem; MenuItem_PList_Line3: TMenuItem; MenuItem_PList_Property: TMenuItem; MenuItem_Video_SelectMonitor: TMenuItem; MenuItem_PVideo_SelectMonitor: TMenuItem; MenuItem_Video_SelectMonitor_Self: TMenuItem; MenuItem_PVideo_SelectMonitor_Self: TMenuItem; MenuItem_PPVideo_SelectMonitor_Self: TMenuItem; MenuItem_Find_FindUp: TMenuItem; MenuItem_Find_FindDown: TMenuItem; MenuItem_PPSort: TMenuItem; MenuItem_PPFind_FindDown: TMenuItem; MenuItem_PPFind_FindUp: TMenuItem; MenuItem_PPSort_FileName: TMenuItem; MenuItem_PPSort_Folder: TMenuItem; MenuItem_PPSort_Name: TMenuItem; MenuItem_PPSort_Ext: TMenuItem; MenuItem_PPSort_Line1: TMenuItem; MenuItem_PPSort_Shuffle: TMenuItem; MenuItem_PFind_FindDown: TMenuItem; MenuItem_PFind_FindUp: TMenuItem; ToolButton_List_GoToPlaying: TToolButton; ToolButton_List_FolderName: TToolButton; ToolButton_List_Delete: TToolButton; ToolButton_Sort: TToolButton; ToolButton5: TToolButton; Action_Find_ListUp: TAction; PageControl1: TPageControl; TabSheet_Playlist: TTabSheet; Panel_Playlist: TPanel; ListBox_Playlist: TListBox; TabSheet_FindList: TTabSheet; ListBox_FindList: TListBox; MenuItem_PList_ListUp: TMenuItem; TabSheet_History: TTabSheet; ListBox_History: TListBox; MenuItem_PPList_Line3: TMenuItem; MenuItem_PPFind_ListUp: TMenuItem; MenuItem_PPList_Property: TMenuItem; PopupMenu_FindList: TPopupMenu; PopupMenu_History: TPopupMenu; MenuItem_PFFind_FindUp: TMenuItem; MenuItem_PFFind_FindDown: TMenuItem; MenuItem_PFFind_FindTop: TMenuItem; MenuItem_PFFind_Line1: TMenuItem; Action_List_PlayItemIndex: TAction; MenuItem_PFList_GoToPlaylist: TMenuItem; MenuItem_List_GoToPlaylist: TMenuItem; MenuItem_Find_FindTop: TMenuItem; MenuItem_PFSort: TMenuItem; MenuItem_PFSort_Shuffle: TMenuItem; MenuItem_PFSort_Line1: TMenuItem; MenuItem_PFSort_Ext: TMenuItem; MenuItem_PFSort_Name: TMenuItem; MenuItem_PFSort_Folder: TMenuItem; MenuItem_PFSort_FileName: TMenuItem; Action_Find_Clear: TAction; MenuItem_PFFind_Clear: TMenuItem; MenuItem_PFFind_Line3: TMenuItem; MenuItem_PFList_Property: TMenuItem; MenuItem_PFind_FindTop: TMenuItem; Action_Line: TAction; MenuItem_File_Line2: TMenuItem; MenuItem_List_Line2: TMenuItem; MenuItem_PFFind_Line2: TMenuItem; MenuItem_PPList_Line2: TMenuItem; MenuItem_PFList_FolderName: TMenuItem; MenuItem_PHList_PlayItemIndex: TMenuItem; MenuItem_PHList_FolderName: TMenuItem; MenuItem_PHList_Line1: TMenuItem; MenuItem_PHList_Line2: TMenuItem; MenuItem_PHFind_FindDown: TMenuItem; MenuItem_PHFind_FindUp: TMenuItem; MenuItem_PHFind_FindTop: TMenuItem; MenuItem_PHList_Property: TMenuItem; MenuItem_PList_GoToPlaylist: TMenuItem; MenuItem_Find_Clear: TMenuItem; MenuItem_Find: TMenuItem; MenuItem_PFind: TMenuItem; MenuItem_Find_Line2: TMenuItem; MenuItem_Play_Replay: TMenuItem; MenuItem_PPlay_Replay: TMenuItem; MenuItem_PLList_Find: TMenuItem; MenuItem_PPFind_FindTop: TMenuItem; D2: TMenuItem; __Action_View: TAction; Action_View_Playlist: TAction; Action_View_Findlist: TAction; Action_View_History: TAction; MenuItem_View: TMenuItem; MenuItem_View_Playlist: TMenuItem; MenuItem_View_Findlist: TMenuItem; MenuItem_View_History: TMenuItem; MenuItem_PView: TMenuItem; MenuItem_PView_History: TMenuItem; MenuItem_PView_Findlist: TMenuItem; MenuItem_PView_Playlist: TMenuItem; G1: TMenuItem; MenuItem_PHList_Find_Line1: TMenuItem; MenuItem_PHList_Delete: TMenuItem; MenuItem_PPFind_Line1: TMenuItem; MenuItem_PFind_Line1: TMenuItem; MenuItem_PFind_Clear: TMenuItem; Action_Sort_MenuPopup: TAction; TabSheet_VideoWindow: TTabSheet; MenuItem_PFFind: TMenuItem; Action_View_VideoWindow: TAction; MenuItem_View_VideoWindow: TMenuItem; MenuItem_PView_VideoWindow: TMenuItem; MenuItem_PFFind_Find_Line1: TMenuItem; MenuItem_PFFind_ListUp: TMenuItem; Action_Find_Opt_Or: TAction; Action_Find_Opt_Not: TAction; MenuItem_Find_Line3: TMenuItem; MenuItem_Find_FindAnd: TMenuItem; MenuItem_Find_FindNot: TMenuItem; MenuItem_PFind_Line2: TMenuItem; MenuItem_PFind_FindAnd: TMenuItem; MenuItem_PFind_FindNot: TMenuItem; MenuItem_PFFind_Find_Line2: TMenuItem; MenuItem_PFFind_FindAnd: TMenuItem; MenuItem_PFFind_FindNot: TMenuItem; Action_List_DeleteWithPlaylist: TAction; MenuItem_PFList_DeleteWidthPlaylist: TMenuItem; MenuItem_PHList_Line3: TMenuItem; MenuItem_PHFind_Opt_Or: TMenuItem; MenuItem_PHFind_Opt_Not: TMenuItem; MenuItem_List_DeleteWidthPlaylist: TMenuItem; MenuItem_PList_DeleteWidthPlaylist: TMenuItem; PopupMenu_Find_Opt: TPopupMenu; O1: TMenuItem; N3: TMenuItem; Action_Video_Wallvideo: TAction; MenuItem_Video_Wallvideo: TMenuItem; MenuItem_PVideo_Wallvideo: TMenuItem; PopupMenu_Player: TPopupMenu; MenuItem_PPPlay_SelectMonitor: TMenuItem; MenuItem_PPPlay_SelectMonitor_Self: TMenuItem; MenuItem_PPPlay_Wallvideo: TMenuItem; MenuItem_PPVideo_CaptureBitmap: TMenuItem; MenuItem_PPPlay_Line4: TMenuItem; MenuItem_PPList_DeletePlaying: TMenuItem; Action_List_GotoPlaylist: TAction; D1: TMenuItem; MenuItem_PHList_GoToPlaylist: TMenuItem; Action_Video_FitToVideo: TAction; Panel_Info: TPanel; Grid_Info: TStringGrid; Shape_Info_Line: TShape; Image_Info_Thumb: TImage; MenuItem_Video_FitToVideo: TMenuItem; MenuItem_PVideo_FitToVideo: TMenuItem; MenuItem_PPVideo_FitToVideo: TMenuItem; PopupMenu_Info: TPopupMenu; Action_Info_CopyTitle: TAction; Action_Info_CopyArtist: TAction; Action_Info_CopyAlbum: TAction; __Action_Info_Copy: TAction; MenuItem_Info_Copy: TMenuItem; MenuItem_Info_CopyTitle: TMenuItem; MenuItem_Info_CopyArtist: TMenuItem; MenuItem_Info_CopyAlbum: TMenuItem; MenuItem_PInfo_Copy: TMenuItem; MenuItem_PInfo_CopyAlbum: TMenuItem; MenuItem_PInfo_CopyArtist: TMenuItem; MenuItem_PInfo_CopyTitle: TMenuItem; MenuItem_PIInfo_CopyAlbum: TMenuItem; MenuItem_PIInfo_CopyArtist: TMenuItem; MenuItem_PIInfo_CopyTitle: TMenuItem; Action_Video_FullScreen: TAction; Action_Video_ZoomUp: TAction; Action_Video_ZoomDown: TAction; Action_Video_Magni: TAction; Action_Video_Zoom100: TAction; Panel_VideoBase: TPanel; Panel_VideoWindow: TPanel; ToolButton_Video_Wallvideo: TToolButton; __Action_Video: TAction; __Action_File: TAction; __Action_List: TAction; __Action_Play: TAction; __Action_Opt: TAction; __Action_Help: TAction; V1: TMenuItem; V2: TMenuItem; MenuItem_Video_Line1: TMenuItem; MenuItem_Video_Line2: TMenuItem; MenuItem_Video_Magni: TMenuItem; MenuItem_Video_ZoomUp: TMenuItem; MenuItem_Video_ZoomDown: TMenuItem; MenuItem_Video_Zoom100: TMenuItem; MenuItem_PPPlay_Line1: TMenuItem; MenuItem_PPVideo_Line1: TMenuItem; MenuItem_PPPlay_Magni: TMenuItem; MenuItem_PPPlay_ZoomUp: TMenuItem; MenuItem_PPPlay_ZoomDown: TMenuItem; MenuItem_PPPlay_Zoom100: TMenuItem; Action_Video_WindowVideo: TAction; Panel_Bottom: TPanel; Shape1: TShape; Panel_Control: TPanel; Label_Time: TLabel; Label_Info: TMyLabel; ToolBar_Control: TToolBar; ToolButton_PlayPlayPause: TToolButton; ToolButton_PlayReplay: TToolButton; ToolButton_PlayBack: TToolButton; ToolButton_PlayNext: TToolButton; ToolButton_PlayStop: TToolButton; ToolButton_Control_Spc1: TToolButton; ToolButton_PlayMute: TToolButton; TrackBar_Seek: TMyTrackBar; TrackBar_Volume: TMyTrackBar; Action_Find_Disp: TAction; F1: TMenuItem; N9: TMenuItem; Panel_Find_Playlist: TPanel; ToolBar_Find: TToolBar; Label_Find: TMyLabel; Panel_Find: TPanel; ComboBox_Find_Text: TComboBox; ToolButton18: TToolButton; ToolButton19: TToolButton; ToolButton2: TToolButton; ToolButton20: TToolButton; Panel_Find_Findlist: TPanel; Panel_Find_History: TPanel; ToolButton3: TToolButton; Panel_Find_Opt: TPanel; CheckBox1: TCheckBox; CheckBox2: TCheckBox; ToolButton4: TToolButton; _Action_Sort: TAction; Action_File_OpenMediaFolder: TAction; L1: TMenuItem; L2: TMenuItem; L3: TMenuItem; L4: TMenuItem; MenuItem_PHList_Find: TMenuItem; MenuItem_PHList_ClearHistory: TMenuItem; Action_List_ClearHistory: TAction; ToolButton1: TToolButton; ToolButton6: TToolButton; ToolButton7: TToolButton; N10: TMenuItem; M3: TMenuItem; U3: TMenuItem; D6: TMenuItem; N12: TMenuItem; N13: TMenuItem; Action_Opt_UseFfdShow: TAction; ffdshowF1: TMenuItem; ffdshowF2: TMenuItem; G2: TMenuItem; G3: TMenuItem; Timer_IsPlay: TTimer; Action_List_DeletePlaylist_Findlist: TAction; Action_List_DeletePlaylist_NotSelected: TAction; Action_Video_Floating: TAction; MenuItem_PPVideo_Floating: TMenuItem; MenuItem_PPFind_Line2: TMenuItem; MenuItem_PPFind_Opt_Or: TMenuItem; MenuItem_PPFind_Opt_Not: TMenuItem; procedure Action_File_OpenFileExecute (Sender: TObject); procedure Action_File_OpenFolderExecute (Sender: TObject); procedure Action_File_OpenThisFolderExecute (Sender: TObject); procedure Action_File_OpenMediaFolderExecute (Sender: TObject); procedure Action_File_ExitExecute (Sender: TObject); procedure Action_List_DeletePlayingExecute (Sender: TObject); procedure Action_List_DeleteExecute (Sender: TObject); procedure Action_List_ClearExecute (Sender: TObject); procedure Action_List_OpenAddExecute (Sender: TObject); procedure Action_List_GotoPlayingExecute (Sender: TObject); procedure Action_List_FolderNameExecute (Sender: TObject); procedure Action_List_PropertyExecute (Sender: TObject); procedure Action_List_PlayItemIndexExecute (Sender: TObject); procedure Action_List_ClearFindlistExecute (Sender: TObject); procedure Action_Sort_FileNameExecute (Sender: TObject); procedure Action_Sort_MenuPopupExecute (Sender: TObject); procedure Action_Find_FindDownExecute (Sender: TObject); procedure Action_Find_ClearExecute (Sender: TObject); procedure Action_Find_DispExecute (Sender: TObject); procedure Action_Find_ListUpExecute (Sender: TObject); procedure Action_Play_PlayExecute (Sender: TObject); procedure Action_Play_PauseExecute (Sender: TObject); procedure Action_Play_PlayPauseExecute (Sender: TObject); procedure Action_Play_ReplayExecute (Sender: TObject); procedure Action_Play_StopExecute (Sender: TObject); procedure Action_Play_NextExecute (Sender: TObject); procedure Action_Play_SkipBackExecute (Sender: TObject); procedure Action_Play_MuteExecute (Sender: TObject); procedure Action_Video_SelectMonitor_SelfExecute(Sender: TObject); procedure Action_Video_CaptureBitmapExecute (Sender: TObject); procedure Action_Video_WallvideoExecute (Sender: TObject); procedure Action_Video_FullScreenExecute (Sender: TObject); procedure Action_Video_FitToVideoExecute (Sender: TObject); procedure Action_Video_ZoomUpExecute (Sender: TObject); procedure Action_Video_Zoom100Execute (Sender: TObject); procedure Action_Video_MagniExecute (Sender: TObject); procedure Action_Info_CopyTitleExecute (Sender: TObject); procedure Action_View_PlaylistExecute (Sender: TObject); procedure Action_Opt_TaskTrayExecute (Sender: TObject); procedure Action_Opt_StatusBarExecute (Sender: TObject); procedure Action_Opt_InfoExecute (Sender: TObject); procedure Action_Help_HelpExecute (Sender: TObject); procedure Action_Help_VersionInfoExecute (Sender: TObject); procedure Action_Debug_CreateGrfFileExecute (Sender: TObject); procedure actNop(Sender: TObject); procedure PopupMenu_MainPopup(Sender: TObject); procedure PopupMenu_InfoPopup(Sender: TObject); procedure MenuItem_OpenHistoryClick(Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormResize (Sender: TObject); procedure FormKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure ListBox_PlaylistClick (Sender: TObject); procedure ListBox_PlaylistDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ListBox_PlaylistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListBox_PlaylistMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ListBox_FindListDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ListBox_FindListDblClick (Sender: TObject); procedure ComboBox_Find_TextChange(Sender: TObject); procedure ComboBox_Find_TextSelect(Sender: TObject); procedure PageControl1Change(Sender: TObject); procedure Panel_VideoWindowClick (Sender: TObject); procedure Panel_VideoWindowDblClick (Sender: TObject); procedure Panel_VideoWindowMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Panel_VideoWindowResize (Sender: TObject); //ツールボタンのドロップダウンでチェックボタンのシミュレート // procedure ToolButton_Video_WallvideoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // procedure ToolButton_Video_WallvideoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // procedure WMApp(var Msg: TMessage); message WM_APP; procedure TrackBar_SeekMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TrackBar_SeekMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure TrackBar_SeekMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TrackBar_VolumeMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Grid_InfoDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure TrayIcon1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Timer_TimeTimer (Sender: TObject); procedure Timer_GetFileTimer(Sender: TObject); procedure Timer_IsPlayTimer(Sender: TObject); procedure MyMessagePanel1TextChange (Sender: TObject; Text: String); procedure ApplicationEvents1Message (var Msg: tagMSG; var Handled: Boolean); procedure ApplicationEvents1Minimize(Sender: TObject); procedure Action_Opt_RandomExecute(Sender: TObject); procedure Action_Video_FloatingExecute(Sender: TObject); private { Private 宣言 } FGraphBuilder : IGraphBuilder; FOverlayMixer : IBaseFilter; FVideoDecoder : IBaseFilter; FVideoRenderer : IBaseFilter; FAudioRenderer : IBaseFilter; FMediaEventEx : IMediaEventEx; FMediaPosition : IMediaPosition; FfDuration : TRefTime; FiVideoWidth : Integer; FiVideoHeight : Integer; FfVideoFrameRate : Extended; FiWallVideoWidth : Integer; FiWallVideoHeight : Integer; FsFileName : WideString; //マウスジェスチャー用 FptMouseGesture : TPoint; FptDragMove : TPoint; // FPlaylist : TMyWStrings; FPlaylist : TMyMediaStrings; FFindList : TMyWStrings; FHistoryList : TMyWStrings; FiItemIndex : Integer; //現在再生中のリストのインデックス FDisallowExts : TMyWStrings; FiUniquID : Integer; //ファイル取得時の表示用 FiGetFileCount : Integer; //取得したファイル数 FsGetFileName : WideString; //取得したファイル名 //レジューム用 FiResumeIndex : Integer; FfResumePos : TRefTime; FbWallvideo : Boolean; FbPaused : Boolean; FsPlaylistFileName : WideString; FsFindlistFileName : WideString; FsHistoryFileName : WideString; FiPlay_MuteImageIndex : Integer; FiList_OpenAddImageIndex : Integer; FiOpt_RandomImageIndex : Integer; { FsMediaAlbum : String; FsMediaArtist : String; FsMediaTitle : String; } //メディア情報用 FbInfoPlaying : Boolean; //再生開始時に再生しているメディアに移動して情報を表示するか //ソート用 FiSort : Integer; //検索用 FFindTextList : TStringList; FiFind_PlaylistIndex : Integer; FiFind_FindlistIndex : Integer; FiFind_HistoryIndex : Integer; //フォーカスが奪われてしまうのを防ぐため FhSubPlayerMsgHwnd : HWND; FhSubPlayerHwnd : HWND; //任意のモニターに表示させるため FiMonitorMenuIndex : Integer; //タスクバーのメニュー FTaskBarMenu : TMyTaskBarMenu; FbMediaEnded : Boolean; FbPassClockChanged : Boolean; FbStart : Boolean; //再生イベント通知のためのメッセージ番号を受け取れるようにする procedure WMGraphNotify(var Msg: TMessage); message WM_GRAPH_NOTIFY; //ディスプレイ設定の変更 procedure WMDisplayChange(var Msg: TMessage); message WM_DISPLAYCHANGE; function FGetMonitorIndex: Integer; procedure FSetMonitor(Sender: TObject); procedure FCreateMonitorMenu; //ドラッグアンドドロップ procedure WMDropFiles (var Msg: TWMDropFiles); message WM_DROPFILES; procedure WMPowerBroadcast (var Msg: TMessage); message WM_POWERBROADCAST; procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; //開く用 // procedure FOpen(sFileName: String); procedure FOpen(iIndex: Integer); procedure FClose(bClearIndex: Boolean); procedure FAddList(AList: TStrings; bSort: Boolean = True); procedure FAddOpenHistory(AMenuItem: TMenuItem; AList: TMyWStrings); overload; procedure FAddOpenHistory(AMenuItem: TMenuItem; AList: TStrings); overload; procedure FAddOpenHistory(AMenuItem: TMenuItem; sFileName: String); overload; procedure FBeginFunc; procedure FEndFunc(bResetCount: Boolean = True); //再生用 procedure FSeek(fPos: TRefTime); function FGetFrameRateString(fFrame: TRefTime): String; function FMediaHasVideo : Boolean; procedure FSetVolume(iVolume : LongInt); procedure FadeIn; procedure FadeOut; procedure DoMediaStarted; procedure DoMediaEnded; procedure FSetCaption; procedure FDispCount(iCount: Integer; sFileName: String); function FGetListObject(sFileName : WideString; AFindData : TWin32FindDataW) : TObject; procedure FSetInfoLabelCaption; //バイナリのリストファイル用 procedure FLoadList(AList: TMyWStrings; sFileName: WideString); procedure FSaveList(AList: TMyWStrings; sFileName: WideString); //設定ファイル用 function FLoadIni : Boolean; procedure FSaveIni; //サブフォーム作成 procedure FCreateSubForm; function FSubFormExists: Boolean; //レジューム用 procedure FSetResume; //リセットカウント procedure ResetCount; procedure ResetFindlistCount; procedure ResetHistoryCount; procedure FRefreshList; procedure FResetPlaylistIndex; procedure FAddHistoryList(sFileName: WideString); procedure FAdjustVideoWindow; procedure FClearInfo; procedure FDeleteItem(AStrings: TMyWStrings; iIndex: Integer); procedure FDispInfo(AStrings: TMyWStrings; iIndex: Integer); procedure FDragMoveInit; procedure FGetDispList(var AListBox: TListBox; var AStrings: TMyWStrings); overload; function FGetListTitle: String; function FGetPlaylistIndex(iUniquID: Integer): Integer; function FGetPlayState: TFilterState; function FIsDragMove: Boolean; function FIsFindlistPage: Boolean; function FIsPlaylistPage: Boolean; function FIsHistoryPage: Boolean; function FIsVideoWindowPage: Boolean; procedure FChangeTab(ATabSheet: TTabSheet); function FIsWallvideo: Boolean; protected procedure WndProc(var Msg: TMessage); override; public { Public 宣言 } //情報表示 procedure SetInfo (Sender: T_MyInfoGet; iIndex: Integer; AMediaInfo: T_MyMediaInfo); procedure SetInfo2(Sender: T_MyInfoGet; iIndex: Integer; AMediaInfo: T_MyMediaInfo); procedure SetInfo3(Sender: T_MyInfoGet; iIndex: Integer; AMediaInfo: T_MyMediaInfo); end; var App_Wallvideo : TApp_Wallvideo; G_InfoForm : TApp_Wallvideo; implementation uses {$IFDEF _DEBUG} myDebug, myDebugDShow, {$ENDIF} ActiveX, CommCtrl, myApp, {$IFDEF CAPTURE_BITMAP} myBmpCaptureEx, {$ENDIF} myClipbrd, myControl, myDragAndDrop, myDShow, myDShowType, myFile, myFileDialog, myFileStrings, myFind, myGraphic, myGrid, myHelpVersionInfo, myIniFile, myListBox, myMenu, // myMessageBox, myMessageDlg, myMonitor, myNum, myParam, myShortCut, mySize, myString, myWallvideo, myWindow, // general, sub; {$R *.dfm} //------------------------------------------------------------------------------ const F_csATOM_DOFUNCTION = 'atom_beginfunc_wallvideo'; //何らかの処理を行っている最中にフォームの操作を行って欲しくない場合にカウンターとしてATOMを使う時の文字列 const F_ciTRACKPOS = 10; //10倍。0.1秒毎に移動可能。 const F_ciMARGIN = 2; const F_ciCOL_ITEM = 0; F_ciCOL_VALUE = 1; F_ciROW_TITLE = 0; F_ciROW_ARTIST = 1; F_ciROW_ALBUM = 2; F_ciROW_FILEINFO = 3; const F_csRESUME_EXT = '.playlist'; F_csFIND_EXT = '.find'; F_csHISTORY_EXT = '.history'; const F_ciMONITORSELECT_MENUDEFCOUNT = 1; F_ciMONITORSELECT_SELFWINDOW = 0; // F_ciMONITORSELECT_DESKTOP = 1; procedure TApp_Wallvideo.FBeginFunc; begin Screen.Cursor := crHourGlass; AddAtom(F_csATOM_DOFUNCTION); //操作を無効にする // ActionList1.State := asSuspended; //Actionが外れはしないが反映されなくなる Self.Enabled := False; DragAcceptFiles(Self.Handle, Self.Enabled); end; procedure TApp_Wallvideo.FEndFunc(bResetCount: Boolean); var l_Atom : ATOM; begin //Atomがあるか確認 l_Atom := FindAtom(F_csATOM_DOFUNCTION); if (l_Atom = 0) then begin //なかった //通常はあるはずなのでないということはどこかで間違っている {$IFDEF _DEBUG} gpcShowMessage('プログラムエラー'#13'FBeginFuncとFEndFuncが対で呼ばれていない'); {$ENDIF} end else begin //あった DeleteAtom(l_Atom); l_Atom := FindAtom(F_csATOM_DOFUNCTION); end; if (l_Atom = 0) then begin //操作を無効にしていたのを戻す // ActionList1.State := asNormal; Self.Enabled := True; DragAcceptFiles(Self.Handle, Self.Enabled); if (bResetCount) then begin ResetCount; end; Screen.Cursor := crDefault; end; end; procedure TApp_Wallvideo.FResetPlaylistIndex; var i : Integer; begin for i := 0 to FPlaylist.Count -1 do begin if (Assigned(FPlaylist.Objects[i])) then begin T_MyMediaInfo(FPlaylist.Objects[i]).PlaylistIndex := i; end; end; end; procedure TApp_Wallvideo.ResetFindlistCount; begin ListBox_Findlist.Count := FFindList.Count; ListBox_Findlist.Refresh; end; procedure TApp_Wallvideo.ResetHistoryCount; begin ListBox_History.Count := FHistoryList.Count; ListBox_History.Refresh; end; procedure TApp_Wallvideo.ResetCount; var li_TopIndex : Integer; begin FResetPlaylistIndex; li_TopIndex := ListBox_PlayList.TopIndex; ListBox_PlayList.Count := FPlaylist.Count; li_TopIndex := gfniNumLimit(li_TopIndex, 0, ListBox_PlayList.Count); ListBox_PlayList.TopIndex := li_TopIndex; ListBox_PlayList.Refresh; if (FPlaylist.Count = 0) then begin FClearInfo; end; ResetFindlistCount; ResetHistoryCount; PopupMenu_MainPopup(nil); end; function _GetIniDir: String; begin Result := gfnsMyVideoPathGet; if (Result = '') then begin Result := gfnsMyMusicPathGet; end; if (Result = '') then begin Result := gfnsMyDocumentsPathGet; end; end; procedure TApp_Wallvideo.ApplicationEvents1Minimize(Sender: TObject); begin if (Action_Opt_TaskTray.Checked) then begin ShowWindow(Application.Handle, SW_HIDE); end; end; function SaveGraphFile(pGraph: IGraphBuilder; wszPath: WideString): HRESULT; const IID_IPersistStream : TGUID = '{00000109-0000-0000-C000-000000000046}'; const wszStreamName: WideString = 'ActiveMovieGraph'; var Storage: IStorage; Stream: IStream; Persist: IPersistStream; begin Result := StgCreateDocfile( PWideChar(wszPath), STGM_CREATE or STGM_TRANSACTED or STGM_READWRITE or STGM_SHARE_EXCLUSIVE, 0, Storage ); if (FAILED(Result)) then begin Exit; end; Result := Storage.CreateStream( PWideChar(wszStreamName), STGM_WRITE or STGM_CREATE or STGM_SHARE_EXCLUSIVE, 0, 0, Stream ); if (FAILED(Result)) then begin Exit; end; pGraph.QueryInterface(IID_IPersistStream, Persist); Result := Persist.Save(Stream, True); Stream := nil; Persist := nil; if (SUCCEEDED(Result)) then begin Result := Storage.Commit(STGC_DEFAULT); end; Storage := nil; end; procedure TApp_Wallvideo.Action_Debug_CreateGrfFileExecute(Sender: TObject); begin SaveGraphFile(FGraphBuilder, Application.ExeName + '.grf'); end; procedure TApp_Wallvideo.WMPowerBroadcast(var Msg: TMessage); var ls_Msg : String; li_Index : Integer; begin Exit; //myDebug.gpcDebug(Msg.WParam); case (Msg.WParam) of { PBT_APMQUERYSUSPEND, PBT_APMQUERYSTANDBY :begin end; } PBT_APMSUSPEND, PBT_APMSTANDBY :begin //停止する FSetResume; FClose(False); if (Action_Video_Wallvideo.Checked) then begin gpcWallVideoFree; end; end; // PBT_APMRESUMESUSPEND, PBT_APMRESUMEAUTOMATIC :begin li_Index := FiResumeIndex; if (FbWallvideo) and (FiResumeIndex >= 0) then begin FiResumeIndex := -1; ls_Msg := '壁紙ビデオを再開しますか'#13#13 + '「はい」で壁紙ビデオを再開します'#13 + '「いいえ」でウィンドウモードで再開します'#13 + '「キャンセル」で停止します' ; case (gfniMessageBoxYesNoCancel(ls_Msg)) of ID_YES :begin //壁紙ビデオモードで再開 end; ID_NO :begin //ウィンドウモードで再開させる Action_Video_Wallvideo.Checked := False; end; ID_CANCEL :begin //中断 Exit; end; end; end; FOpen(li_Index); end; end; end; procedure TApp_Wallvideo.WMQueryEndSession(var Msg: TWMQueryEndSession); //http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm begin // Close; FormDestroy(Self); Msg.Result := 1; end; //------------------------------------------------------------------------------ procedure TApp_Wallvideo.FormCreate(Sender: TObject); var lb_Loaded : Boolean; l_List : TMyWStrings; begin {$IFDEF _DEBUG} myDebug.gpcMessageModeSet(True); myDebugDShow.gpcDShowMessageModeSet(True); {$ENDIF} {$IFDEF DEBUG} Action_Debug_CreateGrfFile.Visible := True; Action_Opt_UseFfdshow.Visible := True; {$ENDIF} {$IFDEF CAPTURE_BITMAP} Action_Video_CaptureBitmap.Visible := ParamW.OptionExists('b'); // Action_Video_CaptureBitmap.Visible := True; {$ELSE} Action_Video_CaptureBitmap.Visible := False; {$ENDIF} FBeginFunc; try G_InfoForm := Self; with Grid_Info do begin Cells[F_ciCOL_ITEM, F_ciROW_TITLE] := 'タイトル'; Cells[F_ciCOL_ITEM, F_ciROW_ARTIST] := 'アーティスト'; Cells[F_ciCOL_ITEM, F_ciROW_ALBUM] := 'アルバム'; Cells[F_ciCOL_ITEM, F_ciROW_FILEINFO] := 'ファイル情報'; ColWidths[F_ciCOL_ITEM] := gfniGridCanvasTextWidth(Grid_Info, Cells[F_ciCOL_ITEM, F_ciROW_FILEINFO]) + (F_ciMARGIN * 2); // Grid_Info.Height := (DefaultRowHeight * RowCount) + (GridLineWidth * (RowCount +1)); // Panel_Info.Height := Grid_Info.Height + Shape_Playlist_Line.Height; end; FPlaylist := TMyMediaStrings.Create; FPlaylist.ObjectsFree := True; FDragMoveInit; FptMouseGesture := Point(MAXINT, MAXINT); //検索用 FiFind_PlaylistIndex := 0; FiFind_FindlistIndex := 0; FiFind_HistoryIndex := 0; FFindTextList := TStringList.Create; FFindList := TMyWStrings.Create; // FFindList.ObjectsFree := True; FFindList.ObjectsFree := False; FHistoryList := TMyWStrings.Create; FHistoryList.ObjectsFree := True; Self.Icon := Application.Icon; TrayIcon1.Icon := Self.Icon; TrayIcon1.Hint := Self.Caption; TrackBar_Seek.Frequency := TrackBar_Seek.Frequency * F_ciTRACKPOS; FiResumeIndex := -1; FfResumePos := 0; FiPlay_MuteImageIndex := Action_Play_Mute.ImageIndex; FiList_OpenAddImageIndex := Action_List_OpenAdd.ImageIndex; FiOpt_RandomImageIndex := Action_Opt_Random.ImageIndex; Shape_Info_Line.Visible := (PageControl1.Style <> tsTabs); // Shape_Info_Line.Visible := False; PageControl1.Align := alClient; Panel_Playlist.Align := alClient; ListBox_Playlist.Align := alClient; ListBox_FindList.Align := alClient; ListBox_History.Align := alClient; Panel_VideoBase.Color := gfniOverlayColorGet; Panel_VideoWindow.Color := gfniOverlayColorGet; // Panel_VideoWindow.Align := alClient; Panel_Find_Playlist.Height := ToolBar_Find.Height; Panel_Find_Findlist.Height := Panel_Find_Playlist.Height; Panel_Find_History.Height := Panel_Find_Playlist.Height; PageControl1.ActivePage := TabSheet_Playlist; // FChangeTab(TabSheet_Playlist); NG 余計なFDispInfoが呼ばれてしまう FClose(True); FDisallowExts := TMyWStrings.Create; with FDisallowExts do begin //HTML Add('.css'); Add('.js'); Add('.htm'); Add('.html'); Add('.xml'); //Help Add('.chm'); Add('.h1?'); Add('.hlp'); //テキスト Add('.doc'); Add('.ini'); Add('.log'); Add('.txt'); //画像 Add('.bmp'); Add('.cur'); Add('.gif'); Add('.jpg'); Add('.jpeg'); Add('.ico'); Add('.png'); //データ Add('.bin'); Add('.dat'); Add('.db'); Add('.sys'); //実行ファイル Add('.bat'); Add('.cmd'); Add('.com'); Add('.dll'); Add('.exe'); Add('.ocx'); Add('.pif'); Add('.scr'); Add('.vbx'); Add('.tvpid'); end; FTaskBarMenu := TMyTaskBarMenu.Create( PopupMenu_Main ); //FiMonitorIndexとFCreateMonitorMneu、FSetMonitorの位置はこの位置である必要あり FiMonitorMenuIndex := 0; lb_Loaded := FLoadIni; //Exit; FCreateMonitorMenu; FSetMonitor(PopupMenu_SelectMonitor.Items[FiMonitorMenuIndex]); Action_Opt_InfoExecute(nil); Action_Opt_StatusBarExecute(nil); Action_Play_MuteExecute(nil); Self.Tag := 1; FormResize(nil); Show; //Shiftキーを押しながら起動しても前面に表示するように // SetWindowPos(Self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); // SetWindowPos(Self.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); SetWindowPos(Self.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); Windows.SetFocus(ListBox_Playlist.Handle); Self.Repaint; //レジューム FsPlaylistFileName := gfnsFileExtChange(gfnsExeNameGet, F_csRESUME_EXT); FsFindlistFileName := gfnsFileExtChange(gfnsExeNameGet, F_csFIND_EXT); FsHistoryFileName := gfnsFileExtChange(gfnsExeNameGet, F_csHISTORY_EXT); if (lb_Loaded) then begin //あらかじめ履歴リストを読み込んでおく if (gfnbFileExists(FsHistoryFileName)) then begin FLoadList(FHistoryList, FsHistoryFileName); end; if (gfnbFileExists(FsPlaylistFileName)) then begin l_List := nil; try l_List := TMyWStrings.Create; l_List.LoadFromFile(FsPlaylistFileName); if (l_List.Count > 0) then begin FAddList(l_List.UStrings, False); end; finally l_List.Free; end; end; //再生リストを読み込む前に読み込むと消去される場合があるためこの位置 if (gfnbFileExists(FsFindlistFileName)) then begin FLoadList(FFindList, FsFindlistFileName); ResetFindlistCount; end; end; FiResumeIndex := -1; finally FEndFunc(False); end; end; procedure TApp_Wallvideo.FormDestroy(Sender: TObject); begin if (Self.Tag = 0) then begin Exit; end; Self.Tag := 0; FadeOut; Action_Play_PauseExecute(nil); gpcWallVideoFree; FSaveIni; FFindTextList.Free; FDisallowExts.Free; FClose(True); FreeAndNil(FTaskBarMenu); FPlaylist.Free; FHistoryList.Free; Action_List_ClearFindlistExecute(nil); FFindList.Free; end; procedure TApp_Wallvideo.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin //メディアプレーヤーの専用キーに対応 //専用キーはグローバル if (Action_Play_PlayPause.Tag = 0) then begin case Key of 176..179 :begin Action_Play_PlayPause.Tag := 1; case (Key) of 179: begin Action_Play_PlayPauseExecute(nil); end; 178: begin Action_Play_StopExecute(nil); end; 177: Action_Play_NextExecute(Action_Play_Back); 176: Action_Play_NextExecute(Action_Play_Next); end; Key := 0; end; end; end; end; procedure TApp_Wallvideo.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var l_WinControl : TWinControl; l_SkipAction : TAction; l_ZoomAction : TAction; begin l_WinControl := Screen.ActiveControl; if (l_WinControl = ComboBox_Find_Text) then begin Exit; end; if (gfnbKeyState(VK_RBUTTON)) then begin if (WheelDelta < 0) then begin l_SkipAction := Action_Play_SkipNext; end else begin l_SkipAction := Action_Play_SkipBack; end; Action_Play_SkipBackExecute(l_SkipAction); Handled := True; end else if (FIsVideoWindowPage) then begin if not(Action_Video_Wallvideo.Checked) and (Action_Video_Magni.Checked) then begin if (WheelDelta < 0) then begin l_ZoomAction := Action_Video_ZoomDown; end else begin l_ZoomAction := Action_Video_ZoomUp; end; Action_Video_ZoomUpExecute(l_ZoomAction); end; end; if (l_WinControl = ListBox_Playlist) or (l_WinControl = ListBox_FindList) or (l_WinControl = ListBox_History) then begin end else begin Handled := True; end; end; procedure TApp_Wallvideo.FormResize(Sender: TObject); var li_ClientWidth : Integer; li_ClientHeight : Integer; li_Left : Integer; li_Top : Integer; li_Width : Integer; li_Height : Integer; begin if (Self.Tag = 0) // and (Sender <> nil) then begin Exit; end; { if (Assigned(FGraphBuilder)) and (FMediaHasVideo) and (FOverlayMixer = nil) // and not(Action_Video_Magni.Checked) then begin } if (Sender <> nil) and (Action_Video_Magni.Checked) then begin Exit; end; li_ClientWidth := Panel_VideoBase.ClientWidth; li_ClientHeight := Panel_VideoBase.ClientHeight; li_Width := li_ClientWidth; li_Height := gfniMediaHeightFromWidth(li_Width, FiVideoWidth, FiVideoHeight); if (li_Height > li_ClientHeight) then begin li_Height := li_ClientHeight; li_Width := gfniMediaWidthFromHeight(li_Height, FiVideoWidth, FiVideoHeight); end; li_Left := (li_ClientWidth - li_Width) div 2; li_Top := (li_ClientHeight - li_Height) div 2; Panel_VideoWindow.SetBounds(li_Left, li_Top, li_Width, li_Height); // end; //lciCOL_PATHとlciCOL_NAMEは使わず直接1や2を指定すること Grid_Info.ColWidths[1] := gfniGridCellWidthsGet(Grid_Info) - Grid_Info.ColWidths[0]; end; function TApp_Wallvideo.FGetMonitorIndex: Integer; { FiMonitorMenuIndexは選択するモニターのインデックス+1 0はフォームのあるモニター メニューアイテムのMenuIndexに同じ } begin if (FiMonitorMenuIndex <= 0) then begin Result := gfniMonitorIndexGet(Self.Handle); end else if (FiMonitorMenuIndex > Screen.MonitorCount) //モニターの数より多い then begin Result := 0; end else begin Result := FiMonitorMenuIndex - F_ciMONITORSELECT_MENUDEFCOUNT; end; end; procedure TApp_Wallvideo.FSetMonitor(Sender: TObject); var l_MenuItem : TMenuItem; l_Action : TAction; l_Monitor : TMonitor; l_VideoWindow : IVideoWindow; li_Left : Integer; li_Top : Integer; // li_Width : Integer; // li_Height : Integer; begin // if not(Sender is TMenuItem) and (Sender <> nil) then begin Exit; end; if (Sender = nil) then begin FiMonitorMenuIndex := F_ciMONITORSELECT_SELFWINDOW; l_MenuItem := PopupMenu_SelectMonitor.Items[FiMonitorMenuIndex]; end else begin l_MenuItem := TMenuItem(Sender); FiMonitorMenuIndex := l_MenuItem.MenuIndex; end; l_Action := TAction(l_MenuItem.Action); if (l_Action <> nil) then begin l_Action.Checked := True; end else begin //AIU ここにくることはないはず l_MenuItem.Checked := True; end; if not(FIsWallvideo) then begin Exit; end; l_Monitor := Screen.Monitors[FGetMonitorIndex]; //壁紙ビデオ gpcSetBounds(FhSubPlayerHwnd, l_Monitor.BoundsRect.Left, l_Monitor.BoundsRect.Top, 0, 0); myGraphic.gpcMaxVideoSizeCalc(Rect(0, 0, FiVideoWidth, FiVideoHeight), l_Monitor.Width, l_Monitor.Height, li_Left, li_Top, FiWallVideoWidth, FiWallVideoHeight); if (Assigned(FGraphBuilder)) then begin try FGraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow); if (l_VideoWindow <> nil) then begin l_VideoWindow.SetWindowPosition(li_Left, li_Top, FiWallVideoWidth, FiWallVideoHeight); end; finally l_VideoWindow := nil; end; end; if (Assigned(FOverlayMixer)) then begin //壁紙ビデオ用にデスクトップの背景を設定 myWallvideo.gpcWallVideoInit(FGetMonitorIndex, gfniOverlayColorGet); end else begin //壁紙ビデオ用のデスクトップの背景を元に戻す myWallvideo.gpcWallVideoFree; end; end; procedure TApp_Wallvideo.Action_Video_SelectMonitor_SelfExecute(Sender: TObject); begin if not(Sender is TAction) then begin Exit; end; FSetMonitor(PopupMenu_SelectMonitor.Items[TAction(Sender).Tag]); end; procedure TApp_Wallvideo.Action_View_PlaylistExecute(Sender: TObject); begin if (Sender = Action_View_Findlist) then begin FChangeTab(TabSheet_Findlist); end else if (Sender = Action_View_History) then begin FChangeTab(TabSheet_History); end else if (Sender = Action_View_VideoWindow) then begin FChangeTab(TabSheet_VideoWindow); end else begin FChangeTab(TabSheet_Playlist); end; end; procedure TApp_Wallvideo.FCreateMonitorMenu; procedure _CreateMenu(AMenuItem: TMenuItem); var i : Integer; l_Monitor : TMonitor; ls_Caption : String; ls_Name : String; l_MenuItem : TMenuItem; ls_ActionName : String; l_Action : TAction; l_Component : TComponent; begin gpcMenuItemFree(AMenuItem, F_ciMONITORSELECT_MENUDEFCOUNT); for i := 0 to Screen.MonitorCount -1 do begin l_Monitor := Screen.Monitors[i]; ls_Caption := Format('モニター(&%d) [%d,%d %dx%d]', [ l_Monitor.MonitorNum +1, l_Monitor.BoundsRect.Left, l_Monitor.BoundsRect.Top, l_Monitor.Width, l_Monitor.Height ]); l_Action := nil; ls_ActionName := Format('Action_Video_SelectMonitor_%d', [i]); if (gfnbIsComponentNameUsed(ls_ActionName)) then begin //Actionが存在する l_Component := gfnComponentGet(ls_ActionName, ActionList1); if (l_Component is TAction) then begin l_Action := TAction(l_Component); end else begin {$IFDEF _DEBUG} gpcShowMessage('Error: Action不在'); {$ENDIF} end; end else begin l_Action := TAction.Create(ActionList1); l_Action.Name := ls_ActionName; l_Action.ActionList := ActionList1; l_Action.Caption := ls_Caption; l_Action.GroupIndex := 1; l_Action.Tag := i + F_ciMONITORSELECT_MENUDEFCOUNT; l_Action.Checked := l_Action.Tag = FiMonitorMenuIndex; l_Action.OnExecute := Action_Video_SelectMonitor_Self.OnExecute; end; //空いているMenuItemのNameを取得する ls_Name := gfnsAvailableName('MenuItem_SelectMonitor'); l_MenuItem := NewItem( ls_Caption, //Caption 0, //ショートカット False, //Checked True, //Enabled FSetMonitor, //OnClick 0, //ヘルプ ls_Name //Name ); l_MenuItem.RadioItem := True; l_MenuItem.GroupIndex := 1; l_MenuItem.Action := l_Action; AMenuItem.Add(l_MenuItem); end; end; begin //モニター選択メニューの構築 _CreateMenu(PopupMenu_SelectMonitor.Items); _CreateMenu(MenuItem_Video_SelectMonitor); _CreateMenu(MenuItem_PVideo_SelectMonitor); _CreateMenu(MenuItem_PPPlay_SelectMonitor); end; procedure TApp_Wallvideo.WMDisplayChange(var Msg: TMessage); //TScreenのMonitorsプロパティがディスプレイの変更に追随しない不具合の回避のため。 begin Self.Monitor; FCreateMonitorMenu; FSetMonitor(nil); end; procedure TApp_Wallvideo.Action_Video_FullScreenExecute(Sender: TObject); begin // Action_Video_FullScreen.Checked := not(Action_Video_FullScreen.Checked); FSetResume; FClose(False); if (FPlaylist.Count > 0) then begin FOpen(FiItemIndex); end; end; procedure TApp_Wallvideo.Action_Video_WallvideoExecute(Sender: TObject); begin Action_Video_Wallvideo.Checked := not(Action_Video_Wallvideo.Checked); if not(FMediaHasVideo) then begin Exit; end; FSetResume; FClose(False); if (FPlaylist.Count > 0) then begin FOpen(FiItemIndex); end; end; procedure TApp_Wallvideo.Action_Video_CaptureBitmapExecute(Sender: TObject); //静止画キャプチャ {$IFNDEF CAPTURE_BITMAP} begin // end; {$ELSE} var lf_Pos : TRefTime; l_ListBox : TListBox; l_Strings : TMyWStrings; ls_File : String; begin if not(FMediaHasVideo) then begin Exit; end; FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin ls_File := FsFileName; end else begin if not(gfnbIsListBoxItemIndexSelected(l_ListBox)) then begin //Exit; ls_File := FsFileName; end else begin ls_File := l_Strings[l_ListBox.ItemIndex]; end; end; if not(gfnbFileExists(ls_File)) then begin gpcShowMessage(Format('%s'#13'ファイルが存在しません', [ls_File])); Exit; end; FMediaPosition.get_CurrentPosition(lf_Pos); Action_Video_CaptureBitmap.Enabled := False; try myBmpCaptureEx.gpcFormCreate(Self); myBmpCaptureEx.gpcImageCapture(ls_File, lf_Pos); myBmpCaptureEx.gpcFormShow; finally Action_Video_CaptureBitmap.Enabled := True; end; end; {$ENDIF} procedure TApp_Wallvideo.Action_Video_FitToVideoExecute(Sender: TObject); var li_Height : Integer; begin if (FIsVideoWindowPage) and (FMediaHasVideo) // and not(FIsWallvideo) then begin li_Height := ToolBar_Main.Height + PageControl1.Height - TabSheet_VideoWindow.ClientHeight + TrackBar_Seek.Height + Panel_Control.Height ; if (Action_Opt_Info.Checked) then begin Inc(li_Height, Panel_Info.Height); end; if (Action_Opt_StatusBar.Checked) then begin Inc(li_Height, StatusBar_Hint.Height); end; Inc(li_Height, Trunc(TabSheet_VideoWindow.ClientWidth * (FiVideoHeight / FiVideoWidth))); Self.ClientHeight := li_Height; end; end; procedure TApp_Wallvideo.Action_Video_FloatingExecute(Sender: TObject); var l_Rect: TRect; begin if (Action_Video_Floating.Checked) then begin l_Rect := Rect(0, 0, Panel_VideoWindow.Width, Panel_VideoWindow.Height); Panel_VideoWindow.ManualFloat(l_Rect); end else begin Panel_VideoWindow.ManualDock(TabSheet_VideoWindow); end; end; procedure TApp_Wallvideo.Action_Video_MagniExecute(Sender: TObject); begin if (Action_Video_Magni.Checked) then begin end else begin FormResize(nil); end; end; procedure TApp_Wallvideo.WMDropFiles(var Msg: TWMDropFiles); var i : Integer; l_Drop : TMyDropFiles; ls_File : String; l_FileList : TMyWStrings; l_FolderList : TMyWStrings; begin FBeginFunc; try l_Drop := TMyDropFiles.Create(Msg, Self); try l_FileList := nil; l_FolderList := nil; try l_FileList := TMyWStrings.Create; l_FolderList := TMyWStrings.Create; for i := 0 to l_Drop.Count -1 do begin ls_File := l_Drop.Files[i]; if (gfnbIsShortCut(ls_File)) then begin ls_File := gfnsLinkToFile(ls_File); end; if (FileExists(ls_File)) then begin l_FileList.Add(ls_File) end else if (DirectoryExists(ls_File)) then begin l_FolderList.Add(gfnsStrEndFit(ls_File, '\')); end; end; if (l_FileList.Count > 0) then begin Dialog_OpenFile.Files.Assign(l_FileList.UStrings); Dialog_OpenFile.FileName := Dialog_OpenFile.Files[0]; Action_File_OpenFileExecute(nil); end; if (l_FolderList.Count > 0) then begin Dialog_OpenFolder.Folders.Assign(l_FolderList.UStrings); //Dialog_OpenFolder.FolderName := Dialog_OpenFolder.Folders[0]; Action_File_OpenFolderExecute(nil); end; finally l_FileList.Free; l_FolderList.Free; end; finally l_Drop.Free; end; finally FEndFunc(False); end; end; //------------------------------------------------------------------------------ //バイナリのリストファイル用 type T_MyMediaData = record iUniquID : Integer; iPlaylistIndex : Integer; { sMediaTitle : WideString; sMediaArtist : WideString; sMediaAlbum : WideString; } iVideoWidth : Integer; iVideoHeight : Integer; fVideoFrameRate : Double; fMediaDuration : TRefTime; iMediaLength : Integer; // sFileName : WideString; iFileSize : Int64; iFileLastWriteTime : Int64; iFileCreationTime : Int64; { FsMediaLengthString : WideString; FsVideoFrameRateString : WideString; FsFileSizeString : WideString; FsFileLastWriteTimeString : WideString; FsFileCreationTimeString : WideString; } end; procedure TApp_Wallvideo.FLoadList(AList: TMyWStrings; sFileName: WideString); begin AList.LoadFromFile(sFileName); end; procedure TApp_Wallvideo.FSaveList(AList: TMyWStrings; sFileName: WideString); var i : Integer; begin AList.SaveToFile(sFileName, cdUTF_8, nlCRLF); for i := 0 to AList.Count-1 do begin end; end; //***IniFile const lcsSECT_BOUNDS = 'Bounds'; lcsSECT_DIALOG = 'Dialog'; lcsKEY_DLG_OPENFILEDIR = 'OpenFileDir'; lcsKEY_DLG_OPENFOLDERDIR = 'OpenFolderDir'; lcsSECT_LIST = 'List'; lcsKEY_LIST_FOLDERNAME = 'FolderName'; lcsKEY_LIST_OPENADD = 'OpenAdd'; lcsKEY_LIST_GOTOPLAYLIST = 'GotoPlaylist'; lcsSECT_FIND = 'Find'; lcsKEY_FIND_DISP = 'Display'; lcsKEY_FIND_OPT_OR = 'Or'; lcsKEY_FIND_OPT_NOT = 'Not'; lcsSECT_PLAY = 'Play'; lcsKEY_PLAY_MUTE = 'Mute'; lcsKEY_PLAY_VOLUME = 'Volume'; lcsSECT_RESUME = 'Resume'; lcsKEY_RESUME_FILENAME = 'FileName'; lcsKEY_RESUME_INDEX = 'ResumeIndex'; lcsKEY_RESUME_POS = 'ResumePosition'; lcsSECT_VIDEO = 'Video'; lcsKEY_VIDEO_MONITORINDEX = 'MonitorIndex'; lcsKEY_VIDEO_WALLVIDEO = 'Wallvideo'; lcsKEY_VIDEO_FULLSCREEN = 'FullScreen'; lcsKEY_VIDEO_MAXSCREEN = 'MaxScreen'; lcsKEY_VIDEO_TRANSPARENT = 'Transparent'; lcsKEY_VIDEO_MAGNI = 'Magnification'; lcsSECT_WINDOW = 'Window'; lcsKEY_WINDOW_INDEX = 'Index'; lcsSECT_OPT = 'Option'; lcsKEY_OPT_RANDOM = 'Random'; {$IFDEF DEBUG} lcsKEY_OPT_USEFFDSHOW = 'ffdshow'; {$ENDIF} {$IFDEF CONFIRMERR} lcsKEY_OPT_CONFIRMERR = 'ConfirmErrorFile'; {$ENDIF} // lcsKEY_OPT_SCREENSAVER = 'AllowScreenSaver'; lcsKEY_OPT_INFOPANEL = 'InfoPanel'; lcsKEY_OPT_STATUSBAR = 'ShowStatusBar'; lcsKEY_OPT_TASKTRAY = 'TaskTray'; lcsSECT_HISTORY_OPENFILE = 'OpenFileHistory'; lcsSECT_HISTORY_OPENFOLDER = 'OpenFolderHistory'; lcsSECT_HISTORY_OPENTHISFOLDER = 'OpenThisFolderHistory'; function TApp_Wallvideo.FLoadIni : Boolean; procedure _ReadHistory(AIniFile: TMyIniFile; sSection: String; APopupMenu: TPopupMenu); var l_History : TMyWStrings; begin if (AIniFile.SectionExists(sSection)) then begin l_History := TMyWStrings.Create; try AIniFile.ReadSectionText(sSection, l_History); FAddOpenHistory(APopupMenu.Items, l_History); finally l_History.Free; end; end; end; var l_IniFile : TMyIniFile; li_Index : Integer; begin Result := True; //Shift+Ctrl起動で設定を読み込まない。 if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Result := False; Exit; end; l_IniFile := nil; try l_IniFile := TMyIniFile.Create; with l_IniFile do begin //[Bounds] if (gfnbKeyState(VK_SHIFT)) then begin //[Shift]併用でメインモニターで起動 //Self.SetBounds(75, 75, Self.Width, Self.Height); end else begin SetMonitorBoundsRect(lcsSECT_BOUNDS, Self); end; //[List] Action_List_FolderName.Checked := ReadBool(lcsSECT_LIST, lcsKEY_LIST_FOLDERNAME, Action_List_FolderName.Checked); Action_List_OpenAdd.Checked := ReadBool(lcsSECT_LIST, lcsKEY_LIST_OPENADD, Action_List_OpenAdd.Checked); Action_List_OpenAddExecute(nil); //[Find] Action_Find_Opt_Or.Checked := ReadBool(lcsSECT_FIND, lcsKEY_FIND_OPT_OR, Action_Find_Opt_Or.Checked); Action_Find_Opt_Not.Checked := ReadBool(lcsSECT_FIND, lcsKEY_FIND_OPT_NOT, Action_Find_Opt_Not.Checked); Action_Find_Disp.Checked := ReadBool(lcsSECT_FIND, lcsKEY_FIND_DISP, Action_Find_Disp.Checked); Action_Find_DispExecute(nil); //[Play] Action_Play_Mute.Checked := ReadBool(lcsSECT_PLAY, lcsKEY_PLAY_MUTE, Action_Play_Mute.Checked); TrackBar_Volume.Position := gfniNumLimit(ReadInteger(lcsSECT_PLAY, lcsKEY_PLAY_VOLUME, TrackBar_Volume.Position), TrackBar_Volume.Min, TrackBar_Volume.Max); //[Resume] FsFileName := ReadString (lcsSECT_RESUME, lcsKEY_RESUME_FILENAME, FsFileName); FiResumeIndex := ReadInteger(lcsSECT_RESUME, lcsKEY_RESUME_INDEX, FiResumeIndex); FfResumePos := ReadFloat (lcsSECT_RESUME, lcsKEY_RESUME_POS, FfResumePos); //[Video] FiMonitorMenuIndex := ReadInteger(lcsSECT_VIDEO, lcsKEY_VIDEO_MONITORINDEX, FiMonitorMenuIndex); if not(gfnbIsInsideRange(FiMonitorMenuIndex, 0, Screen.MonitorCount)) then begin FiMonitorMenuIndex := F_ciMONITORSELECT_SELFWINDOW; end; //Ctrlキーのみ押下で壁紙ビデオをキャンセル if (gfnbKeyState(VK_CONTROL)) then begin Action_Video_Wallvideo.Checked := False; end else begin Action_Video_Wallvideo.Checked := ReadBool(lcsSECT_VIDEO, lcsKEY_VIDEO_WALLVIDEO, Action_Video_Wallvideo.Checked); end; Action_Video_Magni.Checked := ReadBool(lcsSECT_VIDEO, lcsKEY_VIDEO_MAGNI, Action_Video_Magni.Checked); //[Window] li_Index := ReadInteger(lcsSECT_WINDOW, lcsKEY_WINDOW_INDEX, PageControl1.ActivePageIndex); if not(gfnbIsInsideRange(li_Index, 0, PageControl1.PageCount-1)) then begin li_Index := PageControl1.ActivePageIndex; end; try // PageControl1.ActivePageIndex := li_Index; FChangeTab(PageControl1.Pages[li_Index]); except end; //[Option] {$IFDEF DEBUG} Action_Opt_UseFfdShow.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_USEFFDSHOW, Action_Opt_UseFfdShow.Checked); {$ENDIF} Action_Opt_TaskTray.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_TASKTRAY, Action_Opt_TaskTray.Checked); Action_Opt_Info.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_INFOPANEL, Action_Opt_Info.Checked); {$IFDEF CONFIRMERR} Action_Opt_ConfirmErr.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_CONFIRMERR, Action_Opt_ConfirmErr.Checked); {$ENDIF} Action_Opt_StatusBar.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_STATUSBAR, Action_Opt_StatusBAr.Checked); Action_Opt_Random.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_RANDOM, Action_Opt_Random.Checked); Action_Opt_RandomExecute(nil); //[Dialog] Dialog_OpenFile.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DLG_OPENFILEDIR, Dialog_OpenFile.InitialDir); // Dialog_OpenFile.Filter := ReadString(lcsSECT_DIALOG, lcsKEY_DLG_OPENFILTER, Dialog_OpenFile.Filter); Dialog_OpenFolder.InitialDir := ReadString(lcsSECT_DIALOG, lcsKEY_DLG_OPENFOLDERDIR, Dialog_OpenFolder.InitialDir); //[History] _ReadHistory(l_IniFile, lcsSECT_HISTORY_OPENFILE, PopupMenu_OpenFile); _ReadHistory(l_IniFile, lcsSECT_HISTORY_OPENFOLDER, PopupMenu_OpenFolder); _ReadHistory(l_IniFile, lcsSECT_HISTORY_OPENTHISFOLDER, PopupMenu_OpenThisFolder); gpcFindIniLoad(l_IniFile, ComboBox_Find_Text.Items); if (ComboBox_Find_Text.Items.Count > 0) then begin ComboBox_Find_Text.Text := ComboBox_Find_Text.Items[0]; end; end; finally l_IniFile.Free end; end; procedure TApp_Wallvideo.FSaveIni; procedure _WriteHistory(AIniFile: TMyIniFile; sSection: String; APopupMenu: TPopupMenu); var l_History : TMyWStrings; i : Integer; begin l_History := TMyWStrings.Create; try for i := 0 to APopupMenu.Items.Count-1 do begin l_History.Add(APopupMenu.Items[i].Hint); end; AIniFile.WriteSectionText(sSection, l_History); finally l_History.Free; end; end; var l_IniFile : TMyIniFile; begin //Shift+Ctrl終了で設定を書き込まない。 if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Exit; end; l_IniFile := nil; try l_IniFile := TMyIniFile.Create; with l_IniFile do begin //[Bounds] if (gfnbKeyState(VK_SHIFT)) then begin EraseSection(lcsSECT_BOUNDS); end else begin WriteBoundsRect(lcsSECT_BOUNDS, Self); end; //[List] WriteBool(lcsSECT_LIST, lcsKEY_LIST_FOLDERNAME, Action_List_FolderName.Checked); WriteBool(lcsSECT_LIST, lcsKEY_LIST_OPENADD, Action_List_OpenAdd.Checked); //[Find] WriteBool(lcsSECT_FIND, lcsKEY_FIND_OPT_OR, Action_Find_Opt_Or.Checked); WriteBool(lcsSECT_FIND, lcsKEY_FIND_OPT_NOT, Action_Find_Opt_Not.Checked); WriteBool(lcsSECT_FIND, lcsKEY_FIND_DISP, Action_Find_Disp.Checked); //[Play] WriteBool (lcsSECT_PLAY, lcsKEY_PLAY_MUTE, Action_Play_Mute.Checked); WriteInteger(lcsSECT_PLAY, lcsKEY_PLAY_VOLUME, TrackBar_Volume.Position); //[Video] WriteInteger(lcsSECT_VIDEO, lcsKEY_VIDEO_MONITORINDEX, FiMonitorMenuIndex); WriteBool (lcsSECT_VIDEO, lcsKEY_VIDEO_WALLVIDEO, Action_Video_Wallvideo.Checked); WriteBool (lcsSECT_VIDEO, lcsKEY_VIDEO_MAGNI, Action_Video_Magni.Checked); //[Resume] WriteString (lcsSECT_RESUME, lcsKEY_RESUME_FILENAME, FsFileName); WriteInteger(lcsSECT_RESUME, lcsKEY_RESUME_INDEX, FiItemIndex); FfResumePos := 0; if (Assigned(FMediaPosition)) then begin FMediaPosition.get_CurrentPosition(FfResumePos); end; WriteFloat(lcsSECT_RESUME, lcsKEY_RESUME_POS, FfResumePos); //[Window] WriteInteger(lcsSECT_WINDOW, lcsKEY_WINDOW_INDEX, PageControl1.ActivePageIndex); //[Option] {$IFDEF DEBUG} WriteBool(lcsSECT_OPT, lcsKEY_OPT_USEFFDSHOW, Action_Opt_UseFfdShow.Checked); {$ENDIF} WriteBool(lcsSECT_OPT, lcsKEY_OPT_TASKTRAY, Action_Opt_TaskTray.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPT_INFOPANEL, Action_Opt_Info.Checked); {$IFDEF CONFIRMERR} WriteBool(lcsSECT_OPT, lcsKEY_OPT_CONFIRMERR, Action_Opt_ConfirmErr.Checked); {$ENDIF} WriteBool(lcsSECT_OPT, lcsKEY_OPT_STATUSBAR, Action_Opt_StatusBar.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPT_RANDOM, Action_Opt_Random.Checked); //[Dialog] WriteString(lcsSECT_DIALOG, lcsKEY_DLG_OPENFILEDIR, Dialog_OpenFile.InitialDir); // WriteString(lcsSECT_DIALOG, lcsKEY_DLG_OPENFILTER, Dialog_OpenFile.Filter); WriteString(lcsSECT_DIALOG, lcsKEY_DLG_OPENFOLDERDIR, Dialog_OpenFolder.InitialDir); //[History] _WriteHistory(l_IniFile, lcsSECT_HISTORY_OPENFILE, PopupMenu_OpenFile); _WriteHistory(l_IniFile, lcsSECT_HISTORY_OPENFOLDER, PopupMenu_OpenFolder); _WriteHistory(l_IniFile, lcsSECT_HISTORY_OPENTHISFOLDER, PopupMenu_OpenThisFolder); gpcFindIniSave(l_IniFile, ComboBox_Find_Text.Items); end; finally l_IniFile.Free end; FSaveList(FPlaylist, FsPlaylistFileName); FSaveList(FFindList, FsFindListFileName); FSaveList(FHistorylist, FsHistoryFileName); end; //--- 情報表示 ----------------------------------------------------------------- procedure TApp_Wallvideo.FClearInfo; begin with Grid_Info do begin Cells[1, F_ciROW_TITLE] := ''; Cells[1, F_ciROW_ARTIST] := ''; Cells[1, F_ciROW_ALBUM] := ''; Cells[1, F_ciROW_FILEINFO] := ''; end; Image_Info_Thumb.Canvas.FillRect(Rect(0, 0, Image_Info_Thumb.Width, Image_Info_Thumb.Height)); end; procedure TApp_Wallvideo.SetInfo(Sender: T_MyInfoGet; iIndex: Integer; AMediaInfo: T_MyMediaInfo); var l_MediaInfo : T_MyMediaInfo; l_ListBox : TListBox; l_Strings : TMyWStrings; begin if (Self.Tag = 0) then begin Sender.Terminate; // Sender.Free; Exit; end; FGetDispList(l_ListBox, l_Strings); { if (l_ListBox <> nil) and (iIndex <> l_ListBox.ItemIndex) then begin // Sender.Terminate; Exit; end; } if (AMediaInfo = nil) then begin if (l_Strings.Objects[iIndex] = nil) then begin // Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_FILEINFO] := 'ファイルが存在しません'; Exit; end else begin l_MediaInfo := T_MyMediaInfo(l_Strings.Objects[iIndex]); end; end else begin l_MediaInfo := AMediaInfo; end; if (l_ListBox <> nil) and (iIndex <> l_ListBox.ItemIndex) then begin // Sender.Terminate; Exit; end; FClearInfo; if (gfnbIsEqualFileName(l_Strings[iIndex], l_MediaInfo.FileName)) then begin //タイトル Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_TITLE] := l_MediaInfo.MediaTitle; //アーティスト Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_ARTIST] := l_MediaInfo.MediaArtist; //アルバム Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_ALBUM] := l_MediaInfo.MediaAlbum; end; end; procedure TApp_Wallvideo.SetInfo2(Sender: T_MyInfoGet; iIndex: Integer; AMediaInfo: T_MyMediaInfo); var l_MediaInfo : T_MyMediaInfo; ls_Info : String; l_ListBox : TListBox; l_Strings : TMyWStrings; begin if (Self.Tag = 0) then begin Sender.Terminate; // Sender.Free; Exit; end; try FGetDispList(l_ListBox, l_Strings); { if (l_ListBox <> nil) and (iIndex <> l_ListBox.ItemIndex) then begin // Sender.Terminate; // Exit; end; } if not(FileExists(l_Strings[iIndex])) then begin Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_FILEINFO] := 'ファイルが存在しません'; Exit; end; if (l_Strings.Objects[iIndex] = nil) then begin //ここにはこないはずである if (AMediaInfo = nil) then begin Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_FILEINFO] := 'ファイルが存在しません'; Exit; end; l_MediaInfo := T_MyMediaInfo.Create; l_MediaInfo.Assign(AMediaInfo); l_Strings.Objects[iIndex] := l_MediaInfo; end else begin l_MediaInfo := T_MyMediaInfo(l_Strings.Objects[iIndex]); if (AMediaInfo <> nil) then begin l_MediaInfo.Assign(AMediaInfo); end; end; if (l_ListBox <> nil) and (iIndex <> l_ListBox.ItemIndex) then begin // Sender.Terminate; Exit; end; if (gfnbIsEqualFileName(l_Strings[iIndex], l_MediaInfo.FileName)) then begin //ファイル情報 if (l_MediaInfo.VideoWidth > 0) and (l_MediaInfo.VideoHeight > 0) then begin ls_Info := Format('%dx%d', [l_MediaInfo.VideoWidth, l_MediaInfo.VideoHeight]); end; if (l_MediaInfo.VideoFrameRate > 0) then begin ls_Info := Format('%s %.2ffps', [ls_Info, l_MediaInfo.VideoFrameRate]); end; if (ls_Info <> '') then begin ls_Info := ls_Info + ' '; end; ls_Info := Format('%s%s秒 %s (%s)', [ls_Info, gfnsSecToTimeStr(l_MediaInfo.MediaLength), l_MediaInfo.FileSizeString, l_MediaInfo.FileLastWriteTimeString]); Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_FILEINFO] := ls_Info; end; finally Sender.Terminate; // Sender.Free; end; end; procedure TApp_Wallvideo.SetInfo3(Sender: T_MyInfoGet; iIndex: Integer; AMediaInfo: T_MyMediaInfo); var l_MediaInfo : T_MyMediaInfo; l_ListBox : TListBox; l_Strings : TMyWStrings; begin if (Self.Tag = 0) then begin Sender.Terminate; // Sender.Free; Exit; end; try FGetDispList(l_ListBox, l_Strings); if (l_Strings.Objects[iIndex] = nil) then begin //ここにはこないはずである if (AMediaInfo = nil) then begin Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_FILEINFO] := 'ファイルが存在しません'; Exit; end; l_MediaInfo := T_MyMediaInfo.Create; l_MediaInfo.Assign(AMediaInfo); l_Strings.Objects[iIndex] := l_MediaInfo; end else begin l_MediaInfo := T_MyMediaInfo(l_Strings.Objects[iIndex]); if (AMediaInfo <> nil) then begin l_MediaInfo.Assign(AMediaInfo); end; end; if (l_ListBox <> nil) and (iIndex <> l_ListBox.ItemIndex) then begin // Sender.Terminate; Exit; end; if not(FileExists(l_Strings[iIndex])) then begin Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_FILEINFO] := 'ファイルが存在しません'; Image_Info_Thumb.Visible := False; Exit; end; if (AMediaInfo = nil) // or (AMediaInfo.Bitmap = nil) or not(AMediaInfo.MediaHasImage) then begin Image_Info_Thumb.Visible := False; Exit; end; Image_Info_Thumb.Visible := True; // Image_Info_Thumb.Picture.Bitmap.Assign(AMediaInfo.Bitmap); // gpcBmpCopy(AMediaInfo.Bitmap, Image_Info_Thumb.Picture.Bitmap); finally Sender.Terminate; // FreeAndNil(Sender); // Sender.Free; end; end; procedure TApp_Wallvideo.ListBox_PlaylistClick(Sender: TObject); var l_ListBox : TListBox; l_Strings : TMyWStrings; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin Exit; end; l_ListBox.Tag := 1; //検索に使用 if (l_ListBox.Count > 0) then begin if (FbInfoPlaying) then begin l_ListBox.ItemIndex := FiItemIndex; l_ListBox.ItemIndex := gfniNumLimit(l_ListBox.ItemIndex, 0, l_ListBox.Count -1); Action_List_GotoPlayingExecute(nil); end; FbInfoPlaying := False; FDispInfo(l_Strings, l_ListBox.ItemIndex); end; PopupMenu_MainPopup(nil); end; procedure TApp_Wallvideo.FDispInfo(AStrings: TMyWStrings; iIndex: Integer); var l_InfoGet : T_MyInfoGet; begin if (AStrings.Count <= 0) or not(gfnbIsInsideRange(iIndex, 0, AStrings.Count-1)) then begin FClearInfo; Exit; end; l_InfoGet := T_MyInfoGet.Create(iIndex, AStrings); if (l_InfoGet = nil) then begin //Beep; //ダミー end; end; //--- 情報表示ここまで --------------------------------------------------------- procedure TApp_Wallvideo.PageControl1Change(Sender: TObject); const lcs_FINDTITLE = '検索'; begin if (Application.Terminated) then begin Exit; end; if (FIsVideoWindowPage) then begin Label_Find.Caption := lcs_FINDTITLE; end else begin Label_Find.Caption := Format('%sを%s', [PageControl1.ActivePage.Caption, lcs_FINDTITLE]); end; if (FIsFindlistPage) then begin ToolBar_Find.Parent := Panel_Find_Findlist; FDispInfo(FFindlist, ListBox_Findlist.ItemIndex); end else if (FIsHistoryPage) then begin ToolBar_Find.Parent := Panel_Find_History; FDispInfo(FHistorylist, ListBox_History.ItemIndex); end else begin if (FIsPlaylistPage) then begin ToolBar_Find.Parent := Panel_Find_Playlist; FDispInfo(FPlaylist, ListBox_Playlist.ItemIndex); end else begin FDispInfo(FPlaylist, FiItemIndex); end; end; PopupMenu_MainPopup(nil); end; procedure TApp_Wallvideo.FChangeTab(ATabSheet: TTabSheet); begin if (Self.Tag = 0) // if (Application.Terminated) then begin Exit; end; if (ATabSheet <> nil) then begin PageControl1.ActivePage := ATabSheet; end; PageControl1Change(nil); { if (FIsPlaylistPage) then begin ToolBar_Find.Parent := Panel_Find_Playlist; end else if (FIsFindlistPage) then begin ToolBar_Find.Parent := Panel_Find_Findlist; end else if (FIsHistoryPage) then begin ToolBar_Find.Parent := Panel_Find_History; end; } end; procedure TApp_Wallvideo.ListBox_FindListDblClick(Sender: TObject); begin if (gfnbKeyState(VK_RBUTTON)) then begin Action_List_PlayItemIndexExecute(Action_List_PlayItemIndex); end else begin Action_List_PlayItemIndexExecute(Action_List_GotoPlaylist); end; end; procedure TApp_Wallvideo.Action_List_PlayItemIndexExecute(Sender: TObject); var i : Integer; li_Index : Integer; l_MediaInfo : T_MyMediaInfo; l_ListBox : TListBox; l_Strings : TMyWStrings; ls_File : WideString; lb_GotoPlaylist : Boolean; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin Exit; end; if not(gfnbIsListBoxItemIndexSelected(l_ListBox)) then begin Exit; end; ls_File := l_Strings[l_ListBox.ItemIndex]; if (FIsPlaylistPage) then begin li_Index := l_ListBox.ItemIndex; end else begin // lb_GotoPlaylist := True; lb_GotoPlaylist := (Sender = Action_List_GotoPlaylist); l_MediaInfo := T_MyMediaInfo(l_Strings.Objects[l_ListBox.ItemIndex]); li_Index := -1; if (FIsFindlistPage) and (l_MediaInfo <> nil) then begin li_Index := l_MediaInfo.PlaylistIndex; end; if (li_Index <= -1) then begin for i := 0 to FPlaylist.Count-1 do begin if (gfnbIsEqualFileName(FPlaylist[i], ls_File)) then begin li_Index := i; Break; end; end; end; if (li_Index <= -1) then begin Beep; if (gfniMessageBoxYesNo(WideFormat('%s'#13'指定したファイルが再生リストにありません'#13'追加しますか', [ls_File])) = ID_YES) then begin FPlaylist.AddObject(ls_File, T_MyMediaInfo.Create(ls_File)); ResetCount; li_Index := FPlaylist.Count-1; end else begin Exit; end; end; if (lb_GotoPlaylist) then begin ListBox_Playlist.TopIndex := li_Index; ListBox_Playlist.ClearSelection; ListBox_Playlist.Selected[li_Index] := True; ListBox_Playlist.ItemIndex := li_Index; FChangeTab(TabSheet_Playlist); ListBox_PlaylistClick(ListBox_Playlist); Exit; end; end; FiItemIndex := li_Index; FOpen(FiItemIndex); end; procedure TApp_Wallvideo.ListBox_PlaylistDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); const lci_MARGIN = 2; var ls_Text : WideString; l_ListBox : TListBox; l_Strings : TMyWStrings; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin Exit; end; with l_ListBox.Canvas do begin FillRect(Rect); Inc(Rect.Left); Dec(Rect.Right); if (Action_List_FolderName.Checked) then begin ls_Text := l_Strings[Index]; end else begin ls_Text := gfnsFileNameGet(l_Strings[Index]); end; Font.Assign(l_ListBox.Font); if (FIsPlaylistPage) and (Index = FiItemIndex) then begin Font.Style := [fsBold]; end; if (odSelected in State) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end; DrawTextW(Handle, PWideChar(WideFormat('%d: %s', [Index+1, ls_Text])), -1, Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); end; end; procedure TApp_Wallvideo.ListBox_FindListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); const lci_MARGIN = 2; var ls_Text : WideString; l_Info : T_MyMediaInfo; l_ListBox : TListBox; l_Strings : TMyWStrings; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin Exit; end; with l_ListBox.Canvas do begin FillRect(Rect); Inc(Rect.Left); Dec(Rect.Right); if (Action_List_FolderName.Checked) then begin ls_Text := l_Strings[Index]; end else begin ls_Text := gfnsFileNameGet(l_Strings[Index]); end; Font.Assign(l_ListBox.Font); if (odSelected in State) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end; l_Info := T_MyMediaInfo(l_Strings.Objects[Index]); if (l_Info <> nil) then begin DrawTextW(Handle, PWideChar(WideFormat('%d: %s', [l_Info.PlaylistIndex+1, ls_Text])), -1, Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); end else begin DrawTextW(Handle, PWideChar(ls_Text), -1, Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); end; end; end; procedure TApp_Wallvideo.Panel_VideoWindowClick(Sender: TObject); begin Windows.SetFocus(Panel_VideoWindow.Handle); end; procedure TApp_Wallvideo.Panel_VideoWindowDblClick(Sender: TObject); begin //myDebug.gpcDebug('DblClick'); if (gfnbKeyState(VK_RBUTTON)) then begin { if (Action_Video_CaptureBitmap.Visible) and (Action_Video_CaptureBitmap.Enabled) then begin Action_Video_CaptureBitmapExecute(nil); end; } Action_Video_FitToVideoExecute(nil); end else begin (* //壁紙ビデオでダブルクリック後にマウスの動きに追従してフォームが動いてしまうことへの対処 Action_Video_Magni.Tag := 1; if (Action_Video_Magni.Checked) and not(FIsWallvideo) then begin //myDebug.gpcDebug([Panel_VideoWindow.Width, Panel_VideoWindow.Height]); if (Panel_VideoWindow.Width <> FiVideoWidth) or (Panel_VideoWindow.Height <> FiVideoHeight) then begin Action_Video_Zoom100Execute(nil); end else begin FormResize(nil); end; end else begin // Action_Video_Wallvideo.Checked := not(Action_Video_Wallvideo.Checked); Action_Video_WallvideoExecute(nil); // FAdjustVideoWindow; end; *) end; end; function TApp_Wallvideo.FIsDragMove: Boolean; begin Result := (FptDragMove.X <> MAXINT) and (FptDragMove.Y <> MAXINT); end; procedure TApp_Wallvideo.FDragMoveInit; begin FptDragMove := Point(MAXINT, MAXINT); end; procedure TApp_Wallvideo.Panel_VideoWindowMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var l_Point : TPoint; l_WinControl : TWinControl; begin //myDebug.gpcDebug('MouseMove', FptDragMove); if (FIsVideoWindowPage) and (Action_Video_Magni.Checked) and (FMediaHasVideo) and not(FIsWallvideo) and (gfnbKeyState(VK_LBUTTON)) then begin Screen.Cursor := crSizeAll; end; if (Action_Video_Magni.Tag <> 0) then begin // Action_Video_Magni.Tag := 0; //NG Exit; end; if (FIsVideoWindowPage) and (FIsDragMove) and (Sender is TWinControl) // and not(FIsFullScreen) then begin l_Point := gfnptMousePosGet; if (Action_Video_Magni.Checked) and (FMediaHasVideo) and not(FIsWallvideo) then begin // Screen.Cursor := crSizeAll; l_WinControl := Panel_VideoWindow; gpcControlMove(l_WinControl, l_Point.X - FptDragMove.X, l_Point.Y - FptDragMove.Y); end else begin l_WinControl := Self; end; // gpcControlMove(l_WinControl, l_Point.X - FptDragMove.X, l_Point.Y - FptDragMove.Y); end; end; procedure TApp_Wallvideo.ListBox_PlaylistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_WinControl : TWinControl; begin //myDebug.gpcDebug('MouseDown'); FDragMoveInit; FptMouseGesture := Point(MAXINT, MAXINT); if (FIsVideoWindowPage) and (Action_Video_Magni.Checked) and (FMediaHasVideo) and not(FIsWallvideo) and (Button = mbLeft) then begin Screen.Cursor := crSizeAll; end else begin Screen.Cursor := crDefault; end; if (Action_Video_Magni.Tag <> 0) then begin Action_Video_Magni.Tag := 0; Exit; end; if (Button = mbRight) then begin FptMouseGesture := gfnptMousePosGet; end else begin if (FIsVideoWindowPage) // and (Action_Video_Magni.Checked) then begin //移動 if (Sender is TWinControl) then begin //移動 if (FIsVideoWindowPage) and (Action_Video_Magni.Checked) and (FMediaHasVideo) and not(FIsWallvideo) then begin l_WinControl := Panel_VideoWindow; end else begin l_WinControl := Self; end; FptDragMove := gfnptMousePosGet; FptDragMove.X := FptDragMove.X - l_WinControl.Left; FptDragMove.Y := FptDragMove.Y - l_WinControl.Top; end; end; end; end; procedure TApp_Wallvideo.ListBox_PlaylistMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); function _GetPopupMenu(Sender: TObject): TPopupMenu; begin if (Sender is TListBox) and (TListBox(Sender).PopupMenu <> nil) then begin Result := TListBox(Sender).PopupMenu; end else if (Sender is TPanel) then begin Result := TPanel(Sender).PopupMenu; end else begin Result := PopupMenu_Main; end; end; var l_Pos : TPoint; l_Rect : TRect; ls_Compas : String; l_Action : TAction; begin //myDebug.gpcDebug('MouseUp'); FDragMoveInit; Screen.Cursor := crDefault; if (Button = mbLeft) then begin if (FIsVideoWindowPage) then begin FAdjustVideoWindow; end; end else if (Button = mbMiddle) then begin if (FIsVideoWindowPage) then begin Action_Video_Magni.Checked := not(Action_Video_Magni.Checked); Action_Video_MagniExecute(nil); end; end else if (Button = mbRight) and ((FptMouseGesture.X <> MAXINT) and (FptMouseGesture.Y <> MAXINT)) then begin l_Pos := gfnptMousePosGet; ls_Compas := gfnsCompasGet(FptMouseGesture, l_Pos); FptMouseGesture := Point(MAXINT, MAXINT); // FGetDispList(l_ListBox, l_Strings); // l_Rect := gfnrcClientOriginRect(l_ListBox); l_Rect := gfnrcClientOriginRect(Self); if not(PtInRect(l_Rect, l_Pos)) then begin Exit; end; if (ls_Compas = '') then begin // PopupMenu_Main.Popup(l_Pos.X, l_Pos.Y); // l_ListBox.PopupMenu.Popup(l_Pos.X, l_Pos.Y); _GetPopupMenu(Sender).Popup(l_Pos.X, l_Pos.Y); end else begin if (ls_Compas = '上') then begin l_Action := Action_Play_PlayPause; end else if (ls_Compas = '下') then begin l_Action := Action_Play_Replay; end else if (ls_Compas = '左') then begin l_Action := Action_Play_Back; end else if (ls_Compas = '右') then begin l_Action := Action_Play_Next; end else begin l_Action := nil; end; if (l_Action <> nil) then begin l_Action.Execute; end; end; end; end; procedure TApp_Wallvideo.FAdjustVideoWindow; var li_Left : Integer; li_Top : Integer; l_Rect : TRect; begin li_Left := Panel_VideoWindow.Left; li_Top := Panel_VideoWindow.Top; l_Rect := Panel_VideoBase.ClientRect; if (Panel_VideoWindow.Width >= gfniRectWidth(l_Rect)) then begin if (Panel_VideoWindow.BoundsRect.Right <= l_Rect.Right) then li_Left := li_Left + l_Rect.Right - Panel_VideoWindow.BoundsRect.Right; if (Panel_VideoWindow.BoundsRect.Bottom <= l_Rect.Bottom) then li_Top := li_Top + l_Rect.Bottom - Panel_VideoWindow.BoundsRect.Bottom; if (Panel_VideoWindow.BoundsRect.Left >= l_Rect.Left) then li_Left := li_Left + l_Rect.Left - Panel_VideoWindow.BoundsRect.Left; if (Panel_VideoWindow.BoundsRect.Top >= l_Rect.Top) then li_Top := li_Top + l_Rect.Top - Panel_VideoWindow.BoundsRect.Top; end else begin if (Panel_VideoWindow.BoundsRect.Right >= l_Rect.Right) then li_Left := li_Left + l_Rect.Right - Panel_VideoWindow.BoundsRect.Right; if (Panel_VideoWindow.BoundsRect.Bottom >= l_Rect.Bottom) then li_Top := li_Top + l_Rect.Bottom - Panel_VideoWindow.BoundsRect.Bottom; if (Panel_VideoWindow.BoundsRect.Left <= l_Rect.Left) then li_Left := li_Left + l_Rect.Left - Panel_VideoWindow.BoundsRect.Left; if (Panel_VideoWindow.BoundsRect.Top <= l_Rect.Top) then li_Top := li_Top + l_Rect.Top - Panel_VideoWindow.BoundsRect.Top; end; Panel_VideoWindow.SetBounds(li_Left, li_Top, Panel_VideoWindow.Width, Panel_VideoWindow.Height); end; const F_ciFADETIME = 500; //フェードインにかける時間(ミリ病) procedure TApp_Wallvideo.FadeIn; var i : Integer; li_Volume : Integer; li_Start : DWORD; li_Sleep : Integer; li_Fade : Integer; lf_Interval : Extended; begin if (Action_Play_Mute.Checked) then begin Exit; end; li_Volume := TrackBar_Volume.Position; Sleep(500); li_Start := GetTickCount; lf_Interval := F_ciFADETIME / li_Volume; li_Fade := 1; i := 1; while (i < li_Volume) do begin Application.ProcessMessages; try li_Sleep := Trunc(li_Start + (lf_Interval * i) - GetTickCount); if (li_Sleep > 0) then begin Sleep(li_Sleep); if (li_Fade > 1) then begin Dec(li_Fade); end; end else if (li_Sleep < 0) then begin Inc(li_Fade); end; FSetVolume(gfniNumLimit(i, 0, 100)); if (i >= li_Volume) then begin Break; end; Inc(i, li_Fade); except //myDebug.gpcDebug([i, settings.volume, gfniNumLimit(i * lci_IN, 0, F_iFadeVolume)]); end; end; FSetVolume(li_Volume); end; procedure TApp_Wallvideo.FadeOut; var i : Integer; li_Volume : Integer; li_Start : DWORD; li_Sleep : Integer; li_Fade : Integer; lf_Interval : Extended; begin if (Action_Play_Mute.Checked) then begin Exit; end; li_Volume := TrackBar_Volume.Position; if (li_Volume > 0) then begin li_Start := GetTickCount; lf_Interval := F_ciFADETIME / li_Volume; li_Fade := 1; i := 1; while (i < li_Volume) do begin Application.ProcessMessages; try li_Sleep := Trunc(li_Start + (lf_Interval * i) - GetTickCount); if (li_Sleep > 0) then begin Sleep(li_Sleep); if (li_Fade > 1) then begin Dec(li_Fade); end; end else if (li_Sleep < 0) then begin Inc(li_Fade); end; FSetVolume(gfniNumLimit(li_Volume - i, 0, 100)); if ((li_Volume - i) <= 0) then begin Break; end; Inc(i, li_Fade); except end; end; FSetVolume(0); end; end; procedure TApp_Wallvideo.DoMediaStarted; begin FadeIn; // ListBox_Playlist.Repaint; // FListRefresh; // Action_List_GotoPlayingExecute(nil); // ListBox_PlaylistClick(nil); end; procedure TApp_Wallvideo.DoMediaEnded; begin Timer_Time.Enabled := False; if (FbMediaEnded) then begin Exit; end; FbMediaEnded := True; //連続再生 if (FPlaylist.Count = 0) then begin FClose(False); end else begin Action_Play_NextExecute(Action_Play_Next); end; end; procedure TApp_Wallvideo.WMGraphNotify(var Msg: TMessage); //イベント処理 var li_EventCode : Longint; li_Param1 : Longint; li_Param2 : Longint; begin if (FMediaEventEx = nil) then begin Exit; end; // イベントを全て取得 while (Succeeded(FMediaEventEx.GetEvent(li_EventCode, li_Param1, li_Param2, 0))) do begin try {$IFDEF _DEBUG} myDebugDShow.gpcDS_MediaEvent(li_EventCode, li_Param1, li_Param2); {$ENDIF} case (li_EventCode) of EC_VIDEO_SIZE_CHANGED :begin //ネイティブビデオサイズが変更されたときに送信される。 Timer_IsPlay.Enabled := True; end; EC_COMPLETE :begin //再生が終わりに来た DoMediaEnded; end; EC_CLOCK_CHANGED :begin //基準クロックが変更された。 //ここに来た後EC_PAUSEDイベントが起きればPlay成功。 FbPassClockChanged := True; end; EC_PAUSED :begin //ポーズ要求が完了した。 if (FbPassClockChanged) then begin //基準クロック変更後にここに来ればPlay成功。 //EC_CLOCK_CHANGEDを過ぎて初めてのEC_PAUSEDで再生開始のイベント if (FbStart = False) then begin DoMediaStarted; end; FbStart := True; end end; end; finally FMediaEventEx.FreeEventParams(li_EventCode, li_Param1, li_Param2); end; end; end; function TApp_Wallvideo.FGetPlayState: TFilterState; var l_MediaControl : IMediaControl; begin Result := State_Stopped; if (Assigned(FGraphBuilder)) then begin FGraphBuilder.QueryInterface(IMediaControl, l_MediaControl); l_MediaControl.GetState(0, Result); l_MediaControl := nil; end; end; procedure TApp_Wallvideo.Action_Play_PlayPauseExecute(Sender: TObject); //再生/一時停止 var li_Index : Integer; begin if (Assigned(FGraphBuilder)) then begin if (FGetPlayState = State_Running) then begin Action_Play_PauseExecute(nil); end else begin Action_Play_PlayExecute(nil); end; end else if (FPlaylist.Count > 0) then begin li_Index := gfniListBoxSelectedIndex(ListBox_Playlist); if (li_Index < 0) then begin li_Index := 0; end; FOpen(li_Index); end else begin Action_File_OpenFileExecute(Dialog_OpenFile); //引数はnil以外にする必要あり end; end; procedure TApp_Wallvideo.Action_Play_ReplayExecute(Sender: TObject); var li_Ret : HResult; l_MediaControl : IMediaControl; l_MediaPosition : IMediaPosition; begin if (Assigned(FGraphBuilder)) then begin FGraphBuilder.QueryInterface(IMediaControl, l_MediaControl); li_Ret := l_MediaControl.Stop; if (Succeeded(li_Ret)) then begin li_Ret := l_MediaControl.StopWhenReady; end; l_MediaControl := nil; if not(Succeeded(li_Ret)) then begin Exit; end; FGraphBuilder.QueryInterface(IMediaPosition, l_MediaPosition); li_Ret := l_MediaPosition.put_CurrentPosition(0); l_MediaPosition := nil; if not(Succeeded(li_Ret)) then begin Exit; end; Action_Play_PlayPauseExecute(nil); end; end; procedure TApp_Wallvideo.Action_Play_PlayExecute(Sender: TObject); //再生開始 var l_MediaControl : IMediaControl; begin if (Assigned(FGraphBuilder)) then begin FGraphBuilder.QueryInterface(IMediaControl, l_MediaControl); try l_MediaControl.Run; finally l_MediaControl := nil; end; Timer_Time.Enabled := True; end else begin Action_File_OpenFileExecute(nil); end; end; procedure TApp_Wallvideo.Action_Play_PauseExecute(Sender: TObject); //一時停止 var l_MediaControl : IMediaControl; begin Timer_Time.Enabled := False; if (Assigned(FGraphBuilder)) then begin FGraphBuilder.QueryInterface(IMediaControl, l_MediaControl); try l_MediaControl.Pause; finally l_MediaControl := nil; end; Timer_TimeTimer(nil); end; end; procedure TApp_Wallvideo.Action_Play_StopExecute(Sender: TObject); //停止 begin FClose(True); myWallvideo.gpcWallVideoFree; end; procedure TApp_Wallvideo.Action_Play_NextExecute(Sender: TObject); //前へ、次へ var li_Inc : Integer; li_Count : Integer; li_Index : Integer; begin li_Count := FPlaylist.Count; if (li_Count > 0) then begin if (Action_Opt_Random.Checked) then begin //ランダム(シャッフルではない) if (li_Count = 1) then begin FiItemIndex := 0; end else begin repeat li_Index := Random(li_Count); until (li_Index <> FiItemIndex); FiItemIndex := li_Index; end; end else begin if (Sender = Action_Play_Back) then begin li_Inc := -1; end else begin li_Inc := +1; end; FiItemIndex := gfniNumLoop(FiItemIndex + li_Inc, 0, ListBox_Playlist.Count -1); end; FOpen(FiItemIndex); end; end; procedure TApp_Wallvideo.Action_Play_SkipBackExecute(Sender: TObject); //スキップ const lci_SMALLSKIP = 1; lci_NORMALSKIP = 30; lci_LARGESKIP = 90; var li_Skip : Integer; begin if (FindAtom(F_csATOM_DOFUNCTION) <> 0) then begin Exit; end; FBeginFunc; try if (FGraphBuilder = nil) then begin Exit; end; if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin //Shift+Ctrl li_Skip := Trunc(FfDuration / 10); //長さの1/10 end else if (gfnbKeyState(VK_CONTROL)) then begin //Ctrl li_Skip := lci_SMALLSKIP; end else if (gfnbKeyState(VK_SHIFT)) then begin //Shift li_Skip := lci_LARGESKIP; end else begin li_Skip := lci_NORMALSKIP; end; if (Sender = Action_Play_SkipNext) then begin //li_Skipのまま end else if (Sender = Action_Play_SkipBack) then begin li_Skip := -li_Skip; end else begin li_Skip := 0; end; if (li_Skip <> 0) then begin if (Assigned(FGraphBuilder)) then begin Timer_Time.Enabled := False; //TrackBar_Seek.Position := TrackBar_Seek.Position + li_Skip; //TrackBar_SeekChange(nil); FSeek((TrackBar_Seek.Position / F_ciTRACKPOS) + li_Skip); //2013-10-07:バグ修正 Timer_Time.Enabled := True; end; end; finally FEndFunc(False); end; end; procedure TApp_Wallvideo.FSetVolume(iVolume : LongInt); var li_Volume : LongInt; l_BasicAudio : IBasicAudio; begin if (FGraphBuilder <> nil) and (Succeeded(FGraphBuilder.QueryInterface(IBasicAudio, l_BasicAudio))) then begin try if (iVolume <= 0) then begin li_Volume := -10000; end else begin li_Volume := gfniRound(Ln(iVolume / 100) * 1000); end; l_BasicAudio.put_Volume(li_Volume); finally l_BasicAudio := nil; end; end; end; procedure TApp_Wallvideo.Action_Play_MuteExecute(Sender: TObject); var li_Volume : LongInt; begin if (Action_Play_Mute.Checked) then begin Action_Play_Mute.ImageIndex := FiPlay_MuteImageIndex +1; li_Volume := 0; end else begin Action_Play_Mute.ImageIndex := FiPlay_MuteImageIndex; li_Volume := TrackBar_Volume.Position; end; FSetVolume(li_Volume); end; procedure TApp_Wallvideo.TrackBar_VolumeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Exit; // if (gfnbKeyState(VK_LBUTTON)) then begin TrackBar_Volume.Hint := IntToStr(TrackBar_Volume.Position); { if (TrackBar_Volume.Position = 0) then begin TrackBar_Volume.Hint := '-10000db'; end else begin TrackBar_Volume.Hint := Format('%ddb', [gfniRound(Ln(TrackBar_Volume.Position / 100) * 1000)]); end; } Application.ActivateHint(gfnptMousePosGet); // end else begin // TrackBar_Volume.Hint := ''; // end; end; function TApp_Wallvideo.FGetPlaylistIndex(iUniquID: Integer): Integer; var i : Integer; l_MediaInfo : T_MyMediaInfo; begin for i := 0 to FPlaylist.Count-1 do begin l_MediaInfo := T_MyMediaInfo(FPlaylist.Objects[i]); if (l_MediaInfo <> nil) then begin if (l_MediaInfo.UniquID = iUniquID) then begin Result := i; Exit; end; end; end; Result := -1; end; procedure TApp_Wallvideo.Action_Sort_MenuPopupExecute(Sender: TObject); var l_Pos : TPoint; begin l_Pos := gfnptClientToScreen(ToolBar_Main.Handle, Point(ToolButton_Sort.Left, ToolButton_Sort.Top + ToolButton_Sort.Height)); ToolButton_Sort.PopupMenu.Popup(l_Pos.X, l_Pos.Y); end; procedure TApp_Wallvideo.Action_Sort_FileNameExecute(Sender: TObject); const lci_SORT_NONE = 0; lci_SORT_SHUFFLE = 1; lci_SORT_FILENAME = 2; lci_SORT_PATH = 3; lci_SORT_NAME = 4; lci_SORT_EXT = 5; function _MakCaption(sCaption: String; iSort: Integer): String; var li_Pos : Integer; ls_Marker : String; begin li_Pos := Pos(' ', sCaption); if (li_Pos > 0) then begin Result := Copy(sCaption, 1, li_Pos -1); end else begin Result := sCaption; end; if (Abs(FiSort) = iSort) then begin if (FiSort > 0) then begin ls_Marker := ' △'; end else if (FiSort < 0) then begin ls_Marker := ' ▽'; end else begin ls_Marker := ''; end; Result := Result + ls_Marker; end; end; procedure _DoSort(iSort: Integer; fnAscend, fnDescend: TMyWStringsSortCompare); var l_List : TMyFileStrings; l_ListBox : TListBox; l_Strings : TMyWStrings; begin if (Abs(FiSort) = iSort) then begin FiSort := -FiSort; end else begin FiSort := iSort; end; FGetDispList(l_ListBox, l_Strings); l_Strings.BeginUpdate; try l_List := nil; try l_List := TMyFileStrings.Create(l_Strings.UStrings); if (Abs(FiSort) = lci_SORT_SHUFFLE) then begin l_List.Shuffle; end else if (FiSort >= 0) then begin l_List.CustomSort(fnAscend); end else begin l_List.CustomSort(fnDescend); end; finally l_List.Free; end; finally l_Strings.EndUpdate; end; end; var i : Integer; li_UniquID : Integer; begin FBeginFunc; try if (Assigned(FPlaylist.Objects[FiItemIndex])) then begin li_UniquID := T_MyMediaInfo(FPlaylist.Objects[FiItemIndex]).UniquID; end else begin li_UniquID := -1; end; if (Sender = Action_Sort_FileName) then begin _DoSort(lci_SORT_FILENAME, gfniSortFuncFileNameAscending, gfniSortFuncFileNameDescending); end else if (Sender = Action_Sort_Folder) then begin _DoSort(lci_SORT_PATH, gfniSortFuncMediaPathAscending, gfniSortFuncMediaPathDescending); end else if (Sender = Action_Sort_Name) then begin _DoSort(lci_SORT_NAME, gfniSortFuncMediaNameAscending, gfniSortFuncMediaNameDescending); end else if (Sender = Action_Sort_Ext) then begin _DoSort(lci_SORT_EXT, gfniSortFuncMediaExtAscending, gfniSortFuncMediaExtDescending); end else if (Sender = Action_Sort_Shuffle) then begin _DoSort(lci_SORT_SHUFFLE, nil, nil); FiSort := lci_SORT_SHUFFLE; end else begin FiSort := lci_SORT_NONE; end; Action_Sort_FileName.Caption := _MakCaption(Action_Sort_FileName.Caption, lci_SORT_FILENAME); Action_Sort_Folder.Caption := _MakCaption(Action_Sort_Folder.Caption, lci_SORT_PATH); Action_Sort_Name.Caption := _MakCaption(Action_Sort_Name.Caption, lci_SORT_NAME); Action_Sort_Ext.Caption := _MakCaption(Action_Sort_Ext.Caption, lci_SORT_EXT); if (Sender = nil) then begin Exit; end else if (FiSort <> lci_SORT_NONE) then begin ToolButton_Sort.Action := TAction(Sender); end; if (FIsFindlistPage) then begin ListBox_FindList.Refresh; Exit; end; FResetPlaylistIndex; if (li_UniquID >= 0) then begin FiItemIndex := FGetPlaylistIndex(li_UniquID); end else begin for i := 0 to FPlaylist.Count-1 do begin if (gfnbIsEqualFileName(FPlaylist[i], FsFileName)) then begin FiItemIndex := i; Exit; end; end; //該当するファイルがなかった。 //ここにくることはないはず gpcShowMessage('ソートエラー'); end; finally FEndFunc(True); end; end; procedure TApp_Wallvideo.FClose(bClearIndex: Boolean); var l_MediaControl : IMediaControl; begin if (bClearIndex) then begin FiItemIndex := -1; Label_Time.Caption := ''; Label_Info.Caption := ''; // Self.Hint := ''; Self.Caption := gfnsProductNameGet; end; FbPassClockChanged := False; FbStart := False; Timer_Time.Enabled := False; Timer_IsPlay.Enabled := False; //AIU if (FGraphBuilder <> nil) then begin FadeOut; FGraphBuilder.QueryInterface(IMediaControl, l_MediaControl); l_MediaControl.Stop; l_MediaControl := nil; DisconnectFilters(FGraphBuilder); end; TrackBar_Seek.Position := 0; TrackBar_Seek.Hint := ''; FClearInfo; FMediaPosition := nil; FAudioRenderer := nil; FVideoRenderer := nil; FOverlayMixer := nil; FVideoDecoder := nil; FMediaEventEx := nil; FGraphBuilder := nil; FiVideoWidth := 0; FiVideoHeight := 0; //ツールバーの開く関連ボタンと壁紙ビデオのボタンの不具合への対処 //やっつけ気味 if (Self.Tag = 0) then begin Exit; end; PopupMenu_MainPopup(nil); FRefreshList; end; const F_ciHISTORYCOUNT = 30; procedure TApp_Wallvideo.FAddOpenHistory(AMenuItem: TMenuItem; AList: TMyWStrings); var i : Integer; begin for i := AList.Count -1 downto 0 do begin FAddOpenHistory(AMenuItem, AList[i]); end; end; procedure TApp_Wallvideo.FAddOpenHistory(AMenuItem: TMenuItem; AList: TStrings); var i : Integer; begin for i := AList.Count -1 downto 0 do begin FAddOpenHistory(AMenuItem, AList[i]); end; end; procedure TApp_Wallvideo.FAddOpenHistory(AMenuItem: TMenuItem; sFileName: String); var i : Integer; ls_File : String; ls_Name : String; ls_Caption : String; begin if (sFileName = '') then begin Exit; end; ls_File := UpperCase(sFileName); //履歴に同じファイルがあれば一番上にもっていくために削除しておく for i := AMenuItem.Count -1 downto 0 do begin if (UpperCase(AMenuItem[i].Hint) = ls_File) then begin AMenuItem[i].Free; end; end; //空いている名前を取得する ls_Name := gfnsAvailableName('OpenHistory'); if (sFileName[Length(sFileName)] = '\') then begin ls_Caption := sFileName; end else begin ls_Caption := ExtractFileName(sFileName); end; //頭に挿入 AMenuItem.Insert(0, NewItem( ls_Caption, //Caption 0, //ShortCut False, //Checked True, //Enabled MenuItem_OpenHistoryClick, //OnClickイベント 0, //HelpContext ls_Name //Name )); AMenuItem[0].Hint := sFileName; if (AMenuItem.Count > F_ciHISTORYCOUNT) then begin //最後の履歴を削除 AMenuItem[AMenuItem.Count-1].Free; end; end; procedure TApp_Wallvideo.MenuItem_OpenHistoryClick(Sender: TObject); var l_MenuItem : TMenuItem; ls_Item : String; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); ls_Item := TMenuItem(Sender).Hint; if (l_MenuItem.GetParentMenu = PopupMenu_OpenFile) then begin //開くの履歴 Dialog_OpenFile.Files.Clear; Dialog_OpenFile.Files.Add(ls_Item); Action_File_OpenFileExecute(nil); end else if (l_MenuItem.GetParentMenu = PopupMenu_OpenFolder) then begin //フォルダを開くの履歴 Dialog_OpenFolder.Folders.Clear; Dialog_OpenFolder.Folders.Add(ls_Item); Action_File_OpenFolderExecute(nil); end; end; procedure TApp_Wallvideo.MyMessagePanel1TextChange(Sender: TObject; Text: string); var i : Integer; l_Param : TMyParam; l_Option : TMyParamOption; begin {$IFDEF _DEBUG} (* if (Pos('/TIME:', Text) = 0) then begin myDebug.gpcDebug(Text); end; *) {$ENDIF} l_Param := TMyParam.Create(Text); try for i := 0 to l_Param.Count -1 do begin l_Option := l_Param.OptionParam[i]; if (l_Option.CompareOption(G_csSUBPLAYER_MSG)) then begin //メッセージの送り先 FhSubPlayerMsgHwnd := l_Option.ValueInt; FhSubPlayerHwnd := gfnhToplevelWindowGet(FhSubPlayerMsgHwnd); end; end; finally l_Param.Free; end; end; procedure TApp_Wallvideo.Action_File_OpenFileExecute(Sender: TObject); //開く begin FBeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin Dialog_OpenFile.InitialDir := _GetIniDir; Dialog_OpenFile.FileName := ''; end else if not(gfnbFolderExists(Dialog_OpenFile.InitialDir)) then begin Dialog_OpenFile.InitialDir := gfnsExistsFolderGet(Dialog_OpenFile.InitialDir); end; if (Sender = nil) or (Dialog_OpenFile.Execute) then begin Dialog_OpenFile.InitialDir := gfnsExistsFolderGet(Dialog_OpenFile.FileName); FAddList(Dialog_OpenFile.Files); //開いた履歴に追加 FAddOpenHistory(PopupMenu_OpenFile.Items, Dialog_OpenFile.Files); end; finally FEndFunc(False); end; end; procedure TApp_Wallvideo.Action_File_OpenFolderExecute(Sender: TObject); begin FBeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin Dialog_OpenFolder.InitialDir := _GetIniDir; end else if not(gfnbFolderExists(Dialog_OpenFolder.InitialDir)) then begin Dialog_OpenFolder.InitialDir := gfnsExistsFolderGet(Dialog_OpenFolder.InitialDir); end; if (Sender = nil) or (Dialog_OpenFolder.Execute) then begin Dialog_OpenFolder.InitialDir := Dialog_OpenFolder.FolderName; // if (gfnbKeyState(VK_SHIFT)) // then begin // //選択フォルダのファイルのみリストアップ // Action_File_OpenThisFolderExecute(nil); // end else // begin //サブフォルダ内のファイルも含めてリストアップ FAddList(Dialog_OpenFolder.Folders.UStrings); // end; FAddOpenHistory(PopupMenu_OpenFolder.Items, Dialog_OpenFolder.Folders); end; finally FEndFunc(False); end; end; procedure TApp_Wallvideo.Action_File_OpenThisFolderExecute(Sender: TObject); //サブフォルダ内のファイルは含めずリストアップ var l_Dir : TMyWStrings; lh_File : THandle; lr_Info : TWin32FindData; begin FBeginFunc; try if (gfnbKeyState(VK_SHIFT)) then begin Dialog_OpenThisFolder.InitialDir := _GetIniDir; end else if not(gfnbFolderExists(Dialog_OpenThisFolder.InitialDir)) then begin Dialog_OpenThisFolder.InitialDir := gfnsExistsFolderGet(Dialog_OpenThisFolder.InitialDir); end; if (Sender = nil) or (Dialog_OpenThisFolder.Execute) then begin Dialog_OpenThisFolder.InitialDir := Dialog_OpenThisFolder.FolderName; l_Dir := TMyWStrings.Create; try lh_File := Windows.FindFirstFile(PChar(Dialog_OpenThisFolder.FolderName + '\*.*'), lr_Info); if (lh_File <> INVALID_HANDLE_VALUE) then begin repeat if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin l_Dir.Add(gfnsStrEndFit(Dialog_OpenThisFolder.FolderName, '\') + lr_Info.cFileName); end; // Application.ProcessMessages; until not(Windows.FindNextFile(lh_File, lr_Info)); Windows.FindClose(lh_File); end; FAddList(l_Dir.UStrings); finally l_Dir.Free; end; FAddOpenHistory(PopupMenu_OpenThisFolder.Items, Dialog_OpenThisFolder.Folders); end; finally FEndFunc(False); end; end; procedure TApp_Wallvideo.Action_File_OpenMediaFolderExecute(Sender: TObject); //メディアのフォルダを開く var ls_File : String; ls_Folder : String; l_ListBox : TListBox; l_Strings : TMyWStrings; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin ls_File := FsFileName; end else begin if not(gfnbIsListBoxItemIndexSelected(l_ListBox)) then begin Exit; end; ls_File := l_Strings[l_ListBox.ItemIndex]; end; ls_Folder := gfnsFilePathGet(ls_File); //gfnbFolderExistsは引数にファイル名を渡した場合パスを切り離すことはしない if not(gfnbFolderExists(ls_Folder)) then begin Exit; end; gpcExploreOpen(ls_Folder); end; procedure TApp_Wallvideo.Action_List_PropertyExecute(Sender: TObject); var ls_File : WideString; l_ListBox : TListBox; l_Strings : TMyWStrings; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin l_ListBox := ListBox_Playlist; end; if not(gfnbIsListBoxItemIndexSelected(l_ListBox)) then begin Exit; end; ls_File := l_Strings[l_ListBox.ItemIndex]; //エクスプローラのプロパティページ gpcPropertyPageOpen(Format('"%s"', [ls_File])); end; //------------------------------------------------------------------------------ procedure TApp_Wallvideo.FGetDispList(var AListBox: TListBox; var AStrings: TMyWStrings); begin if (PageControl1.ActivePage = TabSheet_FindList) then begin AListBox := ListBox_FindList; AStrings := FFindList; end else if (PageControl1.ActivePage = TabSheet_History) then begin AListBox := ListBox_History; AStrings := FHistoryList; end else if (PageControl1.ActivePage = TabSheet_VideoWindow) then begin AListBox := nil; AStrings := FPlaylist; end else begin AListBox := ListBox_Playlist; AStrings := FPlaylist; end; end; function TApp_Wallvideo.FIsPlaylistPage: Boolean; begin Result := (PageControl1.ActivePage = TabSheet_Playlist); end; function TApp_Wallvideo.FIsFindlistPage: Boolean; begin Result := (PageControl1.ActivePage = TabSheet_Findlist); end; function TApp_Wallvideo.FIsHistoryPage: Boolean; begin Result := (PageControl1.ActivePage = TabSheet_History); end; function TApp_Wallvideo.FIsVideoWindowPage: Boolean; begin Result := (PageControl1.ActivePage = TabSheet_VideoWindow); end; //--- 検索 --------------------------------------------------------------------- procedure TApp_Wallvideo.Action_Find_DispExecute(Sender: TObject); begin Panel_Find_Playlist.Visible := Action_Find_Disp.Checked; Panel_Find_Findlist.Visible := Panel_Find_Playlist.Visible; Panel_Find_History.Visible := Panel_Find_Playlist.Visible; FormResize(nil); end; procedure TApp_Wallvideo.ComboBox_Find_TextChange(Sender: TObject); begin Action_Find_ListUp.Enabled := (gfnsFindTrim(ComboBox_Find_Text.Text) <> ''); if (Action_Find_ListUp.Enabled) then begin if (FIsFindlistPage) then begin Action_Find_ListUp.Enabled := (FFindlist.Count > 0); end else begin Action_Find_ListUp.Enabled := (FPlaylist.Count > 0); end; end; Action_Find_FindDown.Enabled := Action_Find_ListUp.Enabled and not(FIsVideoWindowPage) ; Action_Find_FindUp.Enabled := Action_Find_FindDown.Enabled; Action_Find_FindTop.Enabled := Action_Find_FindDown.Enabled; // and (FIsPlaylistPage or FIsFindlistPage) ; end; procedure TApp_Wallvideo.ComboBox_Find_TextSelect(Sender: TObject); begin gpcFindHistoryAdd(ComboBox_Find_Text.Items, ComboBox_Find_Text.Text); end; procedure TApp_Wallvideo.Action_Find_ClearExecute(Sender: TObject); begin FFindList.Clear; ResetFindlistCount; end; procedure TApp_Wallvideo.Action_Find_FindDownExecute(Sender: TObject); procedure _SetFocus(iIndex: Integer); begin ListBox_Playlist.Items.BeginUpdate; try ListBox_Playlist.ClearSelection; ListBox_Playlist.Selected[iIndex] := True; if not(gfnbListBoxIsViewIndex(ListBox_Playlist, iIndex)) then begin ListBox_Playlist.TopIndex := iIndex; end; finally ListBox_Playlist.Items.EndUpdate; end; gpcSetFocus(ListBox_Playlist); end; var i : Integer; l_ListBox : TListBox; l_Strings : TMyWStrings; li_Start : Integer; li_End : Integer; li_Inc : Integer; li_Shift : Integer; l_Find : TStrings; lb_Match : Boolean; begin if (Sender = Action_Find_FindDown) or (Sender = Action_Find_FindTop) or (Sender = Action_Find_FindUp) then begin //OK end else begin //NG Beep; Exit; end; if (gfnsFindTrim(ComboBox_Find_Text.Text) = '') then begin Beep; Exit; end; FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin // l_ListBox := ListBox_Playlist; Exit; end; l_Find := nil; try l_Find := TStringList.Create; gpcFindDiv(ComboBox_Find_Text.Text, l_Find); gpcFindHistoryAdd(ComboBox_Find_Text.Items, ComboBox_Find_Text.Text); ComboBox_Find_Text.Text := ComboBox_Find_Text.Items[0]; if (l_ListBox.Tag <> 0) then begin li_Shift := 0; l_ListBox.Tag := 0; end else begin li_Shift := 1; end; if (Sender = Action_Find_FindDown) or (Sender = Action_Find_FindTop) then begin li_Inc := 1; li_End := l_ListBox.Count-1; if (Sender = Action_Find_FindTop) then begin li_Start := 0; end else begin // li_Start := gfniNumLimit(l_ListBox.ItemIndex + li_Shift, 0, li_End); li_Start := l_ListBox.ItemIndex + li_Shift; end; end else if (Sender = Action_Find_FindUp) then begin li_Inc := -1; li_End := 0; // li_Start := gfniNumLimit(l_ListBox.ItemIndex - li_Shift, 0, l_ListBox.Count-1); li_Start := l_ListBox.ItemIndex - li_Shift; end else begin li_Inc := 1; li_Start := 0; li_End := l_ListBox.Count-1; end; //{TODO: 検索対象をループさせる} i := li_Start; while gfnbIsInsideRangeEx(i, li_Start, li_End) do begin lb_Match := gfnbIsFindMatch(gfnsFindConvert(l_Strings[i]), l_Find, not(Action_Find_Opt_Or.Checked)); if (Action_Find_Opt_Not.Checked) then begin lb_Match := not(lb_Match) end; if (lb_Match) then begin l_ListBox.Items.BeginUpdate; try l_ListBox.ClearSelection; l_ListBox.Selected[i] := True; if not(gfnbListBoxIsViewIndex(l_ListBox, i)) then begin l_ListBox.TopIndex := i; end; finally l_ListBox.Items.EndUpdate; end; gpcSetFocus(l_ListBox); Exit; end; Inc(i, li_Inc); end; gpcShowMessage('一致する検索結果がみつかりませんでした'); finally l_Find.Free; end; // Beep; end; procedure TApp_Wallvideo.Action_Find_ListUpExecute(Sender: TObject); var i : Integer; l_Find : TStrings; l_MediaInfo : T_MyMediaInfo; l_Strings : TMyWStrings; lb_Free : Boolean; lb_Match : Boolean; begin lb_Free := False; l_Strings := nil; try if (FIsFindlistPage) then begin l_Strings := TMyWStrings.Create; l_Strings.ObjectsFree := False; l_Strings.Assign(FFindList); lb_Free := True; end else if (FIsHistoryPage) then begin l_Strings := FHistoryList; end else begin l_Strings := FPlaylist; end; FFindList.Clear; l_Find := nil; try l_Find := TStringList.Create; gpcFindDiv(ComboBox_Find_Text.Text, l_Find); gpcFindHistoryAdd(ComboBox_Find_Text.Items, ComboBox_Find_Text.Text); ComboBox_Find_Text.Text := ComboBox_Find_Text.Items[0]; for i := 0 to l_Strings.Count-1 do begin lb_Match := gfnbIsFindMatch(gfnsFindConvert(l_Strings[i]), l_Find, not(Action_Find_Opt_Or.Checked)); if (Action_Find_Opt_Not.Checked) then begin lb_Match := not(lb_Match) end; if (lb_Match) then begin if (l_Strings.Objects[i] = nil) then begin l_MediaInfo := T_MyMediaInfo.Create(l_Strings[i]); end else begin // l_MediaInfo := T_MyMediaInfo.Create; // l_MediaInfo.Assign(T_MyMediaInfo(FPlaylist.Objects[i])); l_MediaInfo := T_MyMediaInfo(l_Strings.Objects[i]); end; FFindList.AddObject(l_Strings[i], l_MediaInfo); end; end; ResetFindlistCount; FChangeTab(TabSheet_FindList); gpcSetFocus(ListBox_Findlist); finally l_Find.Free; end; finally if (lb_Free) then begin l_Strings.Free; end; end; end; //--- 検索ここまで ------------------------------------------------------------- procedure TApp_Wallvideo.Action_Help_HelpExecute(Sender: TObject); //ヘルプ const lcs_HELPFILE = 'hlp\index.html'; var ls_HelpFile : String; begin ls_HelpFile := gfnsExePathGet + lcs_HELPFILE; Action_Help_Help.Visible := FileExists(ls_HelpFile); if not(Action_Help_Help.Visible) or (Sender = nil) then begin Exit; end; gpcExecute(ls_HelpFile); end; procedure TApp_Wallvideo.Action_Help_VersionInfoExecute(Sender: TObject); //ヘルプバージョン情報 begin gpcVersionInfoCreate; gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/xe/wallvideo/help/'); gpcVersionInfoShowModal; gpcVersionInfoRelease; end; procedure TApp_Wallvideo.Action_Info_CopyTitleExecute(Sender: TObject); var ls_Str: WideString; begin if (Sender = Action_Info_CopyTitle) then begin ls_Str := Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_TITLE]; end else if (Sender = Action_Info_CopyArtist) then begin ls_Str := Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_ARTIST]; end else if (Sender = Action_Info_CopyAlbum) then begin ls_Str := Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_ALBUM]; end else begin ls_Str := ''; end; ls_Str := Trim(ls_Str); if (ls_Str <> '') then begin gpcStrToClipboard(ls_Str); end; end; procedure TApp_Wallvideo.PopupMenu_InfoPopup(Sender: TObject); begin Action_Info_CopyTitle.Enabled := (Trim(Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_TITLE]) <> ''); Action_Info_CopyArtist.Enabled := (Trim(Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_ARTIST]) <> ''); Action_Info_CopyAlbum.Enabled := (Trim(Grid_Info.Cells[F_ciCOL_VALUE, F_ciROW_ALBUM]) <> ''); end; procedure TApp_Wallvideo.FDispCount(iCount: Integer; sFileName: String); //ファイル取得中の表示 begin FiGetFileCount := iCount; FsGetFileName := sFileName; end; procedure TApp_Wallvideo.Timer_GetFileTimer(Sender: TObject); //ファイル取得中の表示 begin if (FsGetFileName <> '') then begin // Self.Caption := Format('[%d] %s', [FiGetFileCount, FsGetFileName]); Label_Info.Caption := Format('[%d] %s', [FiGetFileCount, FsGetFileName]); Label_Info.Update; end else begin // Self.Caption := ''; Label_Info.Caption := ''; // FSetCaption; end; end; procedure TApp_Wallvideo.Timer_IsPlayTimer(Sender: TObject); function _GetPlayState: Integer; var li_Ret : HRESULT; l_State : TFilterState; li_Count : Integer; l_MediaControl : IMediaControl; begin Result := gciPLAYSTATE_STOPPED; if (FGraphBuilder <> nil) then begin FGraphBuilder.QueryInterface(IMediaControl, l_MediaControl); try li_Count := 1; repeat li_Ret := l_MediaControl.GetState(100, l_State); Inc(li_Count); until Succeeded(li_Ret) or (li_Count >= 10); finally l_MediaControl := nil; end; if (li_Ret = S_OK) then begin case l_State of State_Stopped: Result := gciPLAYSTATE_STOPPED; State_Paused : Result := gciPLAYSTATE_PAUSED; State_Running: Result := gciPLAYSTATE_PLAYING; end; end; end; end; var l_State : Integer; begin Timer_IsPlay.Enabled := False; l_State := _GetPlayState; if (l_State = gciPLAYSTATE_PLAYING) or (l_State = gciPLAYSTATE_PAUSED) then begin Exit; end; // 何故か品質云々でサンプルを削除しましたというイベント起きるようになってしまった TrackBar_Seek.Position := TrackBar_Seek.Position; FSeek(TrackBar_Seek.Position div F_ciTRACKPOS); end; function TApp_Wallvideo.FGetListObject(sFileName: WideString; AFindData: TWin32FindDataW): TObject; begin // Result := nil; Result := T_MyMediaInfo.Create(sFileName, AFindData); T_MyMediaInfo(Result)._SetUniquID(FiUniquID); Inc(FiUniquID); // T_MyMediaInfo(Result)._SetID(FPlaylist.Count-1); // T_MyMediaInfo(Result).PlaylistIndex := T_MyMediaInfo(Result).UniquID; end; procedure TApp_Wallvideo.FAddList(AList: TStrings; bSort: Boolean = True); var i : Integer; li_Count : Integer; l_List : TMyMediaStrings; l_Exts : TStrings; begin if (Action_List_OpenAdd.Checked) then begin //リストに追加 li_Count := FPlaylist.Count; end else begin //リストを置き換え li_Count := 0; FClearInfo; Action_Find_ClearExecute(nil); FiUniquID := 0; end; l_List := nil; try l_List := TMyMediaStrings.Create; l_List.IsAppend := Action_List_OpenAdd.Checked; l_Exts := nil; try l_Exts := TStringList.Create; gpcDialogFilterExtToStrings(Dialog_OpenFile.Filter, l_Exts); for i := l_Exts.Count -1 downto 0 do begin if (l_Exts[i] = '*.*') then begin l_Exts.Delete(i); end else begin l_Exts[i] := gfnsFileExtGet(l_Exts[i]); end; end; l_List.AllowExtAdd(l_Exts); finally l_Exts.Free; end; Timer_GetFile.Enabled := True; l_List.DisallowExt.Assign(FDisallowExts.UStrings); l_List.OnDispCount := FDispCount; l_List.NeedExists := False; l_List.ObjectsFree := False; l_List.OnGetListObject := FGetListObject; l_List.IsGetSort := bSort; l_List.GetList(AList); Timer_GetFile.Enabled := False; if (l_List.Count = 0) then begin gpcShowMessage('取得ファイルがありませんでした'); Exit; end; FbInfoPlaying := True; //ソートマーカーを消しておく Action_Sort_FileNameExecute(nil); if (Action_List_OpenAdd.Checked) then begin //リストに追加 FPlaylist.AddStrings(l_List); end else begin //リストを置き換え FPlaylist.Assign(l_List); end; ResetCount; PopupMenu_MainPopup(nil); // FChangeTab(TabSheet_Playlist); if (gfnbIsInsideRange(FiResumeIndex, 0, FPlaylist.Count-1)) and (FsFileName <> '') and (gfnbIsEqualFileName(FPlaylist[FiResumeIndex], FsFileName)) then begin FiItemIndex := FiResumeIndex; end else begin if (Action_Opt_Random.Checked) then begin FiItemIndex := Random(l_List.Count) + li_Count; end else begin FiItemIndex := li_Count; end; end; FOpen(FiItemIndex); finally l_List.Free; end; end; procedure TApp_Wallvideo.FCreateSubForm; //サブフォーム作成 begin gpcExecuteWait(gfnsExeNameGet, Format('/%s /%s:%d', [G_csSUBPLAYER_RUN, G_csMAINPLAYER_MSG, MyMessagePanel1.Handle])); end; function TApp_Wallvideo.FSubFormExists: Boolean; begin if not(IsWindow(FhSubPlayerHwnd)) then begin FCreateSubForm; end; Result := IsWindow(FhSubPlayerHwnd); end; procedure TApp_Wallvideo.Grid_InfoDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var li_Opt : Cardinal; begin with Grid_Info.Canvas do begin Font.Assign(Grid_Info.Font); Brush.Color := Grid_Info.Color; Font.Color := Grid_Info.Font.Color; FillRect(Rect); Inc(Rect.Left, F_ciMARGIN); li_Opt := DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER; { if (ACol = lciCOL_ITEM) then begin li_Opt := li_Opt or DT_RIGHT; end; } DrawText(Handle, PChar(Grid_Info.Cells[ACol, ARow]), -1, Rect, li_Opt); end; end; function TApp_Wallvideo.FMediaHasVideo : Boolean; begin Result := (FiVideoWidth > 0) and (FiVideoHeight > 0); end; function TApp_Wallvideo.FGetFrameRateString(fFrame: TRefTime): String; function _GetAvgTimePerFrame: TRefTime; var l_EnumPins : IEnumPins; l_Pin : IPin; l_PinInfo : TPinInfo; l_MediaType : TAMMediaType; li_Time : Int64; begin Result := 0; l_EnumPins := nil; try if (FOverlayMixer <> nil) then begin FOverlayMixer.EnumPins(l_EnumPins); end else if (FVideoRenderer <> nil) then begin FVideoRenderer.EnumPins(l_EnumPins); end; if (l_EnumPins <> nil) then begin while(l_EnumPins.Next(1, l_Pin, nil) = S_OK) do begin l_Pin.QueryPinInfo(l_PinInfo); try if (l_PinInfo.dir = PINDIR_INPUT) then begin //入力 l_Pin.ConnectionMediaType(l_MediaType); try if (IsEqualGUID(l_MediaType.majortype, MEDIATYPE_Video)) then begin if (IsEqualGUID(l_MediaType.formattype, FORMAT_VideoInfo)) then begin //VIDEOINFOHEADER li_Time := PVideoInfoHeader(l_MediaType.pbFormat)^.AvgTimePerFrame; end else if (IsEqualGUID(l_MediaType.formattype, FORMAT_VideoInfo2)) then begin //VIDEOINFOHEADER2 li_Time := PVideoInfoHeader2(l_MediaType.pbFormat)^.AvgTimePerFrame; end else if (IsEqualGUID(l_MediaType.formattype, FORMAT_MPEGVideo)) then begin //MPEG1VIDEOINFO li_Time := PMpeg1VideoInfo(l_MediaType.pbFormat)^.hdr.AvgTimePerFrame; end else if (IsEqualGUID(l_MediaType.formattype, FORMAT_MPEG2Video)) then begin //MPEG2VIDEOINFO li_Time := PMpeg2VideoInfo(l_MediaType.pbFormat)^.hdr.AvgTimePerFrame; end else begin li_Time := 0; end; if (li_Time > 0) then begin Result := li_Time / UNITS; Break; end; end; finally FreeMediaType(@l_MediaType); end; end; finally if (l_PinInfo.pFilter <> nil) then begin l_PinInfo.pFilter := nil; end; l_Pin := nil; end; end; end; finally l_EnumPins := nil; end; end; var l_AvgTimePerFrame : TRefTime; begin // l_AvgTimePerFrame := _GetAvgTimePerFrame; l_AvgTimePerFrame := fFrame; if (l_AvgTimePerFrame = 0) then begin Result := '-'; end else begin // Result := Format('%g', [gfniRound(100 / l_AvgTimePerFrame) / 100]); Result := Format('%g', [l_AvgTimePerFrame]); end; end; procedure TApp_Wallvideo.FSetCaption; //キャプション設定 begin Self.Caption := gfnsProductNameGet; if (FsFileName <> '') then begin Self.Caption := Self.Caption + '/' + ChangeFileExt(ExtractFileName(FsFileName), ''); // StatusBar_Hint.SimpleText := ChangeFileExt(ExtractFileName(FsFileName), ''); end else begin // StatusBar_Hint.SimpleText := ''; end; end; procedure TApp_Wallvideo.FAddHistoryList(sFileName: WideString); const lci_HISTORY_COUNT = 100; var li_Index : Integer; begin if (FHistoryList.Count > 0) then begin if not(gfnbIsEqualFileName(FHistoryList[0], sFileName)) then begin FHistoryList.Insert(0, sFileName); end; end else begin FHistoryList.Insert(0, sFileName); end; if (FHistoryList.Count > lci_HISTORY_COUNT) then begin //AIU li_Index := FHistoryList.Count-1; if (FHistoryList.Objects[li_Index] <> nil) then begin FHistoryList.Objects[li_Index].Free; FHistoryList.Objects[li_Index] := nil; end; FHistoryList.Delete(li_Index); end; ResetHistoryCount; end; procedure TApp_Wallvideo.FOpen(iIndex: Integer); //ファイルを開いて再生 procedure _SetVideoWindow; var l_VideoWindow : IVideoWindow; begin FGraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow); try l_VideoWindow.put_Owner(Panel_VideoWindow.Handle); l_VideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS); l_VideoWindow.put_MessageDrain(Panel_VideoWindow.Handle); //マウスメッセージを拾えるようにする //SetWindowForegroundはSetWindowPosの後でないと機能しない(必ずフラッシュしてしまう) // l_VideoWindow.SetWindowForeground(OAFALSE); //タスクバーがフラッシュするのを防ぐ finally l_VideoWindow := nil; end; FormResize(nil); Panel_VideoWindowResize(nil); end; procedure _DeleteList; var li_Ret : Integer; ls_File : String; begin li_Ret := mrYes; if (Action_Opt_ConfirmErr.Checked) then begin if (Action_List_FolderName.Checked) then begin ls_File := FsFileName; end else begin ls_File := ExtractFileName(FsFileName); end; li_Ret := gfniMessageBoxYesNo(Format('%s'#13#13'は再生できないためリストから削除します'#13'よろしいですか', [ls_File])); end; if (li_Ret = ID_YES) then begin StatusBar_Hint.SimpleText := Format('%s をリストから削除しました', [ExtractFileName(FsFileName)]); StatusBar_Hint.Repaint; //Application.ProcessMessages; Action_List_DeletePlayingExecute(nil); end; end; var l_VideoWindow : IVideoWindow; lb_Wallvideo : Boolean; // l_VideoSize : TMyVideoSize; l_MediaInfo : T_MyMediaInfo; //amazon用 li_Ret : HResult; l_WMASFReader : IBaseFilter; l_FileSourceFilter : IFileSourceFilter; begin FBeginFunc; try FClose(False); if (FPlaylist.Count = 0) then begin Exit; end; if (ListBox_Playlist.ItemIndex < 0) then begin ListBox_Playlist.ItemIndex := 0; end; FsFileName := FPlaylist[iIndex]; l_VideoSize := gfnVideoSizeGet(FsFileName); if (l_VideoSize.Duration <= 0) then begin _DeleteList; Exit; end; FiVideoWidth := l_VideoSize.Width; FiVideoHeight := l_VideoSize.Height; FfDuration := l_VideoSize.Duration; FfVideoFrameRate := l_VideoSize.VideoFrameRate; TrackBar_Seek.Max := Trunc(FfDuration * F_ciTRACKPOS); if (FPlaylist.Objects[iIndex] = nil) then begin l_MediaInfo := T_MyMediaInfo.Create(FsFileName); FPlaylist.Objects[iIndex] := l_MediaInfo; end else begin l_MediaInfo := T_MyMediaInfo(FPlaylist.Objects[iIndex]); end; l_MediaInfo._SetVideoSize(l_VideoSize); CreateGraphBuilder(FGraphBuilder); if (FMediaHasVideo) then begin if (Action_Video_Wallvideo.Checked) then begin CreateOverlayMixer(FOverlayMixer, FVideoRenderer, FGraphBuilder); end else begin // CreateVideoRenderer(FVideoRenderer, FGraphBuilder); CreateVMR9(FVideoRenderer, FGraphBuilder) end; if (Action_Opt_UseFfdShow.Checked) then begin Create_ffdshow(FVideoDecoder, FGraphBuilder); end; end; //イベント通知ウィンドウをセット。 FGraphBuilder.QueryInterface(IMediaEventEx, FMediaEventEx); FMediaEventEx.SetNotifyWindow(Self.Handle, WM_GRAPH_NOTIFY, 0); //読み込み if (Failed(FGraphBuilder.RenderFile(PChar(FsFileName), nil))) then begin //amazonのmp3は↑だと失敗するのでWM ASF Readerを使う。 //WM ASF Readerは自分で作成してグラフに追加しておかなければならない。 //更に繋ぐオーディオレンダラーも(デフォルトのものであっても)自分で作成してグラフに追加しておかなくてはならない。 CoCreateInstance( CLSID_WMAsfReader, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, l_WMASFReader ); //http://www.codeproject.com/KB/directx/saveimagefromstreamingurl.aspx FGraphBuilder.AddFilter(l_WMASFReader, 'WM ASF Reader'); l_WMASFReader.QueryInterface(IID_IFileSourceFilter, l_FileSourceFilter); l_FileSourceFilter.Load(PChar(FsFileName), nil); l_FileSourceFilter := nil; CreateBaseFilter(FAudioRenderer, CLSID_AudioRendererCategory, 'Default DirectSound Device'); FGraphBuilder.AddFilter(FAudioRenderer, 'WM ASF Reader'); li_Ret := ConnectFilters(FGraphBuilder, l_WMASFReader, FAudioRenderer); l_WMASFReader := nil; if (Failed(li_Ret)) then begin _DeleteList; Exit; end; end; if (FfResumePos >= FfDuration) then begin FfResumePos := 0; FClose(False); Action_Play_NextExecute(Action_Play_Next); Exit; end; //再生時間取得用 FGraphBuilder.QueryInterface(IMediaPosition, FMediaPosition); FMediaPosition.put_CurrentPosition(FfResumePos); FfResumePos := 0; if not(Action_Video_Wallvideo.Checked) then begin _SetVideoWindow; //壁紙ビデオ用のデスクトップの背景を元に戻す myWallvideo.gpcWallVideoFree; end else begin //壁紙ビデオ lb_Wallvideo := False; if (FMediaHasVideo) then begin if not(FSubFormExists) or not(gfnbIsOverlayMixerInputConected(FOverlayMixer)) then begin Beep; //オーバーレイが使用できなかった DisconnectPins(FOverlayMixer); DisconnectPins(FVideoRenderer); RemoveFilters(FGraphBuilder, [FOverlayMixer, FVideoRenderer]); RemoveFilters(FGraphBuilder, [FOverlayMixer]); FOverlayMixer := nil; FVideoRenderer := nil; //SaveGraphFile(FGraphBuilder, gfnsExeNameGet + '.grf'); GetVideoRenderer(FVideoRenderer, FGraphBuilder); _SetVideoWindow; end else begin //ファイルを読み込んでからでないと別ウィンドウが開いてしまう。 FGraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow); try //壁紙ビデオ l_VideoWindow.put_Owner(FhSubPlayerHwnd); l_VideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS); // l_VideoWindow.put_MessageDrain(Panel_Video.Handle); //マウスメッセージを拾えるようにする l_VideoWindow.SetWindowForeground(OAFALSE); //タスクバーがフラッシュするのを防ぐ FSetMonitor(PopupMenu_SelectMonitor.Items[FiMonitorMenuIndex]); lb_Wallvideo := True; finally l_VideoWindow := nil; end; end; end; if not(lb_Wallvideo) then begin //壁紙ビデオ用のデスクトップの背景を元に戻す myWallvideo.gpcWallVideoFree; if (FMediaHasVideo) then begin gpcShowMessage('壁紙ビデオの表示に失敗しました'#13'ウィンドウモードに切り替えます'); StatusBar_Hint.SimpleText := '壁紙ビデオの表示に失敗しました。ウィンドウモードに切り替えます'; Action_Video_Wallvideo.Checked := False; end; end; end; //ボリューム調整 FSetVolume(0); //再生開始 // if not(FbPaused) // then begin Action_Play_PlayExecute(nil); // end; FbPaused := False; if (FIsVideoWindowPage) then begin FDispInfo(FPlaylist, FiItemIndex); end else if (FbInfoPlaying) then begin ListBox_PlaylistClick(nil); end; FSetInfoLabelCaption; //キャプション設定 FSetCaption; FAddHistoryList(FsFileName); FbMediaEnded := False; finally PopupMenu_MainPopup(nil); FEndFunc(False); end; end; procedure TApp_Wallvideo.FDeleteItem(AStrings: TMyWStrings; iIndex: Integer); var i : Integer; l_MediaInfo : T_MyMediaInfo; li_UniquID : Integer; l_FindMediaInfo : T_MyMediaInfo; li_FindID : Integer; begin if (FIsPlaylistPage) then begin //検索リストに削除アイテムがあれば削除する l_MediaInfo := T_MyMediaInfo(FPlaylist.Objects[iIndex]); if (l_MediaInfo <> nil) then begin li_UniquID := l_MediaInfo.UniquID; // if (gfnbIsInsideRange(li_UniquID, 0, FPlaylist.Count-1)) // then begin for i := FFindList.Count-1 downto 0 do begin l_FindMediaInfo := T_MyMediaInfo(FFindlist.Objects[i]); if (l_FindMediaInfo <> nil) then begin li_FindID := l_FindMediaInfo.UniquID; if (li_UniquID = li_FindID) then begin FFindList.Delete(i); end; end; end; ResetFindlistCount; // end; end; end; AStrings.Delete(iIndex); end; procedure TApp_Wallvideo.Action_List_DeletePlayingExecute(Sender: TObject); //リストから再生中のファイルを削除 var li_Index : Integer; lb_Playing : Boolean; ls_File : String; begin if (FiItemIndex < 0) then begin Exit; end; li_Index := FiItemIndex; if (Action_List_FolderName.Checked) then begin ls_File := FPlaylist[li_Index]; end else begin ls_File := ExtractFileName(FPlaylist[li_Index]); end; if (Sender = nil) // or (MessageDlg(Format('%s'#13#13'%s', [ls_File, '再生中のファイルをリストから削除します'#13'よろしいですか']), mtCustom, [mbYes, mbNo], 0, mbYes) = mrYes) or (gfniMessageBoxYesNo(Format('%s'#13#13'%s', [ls_File, '再生中のファイルをリストから削除します'#13'よろしいですか'])) = ID_YES) then begin lb_Playing := (FiItemIndex = li_Index); if (lb_Playing) then begin FClose(False); end; // G_PlaylistStrings.Delete(li_Index); FDeleteItem(FPlaylist, li_Index); if (li_Index <= FiItemIndex) then begin Dec(FiItemIndex); end; ResetCount; if (lb_Playing) then begin Action_Play_NextExecute(Action_Play_Next); end; end; if (FPlaylist.Count = 0) then begin FClearInfo; end; end; function TApp_Wallvideo.FGetListTitle: String; begin if (FIsVideoWindowPage) then begin Result := TabSheet_Playlist.Caption; end else begin Result := PageControl1.ActivePage.Caption; end; end; procedure TApp_Wallvideo.Action_List_DeleteExecute(Sender: TObject); //リストから選択ファイルを削除 function _DeleteItem(AStrings: TMyWStrings; iIndex: Integer): Boolean; begin Result := False; if (iIndex >= 0) then begin if (AStrings = FPlaylist) and (iIndex = FiItemIndex) then begin Dec(FiItemIndex); Result := True; FClose(False); end; FDeleteItem(AStrings, iIndex); if (AStrings = FPlaylist) and (iIndex < FiItemIndex) then begin Dec(FiItemIndex); end; end; end; function _GetPlaylistIndex(sFileName: WideString): Integer; var i : Integer; begin for i := 0 to FPlaylist.Count-1 do begin if (gfnbIsEqualFileName(FPlaylist[i], sFileName)) then begin Result := i; Exit; end; end; Result := -1; end; var i : Integer; l_ListBox : TListBox; l_Strings : TMyWStrings; ls_ListTitle : WideString; ls_File : WideString; ls_SelectFiles : WideString; li_Count : Integer; li_Index : Integer; l_MediaInfo : T_MyMediaInfo; lb_Playing : Boolean; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin Exit; end; //削除するファイル名を列挙 ls_File := ''; ls_SelectFiles := ''; li_Count := 0; for i := 0 to l_Strings.Count-1 do begin if (l_ListBox.Selected[i]) then begin if (Action_List_FolderName.Checked) then begin ls_File := l_Strings[i]; end else begin ls_File := ExtractFileName(l_Strings[i]); end; ls_SelectFiles := ls_SelectFiles + #13 + ls_File; Inc(li_Count); if (li_Count > 10) then begin ls_SelectFiles := ls_SelectFiles + #13 + Format('...他、全%dファイル', [l_ListBox.SelCount]); Break; end; end; end; ls_ListTitle := FGetListTitle; if (Sender = Action_List_DeleteWithPlaylist) then begin ls_ListTitle := Format('%sと%s', [ls_ListTitle, TabSheet_Playlist.Caption]); end; if (l_ListBox.SelCount > 0) and (gfniMessageBoxYesNo(Format('%s'#13#13'選択ファイルを%sから削除します'#13'よろしいですか', [TrimLeft(ls_SelectFiles), ls_ListTitle])) = ID_YES) then begin //現在再生中のファイルかどうか lb_Playing := False; FBeginFunc; try for i := l_ListBox.Count-1 downto 0 do begin if (l_ListBox.Selected[i]) then begin if (FIsFindlistPage) and (Sender = Action_List_DeleteWithPlaylist) then begin l_MediaInfo := T_MyMediaInfo(l_Strings.Objects[i]); if (l_MediaInfo <> nil) then begin li_Index := l_MediaInfo.PlaylistIndex; if not(gfnbIsEqualFileName(FPlaylist[li_Index], l_Strings[i])) then begin li_Index := _GetPlaylistIndex(l_Strings[i]); end; end else begin li_Index := _GetPlaylistIndex(l_Strings[i]); end; if (_DeleteItem(FPlaylist, li_Index)) then begin lb_Playing := True; end; end; if (_DeleteItem(l_Strings, i)) then begin lb_Playing := True; end; end; Application.ProcessMessages; end; ResetCount; finally FEndFunc(True); if (lb_Playing) then begin Action_Play_NextExecute(Action_Play_Next); // FOpen(FiItemIndex); if (l_ListBox = ListBox_Playlist) then begin ListBox_Playlist.Selected[FiItemIndex] := True; l_ListBox.ItemIndex := FiItemIndex; FDispInfo(l_Strings, l_ListBox.ItemIndex); end; end; end; end; if (FPlaylist.Count = 0) then begin FClearInfo; end; end; procedure TApp_Wallvideo.Action_List_ClearFindlistExecute(Sender: TObject); {検索リストをクリア 検索リストはオブジェクトにFPlaylistのオブジェクトのコピーではなくそのものを持つた めクリア時に注意が必要 } var i : Integer; l_MediaInfo : T_MyMediaInfo; begin for i := 0 to FFindList.Count-1 do begin l_MediaInfo := T_MyMediaInfo(FFindList.Objects[i]); if (l_MediaInfo <> nil) and (l_MediaInfo.UniquID <= 0) then begin l_MediaInfo.Free; FFindList.Objects[i] := nil; end; end; FFindList.Clear; end; procedure TApp_Wallvideo.Action_List_ClearExecute(Sender: TObject); //リストクリア var l_ListBox : TListBox; l_Strings : TMyWStrings; ls_Title : String; begin FGetDispList(l_ListBox, l_Strings); if (l_ListBox = nil) then begin Exit; end; ls_Title := FGetListTitle; // if (Sender = nil) // or (MessageDlg('リストをクリアします'#13'よろしいですか', mtCustom, [mbYes, mbNo], 0, mbNo) = mrYes) if (gfniMessageBoxYesNo(Format('%sをクリアします'#13'よろしいですか', [ls_Title])) = ID_YES) then begin if (FIsPlaylistPage) then begin FClose(True); FPlaylist.Clear; // FFindList.Clear; Action_List_ClearFindlistExecute(nil); ResetCount; end else if (FIsFindlistPage) then begin // FFindList.Clear; Action_List_ClearFindlistExecute(nil); ResetFindlistCount; end else if (FIsHistoryPage) then begin FHistorylist.Clear; ResetHistoryCount; end; end; end; procedure TApp_Wallvideo.Action_List_FolderNameExecute(Sender: TObject); begin FRefreshList; end; procedure TApp_Wallvideo.Action_List_GotoPlayingExecute(Sender: TObject); begin FChangeTab(TabSheet_Playlist); ListBox_Playlist.TopIndex := gfniNumLimit(FiItemIndex, 0, ListBox_Playlist.Count -1); gpcSetFocus(ListBox_Playlist); end; procedure TApp_Wallvideo.Action_List_OpenAddExecute(Sender: TObject); begin if (Action_List_OpenAdd.Checked) then begin Action_List_OpenAdd.ImageIndex := FiList_OpenAddImageIndex -1; end else begin Action_List_OpenAdd.ImageIndex := FiList_OpenAddImageIndex; end; end; procedure TApp_Wallvideo.Action_Opt_TaskTrayExecute(Sender: TObject); begin if (Action_Opt_TaskTray.Checked) then begin //タスクトレイにアイコンを追加する ShowWindow(Application.Handle, SW_HIDE); gpcWindowStyleExAdd(Application.Handle, WS_EX_TOOLWINDOW); end else begin gpcWindowStyleExDel(Application.Handle, WS_EX_TOOLWINDOW); ShowWindow(Application.Handle, SW_SHOW); end; TrayIcon1.Visible := Action_Opt_TaskTray.Checked; end; procedure TApp_Wallvideo.Action_Opt_InfoExecute(Sender: TObject); begin if (Action_Opt_Info.Checked) then begin Panel_Info.Top := Self.ClientHeight - Panel_Info.Height - Panel_Bottom.Height; // Panel_Info.Top := Shape_Info.Top - Panel_Info.Height; end; Panel_Info.Visible := Action_Opt_Info.Checked; FormResize(nil); end; procedure TApp_Wallvideo.Action_Opt_RandomExecute(Sender: TObject); begin if (Action_Opt_Random.Checked) then begin Action_Opt_Random.ImageIndex := FiOpt_RandomImageIndex -1; end else begin Action_Opt_Random.ImageIndex := FiOpt_RandomImageIndex; end; end; procedure TApp_Wallvideo.Action_Opt_StatusBarExecute(Sender: TObject); begin if (Action_Opt_StatusBar.Checked) then begin StatusBar_Hint.Top := Self.ClientHeight; end; StatusBar_Hint.Visible := Action_Opt_StatusBar.Checked; // Self.ShowHint := not(Action_Opt_StatusBar.Checked); end; procedure TApp_Wallvideo.TrayIcon1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin //ウィンドウをアクティブにする if (IsIconic(Application.Handle)) then begin if (Button = mbLeft) then begin Application.Restore; end; end else begin //最小化されていない SetForegroundWindow(Application.Handle); end; end; procedure TApp_Wallvideo.actNop(Sender: TObject); begin // end; procedure TApp_Wallvideo.Action_File_ExitExecute(Sender: TObject); begin Close; end; procedure TApp_Wallvideo.WndProc(var Msg: TMessage); begin case Msg.Msg of WM_INITMENU :begin if (Msg.WParam = wParam(MainMenu1.Handle)) then begin PopupMenu_MainPopup(nil); end; end; end; inherited WndProc(Msg); end; function TApp_Wallvideo.FIsWallvideo: Boolean; begin Result := Action_Video_Wallvideo.Checked and FMediaHasVideo and FSubFormExists and gfnbIsOverlayMixerInputConected(FOverlayMixer) ; end; procedure TApp_Wallvideo.FSetResume; begin // FbWallvideo := FIsWallvideo; FbPaused := not(FGetPlayState = State_Running); FfResumePos := 0; if (Assigned(FMediaPosition)) then begin FMediaPosition.get_CurrentPosition(FfResumePos); end; if (FiItemIndex < 0) or (FiItemIndex > FPlaylist.Count-1) then begin FiResumeIndex := 0; end else begin FiResumeIndex := FiItemIndex; end; end; procedure TApp_Wallvideo.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); var l_ToolButton : TToolButton; l_Action : TAction; l_Rect : TRect; begin if (Msg.hwnd = Application.Handle) then begin case Msg.message of WM_SYSCOMMAND :begin FTaskBarMenu.Execute(Msg.wParam); end; end; end else begin case Msg.message of WM_MOUSEMOVE :begin l_ToolButton := ToolButton_Video_Wallvideo; if (l_ToolButton.Tag <> 0) then begin l_Action := TAction(l_ToolButton.Action); if (l_Action = nil) or (l_Action.Checked = False) then begin Exit; end; if (gfnbKeyState(VK_LBUTTON)) then begin if not(l_ToolButton.Down) then begin l_Rect := gfnrcOriginRect(l_ToolButton); if not(PtInRect(l_Rect, Msg.pt)) then begin ReleaseCapture; // NG l_ToolButton.Down := l_Action.Checked; PostMessage(Self.Handle, WM_APP, 0, LPARAM(l_ToolButton)); end; end; end else begin l_ToolButton.Tag := 0; { //AIU if not(l_ToolButton.Down) then begin l_Rect := gfnrcOriginRect(l_ToolButton); if not(PtInRect(l_Rect, Msg.pt)) then begin // NG l_ToolButton.Down := l_Action.Checked; PostMessage(Self.Handle, WM_APP, 0, LPARAM(l_ToolButton)); end; end; } end; end; end; end; end; end; { procedure TApp_Wallvideo.ToolButton_Video_WallvideoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_ToolButton : TToolButton; begin if (Button = mbLeft) and (Sender is TToolButton) then begin l_ToolButton := TToolButton(Sender); l_ToolButton.Tag := 1; end; end; procedure TApp_Wallvideo.ToolButton_Video_WallvideoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_ToolButton : TToolButton; begin if (Sender is TToolButton) then begin l_ToolButton := TToolButton(Sender); l_ToolButton.Tag := 0; PostMessage(Self.Handle, WM_APP, 0, LPARAM(Sender)); end; end; procedure TApp_Wallvideo.WMApp(var Msg: TMessage); //ツールボタンのスタイルがtbsDropDownでもチェック状態にできるように var l_ToolButton : TToolButton; l_Action : TAction; begin if (Msg.LParam = 0) then begin Exit; end; l_ToolButton := TToolButton(Msg.LParam); if (l_ToolButton.Style = tbsDropDown) then begin l_Action := TAction(l_ToolButton.Action); if (l_Action = nil) then begin Exit; end; l_ToolButton.Down := l_Action.Checked; end; end; } procedure TApp_Wallvideo.Action_Video_Zoom100Execute(Sender: TObject); var l_WinControl : TWinControl; lpt_Client : TPoint; lpt_Pos : TPoint; lrc_Rect : TRect; lf_Left : Extended; lf_Top : Extended; li_Width : Integer; li_Height : Integer; begin if not(FIsWallvideo) then begin l_WinControl := Panel_VideoWindow; lpt_Pos := gfnptMousePosGet; lrc_Rect := gfnrcOriginRect(l_WinControl); if (PtInRect(lrc_Rect, lpt_Pos)) then begin li_Width := l_WinControl.ClientWidth; li_Height := l_WinControl.ClientHeight; lf_Left := (lpt_Pos.X - l_WinControl.ClientOrigin.X) / li_Width; lf_Top := (lpt_Pos.Y - l_WinControl.ClientOrigin.Y) / li_Height; lpt_Client.X := gfniRound(lpt_Pos.X - (FiVideoWidth * lf_Left)); lpt_Client.Y := gfniRound(lpt_Pos.Y - (FiVideoHeight * lf_Top)); lpt_Client := l_WinControl.Parent.ScreenToClient(lpt_Client); end else begin lpt_Client.X := l_WinControl.Left; lpt_Client.Y := l_WinControl.Top; end; l_WinControl.SetBounds(lpt_Client.X, lpt_Client.Y, FiVideoWidth, FiVideoHeight); end; end; procedure TApp_Wallvideo.Action_Video_ZoomUpExecute(Sender: TObject); //映像のみの部分拡大・縮小 const lci_SMALLZOOM = 2; lci_LARGEZOOM = 20; lci_MAX = 20; lci_MIN = 5; var lf_Left : Extended; lf_Top : Extended; lpt_Client : TPoint; li_Zoom : Integer; li_Width : Integer; li_Height : Integer; li_VideoWidth : Integer; li_VideoHeight : Integer; lpt_Pos : TPoint; lrc_Rect : TRect; begin if not(FMediaHasVideo) or not(FIsVideoWindowPage) or (ComboBox_Find_Text.Focused) then begin Exit; end; // F_bThrough := True; if (Sender = Action_Video_ZoomUP) then begin //拡大 li_Zoom := 1; end else if (Sender = Action_Video_ZoomDOWN) then begin //縮小 li_Zoom := -1; end else begin Exit; end; li_VideoWidth := Panel_VideoWindow.Width; li_VideoHeight := Panel_VideoWindow.Height; if (gfnbKeyState(VK_SHIFT)) then begin li_Width := li_VideoWidth + (li_Zoom * lci_SMALLZOOM); end else begin li_Width := li_VideoWidth + (li_Zoom * lci_LARGEZOOM); end; li_Height := gfniMediaHeightFromWidth(li_Width, FiVideoWidth, FiVideoHeight); if (li_Width <= FiVideoWidth * lci_MAX) // 20倍まで and (li_Height <= FiVideoHeight * lci_MAX) // 20倍まで and (li_Width >= FiVideoWidth div lci_MIN) // 1/5まで and (li_Height >= FiVideoHeight div lci_MIN) // 1/5まで then begin lrc_Rect := gfnrcMinRect([gfnrcRectMove(Panel_VideoBase.ClientRect, Panel_VideoBase.ClientOrigin), gfnrcOriginRect(Panel_VideoWindow)]); lpt_Pos := gfnptMousePosGet; if (PtInRect(lrc_Rect, lpt_Pos)) then begin //plyMediaのクライアント位置 lf_Left := (lpt_Pos.X - Panel_VideoWindow.ClientOrigin.X) / li_VideoWidth; lf_Top := (lpt_Pos.Y - Panel_VideoWindow.ClientOrigin.Y) / li_VideoHeight; lpt_Client.X := gfniRound(lpt_Pos.X - (li_Width * lf_Left)); lpt_Client.Y := gfniRound(lpt_Pos.Y - (li_Height * lf_Top)); lpt_Client := Panel_VideoBase.ScreenToClient(lpt_Client); end else begin lpt_Client.X := Panel_VideoWindow.Left; lpt_Client.Y := Panel_VideoWindow.Top; end; Panel_VideoWindow.SetBounds(lpt_Client.X, lpt_Client.Y, li_Width, li_Height); end; end; procedure TApp_Wallvideo.FSetInfoLabelCaption; var li_Width : Integer; li_Height : Integer; begin Label_Info.Caption := Format('%s秒 %s', [gfnsSecToTimeStr(FfDuration, 0), gfnsFileSizeStringGet(FsFileName)]); if (FMediaHasVideo) then begin if (FIsWallvideo) then begin li_Width := FiWallVideoWidth; li_Height := FiWallVideoHeight; end else begin li_Width := Panel_VideoWindow.Width; li_Height := Panel_VideoWindow.Height; end; Label_Info.Caption := Format('%dx%d %sfps [%dx%d %d%%] %s', [ FiVideoWidth, FiVideoHeight, FGetFrameRateString(FfVideoFrameRate), li_Width, li_Height, gfniRound((li_Width / FiVideoWidth) * 100), Label_Info.Caption, '' ]); end; end; procedure TApp_Wallvideo.Panel_VideoWindowResize(Sender: TObject); var l_VideoWindow : IVideoWindow; begin if (Self.Tag = 0) then begin Exit; end; if (Assigned(FGraphBuilder)) then begin FSetInfoLabelCaption; if (FMediaHasVideo) // and not(FIsWallvideo) and (FOverlayMixer = nil) then begin FGraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow); try l_VideoWindow.SetWindowPosition(0, 0, Panel_VideoWindow.Width, Panel_VideoWindow.Height); //SetWindowPositionの後でないと効果がない l_VideoWindow.SetWindowForeground(OAFALSE); //タスクバーがフラッシュするのを防ぐ finally l_VideoWindow := nil; end; end; end; end; procedure TApp_Wallvideo.PopupMenu_MainPopup(Sender: TObject); var l_ListBox : TListBox; l_Strings : TMyWStrings; ls_ListTitle : String; begin FGetDispList(l_ListBox, l_Strings); Action_Help_HelpExecute(nil); if (l_ListBox <> nil) then begin Action_File_OpenMediaFolder.Enabled := gfnbIsListBoxItemIndexSelected(l_ListBox); end else begin Action_File_OpenMediaFolder.Enabled := Assigned(FGraphBuilder); end; Action_Video_CaptureBitmap.Enabled := Action_File_OpenMediaFolder.Enabled; // Action_PlayPlayPause.Enabled := Assigned(FGraphBuilder) or (ListBox_Playlist.SelCount > 0); Action_Play_Stop.Enabled := Assigned(FGraphBuilder); Action_Play_Replay.Enabled := Action_Play_Stop.Enabled; Action_Play_Back.Enabled := (FPlaylist.Count > 0); Action_Play_Next.Enabled := Action_Play_Back.Enabled; Action_List_Delete.Enabled := (l_ListBox <> nil) and (l_ListBox.SelCount > 0); ls_ListTitle := FGetListTitle; //FCloseから呼ばれた時にCaptionの値を代入すると、ツールバーの開く関連のボタンと壁紙ボタンの挙動がおかしくなる //ただし起動時のみの現象。謎。 Action_List_Delete.Caption := Format('選択ファイルを%sから削除(&D)', [ls_ListTitle]); Action_List_Delete.Hint := StripHotkey(Action_List_Delete.Caption); Action_List_Clear.Enabled := not(FIsHistoryPage) and (l_Strings.Count > 0); Action_List_Clear.Caption := Format('%sをクリア(&C)', [ls_ListTitle]); Action_List_Clear.Hint := Action_List_Clear.Caption; Action_List_DeletePlaying.Enabled := Action_Play_Stop.Enabled; Action_List_GotoPlaying.Enabled := Action_Play_Stop.Enabled; Action_List_Property.Enabled := gfnbIsListBoxItemIndexSelected(l_ListBox); Action_List_PlayItemIndex.Enabled := Action_List_Property.Enabled; // Action_List_PlayItemIndex.Visible := not(FIsPlaylistPage); Action_List_GotoPlaylist.Visible := not(FIsPlaylistPage); Action_List_GotoPlaylist.Enabled := gfnbIsListBoxItemIndexSelected(l_ListBox); Action_List_DeleteWithPlaylist.Visible := FIsFindlistPage; Action_List_DeleteWithPlaylist.Enabled := Action_List_Delete.Enabled and (FIsFindlistPage or FIsHistoryPage); Action_Sort_FileName.Enabled := Action_List_Clear.Enabled; Action_Sort_Folder.Enabled := Action_Sort_FileName.Enabled; Action_Sort_Name.Enabled := Action_Sort_FileName.Enabled; Action_Sort_Ext.Enabled := Action_Sort_FileName.Enabled; Action_Sort_Shuffle.Enabled := Action_Sort_FileName.Enabled; Action_Sort_MenuPopup.Enabled := Action_Sort_FileName.Enabled; __Action_Sort.Enabled := Action_Sort_FileName.Enabled; ComboBox_Find_TextChange(nil); Action_Find_Clear.Enabled := FIsFindlistPage and (ListBox_FindList.SelCount > 0); Action_Video_FitToVideo.Enabled := FMediaHasVideo; Action_Video_ZoomUp.Enabled := FMediaHasVideo and Action_Video_Magni.Checked and not(FIsWallvideo); Action_Video_ZoomDown.Enabled := Action_Video_ZoomUp.Enabled; Action_Video_Zoom100.Enabled := Action_Video_ZoomUp.Enabled; Action_Video_CaptureBitmap.Enabled := Action_Video_FitToVideo.Enabled; TrackBar_Seek.Enabled := Action_Play_PlayPause.Enabled; PopupMenu_InfoPopup(nil); end; //シークバー --- procedure TApp_Wallvideo.Timer_TimeTimer(Sender: TObject); //現在位置表示。 var lf_Pos : TRefTime; begin if (FGraphBuilder = nil) or (FMediaPosition = nil) then begin Timer_Time.Enabled := False; Exit; end; Timer_Time.Tag := 1; FMediaPosition.get_CurrentPosition(lf_Pos); Label_Time.Caption := Format('%s/%s', [gfnsSecToTimeStr(lf_Pos, 0), gfnsSecToTimeStr(FfDuration, 0)]); if (TrackBar_Seek.ThumbHold = False) and (TrackBar_Seek.Tag = 0) then begin TrackBar_Seek.Position := Trunc(lf_Pos * F_ciTRACKPOS); end; if (lf_Pos = FfDuration) then begin // Timer_Time.Enabled := False; DoMediaEnded; end; Timer_Time.Tag := 0; end; procedure TApp_Wallvideo.FSeek(fPos: TRefTime); var l_MediaPosition : IMediaPosition; begin TrackBar_Seek.Tag := 1; TrackBar_Seek.Position := Trunc(fPos * F_ciTRACKPOS); if (Assigned(FGraphBuilder)) then begin FadeOut; try FGraphBuilder.QueryInterface(IMediaPosition, l_MediaPosition); l_MediaPosition.put_CurrentPosition(fPos); finally l_MediaPosition := nil; end; if not(Action_Play_Mute.Checked) then begin FadeIn; end; end; TrackBar_Seek.Tag := 0; end; procedure TApp_Wallvideo.TrackBar_SeekMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then begin if (PtInRect(TrackBar_Seek.ThumbRect, Point(X, Y))) then begin TrackBar_Seek.Tag := 1; end; end else begin TrackBar_Seek.Tag := 0; ReleaseCapture; end; end; procedure TApp_Wallvideo.TrackBar_SeekMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (TrackBar_Seek.HoverArea = taSeekBody) then begin TrackBar_Seek.Hint := Format('%s秒', [gfnsSecToTimeStr(TrackBar_Seek.HoverPos / F_ciTRACKPOS, 0)]); end else if (TrackBar_Seek.HoverArea = taSeekHead) then begin TrackBar_Seek.Hint := Action_Play_SkipBack.Hint; end else if (TrackBar_Seek.HoverArea = taSeekTail) then begin TrackBar_Seek.Hint := Action_Play_SkipNext.Hint; end; Application.ActivateHint(gfnptMousePosGet); end; procedure TApp_Wallvideo.TrackBar_SeekMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then begin if (TrackBar_Seek.Tag = 1) then begin //つまみを掴んで移動した FSeek(TrackBar_Seek.Position / F_ciTRACKPOS); end else begin if (TrackBar_Seek.HoverArea = taSeekHead) then begin //トラックバーの左端をクリックした Action_Play_SkipBackExecute(Action_Play_SkipBack); end else if (TrackBar_Seek.HoverArea = taSeekTail) then begin //トラックバーの右端をクリックした Action_Play_SkipBackExecute(Action_Play_SkipNext); end else begin FSeek(TrackBar_Seek.HoverPos / F_ciTRACKPOS); end; end; TrackBar_Seek.Tag := 0; end; end; procedure TApp_Wallvideo.FRefreshList; begin ListBox_Playlist.Refresh; ListBox_FindList.Refresh; ListBox_History.Refresh; end; end.