用Tmediaplayer控件,autorewind设为false,至于平滑连接,你可用adobe的
Premiere5生成avi动画使它们同步;下面是我的多媒体播放器原代码:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
MPlayer, ExtCtrls, StdCtrls,shellapi,ComCtrls,
Menus,mmsystem, Buttons,dbctrls,Registry;
type
TForm2 = class(TForm)
TrackBar1: TTrackBar;
Button3: TButton;
Button4: TButton;
Button2: TButton;
Button1: TButton;
Player: TMediaPlayer;
Label2: TLabel;
OpenDialog1: TOpenDialog;
Timer1: TTimer;
Label1: TLabel;
MainMenu1: TMainMenu;
File1: TMenuItem;
open: TMenuItem;
exit1: TMenuItem;
Control1: TMenuItem;
max1: TMenuItem;
pause1: TMenuItem;
stop1: TMenuItem;
Help1: TMenuItem;
about1: TMenuItem;
Button5: TButton;
fullplay1: TMenuItem;
Button6: TButton;
select: TMenuItem;
sel1: TMenuItem;
sel2: TMenuItem;
sel3: TMenuItem;
sel4: TMenuItem;
sel5: TMenuItem;
sel6: TMenuItem;
sel7: TMenuItem;
sel8: TMenuItem;
sel9: TMenuItem;
sel10: TMenuItem;
sel11: TMenuItem;
sel12: TMenuItem;
sel13: TMenuItem;
sel14: TMenuItem;
sel15: TMenuItem;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Label3: TLabel;
ctrl: TMenuItem;
Label4: TLabel;
helpfile1: TMenuItem;
page: TMenuItem;
autoreg: TMenuItem;
Button7: TButton;
Button8: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure exit1Click(Sender: TObject);
procedure FormClick(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure about1Click(Sender: TObject);
procedure PlayerNotify(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure sel1Click(Sender: TObject);
procedure sel2Click(Sender: TObject);
procedure sel3Click(Sender: TObject);
procedure sel4Click(Sender: TObject);
procedure sel5Click(Sender: TObject);
procedure sel6Click(Sender: TObject);
procedure sel7Click(Sender: TObject);
procedure sel8Click(Sender: TObject);
procedure sel9Click(Sender: TObject);
procedure sel10Click(Sender: TObject);
procedure sel11Click(Sender: TObject);
procedure sel12Click(Sender: TObject);
procedure sel13Click(Sender: TObject);
procedure sel14Click(Sender: TObject);
procedure sel15Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure ctrlClick(Sender: TObject);
procedure hideTaskbar;
procedure Button7Click(Sender: TObject);
procedure helpfile1Click(Sender: TObject);
procedure pageClick(Sender: TObject);
procedure autoregClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button8Click(Sender: TObject); //隐藏
private
{ Private declarations }
public
form2:tform2;
{ Public declarations }
end;
var
Form2: TForm2;
opened: boolean;
cycle: boolean;
Efilename,driver:string;
filenum :integer;
x:cardinal;
dwreturn:mcierror;
mcistatusparms
mci_status_parms;
beject:boolean;
mcigenericparms:mci_generic_parms;
wdeviceid:mcideviceid;
implementation
uses Unit1, Unit3;
{$R *.DFM}
procedure TForm2.FormCreate(Sender: TObject);
var
i :integer;
begin
player.Display:=form1;
player.TimeFormat:=tftmsf;
label1.Caption:=timetostr(time);
cycle:=false;
beject:=false;
/////////////////////////////
if getdrivetype('d:/')=5 then
driver:='d';
if getdrivetype('e:/')=5 then
driver:='e';
if getdrivetype('f:/')=5 then
driver:='f';
if getdrivetype('g:/')=5 then
driver:='g';
///////////////////////////////////
if fileExists(driver+':/mpegav/music01.dat') or
fileExists(driver+':/mpegav/avseq01.dat') then
select.Enabled:=true
else
select.Enabled:=false;
///////////////////////////////
if fileExists(driver+':/mpegav/music01.dat') then
efilename:=driver+':/mpegav/music';
if fileExists(driver+':/mpegav/avseq01.dat') then
efilename:=driver+':/mpegav/avseq';
////////////////////////////////////
if select.Enabled then
if fileExists(efilename+'01'+'.dat') then
sel1.Enabled:=true
else
sel1.Enabled:=false;
if fileExists(efilename+'02'+'.dat') then
sel2.Enabled:=true
else
sel2.Enabled:=false;
if fileExists(efilename+'03'+'.dat') then
sel3.Enabled:=true
else
sel3.Enabled:=false;
if fileExists(efilename+'03'+'.dat') then
sel3.Enabled:=true
else
sel3.Enabled:=false;
if fileExists(efilename+'04'+'.dat') then
sel4.Enabled:=true
else
sel4.Enabled:=false;
if fileExists(efilename+'05'+'.dat') then
sel5.Enabled:=true
else
sel5.Enabled:=false;
if fileExists(efilename+'06'+'.dat') then
sel6.Enabled:=true
else
sel6.Enabled:=false;
if fileExists(efilename+'07'+'.dat') then
sel7.Enabled:=true
else
sel7.Enabled:=false;
if fileExists(efilename+'08'+'.dat') then
sel8.Enabled:=true
else
sel8.Enabled:=false;
if fileExists(efilename+'09'+'.dat') then
sel9.Enabled:=true
else
sel9.Enabled:=false;
if fileExists(efilename+'10'+'.dat') then
sel10.Enabled:=true
else
sel10.Enabled:=false;
if fileExists(efilename+'11'+'.dat') then
sel11.Enabled:=true
else
sel11.Enabled:=false;
if fileExists(efilename+'12'+'.dat') then
sel12.Enabled:=true
else
sel12.Enabled:=false;
if fileExists(efilename+'13'+'.dat') then
sel13.Enabled:=true
else
sel13.Enabled:=false;
if fileExists(efilename+'14'+'.dat') then
sel14.Enabled:=true
else
sel14.Enabled:=false;
if fileExists(efilename+'15'+'.dat') then
sel15.Enabled:=true
else
sel15.Enabled:=false;
///////////////////////////////
/////////////////////////////
for i:=10 to 20 do begin
if fileExists('e:/mpegav/music'+inttostr(i)+'.dat')
or fileExists('e:/mpegav/avseq'+inttostr(i)+'.dat') then
filenum:=i;
end;
aboutbox.Close;
//--------------------------------------------------
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then begin
with player do begin
filename:=opendialog1.filename;
label2.Caption:=player.FileName;
try
open;
opened:=true;
play;
trackbar1.Max:=player.Length;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end;
end;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
player.displayrect:=rect(0,0,form1.width,form1.height);
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
if opened then
player.pause;
opened:=false;
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
if opened then
player.Stop;
opened:=false;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
var
RegF:TRegistry;
begin
label1.Caption:=timetostr(time);
if opened=true then begin
trackbar1.Max:=player.Length;
trackbar1.Position:=player.Position;
end;
//-------------------------------------------------------
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
if RegF.ValueExists(application.Title) then
autoreg.Enabled:=false;
except
// ...
End;
RegF.CloseKey;
RegF.Free;
//-------------------------------------------------------------------
//mcistatusparms^.dwItem:=mci_status_media_present;
//dwreturn:=mcisendcommand(wdeviceid,mci_status,mci_status_item,
// dword(mcistatusparms));
//if (mcistatusparms^.dwreturn=0) then
// label4.Caption:='no disk';
//------------------------------------------------
/////////////////////////////
if getdrivetype('d:/')=5 then
driver:='d';
if getdrivetype('e:/')=5 then
driver:='e';
if getdrivetype('f:/')=5 then
driver:='f';
if getdrivetype('g:/')=5 then
driver:='g';
///////////////////////////////////
if fileExists(driver+':/mpegav/music01.dat') or
fileExists(driver+':/mpegav/avseq01.dat') then
select.Enabled:=true
else
select.Enabled:=false;
///////////////////////////////
if fileExists(driver+':/mpegav/music01.dat') then
efilename:=driver+':/mpegav/music';
if fileExists(driver+':/mpegav/avseq01.dat') then
efilename:=driver+':/mpegav/avseq';
////////////////////////////////////
if select.Enabled then
if fileExists(efilename+'01'+'.dat') then
sel1.Enabled:=true
else
sel1.Enabled:=false;
if fileExists(efilename+'02'+'.dat') then
sel2.Enabled:=true
else
sel2.Enabled:=false;
if fileExists(efilename+'03'+'.dat') then
sel3.Enabled:=true
else
sel3.Enabled:=false;
if fileExists(efilename+'03'+'.dat') then
sel3.Enabled:=true
else
sel3.Enabled:=false;
if fileExists(efilename+'04'+'.dat') then
sel4.Enabled:=true
else
sel4.Enabled:=false;
if fileExists(efilename+'05'+'.dat') then
sel5.Enabled:=true
else
sel5.Enabled:=false;
if fileExists(efilename+'06'+'.dat') then
sel6.Enabled:=true
else
sel6.Enabled:=false;
if fileExists(efilename+'07'+'.dat') then
sel7.Enabled:=true
else
sel7.Enabled:=false;
if fileExists(efilename+'08'+'.dat') then
sel8.Enabled:=true
else
sel8.Enabled:=false;
if fileExists(efilename+'09'+'.dat') then
sel9.Enabled:=true
else
sel9.Enabled:=false;
if fileExists(efilename+'10'+'.dat') then
sel10.Enabled:=true
else
sel10.Enabled:=false;
if fileExists(efilename+'11'+'.dat') then
sel11.Enabled:=true
else
sel11.Enabled:=false;
if fileExists(efilename+'12'+'.dat') then
sel12.Enabled:=true
else
sel12.Enabled:=false;
if fileExists(efilename+'13'+'.dat') then
sel13.Enabled:=true
else
sel13.Enabled:=false;
if fileExists(efilename+'14'+'.dat') then
sel14.Enabled:=true
else
sel14.Enabled:=false;
if fileExists(efilename+'15'+'.dat') then
sel15.Enabled:=true
else
sel15.Enabled:=false;
end;
procedure TForm2.TrackBar1Change(Sender: TObject);
begin
if opened then
player.Position:=trackbar1.Position;
player.Play;
end;
procedure TForm2.exit1Click(Sender: TObject);
begin
if opened=true then begin
player.Stop;
form1.Close;
opened:=false;
end;
form1.Close;
end;
procedure TForm2.FormClick(Sender: TObject);
begin
form2.hide;
end;
procedure TForm2.Button5Click(Sender: TObject);
begin
hideTaskbar;
form1.Left:=0;
form1.Top:=-17;
//form1.Width:=800;
//form1.Height:=625;
//form1.Invalidate;
form1.Clientwidth:=Screen.Width;
form1.ClientHeight:=Screen.Height;
form1.Invalidate;
Player.DisplayRect:=form1.ClientRect;
//Player.DisplayRect:=Rect(0, 0, Screen.Width, Screen.Height);
end;
procedure TForm2.about1Click(Sender: TObject);
begin
aboutbox.Visible:=true;
end;
procedure TForm2.PlayerNotify(Sender: TObject);
begin
if cycle then begin
with player do
if notifyvalue=nvsuccessful then begin
position :=0;
play;
end;
end;
end;
procedure TForm2.Button6Click(Sender: TObject);
begin
cycle:= not cycle;
if cycle then Button6.Caption:='循环'
else
Button6.Caption:='单向';
end;
procedure TForm2.sel1Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'01'+'.dat') then
begin
player.FileName:=efilename+'01'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel2Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'02'+'.dat') then
begin
player.FileName:=efilename+'02'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel3Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'03'+'.dat') then
begin
player.FileName:=efilename+'03'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel4Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'04'+'.dat') then
begin
player.FileName:=efilename+'04'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel5Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'05'+'.dat') then
begin
player.FileName:=efilename+'05'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel6Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'06'+'.dat') then
begin
player.FileName:=efilename+'06'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel7Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'07'+'.dat') then
begin
player.FileName:=efilename+'07'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel8Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'08'+'.dat') then
begin
player.FileName:=efilename+'08'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel9Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'09'+'.dat') then
begin
player.FileName:=efilename+'09'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel10Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'10'+'.dat') then
begin
player.FileName:=efilename+'10'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel11Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'11'+'.dat') then
begin
player.FileName:=efilename+'11'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel12Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'12'+'.dat') then
begin
player.FileName:=efilename+'12'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel13Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'13'+'.dat') then
begin
player.FileName:=efilename+'13'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel14Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'14'+'.dat') then
begin
player.FileName:=efilename+'14'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.sel15Click(Sender: TObject);
begin
if select.Enabled then
if fileExists(efilename+'15'+'.dat') then
begin
player.FileName:=efilename+'15'+'.dat';
label2.Caption:=player.FileName;
try
player.Open;
player.Play;
except
on e:exception do
showmessage('郝铸提示您:'+'class: '+ e.classname +
'info: '+ e.Message);
end;
end
else
showmessage('文件不存在');
end;
procedure TForm2.BitBtn1Click(Sender: TObject);
begin
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1',9);
end;
procedure TForm2.BitBtn2Click(Sender: TObject);
begin
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0',9);
end;
procedure TForm2.BitBtn3Click(Sender: TObject);
begin
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,0',9);
end;
procedure TForm2.BitBtn4Click(Sender: TObject);
begin
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Main.cpl',9);
end;
procedure TForm2.BitBtn5Click(Sender: TObject);
begin
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,0',9);
end;
procedure TForm2.BitBtn6Click(Sender: TObject);
begin
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL timedate.cpl',9);
end;
procedure TForm2.hideTaskbar; //隐藏
var
wndHandle : THandle;
wndClass : array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE);
End;
procedure TForm2.ctrlClick(Sender: TObject);
begin
if panel1.Visible=false then
panel1.Visible:=true;
end;
procedure TForm2.Button7Click(Sender: TObject);
begin
//if beject=false then
//begin
//dwreturn:=mcisendcommand(wdeviceid,mci_set,
// mci_set_door_open,
// dword(mcigenericparms));
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
end;
procedure TForm2.helpfile1Click(Sender: TObject);
begin
ShellExecute(0, nil, 'readme.txt', nil, nil, SW_NORMAL);
end;
procedure TForm2.pageClick(Sender: TObject);
begin
ShellExecute(0, nil, 'zg.htm', nil, nil, SW_NORMAL);
end;
procedure TForm2.autoregClick(Sender: TObject);
var
RegF:TRegistry;
begin
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
// RegF.WriteString('test',
// '"d:/haowork/player/test.exe"');
RegF.WriteString(application.Title,
application.ExeName);
if RegF.ValueExists(application.Title) then
showmessage('OK!');
except
// ...
End;
RegF.CloseKey;
RegF.Free;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
form1.showTaskbar;
end;
procedure TForm2.Button8Click(Sender: TObject);
begin
mciSendString('Set cdaudio door open wait', nil, 0, handle);
end;
end.