多线程1

Question

unit MainD; interface 
  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;
  HPosition:integer; implementation uses Main, MainN; constructor myThread3.Create(ListBox:tListbox;filePath:string); 
begin 
  inherited Create(false); 
  aListbox:=ListBox;
  if opennames <>'' then Form1.quit.Click; 
  aListbox.Items.Clear;
  syschecked('delete from 0');
  chdir(filePath); 
end; procedure myThread3.execute;
begin 
  SetDirFile;
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:=expandfilename(sr.name);
            alistbox.Items.Add(extractfileName(s));
            syschecked('insert into 0([name]) values("'+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;
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;
  ListFilesa:=aMediaPlayer.DisplayRect.Right;
  ListFilesc:=aMediaPlayer.DisplayRect.Bottom;
  Form1.Titles.Caption:='播放中            '+inttostr(ListFilesa)+' x '+inttostr(ListFilesc);
  aMediaPlayer.TimeFormat:=tfMilliseconds;
  SetShowRect;
  if OpenListIndex>-1 then
  begin
    aMediaPlayer.Position:=OpenListIndex;
    OpenListIndex:=-1;
  end;
  amediaplayer.Notify:=false;
  aMediaPlayer.Play;
  Fsums:=SetSumTimes(aMediaPlayer.Length);
  Form1.Timers.Caption:='0:00:01 / '+fsums;
  if aMediaPlayer.Position=0 then
  begin
     aMediaPlayer.Position:=93;
     aMediaPlayer.Play;
  end;
  amediaplayer.Notify:=true;
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
      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.

Answer 1

unit MainN;interface 
  uses Windows, StrUtils, SysUtils, Classes, Controls, Forms, Menus, MMSystem, DB, ADODB;procedure SetSysIniInfo1;
function GetRst(lstrSql:string):TadoDataSet;
procedure SysChecked(lstrSql:string);
procedure SetOpenIniInfo;
procedure SetFileIni;
procedure SetDriverInfo(mMenu:TMenuItem;mMenu1:TMenuItem);
function SetDrivers(lstr:string):string; 
function SetWindowMenus(lstr:string):string; 
procedure SetWindowMenu(mMenu:TMenuItem;mMenu1:TMenuItem;lstr:string); 
procedure GetWindowVolume; 
procedure SetWindowVolume;
procedure SetShowRect;
function FileNameIndex:integer;
function FileNameList(lIndex:integer):string;
function OpenLists(lIndex:integer):string;
procedure SetMenuLists(s:string);
procedure SetPopMenus(mMenu:tPopupMenu;mMenu1:TMenuItem;lIndex:integer);
procedure SetSizeType(mMenu:TMenuItem;mMenu1:TMenuItem;lIndex:integer);
procedure SetShowType(mMenu:TMenuItem;lSize:integer);
procedure SetFormPost(mMenu:TMenuItem;mMenu1:TMenuItem;lIndex:integer);
procedure SetPlayInfo(MediaPlayer2:tMediaPlayer);var
  cn:TADOConnection;implementationuses Main, MainD;procedure SetPlayInfo(MediaPlayer2:tMediaPlayer);
begin
  if MediaPlayer2.Position=0 then
    if TMovieMode=1 then
      ToolButton8.Click
    else if TMovieMode=2 then
    begin
      Randomize;
      openfiles(FileNameList(Random(listbox1.Count)+1));
    end
    else if TMovieMode=3 then
      ToolButton1.Click
end;procedure SetFormPost(mMenu:TMenuItem;mMenu1:TMenuItem;lIndex:integer);
begin
   mMenu.Items[winpost].Checked:=false;
   mMenu.Items[lIndex].Checked:=true;
   mMenu1.Items[winpost].Checked:=false;
   mMenu1.Items[lIndex].Checked:=true;
   winpost:=lIndex;
   if lIndex=0 then
      setwindowpos(form1.Handle,hwnd_notopmost,form1.Left,form1.Top,form1.Width,form1.Height,0)
   else if lindex=1 then
      setwindowpos(form1.Handle,hwnd_topmost,form1.Left,form1.Top,form1.Width,form1.Height,0);
end;procedure SetShowType(mMenu:TMenuItem;lSize:integer);
begin
  mMenu.Checked:=true;
  SizeType:=lSize;
  WinSizeType:=true;
  if opennames <>'' then
      SetShowRect;
end;function FileNameIndex:integer;
var
   rs:TadoDataSet;
begin
   rs:=getrst('select 1 from 0 where id<=(select id from 0 where name="'+opennames+'")');
   FileNameIndex:=rs.RecordCount;
end;procedure SetSizeType(mMenu:TMenuItem;mMenu1:TMenuItem;lIndex:integer);
begin
  mMenu.Items[ShowType].Checked:=false;
  mMenu.Items[lIndex].Checked:=true;
  mMenu1.Items[ShowType].Checked:=false;
  mMenu1.Items[lIndex].Checked:=true;
  ShowType:=lIndex;
  WinSizeType:=true;
  if opennames <>'' then
    SetShowRect;
end;procedure SetPopMenus(mMenu:tPopupMenu;mMenu1:TMenuItem;lIndex:integer);
begin
  mMenu.Items[TMovieMode].Checked:=false;
  mMenu.Items[lIndex].Checked:=true;
  mMenu1.items[TMovieMode].Checked:=false;
  mMenu1.Items[lIndex].Checked:=true;
  TMovieMode:=lIndex;
end;function OpenLists(lIndex:integer):string;
var
   rs:TadoDataSet;
begin
   rs:=getrst('select * from (select top '+inttostr(lindex)+' name,id from 1 order by id desc) order by id');
   OpenLists:=rs.FieldValues['name'];
end;function FileNameList(lIndex:integer):string;
var
   rs:TadoDataSet;
begin
   rs:=getrst('select * from (select top '+inttostr(lindex)+' name,id from 0 order by id) order by id desc');
   FileNameList:=rs.FieldValues['name'];
end;procedure SysChecked(lstrSql:string);
begin
   cn.Execute(lstrSql);
end;function GetRst(lstrSql:string):TadoDataSet;
var
   rs:TadoDataSet;
begin
   rs:=TadoDataSet.Create(nil);
   rs.Connection:=cn;
   rs.CursorType:=ctDynamic;
   rs.LockType:=ltBatchOptimistic;
   rs.CommandText:=lstrSql;
   rs.open;
   GetRst:=rs;
end;procedure SetShowRect;
var 
  ltop:integer; 
  lleft:integer; 
  lwidth:integer; 
  lHeight:integer;
begin
  if WindowFull=false then
  begin
  lwidth:=ListFilesa*SizeType div 100; 
  lHeight:=ListFilesc*SizeType div 100;
  with Form1 do 
  begin 
    if ShowType=0 then
      if WinSizeType then
        begin
          if Panel1.Width<lwidth then
            width:=width+lwidth-Panel1.Width;
          if Panel1.Height<lHeight+winStatusHeight then
            height:=height+lHeight+winStatusHeight-Panel1.Height;
            lleft:=(Panel1.Width-lwidth) div 2;
            ltop:=(Panel1.Height-lHeight-winStatusHeight) div 2;
            aMediaPlayer.DisplayRect:=rect(lleft,ltop,lwidth,lHeight);
        end
      else
      begin
         if Panel1.Width<lwidth then
            lwidth:=Panel1.Width;
         if Panel1.Height<lHeight+winStatusHeight then
            lHeight:=Panel1.Height-winStatusHeight;
         lleft:=(Panel1.Width-lwidth) div 2;
         ltop:=(Panel1.Height-lHeight-winStatusHeight) div 2;
         aMediaPlayer.DisplayRect:=rect(lleft,ltop,lwidth,lHeight);
      end
    else if ShowType=1 then
      aMediaPlayer.DisplayRect:=rect(0,0,panel1.Width,panel1.Height-winStatusHeight)
    else if showtype=2 then
    begin
      if Panel1.Width<lwidth then
        lwidth:=Panel1.Width;
      if Panel1.Height<(lwidth*3 div 4+winStatusHeight) then
        height:=height+(lwidth*3 div 4)+winStatusHeight-Panel1.Height;
      lleft:=(Panel1.Width-lwidth) div 2;
      ltop:=(Panel1.Height-(lwidth*3 div 4)-winStatusHeight) div 2;
      aMediaPlayer.DisplayRect:=rect(lleft,ltop,lwidth,(lwidth*3 div 4));
    end
    else if showtype=3 then
    begin
      if Panel1.Width<lwidth then
        lwidth:=Panel1.Width;
      if Panel1.Height<(lwidth*4 div 5+winStatusHeight) then
        height:=height+(lwidth*4 div 5)+winStatusHeight-Panel1.Height;
      lleft:=(Panel1.Width-lwidth) div 2;
      ltop:=(Panel1.Height-(lwidth*4 div 5)-winStatusHeight) div 2;
      aMediaPlayer.DisplayRect:=rect(lleft,ltop,lwidth,(lwidth*4 div 5));
    end
    else
    begin
      if Panel1.Width<lwidth then
        width:=width+lwidth-Panel1.Width;
      if Panel1.Height<(lwidth*9 div 16+winStatusHeight) then
        height:=height+(lwidth*9 div 16)+winStatusHeight-Panel1.Height;
      lleft:=(Panel1.Width-lwidth) div 2;
      ltop:=(Panel1.Height-(lwidth*9 div 16)-winStatusHeight) div 2;
      aMediaPlayer.DisplayRect:=rect(lleft,ltop,lwidth,(lwidth*9 div 16));
    end;
    panel3.Align:=alBottom;
  end;
  end
  else
     aMediaPlayer.DisplayRect:=rect(0,0,Form1.Width,Form1.Height-winStatusHeight);
end; procedure SetWindowVolume; 
var 
  v,t:longint; 
begin
    with Form1 do
    begin
      t:=(imgvoice.left-shpvoice.left+6)*255 div shpvoice.Width;
    end;
    waveoutgetvolume(0,@v);
    if volumetype=0 then
       v:=0
    else
    if VolumeType=1 then
      v:=(t shl 8)or(t shl 24)
    else
    if VolumeType=2 then
      v:=v and $ffff0000 or (t shl 8)
    else
      v:=v and $0000ffff or (t shl 24);
    waveOutSetVolume(0,v);
end; procedure SetSysIniInfo1;
begin
   cn:=TADOConnection.Create(nil);
   cn.CursorLocation:=clUseClient;
   cn.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source='+extractfilePath(application.ExeName)+'List\DateBase.mdb';
   cn.Open;
end;procedure GetWindowVolume; 
var 
  v:longint; 
begin 
  waveOutGetVolume(0,@v); 
  if VolumeType=1 then 
  begin 
    if hi(v)>hi(v shr 16) then 
      v:=hi(v) 
    else 
      v:=hi(v shr 16); 
  end 
  else if VolumeType=2 then 
    v:=hi(v) 
  else 
    v:=hi(v shr 16); 
  with Form1 do 
  begin 
    mainmenu1.Items[1].Items[8].Items[VolumeType-1].Checked:=true;
    PopupMenu1.Items[13].Items[VolumeType-1].Checked:=true;
    imgvoice.left:=shpvoice.left+(shpvoice.width*v) div 255-6; 
  end; 
end; 

Answer 2

function SetWindowMenus(lstr:string):string; 
var 
  f:string; 
begin 
  f:=extractfileName(lstr); 
  with Form1.Canvas do 
  begin 
  if textwidth(lstr)>300 then 
      if textwidth(leftBstr(lstr,3)+'...\'+f)>300 then
        lstr:=leftBstr(lstr,3)+'...\'+RightbStr(f,(300-textwidth(leftbstr(lstr,3)+'...\')) div 6)
      else 
        lstr:=leftbstr(lstr,(300-textwidth('...\'+f)) div 6)+'...\'+f;
  SetWindowMenus:=lstr; 
  end;
end; function SetDrivers(lstr:string):string;
var
  VolN:array[0..255] of Char;
  n,l,f:Longword; 
  s:array[0..255] of Char; 
begin 
  GetVolumeInformation(PChar(lstr),VolN,255,@n,l,f,s,255); 
  SetDrivers:=VolN; 
end; procedure SetDriverInfo(mMenu:TMenuItem;mMenu1:TMenuItem); 
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 
          mMenu1.Caption:=s+SetDrivers(s) 
        else 
          SetWindowMenu(mMenu,mMenu1,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 mMenu1.caption='-' then
  begin
    mItem.caption:='        '+SetWindowMenus(lstr);
    mItem.onclick:=Form1.MainClick;
    mMenu.insert(4,mitem)
  end 
  else 
  begin 
    mItem.caption:=lstr; 
    mItem.onclick:=Form1.DVDClick; 
    mMenu.insert(mMenu1.count,mitem); 
  end; 
end; procedure SetOpenIniInfo; 
var
  rs:TadoDataSet;
  i:Integer;
  s:string;
begin
  rs:=getrst('select * from 1 where name=""');
  if rs.Eof=false then
  syschecked('delete from 1 where name=""');
  rs:=getrst('select name from 1 order by id');
  if rs.Eof=false then
    Form1.MainMenu1.Items[0].Items[6].Items[3].Visible:=true;
  for i:=1 to rs.RecordCount do
  begin
    s:=rs.FieldValues['name'];
    SetWindowMenu(Form1.MainMenu1.Items[0].Items[6],Form1.MainMenu1.Items[0].Items[6].Items[3],s);
    rs.Next;
  end;
end;procedure SetFileIni; 
var
  rs:TadoDataSet;
  i:Integer; 
  s,f:string; 
begin
  rs:=getrst('select * from 0 where name=""');
  if rs.Eof=false then
  syschecked('delete from 0 where name=""');
  rs:=getrst('select startp,endfile from sys');
  OpenListIndex:=rs.FieldValues['startp'];
  if OpenListIndex>-1 then
      f:=rs.FieldValues['endfile'];
  rs:=getrst('select name from 0 order by id');
  for i:=1 to rs.RecordCount do
  begin
    s:=rs.FieldValues['name'];
    Form1.listbox1.AddItem(extractfileName(s),Form1.listbox1);
    if f=s then Form1.openfiles(f);
    rs.Next;
  end;
end;procedure SetMenuLists(s:string);
var
  rs:TadoDataSet;
begin
  rs:=getrst('select 1 from 1 where id>=(select id from 1 where name="'+s+'")');
  if rs.RecordCount>0 then
    Form1.MainMenu1.Items[0].Items[6].Delete(rs.RecordCount+3);
  SetWindowMenu(Form1.MainMenu1.Items[0].Items[6],Form1.MainMenu1.Items[0].Items[6].Items[3],s);
  syschecked('delete from 1 where name="'+s+'"');
  syschecked('insert into 1([name]) values("'+s+'")');
end;
end.