Das alte Codearchive

BP Movieplayer von ???

Hi,

mir war fad und ich hab n bisschen rumgeproggt, da ich gerade was mit Videos zu tun hatte :)

Also hier der unoptimierte und unkomentierte Code:

[code:1:919794b707];
; Konstanten
;
Const windowwidth = 250
Const windowheight = 100
Const windowtitle$ = "B+ Movieplayer"

Const dummy_m = 0
Const open__m = 10
Const play__m = 11
Const beenden__m = 19

;
; Types
;

;
; Arrays
;

;
; Globalen
;
Global gwd = ClientWidth(Desktop())
Global ghg = ClientHeight(Desktop())

Global window = CreateWindow(windowtitle$,ClientWidth(Desktop())/2-windowwidth/2,ClientHeight(Desktop())/2-windowheight/2,windowwidth,windowheight,Desktop(),5)
Global menu = WindowMenu(window)
Global datei_m = CreateMenu("&Datei",dummy_m,menu)
Global open_m = CreateMenu("Ö&ffnen Strg+O",open__m,datei_m)
Global play_m = CreateMenu("&Play F5",play__m,datei_m)
Global beenden_m = CreateMenu("&Beenden Alt+F4",beenden__m,datei_m)

Global moviepath$ = readlastmovie$()
Global movie

setup

Global toolbar = CreateToolBar("toolbar.bmp",0,ClientWidth(window)-16,48,16,window)
Global label = CreateLabel(moviepath$,0,GadgetHeight(toolbar),ClientWidth(window),ClientHeight(window)-GadgetHeight(toolbar),window)

;
; Funktionen
;
Function play()
Graphics gwd,ghg,32,1
SetBuffer BackBuffer()
If FileType(moviepath$) <> 1 Then
EndGraphics
Notify "Video nicht gefunden!"
Else
movie2 = OpenMovie(moviepath$)
Repeat
Flip
Cls
DrawMovie movie2,0,0,gwd,ghg
Until MoviePlaying(movie2) = 0 Or KeyDown(1) = 1 Or MouseDown(1) = 1
CloseMovie movie2
EndGraphics
MoveMouse ClientWidth(Desktop())/2,ClientHeight(Desktop())/2
End If
End Function

Function openvideo(path$="")
moviepath$ = path$
If path$ = "" Then moviepath$ = RequestFile$("Video öffnen","*,mpeg,mpg,avi,wmv,gif")
SetGadgetText label,moviepath$
file = WriteFile("movie.dat")
If file <> 0 Then
WriteString file,moviepath$
CloseFile file
End If
End Function

Function readlastmovie$()
file = ReadFile("movie.dat")
endstring$ = ""
If file <> 0 Then
endstring$ = ReadString$(file)
CloseFile file
End If
Return endstring$
End Function

Function setup()
If FileType("toolbar.bmp") = 0 Then
If FileType("C:pmovieplayer.cfg") = 1 Then
file = ReadFile("C:pmovieplayer.cfg")
If file <> 0 Then
ChangeDir ReadString$(file)
CloseFile file
End If
Else
Notify "Fatalerror bei Selbstkonfiguration!"+Chr$(13)+Chr$(10)+"Bitte wechseln sie in das Verzeichnis dieses Programms und"+Chr$(13)+Chr$(10)+"Starten sie von dort aus das Programm!"+Chr$(13)+Chr$(10)+"Sollte es danach noch immer nicht funktionieren löschen sie bitte die Datei C:pmovieplayer.cfg und starten sie das Programm wie oben erneut!"
End
End If
ElseIf FileType("C:pmovieplayer.cfg") = 0 Then
file = WriteFile("C:pmovieplayer.cfg")
If file <> 0 Then
WriteString file,CurrentDir$()
End If
End If
End Function

;
; Vorbereiten
;
UpdateWindowMenu window
SetToolBarTips toolbar,"Open,Play"
HotKeyEvent 63,0,$1001,play__m
HotKeyEvent 25,2,$1001,play__m
HotKeyEvent 24,2,$1001,open__m
command$ = CommandLine$()
temp = Instr(command$,Chr$(34))
temp2 = Instr(command$,Chr$(34),temp+1)
command$ = Mid(command$,temp+1,temp2-temp-1)

If command$ <> "" And temp <> 0 And temp2 <> 0 Then openvideo(command$)

;
; Hauptschleife
;
Repeat
Select WaitEvent(3000)
Case $101
Case $102
Case $103
Case $201
Case $202
Case $203
Case $204
Case $401
Select EventSource()
Case toolbar
Select EventData()
Case 0
openvideo
Case 1
play
End Select
End Select
Case $801
Case $802
Case $803
Select EventSource()
Case window
End
End Select
Case $804
Case $1001
Select EventData()
Case open__m
openvideo
Case play__m
play
Case beenden__m
End
End Select
Case $2001
Case $2002
Case $4001
End Select
Forever[/code:1:919794b707]

Mfg Skateboarder

[edit] Achja, ihr müsst euch die Toolbar leider selbst pixeln und im selben Ordner wie die Quelltextdatei abspeichern, sonst kommt n lieber Fehler :)

Die Toolbar braucht 2 Icons, am besten 16x16, also insgesammt 32x16! Das erste is für den Öffnen Dialog und das 2. Für den Abspielen Dialog!
[/edit]

Suche:
(unterstützt mySQL Wildcards ala %)