Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Sound: MP3- und Video-Player
(C) Michael Weber 2003
erweitert von Dietmar Horn 2006
Declare Drive&,Files%,EXT#,ende%,Laufwerk$,SBar&,LW&,PB&
Declare Abspiel%,Quit%,Stop%,halt%,cc%
Declare RX!,RY%,zeile%,FNT%
Declare Titel%,MaxTitel%,NextTitel%,CurTitel%,Skip%,Temp$,sekunde%
Declare film%,f%,m%,r%,v%,Volume%,TitelPos%,Filename$,PlayTime%,minimize%,mn%,oldpos%
Def waveOutSetVolume(2) !WINMM,waveOutSetVolume
Def MakeLong(2)Or(&(1),Mul(&(2),$10000))
Def GetDriveType(1) !KERNEL32,GetDriveTypeA
Def CreateStatusBar(4) !COMCTL32,CreateStatusWindowA
DIM EXT#,100
WindowStyle 16
WindowTitle -=[ Webers Media Player ]=-
Window 0,0-%MaxX,@add(@mul(@div(%MaxY,5),3),20)
SetTrueColor 1
cls @RGB(255,255,0)
RX!=@div(%MaxX,5)
RY%=@div(%MaxY,5)
FNT% = @div(%MaxY,16)
Zeile% = @div(RY%,6)
if @lt(%MaxX,1025)
UseFont ARIAL,@mul(@div(Zeile%,4),3),0,1,0,0
else
UseFont ARIAL,20,0,1,0,0
endif
SetDialogFont 1
@CreateText(%HWnd,,0,@add(FNT%,5), @sub(%MaxX,5) ,@sub(@mul(RY%,3),@add(FNT%,5)))
cc% = @CreateGroupBox(%HWnd,Control Center,3,@mul(Zeile%,3),@sub(%MaxX,15),@mul(Zeile%,14))
@CreateGroupBox(%HWnd,Navigator,5,@mul(Zeile%,5),90,@sub(@mul(Zeile%,12),2))
Drive& = @CreateChoiceBox(%HWnd,,10, @mul(Zeile%,9),80,160)
@SendMessage(Drive&,$0145,$4000,EXT#)
@SendMessage(Drive&,$0186,1,0)
Files%=@CreateSortedListBox(%HWnd,, 100 , @mul(Zeile%,5) , @sub(%MaxX,200) , @sub(@mul(RY%,2),15) )
Files%=@CreateSortedListBox(%HWnd,, 100 , @mul(Zeile%,5) , @sub(%MaxX,200) , RY% )
Files% = SKCtrl_CreateColorListBox(%hwnd,0,SKCtrl_RGB(170,255,0),SKCtrl_RGB(0,0,255),100 , @mul(Zeile%,5) , @sub(%MaxX,200) , @sub(@mul(RY%,2),15),%hInstance)
TitelPos% = @CreateHScroll(%HWnd,,10, @sub(@mul(Zeile%,4),@div(Zeile%,4)) , @sub(%MaxX,30),@div(Zeile%,4))
@SendMessage(Files%,$0194,0,0)
Abspiel%=@CreateButton(%HWnd,Play,10, @add(@mul(Zeile%,10),5),80,Zeile%)
Stop%=@CreateButton(%HWnd,Stop,10,@add(@mul(Zeile%,11),5),80,Zeile%)
Quit%=@CreateButton(%HWnd,Ende,10,@sub(@mul(Zeile%,16),5),80,Zeile%)
minimize%=@CreateButton(%HWnd,Minimieren,10,@mul(Zeile%,14),80,Zeile%)
f%=@CreateRadioButton(%HWnd,Filme,10,@mul(Zeile%,6),80,Zeile%)
m%=@CreateRadioButton(%HWnd,Musik,10,@mul(Zeile%,7),80,Zeile%)
r%=@CreateCheckBox(%HWnd,Zufall,10,@add(@mul(Zeile%,12),5),80,Zeile%)
LW& = @CreateText(%HWnd,Laufwerk,10,@mul(Zeile%,8),80,Zeile%)
@CreateGroupBox(%HWnd,Volume,@sub(%MaxX,85),@mul(Zeile%,5),70,@add(@mul(Zeile%,11),2))
SBar& =CreateStatusBar($50800020,0,%HWND,2001)
v% = @CreateVScroll(%HWnd,,@sub(%MaxX,75),@mul(Zeile%,7),50, RY% )
SetScrollRange v%,-12,0
SetScrollPos v%,-8
Volume%=@CreateText(%HWnd,10,@sub(%MaxX,60),@mul(Zeile%,6),20, Zeile% )
SetCheck m%,1
PlayTime% = @CreateText(%HWnd,Time,@sub(%MaxX,65),@mul(Zeile%,15) ,40 ,20)
Titel% = @CreateText(%HWnd,Länge,@sub(%MaxX,65),@mul(Zeile%,14) ,40 ,20)
cls @RGB(255,255,0)
proc Set_Pos
Declare voll%,ist%,prozent%
@Equ$(@MCIsend$(status media length),@MCIsend$(status media position))
voll% =@val(@MCIsend$(status media length))
ist% = @val(@MCIsend$(status media position))
if @GT(ist%,1)
Prozent% = @div(voll%,100)
SetProgressPos(PB&,@int(@div(ist% , Prozent%) ) )
else
SetProgressPos(PB&,1)
endif
endproc
Proc make_Zeit
Parameters zeit$
Decimals 6
Declare sec!,min!
sec! = @div(@val(zeit$),1000)
if @GT(sec!,60)
min! = @div(sec!,60)
sec! = @mul(60,@sub(min!,@int(min!)))
else
Clear min!
sec! = @div(@val(zeit$),1000)
endif
Decimals 0
if @lt(min!,10)
zeit$ = 0 + @str$(@int(min!)) + :
else
zeit$ = @str$(@int(min!)) + :
endif
if @lt(sec!,10)
zeit$ = zeit$ + 0 + @str$(@int(sec!))
else
zeit$ = zeit$ + @str$(@int(sec!))
endif
SetText PlayTime%,zeit$
sec! = @div(@val(@MCISend$(status media length )),1000)
if @GT(sec!,60)
min! = @div(sec!,60)
sec! = @mul(60,@sub(min!,@int(min!)))
else
Clear min!
sec! = @div(@val(zeit$),1000)
endif
Decimals 0
if @lt(min!,10)
zeit$ = 0 + @str$(@int(min!)) + :
else
zeit$ = @str$(@int(min!)) + :
endif
if @lt(sec!,10)
zeit$ = zeit$ + 0 + @str$(@int(sec!))
else
zeit$ = zeit$ + @str$(@int(sec!))
endif
SetText Titel%,zeit$
endproc
proc make_sekunde
Parameters zeit$
if @LT(@val(zeit$),1000)
sekunde% = 1
else
sekunde%=@div(@val(zeit$),1000)
endif
endproc
Proc SetVolume
Parameters left%,right%
waveOutSetVolume(-1,MakeLong(Mul(left%,$1478),Mul(right%,$1478)))
EndProc
Status----------------------------------------------------------------
proc Anzeige
Parameters Wort$,farbe%
declare Shadow%,Step%,AW%
Shadow% = 3
Step% = @div(255,Shadow%)
Usefont ARIAL NARROW,FNT%,0,1,0,0
AW% = @GetActiveWindow()
Wort$ = @UPPER$(Wort$)
if @EQU$(@mid$(Wort$,2,1),:)
if @EQU$(GetDriveType(Laufwerk$),5)
SetText SBar& , CD-Laufwerk + -- + @UPPER$(@left$(Laufwerk$,1)) + -- + @right$(Wort$,@sub(@len(Wort$),3))
else if @EQU$(GetDriveType(Laufwerk$),3)
SetText SBar& , Festplatte + -- + @UPPER$(@left$(Laufwerk$,1)) + -- + @right$(Wort$,@sub(@len(Wort$),3))
else if @EQU$(GetDriveType(Laufwerk$),4)
SetText SBar& , anderes Medium + str$(GetDriveType(Laufwerk$)) + Wort$
endif
else
SetText SBar& , Wort$
endif
if @EQU(%HWnd,AW%)
usebrush 0,@RGB(255,255,0)
usepen 0,3,@RGB(155,155,0)
RectAngle 4,4 - %MaxX,@add(FNT%,8)
usebrush 1,@RGB(255,255,0)
usepen 0,2,@RGB(0,0,255)
RectAngle 2,2 - @sub(%MaxX,6),@add(FNT%,6)
if @GT(@len(Wort$),60)
wort$ = @left$(Wort$,60)
endif
While @GT(Shadow%,-1)
TextColor @RGB(@mul(@TestBit(farbe%,2),@sub(255,@mul(Step%,Shadow%))) , @mul(@TestBit(farbe%,1),@sub(255,@mul(Step%,Shadow%))) , @mul(@TestBit(farbe%,0),@sub(255,@mul(Step%,Shadow%)))),-1
DrawText @add(Shadow%,10),Shadow%,Wort$
DEC Shadow%
endwhile
endif
SetText AW%,Wort$
@SetFocus(AW%)
endproc
Pfad aus Datei entfernen---------------------------------------------
proc Cut_Path
Parameters Name$
Declare l%,DL%
let DL% = @len(Name$)
let l% = @sub(DL%,1)
ende%=1
while ende%
if @Neq$(@mid$(Name$,l%,1),)
DEC l%
else
ende% =0
endif
FileName$ = @right$(Name$,@sub(DL%,l%))
endwhile
FileName$ = @left$(FileName$,@sub(@len(FileName$),4))
Clear ende%
endproc
Abspielen------------------------------------------------------------
proc PlayMP3
parameters Media$
declare Befehl$,Datei$,l%,DL%
if @GT$(Media$,)
Cut_Path Media$
@SetFocus(%HWnd)
let Datei$ = @ShortName$(Media$)
if @EQU$(@Upper$(@Right$(Datei$,4)),.AVI)
wenn AVI
Befehl$ = open + Datei$ + type AVIVideo alias media
else
wenn MPG MPEG oder MP3
Befehl$ = open + Datei$ + type MpegVideo alias media
endif
@MCISend$(set media time format ms)
@MCISend$(Befehl$)
Befehl$ = window media handle + %HWnd
@MCISend$(Befehl$)
@MCISend$(play media )
make_sekunde @val(@MCISend$(status media length ))
SetScrollRange TitelPos%,0,sekunde%
SetTrackBarRange TitelPos%,0,sekunde%
if @Getcheck(f%)
if @FindWindow(@ShortName$(Media$))
film% = @GetActiveWindow()
film% = @FindWindow(@ShortName$(Media$))
SetWindowPos film% = 0 , 0 - %MaxX , %MaxY ;-1
Befehl$ = window media state show
@MCISend$(Befehl$)
endif
endif
endif
endproc
Media Stoppen-----------------------------------------------
proc Stop_Media
@MCISend$(close media) ... schließen
endproc
proc fill_list
@SendMessage(Files%,$0184 ,0,0)
ChDir Laufwerk$
ClearList
if @EQU$(GetDriveType(Laufwerk$),5)
SetText LW& , CD-Drive
else
SetText LW& , Festplatte
endif
if @GetCheck(f%)
if @EQU$(GetDriveType(Laufwerk$),5)
SetText LW& , CD-Drive
AddFiles **.DAT
else
SetText LW& , Festplatte
endif
AddFiles **.MPG
AddFiles **.AVI
AddFiles **.MPEG
else
AddFiles **.mp3
endif
MoveListToList(Files%)
MaxTitel% = @GetCount(Files%)
if @lt(MaxTitel%,1)
if @GetCheck(f%)
@AddString(Files%,auf Laufwerk + Laufwerk$ + keine Filme gefunden!)
else
@AddString(Files%,auf Laufwerk + Laufwerk$ + keine MP3s gefunden!)
endif
MoveListToList(Files%)
endif
endproc
@SetFocus(%HWnd)
let Laufwerk$ = C:
let halt% = 1
Clear mn%
SetVolume 8,8
@DeleteChoice(Drive&,0)
Anfang Hauptschleife----------------------------------------------------------
SetLFN 1
Anzeige Laufwerk wählen , 4
Randomize
Whilenot ende%
if @getfocus(Abspiel%)
if halt%
Clear halt%
if @EQU$(@GetText$(Abspiel%),Play)
SetText Abspiel%, Next >|
else
SetText Abspiel%, Play
endif
else
SetText Abspiel%, Next >|
endif
Anzeige STOP , 4
Stop_Media
Anzeige PLAY , 5
@SendMessage(Files%,$0186 ,NextTitel%,0)
CurTitel% = @GetCursel(Files%)
PlayMP3 @GetString$(Files%,CurTitel%)
if @GetCheck(r%)
NextTitel% = @Rnd(MaxTitel%)
else
NextTitel% = @add(@GetCursel(Files%),1)
if @EQu(NextTitel%,MaxTitel%)
clear NextTitel%
endif
endif
Anzeige @mid$(@GetText$(Drive&),3,1) + : + > + FileName$ , 1
endif
if @getfocus(Drive&)
waitMouse
Laufwerk$ = @add$(@mid$(@GetText$(Drive&),3,1),:)
@SetFocus(%HWnd)
UseCursor 2
Anzeige Suche Dateien , 4
fill_list
Anzeige Auswählen ,1
UseCursor 0
@SetFocus(%HWnd)
endif
if @getfocus(f%)
setCheck f%,1
setCheck m%,0
UseCursor 2
Anzeige Suche Dateien ,4
fill_list
Anzeige Auswählen ,5
UseCursor 0
@setfocus(%HWnd)
endif
if @getfocus(m%)
setCheck m%,1
setCheck f%,0
Anzeige Suche Dateien , 4
UseCursor 2
fill_list
Anzeige Auswählen , 5
UseCursor 0
@setfocus(%HWnd)
endif
Titel zuende---------------------------------------------------------
ifnot halt%
settimer 100
make_sekunde @val(@MCISend$(status media position ))
Skip% = @mul(@GetScrollPos(TitelPos%),1000)
SetScrollPos TitelPos%,Sekunde%
Set_Pos
make_Zeit @MCISend$(status media position )
if @Equ$(@MCIsend$(status media length),@MCIsend$(status media position))
@SendMessage(Files%,$0186 ,NextTitel%,0)
if @GT$(@GetString$(Files%,NextTitel%),)
Stop_Media
PlayMP3 @GetString$(Files%,NextTitel%)
Anzeige @mid$(@GetText$(Drive&),3,1) + : + > + FileName$ , 1
if @GetCheck(r%)
NextTitel% = @Rnd(MaxTitel%)
else
NextTitel% = @add(@GetCursel(Files%),1)
if @EQu(NextTitel%,MaxTitel%)
clear NextTitel%
endif
endif
endif
endif
waitinput
killtimer
endif
---------------------------------------------------------------------
Volume Control-------------------------------------------------------
if @getfocus(v%)
SetVolume @mul(@GetScrollPos(v%),-1) , @mul(@GetScrollPos(v%),-1)
setText Volume%,@str$(@int(@mul(@GetScrollPos(v%),-1)))
@setfocus(%Hwnd)
endif
if @getfocus(Stop%)
ifnot halt%
SetText Abspiel%, Play
Stop_Media
let halt% = 1
endif
endif
Schieberegler
if @getfocus(TitelPos%)
@MCISend$(pause media )
Skip% = @mul(@GetScrollPos(TitelPos%),1000)
Decimals 0
Temp$ = play media from + @str$(Skip%)
@MCISend$(Temp$)
@SetFocus(%HWnd)
endif
if @getfocus(Files%)
SetText Abspiel%, Next >|
Clear halt%
Stop_Media
CurTitel% = @GetCursel(Files%)
PlayMP3 @GetString$(Files%,CurTitel%)
if @GetCheck(r%)
NextTitel% = @Rnd(MaxTitel%)
else
NextTitel% = @add(CurTitel%,1)
if @EQu(NextTitel%,MaxTitel%)
clear NextTitel%
endif
endif
@SendMessage(Files%,$0186 ,CurTitel%,0)
Anzeige @mid$(@GetText$(Drive&),3,1) + : + > + FileName$ , 1
endif
case @getfocus(Quit%):ende% = 1
if @GT(%WinRight,@sub(%MaxX,30))
Clear mn%
endif
if @getfocus(minimize%)
let mn%=1
let oldpos% = 1
@ShowWindow(%HWnd,6)
endif
if @NEQ(mn%,oldpos%)
oldpos% = mn%
Anzeige @mid$(@GetText$(Drive&),3,1) + : + > + FileName$ , 1
endif
endwhile
ende Programm----------------------------------------------------------
Dispose EXT#
Stop_Media