cLaW MP3 Player V1.5 Kaynak Kodu Gönderen: cLaW Tarih: 25 April 2008 14:37:28
Notice: Undefined index: current_action in
/home/del10000/domains/delphidunyasi.net/public_html/Sources/Subs.php on line
2391
Kodlama dili (delphi)
unit Unit1;
interface
uses
ShellApi, Registry, ActiveX, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, MPlayer, sBitBtn, StdCtrls, sButton, sSkinProvider, sSkinManager,
ExtCtrls, sScrollBar, sLabel, sAlphaListBox, Gauges, ComCtrls, IBCtrls,
TabNotBk, DBCtrls, OleServer, AccessXP, Menus, Grids,
DirOutln, mmsystem, CommCtrl, ShlObj, sPanel, sCheckBox, sGauge, ImgList;
type
TForm1 = class(TForm)
sSkinManager1: TsSkinManager;
sSkinProvider1: TsSkinProvider;
sButton1: TsButton;
sButton2: TsButton;
sButton3: TsButton;
sButton4: TsButton;
sBitBtn1: TsBitBtn;
OpenDialog1: TOpenDialog;
MediaPlayer1: TMediaPlayer;
tr: TsScrollBar;
Timer1: TTimer;
sLabel1: TsLabel;
sLabel2: TsLabel;
ListBox1: TsListBox;
ListBox2: TsListBox;
sButton5: TsButton;
OpenDialog2: TOpenDialog;
tr2: TsScrollBar;
sLabel3: TsLabel;
sLabel4: TsLabel;
Timer2: TTimer;
sButton8: TsButton;
MainMenu1: TMainMenu;
Ayarlar1: TMenuItem;
MP3Se1: TMenuItem;
Oynat1: TMenuItem;
Duraklar1: TMenuItem;
Durdur1: TMenuItem;
Kapat1: TMenuItem;
ListeyeMP3Al1: TMenuItem;
Hakknda1: TMenuItem;
SkinSe1: TMenuItem;
Skinler1: TMenuItem;
MaviGzellik1: TMenuItem;
McOS1: TMenuItem;
sButton9: TsButton;
sLabel6: TsLabel;
sLabel7: TsLabel;
sLabel8: TsLabel;
Koyu1: TMenuItem;
Vsta1: TMenuItem;
sPanel1: TsPanel;
OpenDialog3: TOpenDialog;
rep: TsButton;
Timer4: TTimer;
norep: TsButton;
sLabel9: TsLabel;
pp: TTimer;
p6: TProgressBar;
p5: TProgressBar;
p4: TProgressBar;
p3: TProgressBar;
p2: TProgressBar;
p1: TProgressBar;
p9: TProgressBar;
p8: TProgressBar;
p7: TProgressBar;
pp2: TTimer;
dd: TTimer;
Mavi1: TMenuItem;
Buz1: TMenuItem;
Elegant1: TMenuItem;
DoalSkin41: TMenuItem;
NextAlphaSkin1: TMenuItem;
YeilDizayn1: TMenuItem;
sButton10: TsButton;
Label4: TsLabel;
sLabel10: TsLabel;
sLabel11: TsLabel;
Label2: TsLabel;
Label3: TsLabel;
listrep: TTimer;
sButton11: TsButton;
sButton12: TsButton;
Yardm1: TMenuItem;
KsayolTular1: TMenuItem;
sButton13: TsButton;
sButton14: TsButton;
Timer3: TTimer;
sButton15: TsButton;
SaveDialog1: TSaveDialog;
SaveDialog2: TSaveDialog;
asd: TTimer;
Timer5: TTimer;
Timer6: TTimer;
denet: TTimer;
Timer8: TTimer;
sLabel5: TsLabel;
sLabel12: TsLabel;
sButton7: TsBitBtn;
sButton6: TsBitBtn;
MiniOynatcyaGe1: TMenuItem;
procedure sButton1Click(Sender: TObject);
procedure sBitBtn1Click(Sender: TObject);
procedure sButton3Click(Sender: TObject);
procedure sButton2Click(Sender: TObject);
procedure sButton4Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure trChange(Sender: TObject);
procedure sButton5Click(Sender: TObject);
procedure ListBox2DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure tr2Change(Sender: TObject);
procedure sButton8Click(Sender: TObject);
procedure MP3Se1Click(Sender: TObject);
procedure Oynat1Click(Sender: TObject);
procedure Duraklar1Click(Sender: TObject);
procedure Durdur1Click(Sender: TObject);
procedure ListeyeMP3Al1Click(Sender: TObject);
procedure Kapat1Click(Sender: TObject);
procedure ListBox2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Hakknda1Click(Sender: TObject);
procedure sButton9Click(Sender: TObject);
procedure MaviGzellik1Click(Sender: TObject);
procedure McOS1Click(Sender: TObject);
procedure Koyu1Click(Sender: TObject);
procedure Vsta1Click(Sender: TObject);
procedure repClick(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure FindFiles(StartDir, FileMask: string);
procedure norepClick(Sender: TObject);
procedure ppTimer(Sender: TObject);
procedure pp2Timer(Sender: TObject);
procedure ddTimer(Sender: TObject);
procedure Mavi1Click(Sender: TObject);
procedure Buz1Click(Sender: TObject);
procedure Elegant1Click(Sender: TObject);
procedure DoalSkin41Click(Sender: TObject);
procedure NextAlphaSkin1Click(Sender: TObject);
procedure YeilDizayn1Click(Sender: TObject);
procedure WMDROPFILES(var TheMessage: TWMDROPFILES);
message WM_DROPFILES;
procedure sButton10Click(Sender: TObject);
procedure listrepTimer(Sender: TObject);
procedure sButton11Click(Sender: TObject);
procedure sButton12Click(Sender: TObject);
procedure KsayolTular1Click(Sender: TObject);
procedure sButton13Click(Sender: TObject);
procedure sButton14Click(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure sLabel6Click(Sender: TObject);
procedure sLabel7Click(Sender: TObject);
procedure sLabel8Click(Sender: TObject);
procedure sButton15Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure asdTimer(Sender: TObject);
procedure Timer6Timer(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
procedure denetTimer(Sender: TObject);
procedure Timer8Timer(Sender: TObject);
procedure SimgeDurumunaKlt1Click(Sender: TObject);
procedure sSkinManager1AfterChange(Sender: TObject);
procedure AppException(Sender: TObject; E: Exception);
procedure sLabel5Click(Sender: TObject);
procedure sLabel12Click(Sender: TObject);
procedure sButton6Click(Sender: TObject);
procedure sButton7Click(Sender: TObject);
procedure ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListBox2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ListBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListBox2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MiniOynatcyaGe1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
il,i:integer;
liste:TStringList;
ii: integer;
a,Calinan: String;
secili: boolean;
s:string;
r:real;
IsScrolled: boolean;
const
MCI_SETAUDIO = $0873;
MCI_DGV_SETAUDIO_VOLUME = $4002;
MCI_DGV_SETAUDIO_ITEM = $00800000;
MCI_DGV_SETAUDIO_VALUE = $01000000;
MCI_DGV_STATUS_VOLUME = $4019;
X:Integer=0;
ColorCount = 16; //Renk sayısı
//Aşağıda renk adları
Colors: array [0..ColorCount-1] of TColor = (
clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);
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;
implementation
uses Unit2, Unit3, Unit4, Unit6;
{$R *.dfm}
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
NoErrMsg:=(True);
Application.ShowException(E);
MESSAGEBOX(HANDLE,PCHAR('Bilinmeyen Hata Oluştu Data Dosyaların zarar görmemesi için Program Kapatıldı.'),'Programda Dosya Koruması Var Üzgünüm',MB_ICONERROR);
Application.Terminate;
end;
procedure TForm1.WMDROPFILES(var TheMessage: TWMDROPFILES);
var
a:string;
FileName : array[0..MAX_PATH] of char;
begin
Listbox1.clear;
Listbox2.clear;
// Sürüklenen Dosyanın ismini,yolunu al
DragQueryFile(TheMessage.Drop, 0, FileName, 300);
ListBox1.Items.Add((filename));
for i := 0 to listBox1.Items.Count-1 do
begin
ListBox2.Items.Add(ExtractFileName(listBox1.Items.Strings[i]));
end;
end;
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then
exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;
function GetAppPath: string;
begin
Result := ExtractFilePath(Application.ExeName);
if Result[Length(Result)] <> '\data\liste.cmpls' then
Result := Result + '\data\data2.data';
end;
function GetAppPath3: string;
begin
Result := ExtractFilePath(Application.ExeName);
if Result[Length(Result)] <> '\data\' then
Result := Result + '\data\';
end;
function GetAppPath4: string;
begin
Result := ExtractFilePath(Application.ExeName);
if Result[Length(Result)] <> '\data\skin.data' then
Result := Result + '\data\skin.data';
end;
function GetAppPath2: string;
begin
Result := ExtractFilePath(Application.ExeName);
if Result[Length(Result)] <> '\data\liste_.cmpls' then
Result := Result + '\data\data1._data';
end;
function GetAppPath5: string;
begin
Result := ExtractFilePath(Application.ExeName);
if Result[Length(Result)] <> '\data\' then
Result := Result + '\data\';
end;
//Function to get wave volume
function getwavevolume:byte;
var
Volume: DWord;
MyWaveOutCaps: TWaveOutCaps;
vol:real;
s:string;
begin
if WaveOutGetDevCaps(WAVE_MAPPER,@MyWaveOutCaps,sizeof(MyWaveOutCaps))=MMSYSERR_NOERROR then
//Just make sure your wave device is not error,you can get wave volume without use WaveOutGetDevCaps
begin
WaveOutGetVolume(WAVE_MAPPER, @Volume);//Main code to get wave volume
vol:=(Volume div 65537 div 257);
s:=floattostr(int(vol));
getwavevolume:=strtoint(s);
end;
end;
function randomNumber(LBound, HBound: Integer):Integer;
begin
randomize;
Result := LBound + random(HBound - LBound + 1);
end;
//Function to set wave volume
function setwavevolume(volume:DWord):Dword;
var vol:integer;
MyWaveOutCaps: TWaveOutCaps;
begin
vol:=(volume)*65537*257;
if WaveOutGetDevCaps(WAVE_MAPPER,@MyWaveOutCaps,sizeof(MyWaveOutCaps))=MMSYSERR_NOERROR then
//Just make sure your wave device is not error,you can set wave volume without use WaveOutGetDevCaps
begin
WaveOutSetVolume(WAVE_MAPPER, MakeLong(vol, vol));//Main code to set wave volume
end;
end;
function MilliSecondsToString(MilliSeconds: integer): string;
var i1, i2: integer;
begin
i1:=(MilliSeconds div 1000) div 60;
i2:=(MilliSeconds div 1000)-(i1*60);
Result:=FormatFloat('00',i1)+':'+FormatFloat('00',i2);
end;
//ses açma kapama
procedure SetMediaAudioOff(DeviceID : word);
var
SetParm : TMCI_SET_PARMS;
begin
SetParm.dwAudio := MCI_SET_AUDIO_ALL;
mciSendCommand(DeviceID,
MCI_SET,
MCI_SET_AUDIO or MCI_SET_OFF,
Longint(@SetParm));
end;
//ses kapama
Procedure SetMediaAudioOn(DeviceID : word);
var
SetParm : TMCI_SET_PARMS;
begin
SetParm.dwAudio := MCI_SET_AUDIO_ALL;
mciSendCommand(DeviceID,
MCI_SET,
MCI_SET_AUDIO or MCI_SET_ON,
Longint(@SetParm));
end;
////ses kartı kontrol
Function IsSoundCardInstalled(): Boolean;
Begin
Result:=(waveOutGetNumDevs>0);
end;
procedure TForm1.FindFiles(StartDir, FileMask: string);
var
sayi:Word;
i:integer;
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
begin
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
IsFound :=
FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
// ListBox2.Items.Add(listBox1.Items.Strings[i]);
listbox1.items.Add(StartDir + SR.Name);
ListBox2.Items.Add(SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
DirList := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> '.') then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count-1 do
FindFiles(DirList[i], FileMask);
DirList.Free;
end;
procedure TForm1.sButton1Click(Sender: TObject);
begin
////////////////////////////////////////////////////
if OpenDialog1.Execute then
begin
MediaPlayer1.Close;
MediaPlayer1.FileName:=OpenDialog1.FileName;
MediaPlayer1.Open;
sButton3.Visible:=(False);
sButton2.Visible:=(True);
sButton2.Enabled:=(True);
sButton4.Enabled:=(True);
Oynat1.Enabled:=(True);
Duraklar1.Enabled:=(True);
Durdur1.Enabled:=(True);
end;
//////////////////////////////////////////////////
end;
procedure TForm1.sBitBtn1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.sButton3Click(Sender: TObject);
begin
MediaPlayer1.Pause;
sButton3.Visible:=(False);
sButton2.Visible:=(True);
pp.Enabled:=(false);
denet.Enabled:=(false);
end;
procedure TForm1.sButton2Click(Sender: TObject);
begin
MediaPlayer1.Play;
sButton3.Visible:=(True);
sButton2.Visible:=(False);
tr.Enabled:=(True);
tr.Max := MediaPlayer1.Length;
timer1.Enabled:=(True);
rep.Enabled:=(True);
pp.Enabled:=(True);
pp2.Enabled:=(True);
dd.Enabled:=(True);
if opendialog1.FileName = '' Then begin
slabel2.Caption:=ExtractFileName(listbox1.Items[listbox1.ItemIndex])+' - ';
application.Title:=ExtractFileName(listbox1.Items[listbox1.ItemIndex])+' - ';
asd.Enabled:=(True);
denet.Enabled:=(True);
end else begin
slabel2.Caption:=ExtractFileName(opendialog1.FileName)+' - ';
application.Title:=ExtractFileName(opendialog1.FileName)+' - ';
asd.Enabled:=(True);
denet.Enabled:=(True);
end;
end;
procedure TForm1.sButton4Click(Sender: TObject);
begin
MediaPlayer1.Stop;
MediaPlayer1.Close;
sButton3.Visible:=(False);
MediaPlayer1.Open;
sButton2.Visible:=(True);
pp.Enabled:=(false);
denet.Enabled:=(false);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
tr.OnChange := nil;
tr.Position := MediaPlayer1.Position;
tr.OnChange := trChange;
label3.Caption:=MilliSecondsToString(Mediaplayer1.Length);
label4.Caption:=MilliSecondsToString(mediaplayer1.Length-mediaplayer1.Position);
Label2.Caption:=MilliSecondsToString(mediaplayer1.position);
end;
procedure TForm1.trChange(Sender: TObject);
begin
pp.Enabled:=(false)