unit MainT;interface
uses Classes, ExtCtrls, MPlayer, SysUtils, mmSystem;type
myThread = class(TThread)
private
procedure SetMovieVolume;
procedure SetPositionVolume;
protected
procedure Execute;override;
public
constructor Create();
end;type
myThread2 = class(TThread)
private
procedure SetMovieVolume1;
protected
procedure Execute;override;
public
constructor Create(MediaPlayer:tMediaPlayer;Panel:tPanel;Image:tImage);
end;function SetSumTimes(Volumes:integer):string;var
aImage:tImage;
aMediaPlayer:tMediaPlayer;
aPanel:tPanel;
FSums:string;implementationuses MainF;function SetSumTimes(Volumes:integer):string;
begin
SetSumTimes:=format('%.1d',[Volumes div 3600000])+':'+format('%.2d',[(Volumes mod 3600000) div 60000])+':'+format('%.2d',[((Volumes mod 3600000) mod 60000) div 1000]);
end;constructor myThread2.Create(MediaPlayer:tMediaPlayer;Panel:tPanel;Image:tImage);
begin
inherited Create(false);
aMediaPlayer:=MediaPlayer;
aPanel:=Panel;
aImage:=Image;
aMediaPlayer.Wait:=false;
aMediaPlayer.Notify:=true;
end;procedure myThread2.execute;
begin
synchronize(SetMovieVolume1);
end;procedure myThread2.SetMovieVolume1;
begin
aMediaPlayer.DeviceType:=dtAutoSelect;
aMediaPlayer.Close;
aMediaPlayer.FileName:=OpenNames;
aMediaPlayer.Open;
aMediaPlayer.Display:=aPanel;
aMediaPlayer.TimeFormat:=tfMilliseconds;
aMediaPlayer.DisplayRect:=rect(0,0,aPanel.Width,aPanel.Height);
aMediaPlayer.Play;
if OpenListIndex>-1 then
begin
aMediaPlayer.Position:=OpenListIndex;
OpenListIndex:=-1;
aMediaPlayer.Play;
end;
Fsums:=SetSumTimes(aMediaPlayer.Length);
end;constructor myThread.Create();
begin
inherited Create(false);
end;procedure myThread.execute;
begin
if MouseChecked then
while MouseChecked do
begin
sleep(300);
synchronize(SetMovieVolume);
if terminated then exit;
end
else
while aImage.Left<=form1.shpProcess.Left+form1.shpProcess.Width-11 do
begin
if MouseChecked then
exit;
sleep(300);
synchronize(SetPositionVolume);
if terminated then exit;
end;
end;procedure myThread.SetPositionVolume;
begin
if aMediaPlayer.Position>aMediaPlayer.Length then
aImage.Left:=form1.shpProcess.Width+form1.shpProcess.Left-11
else
aImage.Left:=(aMediaPlayer.Position*form1.shpprocess.width) div aMediaPlayer.Length+form1.shpProcess.Left-11;
form1.Timers.Caption:=SetSumTimes(aMediaPlayer.Position)+' / '+fsums;
end;procedure myThread.SetMovieVolume;
var
position:integer;
begin
position:=(aImage.Left-form1.shpProcess.Left+11)*aMediaPlayer.Length div form1.shpprocess.width;
if aMediaPlayer.Mode=mpPlaying then
begin
aMediaPlayer.Position:=position;
aMediaPlayer.Play
end
else
if form1.ToolButton3.Enabled then
aMediaPlayer.Position:=position;
end;end.
uses Classes, ExtCtrls, MPlayer, SysUtils, mmSystem;type
myThread = class(TThread)
private
procedure SetMovieVolume;
procedure SetPositionVolume;
protected
procedure Execute;override;
public
constructor Create();
end;type
myThread2 = class(TThread)
private
procedure SetMovieVolume1;
protected
procedure Execute;override;
public
constructor Create(MediaPlayer:tMediaPlayer;Panel:tPanel;Image:tImage);
end;function SetSumTimes(Volumes:integer):string;var
aImage:tImage;
aMediaPlayer:tMediaPlayer;
aPanel:tPanel;
FSums:string;implementationuses MainF;function SetSumTimes(Volumes:integer):string;
begin
SetSumTimes:=format('%.1d',[Volumes div 3600000])+':'+format('%.2d',[(Volumes mod 3600000) div 60000])+':'+format('%.2d',[((Volumes mod 3600000) mod 60000) div 1000]);
end;constructor myThread2.Create(MediaPlayer:tMediaPlayer;Panel:tPanel;Image:tImage);
begin
inherited Create(false);
aMediaPlayer:=MediaPlayer;
aPanel:=Panel;
aImage:=Image;
aMediaPlayer.Wait:=false;
aMediaPlayer.Notify:=true;
end;procedure myThread2.execute;
begin
synchronize(SetMovieVolume1);
end;procedure myThread2.SetMovieVolume1;
begin
aMediaPlayer.DeviceType:=dtAutoSelect;
aMediaPlayer.Close;
aMediaPlayer.FileName:=OpenNames;
aMediaPlayer.Open;
aMediaPlayer.Display:=aPanel;
aMediaPlayer.TimeFormat:=tfMilliseconds;
aMediaPlayer.DisplayRect:=rect(0,0,aPanel.Width,aPanel.Height);
aMediaPlayer.Play;
if OpenListIndex>-1 then
begin
aMediaPlayer.Position:=OpenListIndex;
OpenListIndex:=-1;
aMediaPlayer.Play;
end;
Fsums:=SetSumTimes(aMediaPlayer.Length);
end;constructor myThread.Create();
begin
inherited Create(false);
end;procedure myThread.execute;
begin
if MouseChecked then
while MouseChecked do
begin
sleep(300);
synchronize(SetMovieVolume);
if terminated then exit;
end
else
while aImage.Left<=form1.shpProcess.Left+form1.shpProcess.Width-11 do
begin
if MouseChecked then
exit;
sleep(300);
synchronize(SetPositionVolume);
if terminated then exit;
end;
end;procedure myThread.SetPositionVolume;
begin
if aMediaPlayer.Position>aMediaPlayer.Length then
aImage.Left:=form1.shpProcess.Width+form1.shpProcess.Left-11
else
aImage.Left:=(aMediaPlayer.Position*form1.shpprocess.width) div aMediaPlayer.Length+form1.shpProcess.Left-11;
form1.Timers.Caption:=SetSumTimes(aMediaPlayer.Position)+' / '+fsums;
end;procedure myThread.SetMovieVolume;
var
position:integer;
begin
position:=(aImage.Left-form1.shpProcess.Left+11)*aMediaPlayer.Length div form1.shpprocess.width;
if aMediaPlayer.Mode=mpPlaying then
begin
aMediaPlayer.Position:=position;
aMediaPlayer.Play
end
else
if form1.ToolButton3.Enabled then
aMediaPlayer.Position:=position;
end;end.
begin
// function要用Result返回函数结果
Result:=format('%.2d:%.2d:%.2d',[Volumes div 3600000,(Volumes mod 3600000) div 60000,((Volumes mod 3600000) mod 60000) div 1000]);
end;
uses Classes, ExtCtrls, MPlayer, SysUtils, mmSystem, StdCtrls, Forms, Dialogs;type
myThread = class(TThread)
private
procedure SetMovieVolume;
procedure SetPositionVolume;
protected
procedure Execute;override;
public
constructor Create();
end;type
myThread2 = class(TThread)
private
procedure SetMovieVolume1;
protected
procedure Execute;override;
public
constructor Create(MediaPlayer:tMediaPlayer;Panel:tPanel;Image:tImage);
end;type
myThread3 = class(TThread)
private
procedure SetDirFile;
protected
procedure Execute;override;
public
constructor Create(ListBox:tListbox;filePath:string);
end;function SetSumTimes(Volumes:integer):string;var
aImage:tImage;
aMediaPlayer:tMediaPlayer;
aPanel:tPanel;
aListbox:tListbox;
FSums:string;
FileList:string;
HPosition:integer;implementationuses MainF;constructor myThread3.Create(ListBox:tListbox;filePath:string);
begin
inherited Create(false);
aListbox:=ListBox;
FileList:='';
if opennames<>'' then form1.quit.Click;
aListbox.Items.Clear;
chdir(filePath);
end;procedure myThread3.execute;
var
i:integer;
f1:textfile;
begin
SetDirFile;
for i:=alistbox.Count+1 to 1000 do
begin
if FileNameList[i]='' then
break;
FileNameList[i]:='';
end;
assignfile(f1,systemPath+'\list\files.txt');
rewrite(f1);
writeln(f1,FileList);
closefile(f1);
end;procedure myThread3.SetDirFile;
var
sr:TSearchRec;
err:integer;
s:string;
begin
err:=findfirst('*.*',$37,sr);
while (err=0) do
begin
if (sr.name[1]<>'.') then
begin
if (sr.attr and fadirectory)=0 then
begin
s:=extractfileext(sr.Name);
if (pos(lowercase(s+';'),ExtList)>0) and (s<>'') then
begin
s:=AnsiUpperCase(expandfilename(sr.name));
alistbox.Items.Add(extractfileName(s));
FileNameList[alistbox.Count]:=s;
if alistbox.Count=1 then
FileList:=s
else
FileList:=FileList+'?'+s;
end;
end;
if (sr.attr and fadirectory)=16 then
begin
chdir(sr.name);
SetDirFile;
chdir('..');
end;
end;
err:=findnext(sr);
end;
end;function SetSumTimes(Volumes:integer):string;
begin
SetSumTimes:=format('%.1d',[Volumes div 3600000])+':'+format('%.2d',[(Volumes mod 3600000) div 60000])+':'+format('%.2d',[((Volumes mod 3600000) mod 60000) div 1000]);
end;constructor myThread2.Create(MediaPlayer:tMediaPlayer;Panel:tPanel;Image:tImage);
begin
inherited Create(false);
aMediaPlayer:=MediaPlayer;
aPanel:=Panel;
aImage:=Image;
aMediaPlayer.Wait:=false;
aMediaPlayer.Notify:=true;
end;procedure myThread2.execute;
begin
synchronize(SetMovieVolume1);
end;procedure myThread2.SetMovieVolume1;
var
c:string;
begin
try
aMediaPlayer.DeviceType:=dtAutoSelect;
aMediaPlayer.Close;
aMediaPlayer.FileName:=OpenNames;
aMediaPlayer.Open;
aMediaPlayer.Display:=aPanel;
aMediaPlayer.TimeFormat:=tfMilliseconds;
aMediaPlayer.DisplayRect:=rect(0,0,aPanel.Width,aPanel.Height);
aMediaPlayer.Play;
if OpenListIndex>-1 then
begin
aMediaPlayer.Position:=OpenListIndex;
OpenListIndex:=-1;
aMediaPlayer.Play;
end;
Fsums:=SetSumTimes(aMediaPlayer.Length);
except
c:=extractfileext(opennames);
showmessage('播放器不支持'+copy(c,2,length(c)-1)+'格式文件的播放！');
end;
end;constructor myThread.Create();
begin
inherited Create(false);
end;procedure myThread.execute;
begin
if MouseChecked then
while MouseChecked do
begin
synchronize(SetMovieVolume);
if terminated then exit;
end
else
while aImage.Left<=form1.shpProcess.Left+form1.shpProcess.Width-11 do
begin
if MouseChecked then
exit;
synchronize(SetPositionVolume);
if terminated then exit;
end;
end;procedure myThread.SetPositionVolume;
begin
if aMediaPlayer.Position>aMediaPlayer.Length then
aImage.Left:=form1.shpProcess.Width+form1.shpProcess.Left-11
else
if aMediaPlayer.Length>0 then
aImage.Left:=(aMediaPlayer.Position*form1.shpprocess.width) div aMediaPlayer.Length+form1.shpProcess.Left-11;
form1.Timers.Caption:=SetSumTimes(aMediaPlayer.Position)+' / '+fsums;
end;procedure myThread.SetMovieVolume;
var
Position:integer;
begin
Position:=(aImage.Left-form1.shpProcess.Left+11)*aMediaPlayer.Length div form1.shpprocess.width;
if HPosition=Position then exit;
if aMediaPlayer.Mode=mpPlaying then
begin
aMediaPlayer.Position:=Position;
aMediaPlayer.Play
end
else
if form1.ToolButton3.Enabled then
aMediaPlayer.Position:=Position;
HPosition:=Position;
end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ImgList, ComCtrls, ToolWin, Menus, Buttons, StdCtrls,
MPlayer, MMSystem, IniFiles;type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Splitter1: TSplitter;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
DVD1: TMenuItem;
DVD: TMenuItem;
DVD2: TMenuItem;
N3: TMenuItem;
quit: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
MainMenu: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
N37: TMenuItem;
N38: TMenuItem;
N39: TMenuItem;
N40: TMenuItem;
N41: TMenuItem;
N42: TMenuItem;
N43: TMenuItem;
N44: TMenuItem;
N45: TMenuItem;
N46: TMenuItem;
N47: TMenuItem;
N48: TMenuItem;
N49: TMenuItem;
N50: TMenuItem;
N51: TMenuItem;
N52: TMenuItem;
N53: TMenuItem;
N54: TMenuItem;
ToolBar1: TToolBar;
btn0: TToolButton;
il1: TImageList;
il2: TImageList;
btn1: TToolButton;
btn2: TToolButton;
btn3: TToolButton;
btn4: TToolButton;
btn5: TToolButton;
btn6: TToolButton;
btn7: TToolButton;
shpProcess: TShape;
imgValue: TImage;
btnVoice: TSpeedButton;
shpVoice: TShape;
imgVoice: TImage;
pnl1: TPanel;
btn9: TSpeedButton;
btn10: TSpeedButton;
btn11: TSpeedButton;
lblTop: TLabel;
lst1: TListBox;
pnl2: TPanel;
lblTitles: TLabel;
lblTimers: TLabel;
DVD3: TMenuItem;
N55: TMenuItem;
N56: TMenuItem;
N57: TMenuItem;
N58: TMenuItem;
N59: TMenuItem;
N60: TMenuItem;
N61: TMenuItem;
N62: TMenuItem;
N63: TMenuItem;
N64: TMenuItem;
N65: TMenuItem;
N66: TMenuItem;
N67: TMenuItem;
N68: TMenuItem;
N69: TMenuItem;
N70: TMenuItem;
N71: TMenuItem;
N72: TMenuItem;
N73: TMenuItem;
N74: TMenuItem;
N75: TMenuItem;
N76: TMenuItem;
N77: TMenuItem;
N78: TMenuItem;
N79: TMenuItem;
N80: TMenuItem;
mp1: TMediaPlayer;
pm1: TPopupMenu;
N81: TMenuItem;
N82: TMenuItem;
N83: TMenuItem;
N84: TMenuItem;
N85: TMenuItem;
N86: TMenuItem;
N87: TMenuItem;
N88: TMenuItem;
N89: TMenuItem;
N90: TMenuItem;
N91: TMenuItem;
N92: TMenuItem;
N93: TMenuItem;
N94: TMenuItem;
N95: TMenuItem;
N96: TMenuItem;
N431: TMenuItem;
N541: TMenuItem;
N1691: TMenuItem;
N97: TMenuItem;
N501: TMenuItem;
N1001: TMenuItem;
N2001: TMenuItem;
N98: TMenuItem;
procedure DVD2Click(Sender: TObject);
procedure pnl2Resize(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure Panel3Resize(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure DVDClick(Sender: TObject);
procedure MainMenuClick(Sender: TObject);
private
{ Private declarations }
procedure SetSysIniInfo;
public
{ Public declarations }
end;var
Form1: TForm1;
TMovieVolume:TThread;
MTMovieVolume:TThread;
TTMovieVolume:TThread;
OpenListIndex:integer;
FileNameList:array [0..1000] of string;
OpensList:array [0..1000] of string;
opennames:string;
filePath:string;
filesPath:string;
OpensPath:string;
ExtList:string;
MouseChecked:Boolean;
VoiceChked:Boolean;
VolumeChked:boolean;
VolumeType:integer;
systemPath:string;
IniFileName:string;
Systemini:TIniFile;implementationuses
MainT, MainM;{$R *.dfm}procedure tForm1.SetSysIniInfo;
var
i,j:integer;
t:tsystem;
begin
VoiceChked:=false;
VolumeType:=0;
filesName:=systemPath+'\list\files.txt';
OpensPath:=systemPath+'\list\opens.txt';
imgVoice.Left:=shpVoice.Left+GetWindowVolume(VolumeType);
systemPath:=extractfilePath(application.ExeName); //应用程序路径
IniFileName:=systemPath+'SystemSets.ini'; //配置文件路径
Systemini:=TIniFile.Create(inifilename);
ExtList:=Systemini.readstring('SystemFile','FindExt','');
SetWindowDat;
SetOpenIniInfo;
SetFileIni;
end; procedure TForm1.DVD2Click(Sender: TObject);
var
b:tbrowseinfo;
d:array[0..260] of char;
i:pitemidlist;
s:string;
begin
b.hwndowner:=self.handle;
b.pidlroot:=nil;
b.pszdisplayname:=nil;
b.lpsztitle:='请选择';
b.ulflags:=0;
b.lpfn:=nil;
b.lparam:=0;
b.iimage:=0;
i:=shbrowseforfolder(b);
if i <>nil then
begin
shgetpathfromidlist(i,@d);
s:=string(d);
end;
if s <>'' then
begin
filePath:=s;
TTMovieVolume:=tthrend.create;
TTMovieVolume.priority:=tpIdle;
end;
end;procedure TForm1.pnl2Resize(Sender: TObject);
begin
aMediaPlayer.DisplayRect:=rect(0,0,aPanel.Width,aPanel.Height);
end;procedure TForm1.Panel1Resize(Sender: TObject);
begin
pnl2.height:=Panel1.height-15;
titles.top:=Panel1.height-15;
timers.top:=titles.top;
timers.left:=pnl2.width-100;
end;procedure TForm1.Panel3Resize(Sender: TObject);
begin
shpValue.width:=panel3.width-30;
shpVoice.left:=panel3.width-shpvoice.width-15;
btnVoice.left:=panel3.width-96;
end;procedure TForm1.N14Click(Sender: TObject);
begin
close
end;procedure TForm1.DVDClick(Sender: TObject);
begin
with sender as tmenuitem do
begin
filePath:=Copy(caption,1,3);
TTMovieVolume:=tthrend.create;
TTMovieVolume.priority:=tpIdle;
end;
end;procedure TForm1.MainMenuClick(Sender: TObject);
begin
with sender as tmenuitem do
begin
openfiles(filenamelist[itemindex-4]);
end;
end;end.
uses Classes, ExtCtrls, MPlayer, SysUtils, mmSystem, StdCtrls, Forms, Dialogs,
registry, Menus, windows;procedure SetWindowDat;
procedure SetOpenIniInfo;
procedure SetFileIni;
//function GetWindowVolume(fType:Integer):Integer;
procedure SetDriverInfo;
function SetDrivers(lstr:string):string;
function SetWindowMenus(lstr:string):string;
procedure SetWindowMenu(mMenu:TMenuItem;mMenu1:TMenuItem;lstr:string);
implementationuses MainF;function SetWindowMenus(lstr:string):string;
var
i,j:integer;
s,f:string;
begin
with form1.canvas do
if textwidth(lstr)>300 then
begin
textwidth(extractfileName(lstr))
end;
SetWindowMenus:=lstr;
end;function SetDrivers(lstr:string):string;
var
VolN:array[0..255] of Char;
n:Longword;
l:Longword;
f:Longword;
s:array[0..255] of Char;
begin
GetVolumeInformation(PChar(lstr),VolN,255,@n,l,f,s,255);
SetDrivers:=VolN;
end;procedure SetDriverInfo;
var
i,j:Integer;
s:string;
begin
j:=0;
for i:=65 to 90 do
begin
s:=chr(i)+':\';
if GetDriveType(pchar(s))=drive_cdrom then
begin
if j=0 then
form1.mainmenu1.Items[0].Items[1].Items[0].Caption:=s+SetDrivers(s)
else
SetWindowMenu(form1.mainmenu1.Items[0].Items[1],form1.mainmenu1.Items[0].Items[1].Items[0],s+SetDrivers(s));
j:=j+1;
end;
end;
end;procedure SetWindowMenu(mMenu:TMenuItem;mMenu1:TMenuItem;lstr:string);
var
mItem:TMenuItem;
begin
mItem:=TMenuItem.create(mMenu1);
if mMenu.caption='历史记录' then
begin
mItem.caption:=SetWindowMenus(lstr);
mItem.onclick:=form1.MainMenuClick;
mMenu.items.insert(4,mitem);
end
else
begin
mItem.caption:=lstr;
mItem.onclick:=form1.DVDClick;
mMenu.items.insert(mMenu1.count,mitem);
end;
end;procedure SetWindowDat;
var
Reg: TRegistry;
begin
IF Systemini.readstring('systemfile','DatRegist','')='1' then exit
Reg := TRegistry.Create;
try
Reg.RootKey :=&H80000002;
if Reg.OpenKey('\Software\Microsoft\Windows NT\CurrentVersion\MCI Extensions', True) then
Reg.WriteString('Dat','MPEGVideo');
finally
Reg.free;
end;
Systemini.writestring('systemfile','DatRegist','1')
end;procedure SetOpenIniInfo;
var
s:string;
f:textfile;
begin
assignfile(f,filesPath);
reset(f);
while not eof(f) do
begin
readln(f,s); end;
rewrite(f);
writeln(f,s);
closefile(f);
end;procedure SetFileIni;
beginend;
end.