program playmedia;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{$APPTYPE GUI}
Uses
Windows,strutils;
function getOpenFileName(p:pointer):boolean ; cdecl external 'Comdlg32.dll' name 'GetOpenFileNameA';
function mciSendString(s:LPCTSTR;p1:LPTSTR;p2:uint;p3:HANDLE):integer;cdecl external 'Winmm.dll' name 'mciSendStringA' ;
function SetWindowTheme(p:hwnd;p1:pchar;p2:pchar):integer;external 'UxTheme.dll' name 'SetWindowTheme' ;
function lineto(h :hdc;i1:integer;i2:integer):integer;external 'Gdi32.dll' name 'LineTo' ;
function moveto(h :hdc;i1:integer;i2:integer;p:lppoint):integer;external 'Gdi32.dll' name 'MoveToEx' ;
function ellipse(h: hdc;left:integer;top:integer;right:integer;bottom:integer):boolean external 'Gdi32.dll' name 'Ellipse' ;
function InstrRev(Src:string; s: Char): integer;
var B:integer;
begin
result := -1;
if length(src) = 0 then exit;
for B:= length(src) downto 0 do
if src[B] = s then
break;
result := B;
end;
Function map(a :double;b :double;_x_ : double;c: double;d: double): double;
begin
exit(((d)-(c))*((_x_)-(a))/((b)-(a))+(c));
End;
Function SelectFile(): string;
Type
TFileName = Array[0..Max_Path] Of Char;
Const
Filter : PChar = 'video files (*.mpg)'#0'*.mpg'#0+
'video files (*.mpeg)'#0'*.mpeg'#0+
'All files (*.*)'#0'*.*'#0#0;
Var
NameRec : OpenFileName;
FName:TFileName;
Begin
FillChar(NameRec,SizeOf(NameRec),0);
FName[0] := #0;
With NameRec Do
Begin
LStructSize := SizeOf(NameRec);
LpStrFilter := Filter;
LpStrFile := @fname;
lpstrTitle :='Movies and songs';
NMaxFile := Max_Path;
Flags := OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
End;
GetOpenFileName(@NameRec);
exit( chr(34)+NameRec.lpstrFile+chr(34));
End;
type
chars = array[0..20] of char;
var
ans,open,s,playfile,handle,position,status,finish,wait,filelength,fileposition,x,the_end,xs,ys:string;
umsg:msg;
win,pause,play,progress:hwnd;
r :rect;
rght,btm,lastrght,lastbtm,instr:integer;
flen,fpos,E:chars;
len,xpos,xnow:double;
hdcwin:hdc;
begin
win := CreateWindowEx( 0,'#32770','play',WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, nil ) ;
pause:= CreateWindowEx( 0,'button','|||',WS_VISIBLE Or WS_CHILD , 0, 3, 30, 17, win, 0, 0, nil ) ;
play := CreateWindowEx( 0,'button','>>',WS_VISIBLE Or WS_CHILD , 30, 3, 30, 17, win, 0, 0, nil ) ;
progress := CreateWindowEx( 0,'button','%',WS_VISIBLE Or WS_CHILD , 60, 3, 30, 17, win, 0, 0, nil ) ;
SetWindowTheme(win,' ',' ');
hdcwin:=getdc(win);
ans:= SelectFile() ;
open:= 'open ' +ans+ ' type mpegvideo alias file1' ;
playfile:= 'play file1' ;
str(win,s);
handle:= 'window file1 handle ' + s ;
position:= 'put file1 destination at 0 20 800 600';
status:= 'status file1 length';
finish:= 'close file1';
wait:='pause file1' ;
filelength:='status file1 length';
fileposition:='status file1 position';
the_end:='status file1 mode';
lastrght:=0;
lastbtm:=0;
mciSendString(pchar(open), nil, 0, 0);
mciSendString(pchar(handle), nil, 0, 0) ;
mcisendstring(pchar(position),nil,0,0);
mciSendString(pchar(playfile), nil, 0,0) ;
instr:=InstrRev(ans,'\');
ans:=midstr(ans,instr,80);
setwindowtext(win,pchar(ans));
while getMessage(@umsg,0,0,0) do
Begin
TranslateMessage(umsg);
DispatchMessage(umsg);
if umsg.message = 273 then
begin
mciSendString(pchar(finish),nil, 0, 0);
PostQuitMessage(0) ;
end;
if umsg.hwnd = pause then
begin
if umsg.message = WM_LBUTTONDOWN then
begin
mciSendString(pchar(wait),nil, 0, 0);
end;
end;
if umsg.hwnd = play then
begin
if umsg.message = WM_LBUTTONDOWN then
begin
mciSendString(pchar(playfile),nil, 0, 0);
end;
end;
getwindowrect(win,@r);
rght:=r.right;
btm:=r.bottom;
if (lastrght<>rght) or (lastbtm<>btm) then
begin
movewindow(win,r.left,r.top,r.right-r.left,r.bottom-r.top,true);
str(r.right-r.left,xs);
str(r.bottom-r.top,ys);
position:= 'put file1 destination at 0 20 '+xs+' '+ys;
mcisendstring(pchar(position),nil,0,0);
end;
lastrght:=rght;
lastbtm:=btm;
mciSendString(pchar(filelength),@flen, 20,0);
mcisendstring(pchar(fileposition),@fpos,20,0);
mciSendString(pchar(the_end), @E, 20,0) ;
val(flen,len);
val(fpos,xpos);
xnow:=map(0,1,xpos/len,0,r.right-r.left);
if umsg.hwnd = progress then
begin
if umsg.message = WM_LBUTTONDOWN then
begin
moveto(hdcwin,0,2,nil);
lineto(hdcwin,trunc(xnow),2);
ellipse(hdcwin,trunc(xnow-2),0,trunc(xnow+2),4);
end;
x:=ans+' '+E ;
setwindowtext(win,pchar(x));
end;
End;
end.
Recent
