VFP新樂園: 3月 2010

星期四, 3月 18, 2010

VFP設計大樂透簽號程式

Green’s LOTTO VFP8版下載
 Green’s LOTTO VFP9版下載

這是什麼啊? 沒錯,這是我多年前無聊時寫來玩的
我同事有拿去玩,聽說中獎率還蠻高的,只是他沒分我1/3就是了

程式的設計原理很簡單,就是亂數函式:Rand()

我們先來看看這個函式的作用(VFP 說明)

返回一個 0 到 1 之間的隨機數。

RAND([nSeedValue])

返回值

數值型

參數

nSeedValue

指定種子數值，它決定 rand( ) 函數返回的數值序列。

在第一次發出 rand( ) 函數時用種子數 nSeedValue，然後再使用不帶 nSeedValue 參數的 rand( ) 函數，將得到一個隨機數序列。如果第三次發出 rand( ) 函數時使用同樣的種子數值 nSeedValue，那麼 RAND( )返回同樣的隨機數序列。

如果第一次發出 RAND( ) 時使用的 nSeedValue 參數是負數，那麼將使用來自系統時鐘的種子值。若要獲得隨機程度最大的數字序列，可以最初用一個負的參數發出 rand( ) 函數，然後再不帶參數發出 rand( ) 函數。

如果省略了 nSeedValue 參數，rand( ) 函數使用默認的種子數值 100001。

示例

第一個示例使用 rand( ) 函數創建了包含 10 條隨機記錄的表，然後使用 min( ) 和 max( ) 函數來顯示表中的最大值和最小值。

第二個示例顯示 1 到 10 之間的一個隨機數。

CLOSE DATABASES
CREATE TABLE Random (cValue N(3))
FOR nItem = 1 TO 10  && 添加 10 條記錄,
   APPEND BLANK
   REPLACE cValue WITH 1 + 100 * RAND()  && 插入隨機值
ENDFOR

CLEAR
LIST  && 顯示值
gnMaximum = 1  && 初始化最小值
gnMinimum = 100  && 初始化最大值
SCAN 
   gnMinimum = MIN(gnMinimum, cValue)
   gnMaximum = MAX(gnMaximum, cValue)
ENDSCAN
? '最小值是: ', gnMinimum  && 顯示最小值
? '最大值是: ', gnMaximum  && 顯示最大值

CLEAR
gnLower = 1
gnUpper = 10

? INT((gnUpper - gnLower + 1) * RAND() + gnLower)

請參閱

EXP() | PI() | MIN() | MAX()

從說明來看,其實它就是可以得到一組0~1之間的亂數,各位別小看這亂數,它可以玩很多東西的,這暫且不說

大家在簽樂透時不是有電腦選號嗎,其實它也是用亂數跑的,廢話少說~我們自己也來做一個吧~~

程式列表如下:

Lotto.prg

myform=CREATEOBJECT('lotto')

myform.show

READ EVENTS

*

