明輝手游網(wǎng)中心:是一個免費(fèi)提供流行視頻軟件教程、在線學(xué)習(xí)分享的學(xué)習(xí)平臺!

用VB編RM格式壓縮軟件

[摘要]作者:綠茗 一天看到一篇文章,說到RM格式的文件能通過控件prct3260.ocx格式壓縮。為此,我把該控件加入VB窗體,通過object browser對象瀏覽器認(rèn)真分析其屬性事件和方法,F(xiàn)編一個小程序,讓大家共享。 運(yùn)行界面如下圖所示: 兩個文本框分別為txtopen,txtsave,瀏覽兩個...
作者:綠茗

一天看到一篇文章,說到RM格式的文件能通過控件prct3260.ocx格式壓縮。為此,我把該控件加入VB窗體,通過object browser對象瀏覽器認(rèn)真分析其屬性事件和方法。現(xiàn)編一個小程序,讓大家共享。
運(yùn)行界面如下圖所示:

兩個文本框分別為txtopen,txtsave,瀏覽兩個按鈕為cmdopen,cmdsave,開始、停止和退出按鈕:cmdstart,cmdstopt,cmdexit,三個顯示狀態(tài)label,lblface, lblfacemul,lbltime。還有一些label。
下面為源程序。
Option Explicit
Dim i As Integer, j As Integer, k As Integer
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdopen_Click()
On Error Resume Next
dlg1.DialogTitle = "請選擇制作的文件"
dlg1.ShowOpen
txtopen.Text = dlg1.FileName
If Trim(txtopen.Text) <> "" Then
cmdsave.Enabled = True
cmdstart.Enabled = True
txtsave.Text = Mid(txtopen.Text, 1, InStr(txtopen.Text, ".")) & "rm"
lblface.Caption = "選擇文件開始"
End If
End Sub
Private Sub cmdsave_Click()
dlg2.DialogTitle = "請輸入要保存的文件"
dlg2.ShowOpen
txtsave.Text = dlg2.FileName + ".rm"
End Sub
Private Sub cmdstart_Click()
ProducerControl1.InputFilename = ""
ProducerControl1.OutputFilename = ""
ProducerControl1.InputFilename = txtopen.Text
ProducerControl1.OutputFilename = txtsave.Text
ProducerControl1.StartEncoding
lblfacemul.Caption = "共1個文件"
cmdstart.Enabled = False
cmdsave.Enabled = False
cmdopen.Enabled = False
cmdstop.Enabled = True
lblface.Caption = "壓縮開始...."
lbltime.Caption = "00:00:00"
Timer1.Enabled = True
i = 0
j = 0
k = 0
End Sub
Private Sub cmdstop_Click()
ProducerControl1.StopEncoding
cmdsave.Enabled = False
cmdopen.Enabled = False
lblface.Caption = "用戶停止"
cmdstart.Enabled = True
cmdstop.Enabled = False
cmdopen.Enabled = True
cmdsave.Enabled = True
Timer1.Enabled = False
lblfacemul.Caption = "共壓縮1個文件"
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 1000
cmdstart.Enabled = False
cmdstop.Enabled = False
cmdsave.Enabled = False
dlg1.Filter = "Media Files(*.dat;*.mov;*.mp3;*.avi) *.dat;*.mov;*.mp3;*.avi Mpeg Files(*.mpg;*.mpeg;*.mpa;*.mp2;*.mp3) *.mpg;*.mpeg;*.mpa;*.mp2;*.mp3 QuickTime Files(*.mov;*.qt) *.mov;*.qt Audio Files(*.wav;*.au) *.wav;*.au"
dlg1.FilterIndex = 1
dlg1.InitDir = App.path
dlg2.Filter = "RM格式(*.rm) *.rm"
txtopen.Text = ""
txtsave.Text = ""
ProducerControl1.InputType = INPUT_SOURCE_FILE '壓縮文件
ProducerControl1.TempDirectory = "c:\windows\temp" '暫存目錄
lblface.Caption = "請選擇文件"
lbltime.Caption = "00:00:00"
ProducerControl1.Target256KDSLCableModem = True '目標(biāo)聽從為256線纜
ProducerControl1.InputDoAudio = True '音頻輸入為真
ProducerControl1.InputDoVideo = True '視頻輸入為真
ProducerControl1.AudioContent = AUDIO_CONTENT_VOICE_BACKGROUND '聲音和背景音樂
ProducerControl1.VideoQuality = VIDEO_QUALITY_SMOOTH_MOTION '平滑圖象
End Sub
Private Sub ProducerControl1_OnEncodingProgressChanged(ByVal duration As Long, ByVal timestamp As Long, ByVal PercentDone As Long, ByVal AudioPeakLevel As Long)
lblfacemul.Caption = "已壓縮 " + CStr(PercentDone) + "%" '顯示壓縮百分比率
End Sub
Private Sub ProducerControl1_OnEncodingStopped()
Timer1.Enabled = False
cmdstop.Enabled = False
cmdstart.Enabled = True
lblface.Caption = "壓縮完成"
lblfacemul.Caption = "謝謝您的使用!"
End Sub
Private Sub Timer1_Timer()
i = i + 1
If i > 59 Then
i = 0
j = j + 1
End If
If j > 59 Then
j = 0
k = k + 1
End If
If k > 23 Then
k = 0
End If
lbltime.Caption = Format(k, "00") & ":" & Format(j, "00") & ":" & Format(i, "00")
End Sub
以上簡單的實(shí)現(xiàn)了RM文件的壓縮,通過對象瀏覽器,你可以為程序增加批量壓縮功能,可以設(shè)定目標(biāo)聽眾等,因篇幅關(guān)系,我就不寫出來了。歡迎與我交流(elby@21cn.com)。