(1.121)  Login

English
Source / code snippets

Media Player - 2

 

CompileMarkSeparation
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
 
07/16/07  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

1.478 Views

Untitledvor 0 min.
Gast.081508/25/24
Walter09/17/20
Andre Rohland03/12/18
Kermit04/27/16
More...

Themeninformationen

this Topic has 1 subscriber:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all rightDatenschutzerklärung
i want none Cookie