Français
Source/ Codesnippets

Media Player - 2

 

KompilierenMarqueSéparation
Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Media-Player (2)
unbekannter Autor ...
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#,10
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  + 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-------------------------------------=s2>---------------------
Dispose EXT#
Stop_Media
 
16.07.2007  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

1.485 Views

Untitledvor 0 min.
Gast.081525.08.2024
Walter17.09.2020
Andre Rohland12.03.2018
Kermit27.04.2016
plus...

Themeninformationen

cet Thema hat 1 participant:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie