VFP新樂園: 2010

星期四, 7月 15, 2010

使用profiler追蹤資料庫存取

在設計C/S程式時,常常會需要觀察資料庫接收了什麼指令,執行結果如何?
所以MSSQL提供了profiler的工具程式可以來觀察,but 如果不經條件篩選的觀察,在繁忙的伺服器裏,可是自討苦吃,您將會很難找到那些指令是偵錯程式時所發出的指令,其實我們可以把它單純化,先取得要偵錯程式的PROCESS ID ,以此來當做profiler篩選器之篩選條件,條件項目為ClientProcessID,設定好後,Profiler只會顯示您要偵錯程式執行的T-SQL指令了

使用profiler追蹤資料庫存取

1.使用procexp.exe 查出要追蹤程式之程序編號(ProcessID)

2.開啟profiler設定過濾條件

星期三, 5月 26, 2010

CSV IMPORT PART II

EXAMPLE:
aa=[abc,"22""Taxi",hello kitty,",","ord"]
?chk_csvfld(aa)

Result:
5

afld[1]=”abc”
afld[2]=”22”Taxi”
afld[3]=”hello kitty”
afld[4]=”,”
afld[5]=”ord”

*green 2010/5/26
FUNCTION chk_csvfld
Lparameters p_str
LOCAL fldnum
*if start is not " then find ,
*if start is " then find ",
*依傳入之字串分解欄位,傳回欄位數
fldnum=0
*Start ....
p_str=ALLTRIM(p_str) &&去除前後空白
is_end=.F.
DO WHILE !is_end
    *->由左向右找
    *         1         2
    *12345678901234567890
    *This,is,a,Book
    *"This","is","a","book"
    fld_end=IIF(LEFT(p_str,1)='"','"','')+"," &&欄位結尾若第一個字為["],則欄位結尾為[",] 若為空白,則為[,]
    endpos=ATC(fld_end,p_str) &&注意,第一個字元不可包含在serach裏,以免重覆找到同一組字元,例如[",",Orz]應得3,但會得1
    IF endpos=1 &&若找到第一個,則往下找第2個
        endpos=ATC(fld_end,p_str,2)
    ENDIF
    *
    IF endpos=0 &&找不到啦-表示為最後一欄
        wfld=SUBSTR(p_str,LEN(fld_end),len(p_str)-len(fld_end)+(2-len(fld_end)))
        p_str=''
        is_end=.T.
    ELSE
        wfld=SUBSTR(p_str,LEN(fld_end),endpos-LEN(fld_end))
        p_str=SUBSTR(p_str,endpos+LEN(fld_end))
    ENDIF
    fldnum=fldnum+1
    DIMENSION afld[fldnum]
    afld[fldnum]=STRTRAN(wfld,[""],["])    &&置換Escape String [""] -> ["]
ENDDO
*
RETURN fldnum
ENDFUNC

*2010/5/26 by Green

PS:
本示範函式可正確轉換約98%的CSV檔

若您需要100%CSV轉檔程式,可洽我的email:greencwi@gmail.com,可轉MSSQL,DBF…等
當然這部分是需要費用的,謝謝您

星期日, 5月 23, 2010

CSV IMPORT

自己寫的CSV IMPORT
取代FOXPRO 之 Append From xxx.CSV TYPE CSV
原因:使用內建之IMPORT指令,會出現line is too long (列過長)之錯誤

注意:本版本無法辨識由EXCEL轉存之 CSV 檔

可辨識的格式為:

“abc”,”123”,”we”….

所有欄位皆以””包括

*green 2010/05/23
*傳入cvs檔案,轉換存入cAlias,錯誤記錄轉入cCSVErrFile
*傳回轉換筆數
Function CSVTRAN2
    Lparameters cCSVfile,cAlias,cCSVErrFile
    Local handle, lcCommand,esckey,nRecord
    If !File(cCSVfile)
        Return .F.
    Endif
    handle = Fopen(cCSVfile)
    If handle <=0
        Return .F.
    Endif
    *
    Fseek(m.handle,0) && Go Top
    nRecord=0
    nn=0
    rec1pos=0
    rr=0
    Do While !Feof(m.handle)
        *!*            esckey=Inkey()
        *!*            If esckey=27
        *!*                Cancel
        *!*            Endif
        lcCommand = Fread(m.handle, 8192)
        haveRecEnd=Occurs(Chr(10),lcCommand)
        If haveRecEnd>0
            ii=1
            Do While ii<=haveRecEnd
                If ii>1
                    rec1pos=Atc(Chr(10),lcCommand,ii-1)
                Else
                    rec1pos=0
                Endif
                rec2pos=Atc(Chr(10),lcCommand,ii)
                rr=rr+1
                Dimension RecStr[rr]
                RecStr[rr]=Substr(lcCommand,rec1pos+1,rec2pos-rec1pos)
                nn=nn+1
                If nn=1
                    *記錄結尾
                    Wait '匯入中-'+cCSVfile+':'+Str(nRecord) Windows Nowait
                    pstr=''
                    For jj=1 To rr
                        pstr=pstr+RecStr[jj]
                    Next jj
                    *大於最大限制
                    *nRecord=nRecord+1
                    *IF ck_fld(cAlias,pstr,cCSVErrFile,nRecord)    &&填入值
                    IF ck_csvfld(cAlias,pstr,cCSVErrFile,nRecord)    &&填入值
                        nRecord=nRecord+1
                    Endif
                    nn=0
                    rr=0
                Endif
                ii=ii+1
            Enddo
            *
            lastPOS=Ratc(Chr(10),lcCommand,1)
            rr=rr+1
            Dimension RecStr[rr]
            RecStr[rr]=Substr(lcCommand,lastPOS+1) &&取最後段之字串
        Else
            *一定大於8192
            rr=rr+1
            Dimension RecStr[rr]
            RecStr[rr]=lcCommand
        Endif
    Enddo
    Fclose(m.handle)
    Wait Clear
    Return nRecord
ENDFUNC

*Green 2010/5/23
*CSVTRAN的子程式,分解單筆CSV記錄(p_str),存入cAlias
Function ck_fld
    Lparameters cAlias,p_str,cCSVErrFile,nRecord
    is_Debug=.F.
    *IF nRecord>=6568
    *    SET STEP ON
    *ENDIF
    op_str=p_str
    *先清空
    p_str='(start)'+ALLTRIM(STRTRAN(p_str,CHR(10),[]))+'(End)'
    *先替換原內含欄分隔字元[',']為[(NotFldDiv)]
    p_str=STRTRAN(p_str,[','],[(NotFldDiv)])
*-----------------------------------------------------------樣版替換(注意:有先後順序)
    *1. [,"""] --> [,"(->Inch<-)]
    DO WHILE !Occurs([,""","],p_str)=0
        p_str=STRTRAN(p_str,[,""","],[,(->Inch<-)","])
    ENDDO
    DO WHILE !Occurs([,"""],p_str)=0
        p_str=STRTRAN(p_str,[,"""],[,"(->Inch<-)])
    ENDDO
    *2. [""",] --> [(->Inch<-)",]
    DO WHILE !Occurs([""",],p_str)=0
        p_str=STRTRAN(p_str,[""",],[(->Inch<-)",])
    ENDDO
*-----------------------------------------------------------樣版替換(注意:有先後順序)
    *3. [,"",] --> [,'',]
    DO WHILE !Occurs([,"",],p_str)=0
        p_str=STRTRAN(p_str,[,"",],[,'',])
    ENDDO
    *4start and end
    p_str=STRTRAN(p_str,[(start)"",],[(start)'',])
    p_str=STRTRAN(p_str,[,""(End)],[,''(End)])
    p_str=STRTRAN(p_str,[(start)],[])
    p_str=STRTRAN(p_str,[(End)],[])
    *5. [""] --> [(->Inch<-)]
    DO WHILE !Occurs([""],p_str)=0
        p_str=STRTRAN(p_str,[""],[(->Inch<-)])
    ENDDO
    *6. ["]--> [']
    p_str=STRTRAN(p_str,["],['])
    *7. [(->Inch<-)] --> ["]
    p_str=STRTRAN(p_str,[(->Inch<-)],["])
    *8.修正錯誤
    p_str=STRTRAN(p_str,[',',','],[','.','])
    *9. FIND [',']
    Fldnum=Occurs([','],p_str)
    *Fldnum=Occurs('","',p_str)
    *p_str=STRTRAN(p_str,'",",","','",".","')
    *取得各欄
    If Fcount(cAlias)=Fldnum+1
        Select (cAlias)
        Append Blank
        For fnum=1 To Fldnum+1
            If fnum>1
                *fld1pos=Atc('","',p_str,fnum-1)+1
                fld1pos=Atc([','],p_str,fnum-1)+1
            Else
                fld1pos=0
            Endif
            *fld2pos=Atc('","',p_str,fnum)
            fld2pos=Atc([','],p_str,fnum)
            fldna = Fields[fnum]
            Select IMPORT_TMP
            If fld2pos=0
                wfldna = Substr(p_str,fld1pos+2,Len(p_str)-fld1pos-3)
                wfldna = STRTRAN(wfldna,[(NotFldDiv)],[',']) &&還原
            Else
                wfldna = Substr(p_str,fld1pos+2,fld2pos-fld1pos-2)
                wfldna = STRTRAN(wfldna,[(NotFldDiv)],[','])    &&還原
            Endif
            Replace &fldna With wfldna
            *            Fwrite(gnErrFile ,'['+STR(fnum)+']'+wfldna+CHR(10))
        Next
    Else
        *? 'Field Count Error'
        IF !EMPTY(cCSVErrFile)
            If File(cCSVErrFile) && 檔案是否存在？
                gnErrFile = Fopen(cCSVErrFile,12)     && 如果存在，以讀寫方式開啟
            Else
                gnErrFile = Fcreate(cCSVErrFile) && 如果不存在，就建立它
            ENDIF
            FSEEK(gnErrFile ,0,2) && 移至檔尾
            If gnErrFile < 0      && 檢查開啟檔案錯誤
                Wait '不能開啟或建立輸出檔案' Window
            ELSE
                *Fwrite(gnErrFile,'['+STR(nRecord)+']'+p_str)
                Fwrite(gnErrFile,op_str)
                IF is_Debug
                    Fwrite(gnErrFile,p_str)
                ENDIF
                FCLOSE(gnErrFile)
            ENDIF
        ENDIF
        RETURN .F.
    ENDIF
    RETURN .T.
Endfunc

*Green 2010/05/23
*傳入CSV,計算筆數
Function CSVRECCOUNT
    Lparameters cCSVfile
    Local handle,nRet
    If !File(cCSVfile)
        Return .F.
    Endif
    handle = Fopen(cCSVfile)
    If handle <=0
        Return .F.
    Endif
    *
    Fseek(m.handle,0) && Go Top
    nRet=0
    Do While !Feof(handle)
        nRet=nRet+Occurs(Chr(10),Fread(handle,8192))
    Enddo
    Fclose(handle)
    Return nRet
Endfunc

*Green 2010/05/23
*傳入CSV,計算筆數 (2) 另一方式計算CSV筆數
Function CSVRECCOUNT2
    Lparameters cCSVfile
    cFile = FILETOSTR(cCSVfile)
    nLines = ALINES(aFile,cFile)
    Return nLines
EndFunc

星期六, 5月 08, 2010

如何檢查檔案是否為正確的DBF檔

在開發系統時,可能會有需求於作業時匯入DBF檔,但如何判斷使用者選擇的檔案是否為正確的DBF檔?
這裏提供我函式庫裏的一個函式給大家參考

使用方式:

nRet=chk_dbf(傳入要判斷的DBF檔含路徑,顯示錯誤訊息) &&

******************
*傳入要測試的dbf檔,測試是否可開啟,可傳回>0之筆數,否傳回-1
Function chk_dbf
    Lparameters p_bf,p_no_show_msg
    Local ret,walias,OERR
    ret=-1
    If !Empty(p_bf)
        If !File(p_bf)
            If At(p_bf,'\')>0    &&有路徑
                If Empty(p_no_show_msg)
                    =chk_err(p_bf+" 不存在!")
                Endif
                Return ret
            Endif
        Endif
        Try
            Select 0
            Use (p_bf) Shar Again
            walias=Alias()
        Catch To OERR
            If Empty(p_no_show_msg)
                =chk_err(p_bf+" 不是資料庫,或已損壞")
            Endif
        Endtry
        If Type("oErr")<>'O'
            If Used(walias)
                Select &walias
                ret=Reccount()
                Use
            Endif
        Endif
    Endif
    Return ret
Endfunc
*********************

*顯示錯誤訊息,可設定顯示時間(秒)
Function chk_err
    Para Msg,p_Timeout
    Local nDialogType
    nDialogType = 0 + 16 + 0

    If !Empty(p_Timeout)
        =Messagebox(Msg,nDialogType, '錯誤!',p_Timeout*1000)
    Else
        =Messagebox(Msg,nDialogType, '錯誤!')
    Endif
    Return
Endfunc

星期三, 4月 21, 2010

如何顯示正確的總筆數

為何不用reccount()?
因為這個函式會將做刪除標記的記錄計算進來,
為了解決這個問題,所以寫了一個函式

Function WRECCOUNT
    Lparameters p_alias
    Local wret
    wret=0
    *20080617 修改 !! 修正計算後指標會跑到最後一筆的情況
    If Empty(p_alias)
        p_alias=Alias()
    Endif
    Select Count(*) From (p_alias) Where !Deleted() Into Array nodelrec
    If !Empty(nodelrec)
        wret=nodelrec[1]
    Endif
    Return wret
Endfunc

使用Select 的語法,計算沒有標記刪除記號的記錄,結果放到矩陣中

星期二, 4月 20, 2010

如何檢查是否為正確的DBF檔

一般我們use非DBF時會跳出系統的錯誤訊息,但我們並非都需要這個訊息,
要檢視特定檔案是否為DBF檔,我使用Try …Catch To 語法來攔截系統錯誤
很多類似的檢測手法都可以當它做範本
範例如下:

*傳入要測試的dbf檔,測試是否可開啟,可傳回>0之筆數,否傳回-1
Function chk_dbf
    Lparameters p_bf,p_no_show_msg
    Local ret,walias,OERR
    ret=-1
    If !Empty(p_bf)
        If !File(p_bf)
            If At(p_bf,'\')>0    &&有路徑
                If Empty(p_no_show_msg)
                    =chk_err(p_bf+" 不存在!")
                Endif
                Return ret
            Endif
        Endif
        Try
            Select 0
            Use (p_bf) Shar Again
            walias=Alias()
        Catch To OERR
            If Empty(p_no_show_msg)
                =chk_err(p_bf+" 不是資料庫,或已損壞")
            Endif
        Endtry
        If Type("oErr")<>'O'
            If Used(walias)
                Select &walias
                ret=Reccount()
                Use
            Endif
        Endif
    Endif
    Return ret
Endfunc

星期六, 4月 10, 2010

使用odbc匯入excel檔案

匯入EXCEL到VFP中有很多方法,但若使用VFP的APPEND FROM …TYPE XLS8,或IMPORT FROM … TYPE XL8

皆只能支援到 EXCEL5.0 ,但現在版本都已經到EXCEL12.0了

所以只能將EXCEL另存成EXCEL5.0的格式再轉入,現在介紹的這個方法,可以直接匯入新版本的EXCEL檔

imp_file="要匯入的EXCEL檔名(包含路徑)"
*
lcMDBName=Substr(imp_file,Rat('\',imp_file)+1,Len(imp_file)-Rat('\',imp_file))

lcMDBDir=Substr(imp_file,1,Rat('\',imp_file))

* for vista
*Microsoft Excel Driver (*.xls);DriverId=790;DefaultDir=C:\;DBQ=testbook.xls
lcCnStr =;
'DRIVER=Microsoft Excel Driver (*.xls);'+;
'DriverId=790;'+;
'DefaultDir='+Substr(imp_file,1,Rat('\',imp_file))+';'+;
'DBQ='+Substr(imp_file,Rat('\',imp_file)+1,Len(imp_file)-Rat('\',imp_file))
*
nCon = Sqlstringconnect( lcCnStr )
If nCon<0    &&連線失敗
    =chk_err("不是正確的來源檔(*.xls)")
    Return .F.
ELSE
   lcSQL = "SELECT * FROM [sheet1$]"
   lnError = SQLExec( nCon, lcSQL ,'tmp_xls')
   IF lnError = 1 &&取檔成功
         SELECT tmp_xls
         BROWSE
   ENDIF
ENDIF
= SQLDISCONNECT(nCon)

匯入ACCESS資料表到VFP

VFP內建可以匯入如CSV,TXT,XLS等格式,但並無提供匯入ACCESS資料表的功能
這裏提供匯入的方式給各位參考:

*檢查是否為合法之 mdb 檔案
lcMDBName=Substr(imp_mdb,Rat('\',imp_mdb)+1,Len(imp_mdb)-Rat('\',imp_mdb)) && a:\abcde\xxx.mdb
lcMDBDir=Substr(imp_mdb,1,Rat('\',imp_mdb))
*
wpt='50'
wbuf='2048'

*vista相容
lcCnStr =;
    'DRIVER=Microsoft Access Driver (*.mdb);'+;
    'UID=admin;'+;
    'UserCommitSync=Yes;'+;
    'Threads=3;'+;
    'SafeTransactions=0;'+;
    'PageTimeout=5;'+;
    'MaxScanRows=8;'+;
    'MaxBufferSize=2048;'+;
    'FIL=MS Access;'+;
    'DriverId=281;'+;
    'DefaultDir='+Substr(imp_mdb,1,Rat('\',imp_mdb))+';'+;
    'DBQ='+Substr(imp_mdb,Rat('\',imp_mdb)+1,Len(imp_mdb)-Rat('\',imp_mdb))
*
*WAIT lcCnStr windows

nCon = Sqlstringconnect( lcCnStr )
If nCon<0    &&連線失敗
    =chk_err("不是正確的來源檔(*.mdb)")
    Return .F.
Endif
*
SQLTables( nCon, ['TABLE'], 'MDB_Tables' )    &&取出資料表到 MDB_Tables

經過以上的動作,即可把MDB裏的資料表抓到VFP使用

星期四, 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)

星期四, 7月 15, 2010

使用profiler追蹤資料庫存取

星期三, 5月 26, 2010

CSV IMPORT PART II

星期日, 5月 23, 2010

CSV IMPORT

星期六, 5月 08, 2010

如何檢查檔案是否為正確的DBF檔

星期三, 4月 21, 2010

如何顯示正確的總筆數

星期二, 4月 20, 2010

如何檢查是否為正確的DBF檔

星期六, 4月 10, 2010

使用odbc匯入excel檔案

匯入ACCESS資料表到VFP

星期四, 3月 18, 2010

VFP設計大樂透簽號程式

返回值

參數

示例

請參閱

星期二, 3月 16, 2010

啥米~~VFP玩轉多媒體

搜尋此網誌及連結網站

網誌存檔

推薦好站

參觀人數統計

追蹤者