unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, MPlayer, FileCtrl, ComCtrls, ShellApi; type TForm1 = class ListBox1: TListBox; ListBox2: TListBox; ListBox3: TListBox; Label1: TLabel; Label2: TLabel; MediaPlayer1: TMediaPlayer; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; Timer1: TTimer; Timer2: TTimer; Timer3: TTimer; OpenDialog1: TOpenDialog; OpenDialog2: TOpenDialog; SaveDialog1: TSaveDialog; Label3: TLabel; Label4: TLabel; Timer4: TTimer; Timer5: TTimer; Label5: TLabel; TrackBar1: TTrackBar; Button6: TButton; Button7: TButton; Label6: TLabel; Label7: TLabel; procedure FormCreate ; procedure Button1Click ; procedure ListBox1DblClick ; procedure Timer1Timer ; procedure Label1MouseDown ; procedure Timer2Timer ; procedure Timer3Timer ; procedure Timer4Timer ; procedure Button2Click ; procedure Timer5Timer ; procedure Button3Click ; procedure Button4Click ; procedure ListBox1KeyDown ; procedure TrackBar1Change ; procedure WMDROPFILES ; message WM_DROPFILES; procedure Button6Click ; procedure Button7Click ; private public end; var Form1: TForm1; kont : bool; sabit, uzunluk, kalan_sure, say : integer; implementation Uses MMSystem; const MCI_SETAUDIO = $0873; MCI_DGV_SETAUDIO_VOLUME = $4002; MCI_DGV_SETAUDIO_ITEM = $00800000; MCI_DGV_SETAUDIO_VALUE = $01000000; MCI_DGV_STATUS_VOLUME = $4019; type MCI_DGV_SETAUDIO_PARMS = record dwCallback: DWORD; dwItem: DWORD; dwValue: DWORD; dwOver: DWORD; lpstrAlgorithm: PChar; lpstrQuality: PChar; end; type MCI_STATUS_PARMS = record dwCallback: DWORD; dwReturn: DWORD; dwItem: DWORD; dwTrack: DWORD; end; // sağ tılklayıp birlikte aç demek için function name :string; var len:integer; begin for len:=length downto 1 do begin if copy(yol, len,1)='\' then begin name:=copy(yol, len+1, length -len+1); break; end; end; end; // sağ tılklayıp birlikte aç demek için prosedür procedure parametre ; begin form1. ListBox2. Items. Add ; form1. ListBox1. Items. Add('1.'+ExtractFileName ; end; // Ses ayarı için procedure SetMPVolume ; var p: MCI_DGV_SETAUDIO_PARMS; begin p. dwCallback := 0; p. dwItem := MCI_DGV_SETAUDIO_VOLUME; p. dwValue := Volume; p. dwOver := 0; p. lpstrAlgorithm := nil; p. lpstrQuality := nil; mciSendCommand(MP. DeviceID, MCI_SETAUDIO, MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal ; end; // Ses ayarı için function GetMPVolume : Integer; var p: MCI_STATUS_PARMS; begin p. dwCallback := 0; p. dwItem := MCI_DGV_STATUS_VOLUME; mciSendCommand(MP. DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal ; Result := p. dwReturn; end; // harici sürükle bırak için... procedure TForm1. WMDROPFILES ; var FileName : array of char; begin // Uygulamaya sürüklenip bırakılan dosyanın ismi DragQueryFile(TheMessage. Drop, 0, FileName, 300); form1. ListBox2. Items. Add ; form1. ListBox1. Items. Add(IntToStr(form1. ListBox1. Items. Count+1)+'.'+ExtractFileName ; end; // mp3 calmayı saglayan fonksiyon // dönüş değeri şarkının milisaniye türünden uzunluğudur function cal :integer; begin form1. mediaplayer1. Devicetype := dtAutoselect; form1. MediaPlayer1. FileName := form1. ListBox2. Items. Strings ; form1. MediaPlayer1. Open; form1. MediaPlayer1. Play; sabit := form1. MediaPlayer1. TrackLength div 337; cal := form1. MediaPlayer1. TrackLength ; form1. TrackBar1. Position := GetMPVolume(form1. MediaPlayer1) div 2; end; // şarkının dakika ve saniye cinsinden süresüni hesaplar procedure sure_hesapla ; var saniye, dakika, tut1, tut2 : integer; begin tut1 := l div 1000; // artık saniyeye çevirdik.. saniye := tut1 mod 60; // kalan saniye tut2 := tut1 - saniye ; dakika := tut2 div 60; // dakika hesapladık... if dakika<10 then begin if saniye <10 then begin form1. label3. Caption := '0'+IntToStr + ':0'+IntToStr ; end else begin form1. label3. Caption := '0'+IntToStr +':'+IntToStr ; end; end else begin if saniye <10 then begin form1. label3. Caption := IntToStr + ':0'+IntToStr ; end else begin form1. label3. Caption := IntToStr +':'+IntToStr ; end; end; end; // şarkı çalarken şarkı için alan süreyi hesaplar procedure kalan_sure_hesapla ; var tut1, tut2, dakika, saniye: integer; begin tut1 := l div 1000; // artık saniyeye çevirdik.. saniye := tut1 mod 60; // kalan saniye tut2 := tut1 - saniye ; dakika := tut2 div 60; // dakika hesapladık... if dakika<10 then begin if saniye <10 then begin form1. label4. Caption := '0'+IntToStr + ':0'+IntToStr ; end else begin form1. label4. Caption := '0'+IntToStr +':'+IntToStr ; end; end else begin if saniye <10 then begin form1. label4. Caption := IntToStr + ':0'+IntToStr ; end else begin form1. label4. Caption := IntToStr +':'+IntToStr ; end; end; end; procedure TForm1. FormCreate ; begin listbox1. BringToFront; mediaplayer1. TimeFormat := tfMilliseconds; say :=0; DragAcceptFiles ; if pos('.', paramstr(1))<>0 then begin parametre(paramstr(1)); end; end; procedure TForm1. Button1Click ; var elsay1, elsay2, elsay3 : integer; begin if openDialog1. Execute then begin listBox3. Items := openDialog1. Files; end; for elsay1 := 0 to listbox3. Items. Count-1 do begin listBox2. Items. Add(listBox3. Items. Strings ); end; listbox3. Items. Clear; listBox1. Items. Clear; for elsay2 := 0 to listBox2. Items. Count -1 do begin listBox1. Items. Add(IntToStr(elsay2+1)+'.'+ExtractFileName(ListBox2. Items. Strings )); end; end; procedure TForm1. ListBox1DblClick ; begin uzunluk := cal ; kalan_sure := uzunluk; kont := true; sure_hesapla ; kalan_sure_hesapla ; label2. Caption := ExtractFileName(listBox2. Items. Strings )+' '; end; procedure TForm1. Timer1Timer ; begin if kont = true then begin label1. Refresh; label1. Repaint; label1. Canvas. Pen. Color := clAqua; label1. Canvas. Brush. Color := clAqua; label1. Canvas. RoundRect(0,0, mediaplayer1. Position div sabit,5,2,2); end; end; procedure TForm1. Label1MouseDown ; var deger: integer; fare : TMouse; begin if kont = true then begin mediaplayer1. Position := (fare. CursorPos. X - form1. Left) sabit; kalan_sure := uzunluk-mediaplayer1. Position; mediaplayer1. Play; end; end; procedure TForm1. Timer2Timer ; begin if kont = true then begin sure_hesapla ; end; end; procedure TForm1. Timer3Timer ; begin if kont = true then begin kalan_sure := kalan_sure - 1000; if kalan_sure >0 then begin kalan_sure_hesapla ; end; end; end; procedure TForm1. Timer4Timer ; begin if and (mediaplayer1. Position = mediaplayer1. TrackLength ) and (listBox1. Items. Count>listBox1. ItemIndex) then begin listBox1. ItemIndex := listBox1. ItemIndex+1; listBox2. ItemIndex := listBox2. ItemIndex+1; uzunluk := cal ; kalan_sure := uzunluk; kont := true; sure_hesapla ; kalan_sure_hesapla ; end; end; procedure TForm1. Button2Click ; begin say := say +1; if (say mod 2) = 1 then begin button2. Caption := 'Devam'; kont := false; mediaplayer1. Stop; end else begin button2. Caption := 'Dur'; kont := true; mediaplayer1. Play; end; end; procedure TForm1. Timer5Timer ; var t : string; begin t := Application. Title; if kont = true then begin label2. Caption := Copy(label2. Caption,2, Length(label2. Caption)-1)+Copy(label2. Caption,1,1); t := Copy(t,2, Length -1)+Copy(t,1,1); Application. Title := t; end; end;