video and audio play
lazarus / 67-Windows

----------------------------------------------------------------------
BobDog · 2020-08-25 17:23

Tested 64 bit fpc 3.0.4.
Should play .avi, .mpg, .mpeg and some other video formats and some
audio formats.
Some it misses, but it is a small program.
Non Lazarus, just bare bones WinApi.
Window can be resized.
video.pas:

 Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i    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; varans,open,s,playfile,handle,position,status,finish,wait,filele
ngth,fileposition,x,the_end,xs,ys:string;umsg:msg;win,pause,play,progr
ess:hwnd;r :rect;rght,btm,lastrght,lastbtm,instr:integer;flen,fpos,E:c
hars;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.