Recent

Author Topic: video and audio play  (Read 239 times)

BobDog

  • Jr. Member
  • **
  • Posts: 50
video and audio play
« on: August 25, 2020, 07:23:32 pm »
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][+][-]
  1.    program playmedia;
  2. {$IFDEF FPC}
  3. {$MODE Delphi}
  4. {$ENDIF}
  5. {$APPTYPE GUI}
  6.  
  7. Uses
  8.   Windows,strutils;
  9.  
  10.    function getOpenFileName(p:pointer):boolean ; cdecl external 'Comdlg32.dll' name 'GetOpenFileNameA';
  11.    function mciSendString(s:LPCTSTR;p1:LPTSTR;p2:uint;p3:HANDLE):integer;cdecl external 'Winmm.dll' name 'mciSendStringA' ;
  12.    function  SetWindowTheme(p:hwnd;p1:pchar;p2:pchar):integer;external 'UxTheme.dll' name 'SetWindowTheme' ;
  13.    function lineto(h :hdc;i1:integer;i2:integer):integer;external 'Gdi32.dll' name 'LineTo' ;
  14.    function moveto(h :hdc;i1:integer;i2:integer;p:lppoint):integer;external 'Gdi32.dll' name 'MoveToEx' ;
  15.    function ellipse(h: hdc;left:integer;top:integer;right:integer;bottom:integer):boolean  external 'Gdi32.dll' name 'Ellipse' ;
  16.  
  17.    function InstrRev(Src:string; s: Char): integer;
  18.   var B:integer;
  19.    begin
  20.    result := -1;
  21.    if length(src) = 0 then exit;
  22.    for B:= length(src) downto 0 do
  23.    if src[B] = s then
  24.     break;
  25.     result := B;
  26.     end;
  27.  
  28.  Function map(a :double;b :double;_x_ : double;c: double;d: double): double;
  29.  begin
  30.   exit(((d)-(c))*((_x_)-(a))/((b)-(a))+(c));
  31.  End;
  32.  
  33. Function SelectFile(): string;
  34.   Type
  35.   TFileName = Array[0..Max_Path] Of Char;
  36. Const
  37.   Filter : PChar = 'video files (*.mpg)'#0'*.mpg'#0+
  38.                    'video files (*.mpeg)'#0'*.mpeg'#0+
  39.                    'All files (*.*)'#0'*.*'#0#0;
  40. Var
  41.   NameRec : OpenFileName;
  42.    FName:TFileName;
  43. Begin
  44.   FillChar(NameRec,SizeOf(NameRec),0);
  45.   FName[0] := #0;
  46.   With NameRec Do
  47.     Begin
  48.       LStructSize := SizeOf(NameRec);
  49.       LpStrFilter := Filter;
  50.       LpStrFile   := @fname;
  51.       lpstrTitle :='Movies and songs';
  52.       NMaxFile    := Max_Path;
  53.       Flags := OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  54.     End;
  55.       GetOpenFileName(@NameRec);
  56.      exit( chr(34)+NameRec.lpstrFile+chr(34));
  57. End;
  58.  
  59.  type
  60.   chars = array[0..20] of char;
  61.  
  62. var
  63. ans,open,s,playfile,handle,position,status,finish,wait,filelength,fileposition,x,the_end,xs,ys:string;
  64. umsg:msg;
  65. win,pause,play,progress:hwnd;
  66. r :rect;
  67. rght,btm,lastrght,lastbtm,instr:integer;
  68. flen,fpos,E:chars;
  69. len,xpos,xnow:double;
  70. hdcwin:hdc;
  71.        begin
  72.        win := CreateWindowEx( 0,'#32770','play',WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, nil ) ;
  73.        pause:= CreateWindowEx( 0,'button','|||',WS_VISIBLE Or WS_CHILD , 0, 3, 30, 17, win, 0, 0, nil ) ;
  74.        play := CreateWindowEx( 0,'button','>>',WS_VISIBLE Or WS_CHILD , 30, 3, 30, 17, win, 0, 0, nil ) ;
  75.        progress := CreateWindowEx( 0,'button','%',WS_VISIBLE Or WS_CHILD , 60, 3, 30, 17, win, 0, 0, nil ) ;
  76.          SetWindowTheme(win,' ',' ');
  77.          hdcwin:=getdc(win);
  78.       ans:= SelectFile() ;
  79.       open:=  'open  ' +ans+ ' type mpegvideo alias file1' ;
  80.       playfile:= 'play file1' ;
  81.       str(win,s);
  82.       handle:=   'window file1 handle ' + s ;
  83.       position:= 'put file1 destination at 0 20 800 600';
  84.       status:=  'status file1 length';
  85.       finish:= 'close file1';
  86.       wait:='pause file1' ;
  87.       filelength:='status file1 length';
  88.       fileposition:='status file1 position';
  89.       the_end:='status file1 mode';
  90.        lastrght:=0;
  91.        lastbtm:=0;
  92.         mciSendString(pchar(open), nil, 0, 0);
  93.         mciSendString(pchar(handle), nil, 0, 0) ;
  94.         mcisendstring(pchar(position),nil,0,0);
  95.         mciSendString(pchar(playfile), nil, 0,0) ;
  96.            instr:=InstrRev(ans,'\');
  97.            ans:=midstr(ans,instr,80);
  98.          setwindowtext(win,pchar(ans));
  99.          while getMessage(@umsg,0,0,0)  do
  100.             Begin
  101.               TranslateMessage(umsg);
  102.               DispatchMessage(umsg);
  103.               if umsg.message = 273 then
  104.               begin
  105.               mciSendString(pchar(finish),nil, 0, 0);
  106.               PostQuitMessage(0) ;
  107.               end;
  108.                if umsg.hwnd = pause then
  109.                 begin
  110.                 if   umsg.message = WM_LBUTTONDOWN then
  111.                 begin
  112.                 mciSendString(pchar(wait),nil, 0, 0);
  113.                 end;
  114.                 end;
  115.                  if umsg.hwnd = play then
  116.                 begin
  117.                 if   umsg.message = WM_LBUTTONDOWN then
  118.                 begin
  119.                 mciSendString(pchar(playfile),nil, 0, 0);
  120.                 end;
  121.                 end;
  122.  
  123.               getwindowrect(win,@r);
  124.               rght:=r.right;
  125.               btm:=r.bottom;
  126.               if (lastrght<>rght) or (lastbtm<>btm) then
  127.               begin
  128.               movewindow(win,r.left,r.top,r.right-r.left,r.bottom-r.top,true);
  129.                  str(r.right-r.left,xs);
  130.                  str(r.bottom-r.top,ys);
  131.               position:= 'put file1 destination at 0 20 '+xs+' '+ys;
  132.                 mcisendstring(pchar(position),nil,0,0);
  133.               end;
  134.               lastrght:=rght;
  135.               lastbtm:=btm;
  136.               mciSendString(pchar(filelength),@flen, 20,0);
  137.               mcisendstring(pchar(fileposition),@fpos,20,0);
  138.               mciSendString(pchar(the_end), @E, 20,0) ;
  139.               val(flen,len);
  140.               val(fpos,xpos);
  141.               xnow:=map(0,1,xpos/len,0,r.right-r.left);
  142.                if umsg.hwnd = progress then
  143.                 begin
  144.                 if   umsg.message = WM_LBUTTONDOWN then
  145.                 begin
  146.                  moveto(hdcwin,0,2,nil);
  147.                  lineto(hdcwin,trunc(xnow),2);
  148.                  ellipse(hdcwin,trunc(xnow-2),0,trunc(xnow+2),4);
  149.                 end;
  150.                 x:=ans+'   '+E ;
  151.                 setwindowtext(win,pchar(x));
  152.                 end;
  153.             End;
  154.        end.
  155.  
  156.  
« Last Edit: August 26, 2020, 01:53:19 pm by BobDog »

 

TinyPortal © 2005-2018