DEFINE CLASS lotto AS form

    Height = 334

    Width = 437

    ShowWindow = 2

    DoCreate = .T.

    AutoCenter = .T.

    Picture = "lotto.jpg"

    Caption = "Lotto Lucky Ver1.0 by greencwi@gmail.com"

    ControlBox = .F.

    Closable = .F.

    Icon = "lotto.ico"

    KeyPreview = .T.

    Name = "LOTTO"

    ADD OBJECT commandbutton1 AS commandbutton WITH ;

        Top = 276, ;

        Left = 216, ;

        Height = 27, ;

        Width = 48, ;

        FontName = "標楷體", ;

        FontSize = 10, ;

        Caption = "開始", ;

        Name = "commandbutton1"

    ADD OBJECT label1 AS label WITH ;

        AutoSize = .T., ;

        FontBold = .F., ;

        FontName = "標楷體", ;

        FontSize = 12, ;

        Caption = "幸運號碼:", ;

        Height = 21, ;

        Left = 12, ;

        Top = 276, ;

        Width = 74, ;

        ForeColor = RGB(255,255,255), ;

        Name = "label1"

    ADD OBJECT n1 AS textbox WITH ;

        FontBold = .T., ;

        FontOutline = .F., ;

        FontShadow = .T., ;

        FontSize = 12, ;

        Alignment = 2, ;

        BorderStyle = 0, ;

        Height = 23, ;

        Left = 36, ;

        SpecialEffect = 1, ;

        Top = 12, ;

        Width = 48, ;

        Style = 0, ;

        DisabledBackColor = RGB(255,255,255), ;

        DisabledForeColor = RGB(128,0,64), ;

        BorderColor = RGB(255,255,255), ;

        Name = "n1"

    ADD OBJECT n2 AS textbox WITH ;

        FontBold = .T., ;

        FontOutline = .F., ;

        FontShadow = .T., ;

        FontSize = 12, ;

        Alignment = 2, ;

        BorderStyle = 0, ;

        Height = 23, ;

        Left = 96, ;

        SpecialEffect = 1, ;

        Top = 12, ;

        Width = 48, ;

        Style = 0, ;

        DisabledBackColor = RGB(255,255,255), ;

        DisabledForeColor = RGB(128,0,64), ;

        BorderColor = RGB(255,255,255), ;

        Name = "n2"

    ADD OBJECT n3 AS textbox WITH ;

        FontBold = .T., ;

        FontOutline = .F., ;

        FontShadow = .T., ;

        FontSize = 12, ;

        Alignment = 2, ;

        BorderStyle = 0, ;

        Height = 23, ;

        Left = 156, ;

        SpecialEffect = 1, ;

        Top = 12, ;

        Width = 48, ;

        Style = 0, ;

        DisabledBackColor = RGB(255,255,255), ;

        DisabledForeColor = RGB(128,0,64), ;

        BorderColor = RGB(255,255,255), ;

        Name = "n3"

    ADD OBJECT n4 AS textbox WITH ;

        FontBold = .T., ;

        FontOutline = .F., ;

        FontShadow = .T., ;

        FontSize = 12, ;

        Alignment = 2, ;

        BorderStyle = 0, ;

        Height = 23, ;

        Left = 216, ;

        SpecialEffect = 1, ;

        Top = 12, ;

        Width = 48, ;

        Style = 0, ;

        DisabledBackColor = RGB(255,255,255), ;

        DisabledForeColor = RGB(128,0,64), ;

        BorderColor = RGB(255,255,255), ;

        Name = "n4"

    ADD OBJECT n5 AS textbox WITH ;

        FontBold = .T., ;

        FontOutline = .F., ;

        FontShadow = .T., ;

        FontSize = 12, ;

        Alignment = 2, ;

        BorderStyle = 0, ;

        Height = 23, ;

        Left = 276, ;

        SpecialEffect = 1, ;

        Top = 12, ;

        Width = 48, ;

        Style = 0, ;

        DisabledBackColor = RGB(255,255,255), ;

        DisabledForeColor = RGB(128,0,64), ;

        BorderColor = RGB(255,255,255), ;

        Name = "n5"

    ADD OBJECT n6 AS textbox WITH ;

        FontBold = .T., ;

        FontOutline = .F., ;

        FontShadow = .T., ;

        FontSize = 12, ;

        Alignment = 2, ;

        BorderStyle = 0, ;

        Height = 23, ;

        Left = 336, ;

        SpecialEffect = 1, ;

        Top = 12, ;

        Width = 48, ;

        Style = 0, ;

        DisabledBackColor = RGB(255,255,255), ;

        DisabledForeColor = RGB(128,0,64), ;

        BorderColor = RGB(255,255,255), ;

        Name = "n6"

    ADD OBJECT grid1 AS grid WITH ;

        ColumnCount = 6, ;

        HeaderHeight = 0, ;

        Height = 165, ;

        Left = 36, ;

        Panel = 1, ;

        RecordSource = "ltmp", ;

        ScrollBars = 2, ;

        Top = 48, ;

        Width = 367, ;

        Name = "grid1", ;

        Column1.ControlSource = "", ;

        Column1.Width = 46, ;

        Column1.Name = "Column1", ;

        Column2.ControlSource = "", ;

        Column2.Width = 61, ;

        Column2.Name = "Column2", ;

        Column3.ControlSource = "", ;

        Column3.Width = 58, ;

        Column3.Name = "Column3", ;

        Column4.ControlSource = "", ;

        Column4.Width = 59, ;

        Column4.Name = "Column4", ;

        Column5.ControlSource = "", ;

        Column5.Width = 58, ;

        Column5.Name = "Column5", ;

        Column6.ControlSource = "", ;

        Column6.Width = 60, ;

        Column6.Name = "Column6"

    ADD OBJECT lotto.grid1.column1.header1 AS header WITH ;

        Caption = "Header1", ;

        Name = "Header1"

    ADD OBJECT lotto.grid1.column1.text1 AS textbox WITH ;

        BorderStyle = 0, ;

        Margin = 0, ;

        ForeColor = RGB(0,0,0), ;

        BackColor = RGB(255,255,255), ;

        Name = "Text1"

    ADD OBJECT lotto.grid1.column2.header1 AS header WITH ;

        Caption = "Header1", ;

        Name = "Header1"

    ADD OBJECT lotto.grid1.column2.text1 AS textbox WITH ;

        BorderStyle = 0, ;

        Margin = 0, ;

        ForeColor = RGB(0,0,0), ;

        BackColor = RGB(255,255,255), ;

        Name = "Text1"

    ADD OBJECT lotto.grid1.column3.header1 AS header WITH ;

        Caption = "Header1", ;

        Name = "Header1"

    ADD OBJECT lotto.grid1.column3.text1 AS textbox WITH ;

        BorderStyle = 0, ;

        Margin = 0, ;

        ForeColor = RGB(0,0,0), ;

        BackColor = RGB(255,255,255), ;

        Name = "Text1"

    ADD OBJECT lotto.grid1.column4.header1 AS header WITH ;

        Caption = "Header1", ;

        Name = "Header1"

    ADD OBJECT lotto.grid1.column4.text1 AS textbox WITH ;

        BorderStyle = 0, ;

        Margin = 0, ;

        ForeColor = RGB(0,0,0), ;

        BackColor = RGB(255,255,255), ;

        Name = "Text1"

    ADD OBJECT lotto.grid1.column5.header1 AS header WITH ;

        Caption = "Header1", ;

        Name = "Header1"

    ADD OBJECT lotto.grid1.column5.text1 AS textbox WITH ;

        BorderStyle = 0, ;

        Margin = 0, ;

        ForeColor = RGB(0,0,0), ;

        BackColor = RGB(255,255,255), ;

        Name = "Text1"

    ADD OBJECT lotto.grid1.column6.header1 AS header WITH ;

        Caption = "Header1", ;

        Name = "Header1"

    ADD OBJECT lotto.grid1.column6.text1 AS textbox WITH ;

        BorderStyle = 0, ;

        Margin = 0, ;

        ForeColor = RGB(0,0,0), ;

        BackColor = RGB(255,255,255), ;

        Name = "Text1"

    ADD OBJECT label2 AS label WITH ;

        AutoSize = .T., ;

        FontBold = .F., ;

        FontName = "標楷體", ;

        FontSize = 12, ;

        Caption = "產生組數:", ;

        Height = 21, ;

        Left = 12, ;

        Top = 252, ;

        Width = 74, ;

        ForeColor = RGB(255,255,255), ;

        Name = "label2"

    ADD OBJECT label3 AS label WITH ;

        AutoSize = .T., ;

        FontBold = .F., ;

        FontName = "標楷體", ;

        FontSize = 12, ;

        Caption = "樂透號數:", ;

        Height = 21, ;

        Left = 12, ;

        Top = 228, ;

        Width = 74, ;

        ForeColor = RGB(255,255,255), ;

        Name = "label3"

    ADD OBJECT label4 AS label WITH ;

        AutoSize = .T., ;

        FontName = "標楷體", ;

        FontSize = 12, ;

        Caption = "玩法:", ;

        Height = 21, ;

        Left = 204, ;

        Top = 228, ;

        Width = 42, ;

        ForeColor = RGB(255,255,255), ;

        Name = "label4"

    ADD OBJECT l_type AS combobox WITH ;

        FontSize = 10, ;

        RowSourceType = 1, ;

        RowSource = "1.出現最多號碼,2.隨機", ;

        Height = 24, ;

        Left = 240, ;

        Style = 2, ;

        Top = 228, ;

        Width = 156, ;

        Name = "l_type"

    ADD OBJECT l_num AS textbox WITH ;

        FontSize = 10, ;

        Alignment = 1, ;

        Value = 49, ;

        Height = 23, ;

        InputMask = "9999999999", ;

        Left = 84, ;

        MaxLength = 10, ;

        Top = 228, ;

        Width = 100, ;

        Name = "l_num"

    ADD OBJECT l_outnum AS textbox WITH ;

        FontSize = 10, ;

        Alignment = 1, ;

        Value = 1, ;

        Height = 23, ;

        InputMask = "9999999999", ;

        Left = 84, ;

        MaxLength = 10, ;

        Top = 252, ;

        Width = 100, ;

        Name = "l_outnum"

    ADD OBJECT l_lucky AS textbox WITH ;

        FontSize = 10, ;

        Alignment = 1, ;

        Value = 1, ;

        Height = 23, ;

        InputMask = "9999999999", ;

        Left = 84, ;

        MaxLength = 10, ;

        Top = 276, ;

        Width = 100, ;

        Name = "l_lucky"

    ADD OBJECT l_disp AS label WITH ;

        FontBold = .T., ;

        FontSize = 14, ;

        BackStyle = 0, ;

        Caption = "", ;

        Height = 26, ;

        Left = 388, ;

        Top = 11, ;

        Width = 44, ;

        ForeColor = RGB(255,255,128), ;

        Name = "l_disp"

    ADD OBJECT l_print AS commandbutton WITH ;

        Top = 276, ;

        Left = 288, ;

        Height = 27, ;

        Width = 48, ;

        FontName = "標楷體", ;

        FontSize = 10, ;

        Caption = "列印", ;

        Name = "l_print"

    ADD OBJECT label5 AS label WITH ;

        AutoSize = .T., ;

        FontBold = .F., ;

        FontName = "標楷體", ;

        FontSize = 12, ;

        Caption = "訊息", ;

        Height = 21, ;

        Left = 12, ;

        Top = 312, ;

        Width = 34, ;

        ForeColor = RGB(255,255,255), ;

        Name = "label5"

    ADD OBJECT cmsg AS textbox WITH ;

        FontName = "標楷體", ;

        FontSize = 10, ;

        Alignment = 0, ;

        Value = "祝您中大獎,中了以後分我1/3,謝謝!! 請按開始執行.....", ;

        Enabled = .F., ;

        Height = 23, ;

        Left = 48, ;

        Top = 307, ;

        Width = 372, ;

        DisabledBackColor = RGB(255,255,128), ;

        DisabledForeColor = RGB(255,0,0), ;

        Name = "cMsg"

    PROCEDURE load

        CREATE CURSOR ltmp (n1 n(2,0),n2 n(2,0),n3 n(2,0),n4 n(2,0),n5 n(2,0),n6 n(2,0))

    ENDPROC

    PROCEDURE btn_defaexit.Click

        quit

        *DODEFAULT()

    ENDPROC

    PROCEDURE commandbutton1.Click

        *

        Local wl_lucky

        wl_lucky=Thisform.l_lucky.Value

        wl_num=Thisform.l_num.Value

        wl_outnum=Thisform.l_outnum.Value

        IF wl_lucky<=0 OR wl_outnum<=0

            =messagebox("輸入的組數,或幸運號碼錯誤!",0,"錯誤",3000)

            RETURN .F.

        endif

        *

        Select ltmp

        ZAP

        SET ESCAPE ON

        is_run=.T.

        ON ESCAPE is_run=.F.

        Do Case

            Case Thisform.l_type.ListIndex=1    &&取最大數

                For r=1 To wl_outnum

                    thisform.cmsg.Value="若要停止執行請按[ESC],目前執行..."+ALLTRIM(STR(r))+"/"+ALLTRIM(STR(wl_outnum))

                    DIMENSION la[wl_num]

                    FOR u=1 TO wl_num

                        la[u]=0

                    NEXT u

        *

                    For j=1 To 6

                        nj='n'+Alltrim(Str(j))

                        *產生號碼

                        Do While .T.

                            IF !is_run

                                is_run=.t.

                                *=messagebox("輸入的組數,或幸運號碼錯誤!",0,"錯誤",3000)

                                *return

                                thisform.cmsg.Value="請選擇....."

                                ans=MESSAGEBOX("您確定要停止出號嗎?",4,"您按了ESC鍵!")

                                thisform.cmsg.Value=""

                                IF ans=6

                                    thisform.cmsg.Value="祝您中大獎,中了以後分我1/3,謝謝!! 請按開始執行....."

                                    RETURN

                                endif

                            endif

                            For i = 1 To wl_lucky

                                vv=Int(Rand()*wl_num)+1

                                la[vv]=la[vv]+1

                                Thisform.&nj..Value=vv

                            Next i

                            wget=0

                            wlmax=0

                            *取最大

                            FOR cc=1 TO wl_num

                                IF la[cc]>wget

                                    wget=la[cc]

                                    wlmax=cc

                                endif

                            NEXT cc

                            thisform.l_disp.Caption=ALLTRIM(STR(wlmax))

                            *檢查是否重覆

                            is_dup=.F.

                            For k=1 To j-1

                                nk='n'+Alltrim(Str(k))

                                If wlmax=Thisform.&nk..Value

                                    is_dup=.T.

                                Endif

                            Next k

                            *

                            If !is_dup

                                *Thisform.&nj..Value=wlmax

                                Exit

                            Endif

                        ENDDO

                        *

                    Next j

                *    If wl_outnum>1

                        Select ltmp

                        Append Blank

                        DIMENSION sortnum[6]

                        FOR rr=1 TO 6

                            nrr='n'+Alltrim(Str(rr))

                            sortnum[rr]=Thisform.&nrr..Value

                        NEXT rr

                        =ASORT(sortnum)

                        For rr=1 To 6

                            nrr='n'+Alltrim(Str(rr))

                            Replace &nrr With sortnum[rr]

                        Next rr

                *    Endif

                Next r

                Select ltmp

                Go Top

                Thisform.Refresh()

                *******************

            Case Thisform.l_type.ListIndex=2    &&隨機

                For r=1 To wl_outnum

                    thisform.cmsg.Value="若要停止執行請按[ESC],目前執行..."+ALLTRIM(STR(r))+"/"+ALLTRIM(STR(wl_outnum))

                    For j=1 To 6

                        nj='n'+Alltrim(Str(j))

                        Do While .T.

                            IF !is_run

                                is_run=.t.

                                *=messagebox("輸入的組數,或幸運號碼錯誤!",0,"錯誤",3000)

                                *return

                                thisform.cmsg.Value="請選擇....."

                                ans=MESSAGEBOX("您確定要停止出號嗎?",4,"您按了ESC鍵!")

                                thisform.cmsg.Value=""

                                IF ans=6

                                    thisform.cmsg.Value="祝您中大獎,中了以後分我1/3,謝謝!! 請按開始執行....."

                                    RETURN

                                endif

                            endif

                            *

                            For i = 1 To wl_lucky

                                Thisform.&nj..Value=Int(Rand()*wl_num)+1

                            Next i

                            *檢查是否重覆

                            is_dup=.F.

                            For k=1 To j-1

                                nk='n'+Alltrim(Str(k))

                                If Thisform.&nj..Value==Thisform.&nk..Value

                                    is_dup=.T.

                                Endif

                            Next k

                            If !is_dup

                                Exit

                            Endif

                        Enddo

                    Next j

                    *If wl_outnum>1

                        Select ltmp

                        Append Blank

                        DIMENSION sortnum[6]

                        FOR rr=1 TO 6

                            nrr='n'+Alltrim(Str(rr))

                            sortnum[rr]=Thisform.&nrr..Value

                        NEXT rr

                        =ASORT(sortnum)

                        For rr=1 To 6

                            nrr='n'+Alltrim(Str(rr))

                            Replace &nrr With sortnum[rr]

                        Next rr

                    *Endif

                Next r

                Select ltmp

                Go Top

                Thisform.Refresh()

        Endcase

        ON ESCAPE

        thisform.cmsg.Value="祝您中大獎,中了以後分我1/3,謝謝!! 請按開始執行....."

    ENDPROC

    PROCEDURE l_type.Init

        this.ListIndex=1

    ENDPROC

    PROCEDURE l_print.Click

        Select ltmp

        Go Top

        If !Eof()

            Report Form Report\lotto To Printer Prompt

        Endif

    ENDPROC

ENDDEFINE

*

*-- EndDefine: lotto

**************************************************

星期二, 3月 16, 2010

啥米~~VFP玩轉多媒體

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 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

訂閱：文章 (Atom)

星期四, 3月 18, 2010

VFP設計大樂透簽號程式

返回值

參數

示例

請參閱

星期二, 3月 16, 2010

啥米~~VFP玩轉多媒體

搜尋此網誌及連結網站

網誌存檔

推薦好站

參觀人數統計

追蹤者