2010/3/18 提供程式給大家玩玩
VFP8版本載點
VFP9版本載點
@.@ 2009/6/19 加入表單程式碼
(基本上我使用的表單元件皆為自訂,但都是引用原來的基礎元件)
很久沒發表文章了,這次給大家上點好料的.....
前一陣子剛換工作,又有一個專案搞了比較久
反正都是理由,這篇文章因為是專案,程式比較"大支"
現在雖然有點空間,但實際上還是很忙,我就儘量了
本文介紹的是我之前為朋友寫的一支程式,因為朋友
喜歡玩多媒體,所以就需要做一些影片後製的動作
他最常用的就是友立的Video Studio,常跟我抱怨它的字幕
不好搞,很花時間,於是呢我就基於好朋友的情誼下,幫他
寫了這支程式,廢話說太多.....
本程式主要功能,就是可以產生 Ulead Video Studio 的字幕檔
有圖有真象: 
接下來準備多媒體相關的函式
建立一個prg將以下函式貼上存檔
這裏示範的是MciLib.prg
各函式的說明改天再補上
************************
Procedure declareprg
Declare Integer mciGetErrorString In Winmm.Dll As DomciGetErrorStr Integer Fdwerror, String @Lpszerrortext, Integer Ccherrortext
Declare Integer mciSendString In Winmm.Dll As DomciSendStr String Lpszcommand, String @Lpszreturnstring, Integer Cchreturn, Integer Hwndcallback
Declare Integer GetShortPathName In Kernel32 As DomciGetShortPathName String LpszLongPath, String @LpszShortPath, Integer CchBuffer
DECLARE integer SetWindowPos IN User32 integer, integer, integer, integer, integer, integer, integer
Public mciALIAS, mciRS, mciRSLEN, mciCB,mciPlayFilename
Public mciListFile
mciListFile="playlist.lst"
mciRS=Space(128)
Endproc
************************
Procedure mciopen
Lparameters lsortsong
*AVIVideo, CDAudio, DAT, DigitalVideo, MMMovie, Other, Overlay, Scanner, Sequencer, VCR, Videodisc, or WaveAudio.
*QtwVideo(mov)
*SET STEP ON
Do Case
Case '.MP3'$(lsortsong)
mciSTR = 'Open "' + lsortsong + '" Alias BBPLAY Type MPEGVideo'
Case '.AVI'$Upper(lsortsong)
mciSTR = 'Open "' + lsortsong + '" Alias BBPLAY Type MPEGVideo'
Case '.WAV'$Upper(lsortsong)
mciSTR = 'Open "' + lsortsong + '" Alias BBPLAY Type WaveAudio'
Case '.MOV'$Upper(lsortsong)
mciSTR = 'Open "' + lsortsong + '" Alias BBPLAY Type MPEGVideo'
Otherwise
mciSTR = 'Open "' + lsortsong + '" Alias BBPLAY Type MPEGVideo'
Endcase
* mciSTR = 'Open "'+lsortsong+'" Alias BBPLAY'
* mciSTR = 'Open '+lsortsong+' Alias BBPLAY'
&& 這裡檔案格式可以兼容
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0) &&影音檔開啟
If Not Empty(mciResult)
cErr = getMCIerror(mciResult)
= mciClose()
= Messagebox("播放裝置或格式錯誤!! " + Alltrim(cErr),16,"open 錯誤訊息!!")
Return .F.
Endif
Endproc
************************
Procedure mciClose
mciSTR = "Close BBPLAY"
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0) &&影音檔關閉
Endproc
************************
Function mciGetPosition
mciSTR = "SET BBPLAY time format milliseconds"
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0)
mciSTR = "status BBPLAY position"
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0)
Return mciRS
************************
Function mcigetplaystatus
mciSTR = "status BBPLAY mode"
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0)
Return mciRS
Endfunc
************************
Function mciGetLength
mciSTR = "SET BBPLAY time format milliseconds"
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0)
mciSTR = "Status BBPLAY length"
mciResult = DomciSendStr(mciSTR, @mciRS, Len(mciRS), 0)
Return mciRS
Endfunc
************************
Procedure mciplay
mciSTR = "Play BBPLAY"
mciResult = DomciSendStr(mciSTR, @mciRS, 0, 0)
If Not Empty(mciResult)
cErr = getMCIerror(mciResult)
= mciClose()
= Messagebox("播放裝置或格式錯誤!! " + Alltrim(cErr),16,"Play 錯誤訊息!!")
Return .F.
Endif
&& 開啟立體聲道
= DomciSendStr("Setaudio BBPLAY Right On", @mciRS, 0, 0)
= DomciSendStr("Setaudio BBPLAY Left On", @mciRS, 0, 0)
Endproc
************************
Procedure mcipause
mciSTR = "Pause BBPLAY"
mciResult = DomciSendStr(mciSTR, @mciRS, 0, 0)
If Not Empty(mciResult)
cErr = getMCIerror(mciResult)
= mciClose()
= Messagebox("播放裝置或格式錯誤!! " + Alltrim(cErr),16,"Pause 錯誤訊息!!")
Return .F.
Endif
Endproc
***********************
Procedure mciresume
mciSTR = "Resume BBPLAY"
mciResult = DomciSendStr(mciSTR, @mciRS, 0, 0)
If Not Empty(mciResult)
cErr = getMCIerror(mciResult)
= mciClose()
= Messagebox("播放裝置或格式錯誤!! " + Alltrim(cErr),16,"Resume 錯誤訊息!!")
Return .F.
Endif
Endproc
************************
Procedure mcistop
mciSTR = "Stop BBPLAY"
mciResult = DomciSendStr(mciSTR, @mciRS, 0, 0)
If Not Empty(mciResult)
cErr = getMCIerror(mciResult)
= mciClose()
= Messagebox("播放裝置或格式錯誤!! " + Alltrim(cErr),16,"Stop 錯誤訊息!!")
Return .F.
Endif
Endproc
*
Procedure GetMp3Id3Tag
Parameters mp3filename
*SET STEP ON
fd=Fopen(mp3filename)
Fseek(fd,-128, 2)
cString = Fread(fd, 128)
Fclose(fd)
mp3Tag=Substr(cString,1,3)
mp3title=Substr(cString,4,30)
mp3artist=Substr(cString,34,30)
mp3album=Substr(cString,64,30 )
mp3year=Substr(cString,94,4)
mp3comment =Substr(cString,98,30)
mp3genre=Substr(cString,128,1)
Return
Endproc
*
Function getsortname
Lparameters lgname
Local subname
subname=''
*SET STEP ON
stname=Space(210)
nn=DomciGetShortPathName(lgname,@stname,Len(stname))
If '.'$stname
subname=Upper(Substr(stname,Atc('.',stname),4))
Endif
stname=Left(stname,Atc(subname,Upper(stname))+3)
Return stname
*
Endfunc
*
Function domci
Lparameters cMCIcmd
*!* This method takes a MCI command string and executes it using
*!* the Windows API function mciSendString
*!* If the function executes successfully, the result is returned.
*!* Otherwise, the error string is returned.
mciResult = DomciSendStr(cMCIcmd, @mciRS, Len(mciRS), 0)
*!* cErr = getMCIerror(nRetValue)
*!* IF nRetValue > 0
*!* RETURN CeRR
*!* ENDIF
If Not Empty(mciResult)
= DomciGetErrorStr(mciResult,@mciRS,Len(mciRS))
mciClose()
= Messagebox("播放裝置或格式錯誤!! " + Alltrim(mciRS),16,"錯誤訊息!!"+cMCIcmd)
Return
Endif
Return Trim(Strtran(mciRS,Chr(0),""))
Endfunc
*
Function set_volume
Lparameters new_volume
*If WAVE_AUDIO_OPEN = .T.
cCmd = ("STATUS " + MCI_NAME + " READY")
If domci(cCmd) = "true" Then
cCmd = "SETAUDIO " + MCI_NAME + " " + "volume to " + Alltrim(new_volume)
domci(cCmd)
Endif
*Endif
Endfunc
*
Function getMCIerror
Lparameters cError
Local nError,cErrorString
*!* This method is called from the doMCI to retrieve the last
*!* MCI error string.
*!* This function also saves the last error number and string
*!* into properties associated with the form.
nError=0
If Type("cError")="C"
If Left(cError,7)="*ERROR*"
nError=Val(Substr(cError,8))
Endif
Endif
If Type("cError")="N"
nError=cError
Endif
cErrorString=Space(256)
=DomciGetErrorStr(nError,@cErrorString,Len(cErrorString))
Return Trim(Chrtran(cErrorString,Chr(0),""))
Endfunc
*表單程式 by GREEN 2009/06/19 POST
PUBLIC oplaymedia
SET CLASSLIB TO u:greengreenprogvssubvcxwbase.vcx ADDITIVE
oplaymedia=NEWOBJECT("playmedia")
oplaymedia.Show
RETURN
**************************************************
*-- Form: playmedia (u:greengreenprogvssubformplaymedia.scx)
*-- ParentClass: w_form (u:greengreenprogvssubvcxwbase.vcx)
*-- BaseClass: form
*-- Time Stamp: 03/28/08 10:48:02 PM
*
DEFINE CLASS playmedia AS w_form
DataSession = 1
Height = 527
Width = 790
ScrollBars = 2
DoCreate = .T.
Picture = "..graphicsvssub.jpg"
Caption = "字幕編輯作業"
Icon = "..graphicsvssub.ico"
initsec = 0
sortsong = ""
song = ""
runtest = .F.
Name = "PLAYMEDIA"
ADD OBJECT w_shape5 AS w_shape WITH ;
Top = 235, ;
Left = 547, ;
Height = 190, ;
Width = 238, ;
BackStyle = 1, ;
Curvature = 5, ;
BackColor = RGB(128,128,192), ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 0, ;
Name = "W_shape5"
ADD OBJECT w_shape4 AS w_shape WITH ;
Top = 13, ;
Left = 469, ;
Height = 108, ;
Width = 312, ;
BackStyle = 1, ;
Curvature = 10, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 1, ;
Name = "W_shape4"
ADD OBJECT w_shape3 AS w_shape WITH ;
Top = 12, ;
Left = 468, ;
Height = 108, ;
Width = 312, ;
BackStyle = 1, ;
Curvature = 10, ;
BackColor = RGB(226,226,226), ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 2, ;
Name = "W_shape3"
ADD OBJECT w_shape2 AS w_shape WITH ;
Top = 12, ;
Left = 180, ;
Height = 72, ;
Width = 132, ;
BackStyle = 1, ;
Curvature = 10, ;
SpecialEffect = 0, ;
BackColor = RGB(128,128,128), ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 3, ;
Name = "W_shape2"
ADD OBJECT w_shape1 AS w_shape WITH ;
Top = 12, ;
Left = 324, ;
Height = 72, ;
Width = 132, ;
BackStyle = 1, ;
Curvature = 10, ;
SpecialEffect = 0, ;
BackColor = RGB(128,128,128), ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 4, ;
Name = "W_shape1"
ADD OBJECT mp3file AS w_label WITH ;
FontSize = 10, ;
WordWrap = .T., ;
Caption = "", ;
Height = 48, ;
Left = 552, ;
Top = 432, ;
Width = 228, ;
TabIndex = 8, ;
ZOrderSet = 5, ;
Name = "mp3file"
ADD OBJECT olepos AS olecontrol WITH ;
Top = 72, ;
Left = 504, ;
Height = 30, ;
Width = 240, ;
TabIndex = 6, ;
Enabled = .F., ;
ZOrderSet = 6, ;
Name = "olepos"
ADD OBJECT showtime AS textbox WITH ;
FontBold = .F., ;
FontName = "Arial Black", ;
FontSize = 13, ;
Alignment = 2, ;
BorderStyle = 1, ;
Value = "00:00:00.000", ;
Enabled = .F., ;
Height = 33, ;
Left = 480, ;
TabIndex = 1, ;
Top = 24, ;
Width = 156, ;
ForeColor = RGB(255,255,0), ;
DisabledBackColor = RGB(64,0,0), ;
DisabledForeColor = RGB(255,255,128), ;
ZOrderSet = 7, ;
Name = "showtime"
ADD OBJECT w_cmd2 AS w_cmd WITH ;
Top = 492, ;
Left = 144, ;
Width = 120, ;
Caption = "產生字幕(.utf)", ;
TabIndex = 2, ;
ZOrderSet = 8, ;
Name = "W_cmd2"
ADD OBJECT w_cmd7 AS w_cmd WITH ;
Top = 492, ;
Left = 12, ;
Width = 120, ;
Caption = "讀取字幕(.utf)", ;
TabIndex = 3, ;
ZOrderSet = 9, ;
Name = "W_cmd7"
ADD OBJECT subgrid AS grid WITH ;
ColumnCount = 4, ;
FontSize = 10, ;
DeleteMark = .F., ;
Height = 345, ;
Left = 12, ;
Panel = 1, ;
RecordMark = .T., ;
RecordSource = "ttmp", ;
RowHeight = 19, ;
ScrollBars = 2, ;
TabIndex = 4, ;
Top = 132, ;
Width = 528, ;
GridLineColor = RGB(0,128,192), ;
HighlightBackColor = RGB(255,255,128), ;
HighlightForeColor = RGB(255,0,0), ;
HighlightStyle = 2, ;
ZOrderSet = 10, ;
Name = "subgrid", ;
Column1.Comment = "seq", ;
Column1.FontSize = 10, ;
Column1.ControlSource = "seq", ;
Column1.Enabled = .T., ;
Column1.Width = 30, ;
Column1.Visible = .T., ;
Column1.Name = "Column1", ;
Column2.Comment = "stime", ;
Column2.FontSize = 10, ;
Column2.ColumnOrder = 2, ;
Column2.ControlSource = "stime", ;
Column2.Enabled = .T., ;
Column2.Width = 85, ;
Column2.Visible = .T., ;
Column2.Name = "Column3", ;
Column3.Comment = "subcap", ;
Column3.FontSize = 10, ;
Column3.ColumnOrder = 3, ;
Column3.ControlSource = "subcap", ;
Column3.Enabled = .T., ;
Column3.Width = 294, ;
Column3.Visible = .T., ;
Column3.ForeColor = RGB(128,0,0), ;
Column3.Name = "Column4", ;
Column4.Comment = "etime", ;
Column4.FontSize = 10, ;
Column4.ColumnOrder = 4, ;
Column4.ControlSource = "etime", ;
Column4.Enabled = .T., ;
Column4.Width = 85, ;
Column4.Visible = .T., ;
Column4.Name = "Column6"
ADD OBJECT playmedia.subgrid.column1.header1 AS header WITH ;
FontSize = 10, ;
Alignment = 2, ;
Caption = "No.", ;
Name = "Header1"
ADD OBJECT playmedia.subgrid.column1.text1 AS textbox WITH ;
FontSize = 10, ;
BorderStyle = 0, ;
Enabled = .T., ;
Margin = 0, ;
Visible = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT playmedia.subgrid.column3.header1 AS header WITH ;
FontSize = 10, ;
Alignment = 2, ;
Caption = "開始時間", ;
Name = "Header1"
ADD OBJECT playmedia.subgrid.column3.text1 AS textbox WITH ;
FontSize = 10, ;
BorderStyle = 0, ;
Enabled = .T., ;
Margin = 0, ;
Visible = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT playmedia.subgrid.column4.header1 AS header WITH ;
FontSize = 10, ;
Alignment = 2, ;
Caption = "歌詞", ;
Name = "Header1"
ADD OBJECT playmedia.subgrid.column4.text1 AS textbox WITH ;
FontSize = 10, ;
BorderStyle = 0, ;
Enabled = .T., ;
Margin = 0, ;
Visible = .T., ;
ForeColor = RGB(128,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT playmedia.subgrid.column6.header1 AS header WITH ;
FontSize = 10, ;
Alignment = 2, ;
Caption = "結束時間", ;
Name = "Header1"
ADD OBJECT playmedia.subgrid.column6.text1 AS textbox WITH ;
FontSize = 10, ;
BorderStyle = 0, ;
Enabled = .T., ;
Margin = 0, ;
Visible = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT mciplayer AS container WITH ;
Top = 27, ;
Left = 660, ;
Width = 108, ;
Height = 27, ;
BorderWidth = 0, ;
TabIndex = 5, ;
ZOrderSet = 11, ;
Name = "MciPlayer"
ADD OBJECT playmedia.mciplayer.cmdplay AS commandbutton WITH ;
Top = 0, ;
Left = 0, ;
Height = 27, ;
Width = 36, ;
Picture = "..graphicsplay.bmp", ;
Caption = "", ;
Enabled = .F., ;
ZOrderSet = 9, ;
Name = "cmdplay"
ADD OBJECT playmedia.mciplayer.cmdstop AS w_cmd WITH ;
Top = 0, ;
Left = 36, ;
Height = 27, ;
Width = 36, ;
Picture = "..graphicsstop.bmp", ;
Caption = "", ;
Enabled = .F., ;
ZOrderSet = 13, ;
Name = "cmdStop"
ADD OBJECT playmedia.mciplayer.cmdpause AS w_cmd WITH ;
Top = 0, ;
Left = 72, ;
Height = 27, ;
Width = 36, ;
Picture = "..graphicspause.bmp", ;
Caption = "", ;
Enabled = .F., ;
ZOrderSet = 13, ;
Name = "cmdPause"
ADD OBJECT chk_new AS w_checkbox WITH ;
Top = 96, ;
Left = 24, ;
Height = 19, ;
Width = 99, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "開啟新視窗", ;
TabIndex = 6, ;
ForeColor = RGB(128,64,64), ;
ZOrderSet = 12, ;
Name = "chk_new"
ADD OBJECT autoend AS w_checkbox WITH ;
Top = 168, ;
Left = 588, ;
Height = 19, ;
Width = 147, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "自動填入結束時間", ;
Value = 1, ;
TabIndex = 6, ;
ForeColor = RGB(128,64,64), ;
ZOrderSet = 13, ;
Name = "autoend"
ADD OBJECT wtime AS w_cmd WITH ;
Top = 132, ;
Left = 600, ;
Height = 27, ;
Width = 121, ;
Caption = "寫入時間", ;
Enabled = .F., ;
TabIndex = 7, ;
ZOrderSet = 14, ;
Name = "Wtime"
ADD OBJECT w_cmd3 AS w_cmd WITH ;
Top = 96, ;
Left = 180, ;
Height = 28, ;
Width = 132, ;
Caption = "清除所有時間", ;
TabIndex = 9, ;
PicturePosition = 2, ;
ZOrderSet = 15, ;
Name = "W_cmd3"
ADD OBJECT w_cmd6 AS w_cmd WITH ;
Top = 60, ;
Left = 12, ;
Height = 28, ;
Width = 144, ;
Picture = "..graphicsmutimedia.bmp", ;
Caption = "載入媒體檔", ;
TabIndex = 9, ;
PicturePosition = 2, ;
ZOrderSet = 16, ;
Name = "W_cmd6"
ADD OBJECT w_cmd4 AS w_cmd WITH ;
Top = 492, ;
Left = 696, ;
Caption = "結束作業", ;
TabIndex = 10, ;
ZOrderSet = 17, ;
Name = "W_cmd4"
ADD OBJECT w_cmd5 AS w_cmd WITH ;
Top = 12, ;
Left = 12, ;
Height = 28, ;
Width = 144, ;
Picture = "..graphicscopy.bmp", ;
Caption = "載入詞句", ;
TabIndex = 12, ;
PicturePosition = 1, ;
ZOrderSet = 18, ;
Name = "W_cmd5"
ADD OBJECT bktime AS w_cmd WITH ;
Top = 192, ;
Left = 600, ;
Height = 28, ;
Width = 120, ;
Caption = "填入結束時間", ;
TabIndex = 13, ;
Visible = .F., ;
ForeColor = RGB(255,0,0), ;
ZOrderSet = 19, ;
Name = "bktime"
ADD OBJECT mod_l AS w_cmd WITH ;
Top = 72, ;
Left = 480, ;
Height = 28, ;
Width = 21, ;
Caption = "<", ;
ForeColor = RGB(255,255,128), ;
BackColor = RGB(64,128,128), ;
ZOrderSet = 20, ;
Name = "mod_l"
ADD OBJECT mod_r AS w_cmd WITH ;
Top = 72, ;
Left = 744, ;
Height = 28, ;
Width = 21, ;
Caption = ">", ;
ForeColor = RGB(255,255,128), ;
BackColor = RGB(64,128,128), ;
ZOrderSet = 21, ;
Name = "mod_r"
ADD OBJECT cmdruntest AS w_cmd WITH ;
Top = 96, ;
Left = 324, ;
Height = 28, ;
Width = 132, ;
Caption = "測試結果", ;
TabIndex = 9, ;
PicturePosition = 2, ;
ZOrderSet = 22, ;
Name = "cmdruntest"
ADD OBJECT w_label2 AS w_label WITH ;
AutoSize = .T., ;
Caption = "前置時間(毫秒)", ;
Height = 20, ;
Left = 192, ;
Top = 24, ;
Width = 114, ;
ForeColor = RGB(255,255,128), ;
ZOrderSet = 23, ;
Name = "W_label2"
ADD OBJECT w_label1 AS w_label WITH ;
AutoSize = .T., ;
Caption = "微調單位(毫秒)", ;
Height = 20, ;
Left = 336, ;
Top = 24, ;
Width = 114, ;
ForeColor = RGB(255,255,128), ;
ZOrderSet = 24, ;
Name = "W_label1"
ADD OBJECT m_tm AS w_spinner WITH ;
Height = 27, ;
KeyboardLowValue = 1, ;
Left = 336, ;
SpinnerLowValue = 1.00, ;
Top = 48, ;
Width = 108, ;
ZOrderSet = 25, ;
Value = 1000, ;
data_type = 5, ;
Name = "m_tm"
ADD OBJECT ld_tm AS w_spinner WITH ;
Height = 27, ;
KeyboardLowValue = 0, ;
Left = 192, ;
SpinnerLowValue = 0.00, ;
Top = 48, ;
Width = 108, ;
ZOrderSet = 26, ;
Value = 0, ;
data_type = 5, ;
Name = "ld_tm"
ADD OBJECT timer1 AS timer WITH ;
Top = 492, ;
Left = 636, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 10, ;
Name = "Timer1"
ADD OBJECT player AS w_shape WITH ;
Top = 240, ;
Left = 552, ;
Height = 180, ;
Width = 228, ;
BackStyle = 1, ;
FillStyle = 4, ;
BackColor = RGB(128,128,128), ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 28, ;
Name = "Player"
ADD OBJECT lbloading AS w_label WITH ;
FontBold = .T., ;
Alignment = 2, ;
Caption = "影像載入中，請稍候...", ;
Height = 20, ;
Left = 554, ;
Top = 319, ;
Visible = .F., ;
Width = 223, ;
ForeColor = RGB(255,255,255), ;
ZOrderSet = 29, ;
Name = "lbloading"
PROCEDURE getpostime
PARAMETERS lpos
hrs=0
mins=0
hsecs=lpos%1000
secs=(lpos-hsecs)/1000
IF secs>=60
wsecs=secs
secs=secs%60
mins=(wsecs-secs)/60
IF mins>=60
wmins=mins
mins=mins%60
hrs=(winis-mins)/60
endif
endif
RETURN tran(hrs,'@L 99') + ":" + tran(mins,'@L 99') + ":" + tran(secs,'@L 99') + "." +tran(hsecs,'@L 999')
ENDPROC
*-- 修改時間
PROCEDURE modi_time
LPARAMETERS otime,mtime,mtype
SET STEP ON
ENDPROC
PROCEDURE trantsec
LPARAMETERS ltm
LOCAL hh,mm,ss,ts
*hh:mm:ss.tss
*123456789012
hh=VAL(SUBSTR(ltm,1,2))
mm=VAL(SUBSTR(ltm,4,2))
ss=VAL(SUBSTR(ltm,7,2))
ts=VAL(SUBSTR(ltm,10,3))
RETURN (hh*60*60*1000)+(mm*60*1000)+(ss*1000)+ts
ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
WAIT nKeyCode windows
ENDPROC
PROCEDURE w_init
=declareprg()
*thisform.grid1.RecordSource='ttmp'
ENDPROC
PROCEDURE w_load
Create Cursor ttmp (seq N(5,0),stime c(12),subcap c(250),etime c(12))
*Index On seq To ttmp
ENDPROC
PROCEDURE Unload
mp3stat=ALLTRIM(mcigetplaystatus())
If'playing'$mp3stat OR 'pause'$mp3stat
=mciStop()
Endif
ENDPROC
PROCEDURE olepos.MouseDown
*** OLE Control Event ***
Lparameters Button, Shift, x, Y
*!* THISFORM.timer1.tag = STR(THISFORM.timer1.interval)
*!* THISFORM.timer1.interval = 0
Thisform.mciPlayer.cmdPause.Picture='RESUME.BMP'
Thisform.timer1.Enabled=.F.
*=mciPause()
Thisform.wtime.Enabled=.F.
ENDPROC
PROCEDURE olepos.MouseUp
*** OLE Control Event ***
Lparameters Button, Shift, x, Y
*=mciResume()
Thisform.wtime.Enabled=.T.
ENDPROC
PROCEDURE olepos.Change
*** OLE Control Event ***
*!* Make sure that there is a media file loaded
*a=doMCI("STATUS BBPLAY READY")
*!* If so, seek to the end
IF doMCI("STATUS BBPLAY READY") = "true" THEN
*!* If so, seek to the end
nPos = THIS.VALUE
IF nPos = 0 THEN
doMCI("SEEK BBPLAY to start")
ELSE
doMCI("SEEK BBPLAY to " + STR(nPos))
ENDIF
thisform.ShowTime.value=thisform.getpostime(this.value)
ENDIF
ENDPROC
PROCEDURE w_cmd2.Click
Local svfile
Select ttmp
Go Top
If Eof()
=chk_err('無字幕可輸出!!')
Return
Endif
svfile=''
svfile=Putfile('請輸入字幕檔名稱',svfile,'UTF')
If !Empty(svfile)
*!* SET PRINTER TO &svfile
*!* SET PRINTER on
*!* Do While !Eof()
*!* wstime= Strtran(stime, '.', ',')
*!* wetime= Strtran(etime, '.', ',')
*!* ? ALLTRIM(STR(seq))
*!* ? wstime+' --> '+wetime
*!* ? ALLTRIM(subcap)
*!* ?
*!* Select ttmp
*!* Skip
*!* ENDDO
*!* SET PRINTER off
*!* SET PRINTER TO
Set Step On
fhwd=FCreate(svfile)
If fhwd<=0
=chk_err('檔案開啟失敗!!')
Else
Do While !Eof()
wseq=Left(Alltrim(Str(seq))+' ',2)
wstime= Strtran(stime, '.', ',')
wetime= Strtran(etime, '.', ',')
Fputs(fhwd,wseq)
Fputs(fhwd,wstime+' --> '+wetime)
Fputs(fhwd,Alltrim(subcap))
Fputs(fhwd,'')
Select ttmp
Skip
Enddo
Fclose(fhwd)
If File(svfile)
=chk_msg('字幕檔產生成功!!')
Else
=chk_err('字幕檔產生失敗..orz')
Endif
Endif
Endif
ENDPROC
PROCEDURE w_cmd7.Click
Select ttmp
Go Top
If !Eof()
If !chk_yn('若開啟檔案,現有作業中的資料將會遺失,確定要讀入嗎?[Y/N]')
Return
Endif
Endif
*********
xfile=Getfile('utf')
If !Empty(xfile)
fhwd=Fopen(xfile,10)
If fhwd<=0
=chk_err('檔案開啟失敗!!')
ELSE
SELECT ttmp
zap
N=0
Do While !Feof(fhwd)
tmpstr=Alltrim(Fgets(fhwd))
If '-->'$tmpstr
wstime=Substr(tmpstr,1,12)
wetime=Substr(tmpstr,18,12)
N=N+1
If !Feof(fhwd)
tmpstr=Alltrim(Fgets(fhwd))
If !Empty(tmpstr)
Select ttmp
Append Blank
Replace seq With N
Replace stime With wstime
Replace etime With wetime
Replace subcap With tmpstr
Else
=chk_err('檔案格式不正確，請檢查!')
Exit
Endif
Else
=chk_err('檔案格式不正確，請檢查!')
Exit
Endif
Endif
Enddo
Fclose(fhwd)
Select ttmp
Go Top
Thisform.Refresh()
Endif
Endif
ENDPROC
PROCEDURE text1.Click
LOCAL mfld,mtesc
mfld=this.ControlSource
IF !EMPTY(&mfld)
mtsec=thisform.trantsec(&mfld)
IF mtsec<=thisform.olepos.max AND mtsec>=0
thisform.olepos.value=mtsec
thisform.olepos.change()
ENDIF
ENDIF
ENDPROC
PROCEDURE text1.Click
LOCAL mfld,mtesc
mfld=this.ControlSource
IF !EMPTY(&mfld)
mtsec=thisform.trantsec(&mfld)
IF mtsec<=thisform.olepos.max AND mtsec>=0
thisform.olepos.value=mtsec
thisform.olepos.change()
ENDIF
ENDIF
ENDPROC
PROCEDURE cmdplay.Click
Parameters selemp3
If EMPTY(thisform.song)
Messagebox("請選擇歌曲！",16+0,"警告")
Return
ENDIF
*
*!* SELECT ttmp
*!* GO top
*!* IF EOF()
*!* Messagebox("請載入詞句！",16+0,"警告")
*!* Return
*!* ENDIF
*
IF doMCI("STATUS BBPLAY READY") = "true" THEN
This.Parent.cmdStop.Enabled=.T.
Thisform.autoend.Enabled=.F.
this.Parent.cmdpause.enabled=.T.
this.Enabled=.F.
thisform.subgrid.Enabled=.F.
Thisform.timer1.Enabled=.T.
thisform.wtime.Enabled=.T.
=mciplay()
ENDIF
*stname=Space(210)
*!* mciclose()
*!* If mciOpen(thisform.sortsong)<>.F. And mciPlay()<>.F.
*!* *!* SELECT ttmp
*!* *!* GO top
*!* *!* REPLACE stime WITH '',etime WITH '' WHILE !EOF()
*!* *!* GO top
*!* *!* thisform.Refresh()
*!* *!* thisform.initsec=SECONDS()
*!* *!* Thisform.timer1.Enabled=.T.
*!* *!* thisform.autoend.Enabled=.F.
*!* *!* thisform.pstat=1 &&播放中
*!* *!* thisform.wtime.Enabled=.T.
*!* *!* this.Parent.cmdStop.Enabled=.T.
*!* *!* this.Parent.cmdpause.enabled=.T.
*!* *!* this.Enabled=.F.
*!* *!* thisform.subgrid.Enabled=.F.
*!*
*!* Else
*!* Return
*!* Endif
ENDPROC
PROCEDURE cmdstop.Click
=doMCI("SEEK BBPLAY to start")
=mciStop()
thisform.runtest=.F.
thisform.cmdruntest.enabled=.T.
thisform.olepos.value=0
thisform.timer1.Enabled=.f.
thisform.bktime.Visible=.f.
this.Parent.cmdplay.Enabled=.T.
this.Parent.cmdpause.Enabled=.F.
this.Parent.cmdpause.Picture='PAUSE.BMP'
this.Enabled=.F.
thisform.wtime.Enabled=.F.
thisform.autoend.Enabled=.T.
thisform.subgrid.Enabled=.T.
ENDPROC
PROCEDURE cmdpause.Click
LOCAL mcistatus
mcistatus=mcigetplaystatus()
Do Case
CASE 'play'$mcistatus
This.Picture='RESUME.BMP'
thisform.timer1.Enabled=.f.
=mciPause()
thisform.wtime.Enabled=.F.
thisform.subgrid.Enabled=.T.
Case 'pause'$mcistatus
This.Picture='PAUSE.BMP'
thisform.timer1.Enabled=.T.
=mciResume()
thisform.wtime.Enabled=.T.
thisform.subgrid.Enabled=.F.
Case 'stop'$mcistatus
This.Picture='PAUSE.BMP'
thisform.timer1.Enabled=.T.
=mciplay()
thisform.wtime.Enabled=.T.
thisform.subgrid.Enabled=.F.
OTHERWISE
=chk_err("暫停時發生非預期之錯誤,請通知程式設計人員!!"+mcistatus)
Endcase
ENDPROC
PROCEDURE wtime.Click
Select ttmp
*
If Eof()
Go Bottom
If !Eof() And Empty(etime)
Replace etime With Thisform.showtime.Value
Thisform.bktime.Visible=.F.
This.Enabled=.F.
Else
Thisform.bktime.Visible=.F.
This.Enabled=.F.
Endif
Endif
*
If Thisform.autoend.Value=1 && 以本句開始時間為上句結束時間
If Empty(stime)
Replace stime With Thisform.showtime.Value
Else
Replace etime With Thisform.showtime.Value
Skip
If Eof()
Thisform.bktime.Visible=.F.
This.Enabled=.F.
Else
Replace stime With Thisform.showtime.Value
Endif
Endif
If Empty(etime)
Thisform.bktime.Visible=.T.
Endif
Else
If Empty(stime)
Replace stime With Thisform.showtime.Value
Else
Replace etime With Thisform.showtime.Value
Skip
Endif
Endif
Thisform.Refresh()
ENDPROC
PROCEDURE w_cmd3.Click
SELECT ttmp
replace stime WITH '',etime WITH '' WHILE !EOF()
GO top
ENDPROC
PROCEDURE w_cmd6.Click
mp3filename=Getfile("mp3,mdi,avi,wmv,rm,mov,wav,mpeg,dat,mpg,vob,asf")
If .Not. Empty(mp3filename)
Thisform.song=mp3filename
* thisform.sortsong=getsortname(mp3filename)
Thisform.sortsong=Thisform.song
=mciclose()
If mciOpen(Thisform.sortsong)=.F.
Return chk_err("非正確之媒體檔案!!")
Else
Thisform.mp3file.Caption=mp3filename
Thisform.mciPlayer.cmdplay.Enabled=.T.
Thisform.olepos.Max=Val(mciGetLength())
*設定輸出之視窗
If Thisform.chk_new.Value=0
Do Case
CASE '.MP3'$UPPER(mp3filename)
CASE '.MDI'$UPPER(mp3filename)
CASE '.CDA'$UPPER(mp3filename)
CASE '.WAV'$UPPER(mp3filename)
CASE '.WAV'$UPPER(mp3filename)
otherwise
thisform.lbloading.Visible=.T.
=mciclose()
* Returns Handle of Main VFP Window
Main_hWnd =_vfp.HWnd
* Get Handle of the form with FOXTOOLS.FLL
cur_window = Thisform.HWnd
NullPointer = 0
*!* Set up open MCI command into string variable
cCmd = ('OPEN "' + Thisform.sortsong + '" alias BBPLAY' +' Type MPEGVideo style child parent ' + Alltrim(Str(cur_window)) + ' WAIT')
*!* Execute the MCI command
=doMCI(cCmd)
*!* It does have visual media, so we need to set up the window
*!* it will play in.
*!* Get the window handle of the window playing the video
cCmd = "status BBPLAY window handle wait"
hWin = Int(Val(doMCI(cCmd)))
*!* Once we have the window handle, we need to position
*!* the video window to be the same position and size
*!* as our player rectangle on the form
x1Pos = Thisform.player.Left
y1Pos = Thisform.player.Top
x2Pos = Thisform.player.Width
y2pos = Thisform.player.Height
*!* Use the SetWindowPos Windows function to set position and size
setWindowPos(hWin,0,x1Pos,y1Pos,x2Pos,y2pos,0)
*!* Everything's done, let's show the video
cCmd = ("WINDOW BBPLAY state show")
=doMCI(cCmd)
thisform.lbloading.Visible=.F.
Endcase
ENDIF
=mciplay()
=mcistop()
*cur_window = ALLTRIM(STR(Thisform.HWnd))
*!* cCmd = ('WINDOW BBPLAY state show')
*!* =doMCI(cCmd)
*!* IF doMCI("STATUS BBPLAY READY") = "true" THEN
*!* =doMCI("SEEK BBPLAY to 1")
*!* ENDIF
Endif
Endif
ENDPROC
PROCEDURE w_cmd4.Click
RELEASE thisform
ENDPROC
PROCEDURE w_cmd5.Click
xfile=Getfile('TXT')
If !Empty(xfile)
fhwd=Fopen(xfile,10)
If fhwd<=0
ELSE
SELECT ttmp
zap
n=0
Do While !Feof(fhwd)
tmpstr=Fgets(fhwd)
If !Empty(tmpstr)
n=n+1
Select ttmp
Append Blank
Replace seq WITH n
Replace subcap With tmpstr
Endif
Enddo
Fclose(fhwd)
Select ttmp
Go Top
thisform.Refresh()
Endif
Endif
ENDPROC
PROCEDURE bktime.Click
SELECT ttmp
if!EOF()
IF EMPTY(etime)
replace etime WITH thisform.showtime.Value
SKIP
thisform.Refresh()
endif
ENDIF
this.Visible=.F.
ENDPROC
PROCEDURE mod_l.Click
mcistatus=(mcigetplaystatus())
If 'stop'$mcistatus OR 'pause'$mcistatus
wm_tm=Thisform.m_tm.Value
wpos=Thisform.olepos.Value-wm_tm
If wpos<=0
wpos=0
Endif
Thisform.olepos.Value=wpos
Thisform.olepos.Change()
Endif
ENDPROC
PROCEDURE mod_r.Click
mcistatus=(mcigetplaystatus())
If 'stop'$mcistatus OR 'pause'$mcistatus
wm_tm=Thisform.m_tm.Value
wpos=Thisform.olepos.Value+wm_tm
If wpos>Thisform.olepos.Max
wpos=Thisform.olepos.Max
Endif
Thisform.olepos.Value=wpos
Thisform.olepos.Change()
Endif
ENDPROC
PROCEDURE cmdruntest.Click
*SELECT ttmp
*GO top
thisform.runtest=.T.
IF doMCI("STATUS BBPLAY READY") = "true" THEN
Thisform.mciplayer.cmdStop.Enabled=.T.
Thisform.autoend.Enabled=.F.
Thisform.mciplayer.cmdpause.enabled=.T.
Thisform.mciplayer.cmdplay.enabled=.F.
this.Enabled=.F.
thisform.subgrid.Enabled=.F.
Thisform.timer1.Enabled=.T.
thisform.wtime.Enabled=.T.
=mciplay()
ENDIF
ENDPROC
PROCEDURE timer1.Timer
LOCAL mcistatus
mcistatus=mcigetplaystatus()
If Left(mcistatus,7)="stopped" Or Left(mcistatus,2)="停止"
Thisform.mciPlayer.cmdStop.Click()
ENDIF
thisform.olepos.value=VAL(mciGetPosition())
thisform.ShowTime.value=thisform.getpostime(thisform.olepos.value)
IF thisform.runtest
SELECT ttmp
IF !EOF()
IF etime<=thisform.ShowTime.value
SKIP
thisform.Refresh()
endif
ELSE
Thisform.mciPlayer.cmdStop.Click()
endif
endif
ENDPROC
ENDDEFINE
*
*-- EndDefine: playmedia
**************************************************
發表於 2008/03/29 01:33 AM
沒有留言:
張貼留言