VB.net 2010 视频教程 VB.net 2010 视频教程 python基础视频教程
SQL Server 2008 视频教程 c#入门经典教程 Visual Basic从门到精通视频教程
当前位置:
首页 > 编程开发 > vb >
  • vb教程之用VB编RM格式压缩软件

作者:绿茗 

一天看到一篇文章,说到RM格式的文件能通过控件prct3260.ocx格式压缩。为此,我把该控件加入VB窗体,通过object browser对象浏览器认真分析其属性事件和方法。现编一个小程序,让大家共享。 
运行界面如下图所示: 

两个文本框分别为txtopen,txtsave,浏览两个按钮为cmdopen,cmdsave,开始、停止和退出按钮:cmdstart,cmdstopt,cmdexit,三个显示状态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 '目标听从为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 
以上简单的实现了RM文件的压缩,通过对象浏览器,你可以为程序增加批量压缩功能,可以设定目标听众等,因篇幅关系,我就不写出来了。欢迎与我交流(elby@21cn.com)。
 

相关教程