Italia
Fonte/ Codesnippets

Media Player - 2

 

KompilierenMarkierenSeparieren
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 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

1.489 Views

Untitledvor 0 min.
Gast.081525.08.2024
Walter17.09.2020
Andre Rohland12.03.2018
Kermit27.04.2016
Di più...

Themeninformationen

Dieses Thema hat 1 subscriber:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie