这个是转AVI的，你可以再调用其他的编码器接口把AVI转成mpeg格式
草在墙头 (2004-04-15 11:28:14)
用AVIWriter控件。
下面是我的界面样式，留给后面和我一样的同志吧：
BMP图像路径：(lable1)____________________________(Edit1) (speedbutton1)
上述路径下的BMP文件：(label2)
ListBox1
保存AVI的路径： (lable2)____________________________(Edit2) (speedbutton2)
帧数：(label3) (edit3) 生成按钮（button1）和退出按钮（button2）
再在界面上加一个SaveDialogs控件。
下面就是我实现bmp to avi 的整个代码：
unit unBuildAVI;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, FileCtrl, ComCtrls, ExtCtrls, AviWriter;
type
TfmBuildAVI = class(TForm)
Label1: TLabel;
Edit1: TEdit;
SpeedButton1: TSpeedButton;
Label2: TLabel;
Edit2: TEdit;
SpeedButton2: TSpeedButton;
ListBox1: TListBox;
Label3: TLabel;
Button1: TButton;
Button2: TButton;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
procedure SpeedButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit3KeyPress(Sender: TObject;
var Key: Char);
private
{ Private declarations }
public
OpenFileList : TStringList;
{ Public declarations }
end;
var
fmBuildAVI: TfmBuildAVI;
implementation
{$R *.dfm}
procedure TfmBuildAVI.SpeedButton1Click(Sender: TObject);
var SelectDir : String;
sr: TSearchRec;
I : Integer;
begin
if not Selectdirectory('请选择您所要BMP文件所在的目录', '', SelectDir) then
Exit;
Edit1.Text := SelectDir;
StatusBar1.Panels[1].Text :='';
StatusBar1.Panels[0].Text :='';
ListBox1.Clear;
if not DirectoryExists(SelectDir) then
Exit;
if FindFirst(SelectDir + '/*.bmp', faReadOnly, sr) = 0 then
begin
if Length(SelectDir)=3 then
SelectDir := Copy(SelectDir, 1, 2);
OpenFileList.Add(SelectDir + '/' + Sr.Name);
ListBox1.Items.Add(Sr.Name);
while FindNext(sr) = 0do
begin
OpenFileList.Add(SelectDir + '/' + Sr.Name);
ListBox1.Items.Add(Sr.Name);
end;
SysUtils.FindClose(sr);
StatusBar1.Panels[1].Text := IntToStr(OpenFileList.Count)+'幅图像';
Show;
end else
begin
StatusBar1.Panels[0].Text := '提示：目录<'+SelectDir+'>下没有BMP图像';
end;
end;
procedure TfmBuildAVI.FormCreate(Sender: TObject);
begin
OpenFileList := TStringList.Create;
end;
procedure TfmBuildAVI.FormDestroy(Sender: TObject);
begin
OpenFileList.Free;
end;
procedure TfmBuildAVI.SpeedButton2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Edit2.Text := SaveDialog1.FileName;
end;
procedure TfmBuildAVI.Button1Click(Sender: TObject);
var BMP : TBitmap ;
i : integer;
BMPwidth, BMPHeight : Integer;
AviWriter1 : TAviWriter;
begin
if Edit1.Text='' then
exit;
if ListBox1.Count = 0 then
exit;
if Edit2.Text='' then
exit;
AviWriter1 := TAviWriter.Create(nil);
try
BMPwidth := 0;
BMPHeight := 0;
for i := 0 to OpenFileList.Count - 1do
begin
BMP := TBitmap.Create;
BMP.LoadFromFile(OpenFileList);
BMPWidth := BMP.Width;
BMPHeight := BMP.Height;
AviWriter1.Bitmaps.Add(Pointer(BMP));
end;
AviWriter1.Width := BMPWidth;
AviWriter1.Height := BMPHeight;
AviWriter1.FrameTime := StrToInt(Edit3.Text);
AviWriter1.Stretch := false;
AviWriter1.FileName := trim(Edit2.Text);
AviWriter1.Write;
for i := 0 to (AviWriter1.Bitmaps.Count - 1)do
TBitmap(AviWriter1.Bitmaps.Items).Free;
Application.MessageBox('生成AVI文件成功', '提示', MB_OK+MB_ICONInformation);
finally
AviWriter1.Free;
end;
end;
procedure TfmBuildAVI.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TfmBuildAVI.Edit3KeyPress(Sender: TObject;
var Key: Char);
begin
if not(key in ['0'..'9', #8, #13]) then
key := #0;
end;
end.
