unit LukasMediaPlayer;
interface
//=============Uses==========================================================
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, MPlayer, ShellApi, ComCtrls, mmsystem, ExtCtrls;
//=============Konstanten=====================================================
const
MCI_SETAUDIO = $0873;
MCI_DGV_SETAUDIO_VOLUME = $4002;
MCI_DGV_SETAUDIO_ITEM = $00800000;
MCI_DGV_SETAUDIO_VALUE = $01000000;
MCI_DGV_STATUS_VOLUME = $4019;
//==============typen=========================================================
type
TForm1 =
class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ListBox1: TListBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
MediaPlayer1: TMediaPlayer;
Button4: TButton;
TrackBar1: TTrackBar;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
TrackBar2: TTrackBar;
Button6: TButton;
Button7: TButton;
Button5: TButton;
Button8: TButton;
//============Normale Proceduren===============================================
procedure TrackBar1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure Button2Click(Sender: TObject);
//Hilfe
procedure Button3Click(Sender: TObject);
//About
procedure Button4Click(Sender: TObject);
//Playlist Löschen
procedure Button6Click(Sender: TObject);
//Laufwerk rdy?
procedure Button7Click(Sender: TObject);
//Laufwerk-Typ
procedure Button8Click(Sender: TObject);
//öffnen
procedure Button5Click(Sender: TObject);
//schliessen
//===========Variablen=========================================================
var
//==========Privat Proceduren==================================================
private
{ Private-Deklarationen }
//=========Public Proceduren==================================================
public
{ Public-Deklarationen }
Procedure AddToPlayList(s:
string);
procedure PlayFile(songNumber: integer);
Procedure WMDropFiles (
Var aMsg: tMessage);
message WM_DROPFILES;
end;
var
Form1: TForm1;
playList: TStringList;
CurrentSong: integer = +1;
// neue globale variable um uns das aktuelle lied zu merken
//============Implementation==================================================
implementation
{$R *.dfm}
//============Volume Quelltext=================================================
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;
procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);
{ Volume: 0 - 1000 }
var
p: MCI_DGV_SETAUDIO_PARMS;
begin
{ Volume: 0 - 1000 }
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(@p));
end;
function GetMPVolume(MP: TMediaPlayer): 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(@p));
Result := p.dwReturn;
{ Volume: 0 - 1000 }
end;
// Example, Beispiel:
//=============Song in Playlist ziehen=========================================
Procedure TForm1.WMDropFiles (
Var aMsg: tMessage);
Var
Idx, Size, FileCount: Integer;
Filename: pChar;
Begin
Inherited;
FileCount := DragQueryFile (aMsg.WParam, $FFFFFFFF,
nil, 255);
For Idx := 0
To FileCount -1
Do Begin
Size := DragQueryFile (aMsg.WParam, Idx,
nil, 0) + 1;
Filename := StrAlloc (Size);
If DragQueryFile (aMsg.WParam, Idx, Filename, Size) = 1
Then { nothing }
else AddToPlayList (pChar (Filename));
StrDispose (Filename);
End;
DragFinish (aMsg.WParam);
End;
Procedure TForm1.AddToPlayList(s:
string);
begin
playList.Add(s);
ListBox1.Items.Add(extractfilename(s));
end;
//=============Hilfe===========================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage('
Hilfe, bitte auf OK klicken!');
ShowMessage('
1.Lied/Video in das weisse Feld ziehen!(MUSS MP3/WMA/WMV - Format haben. Weiter auf OK.');
ShowMessage('
2.Datei anklicken, dass sie blau makiert ist und auf play klicken, um sie abzuspielen! Weiter auf OK.');
ShowMessage('
Zum Beenden der Hilfe bitte auf OK klicken.');
end;
//==============About==========================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
ShowMessage('
Made By: Lukas Baessgen. Weiter auf OK.');
ShowMessage('
Wenn ihr Verbesserungsvorschläge habt --> E-Mail an [email]Zitrone.Saft@web.de[/email] Weiter auf OK.');
ShowMessage('
Vielen dank, dass ihr diesen Player benutzt! Zum Beenden auf OK klicken.');
end;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles (
Handle, True);
playList := TStringList.Create;
end;
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
playList.Free;
end;
//================Nächster song================================================
procedure TForm1.PlayFile(songNumber: integer);
begin
if fileexists(Playlist.Strings[songNumber])
then begin
CurrentSong := songNumber;
mediaplayer1.Close;
mediaplayer1.FileName := Playlist.Strings[songNumber];
mediaplayer1.open;
mediaplayer1.play
end;
end;
//===============Volume setzen=================================================
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
SetMPVolume(MediaPlayer1,TrackBar1.Position);
end;
//===============Angeklickten song abspielen===================================
procedure TForm1.ListBox1Click(Sender: TObject);
var i : integer;
begin
for i := 0
to listbox1.Count - 1
do
if listbox1.Selected[i]
then break;
PlayFile(i);
end;
//==================Lied abspielen=============================================
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
if mediaplayer1.Position = mediaplayer1.Length
then begin
Listbox1.Selected[currentSong] := false;
inc(currentSong);
if currentSong < Playlist.Count
then
else currentsong := 0;
PlayFile(CurrentSong);
Listbox1.Selected[currentSong] := true;
end;
end;
//=================Playlist löschen============================================
procedure TForm1.Button4Click(Sender: TObject);
begin
Listbox1.Clear;
end;
//================Laufwerk bereit?=============================================
function IsDriveReady(Root:
string): Boolean;
var
Oem: Cardinal;
Dw1, Dw2: DWORD;
begin
Oem := SetErrorMode(SEM_FAILCRITICALERRORS);
if Length(Root) = 1
then Root := Root + '
:\';
Result := GetVolumeInformation(PChar(Root),
nil, 0,
nil, Dw1, Dw2,
nil, 0);
SetErrorMode(Oem);
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if IsDriveReady('
D') = true
then
ShowMessage('
Laufwerk bereit!!')
else
ShowMessage('
Laufwerk nicht bereitt!!');
end;
//==================Laufwerktyp bestimmen======================================
procedure TForm1.Button7click(Sender: TObject);
var
typ: Integer;
s:
string;
begin
s := '
D:\';
typ := GetDriveType(PChar(s));
if Typ <> 0
then case typ
of
DRIVE_REMOVABLE:
begin
ShowMessage('
Drive Removable / Diskette');
end;
DRIVE_FIXED:
begin
ShowMessage('
Drive fixed / Festplatte');
end;
DRIVE_CDROM:
begin
ShowMessage('
CD-ROM Drive');
end;
DRIVE_RAMDISK:
begin
ShowMessage('
RAM Drive');
end;
DRIVE_REMOTE:
begin
ShowMessage('
Remote Drive / Netzlaufwerk');
end;
end;
end;
//=============Laufwerke schliessen/öffnen=====================================
procedure TForm1.Button8Click(Sender: TObject);
begin
mciSendString('
Set cdaudio door open wait',
Nil, 0,
Handle);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
mciSendString('
Set cdaudio door closed wait',
Nil, 0,
Handle);
end;
//=============================================================================
end.