Recent

Author Topic: Video play on console  (Read 752 times)

BobDog

  • Jr. Member
  • **
  • Posts: 68
Video play on console
« on: August 28, 2020, 01:12:54 pm »
I put a GUI video and audio play in the Free Pascal thread (windows).
Maybe the wrong place.
This is also a Windows program.
This is video directed to the console.
I have made .avi files the initial  search, they seem to work best here (Win 10).
You may have to twitch the console window to activate the rendering for some files, I am not sure why this should be.
Bog standard Pascal, I do not have Lazarus installed.
I use 3.0.4 fpc on 64 bits, I have not tested 32 bits.
You can easily download sample video files to test.
Code: Pascal  [Select][+][-]
  1.  
  2. program playvideoconsole;
  3.  
  4. {$IFDEF FPC}
  5. {$MODE Delphi}
  6. {$ENDIF}
  7.  
  8. uses
  9.   Windows,
  10.   strutils,
  11.   SysUtils,
  12.   crt;
  13.  
  14. function getOpenFileName(p: pointer): boolean; cdecl external 'Comdlg32.dll' Name 'GetOpenFileNameA';
  15. function mciSendString(s: LPCTSTR; p1: LPTSTR; p2: uint; p3: HANDLE): integer;
  16. cdecl external 'Winmm.dll' Name 'mciSendStringA';
  17. function SetWindowTheme(p: hwnd; p1: PChar; p2: PChar): integer; external 'UxTheme.dll' Name 'SetWindowTheme';
  18. function shell(s: PChar): integer; cdecl external 'msvcrt.dll' Name 'system';
  19. function Printf(mask: PChar): integer; cdecl; varargs; external 'msvcrt.dll' Name 'printf';
  20.  
  21. function GetConsoleHandle(): HWND;
  22. type
  23.   StringName = array[0..1024] of char;
  24. var
  25.   hwndFound: hwnd;
  26.   pszNewWindowTitle, pszOldWindowTitle: StringName;
  27. begin
  28.   GetConsoleTitle(pszOldWindowTitle, 1024);
  29.   wsprintf(pszNewWindowTitle, '%d/%d');
  30.   SetConsoleTitle(pszNewWindowTitle);
  31.   Sleep(40);
  32.   hwndFound := FindWindow(nil, pszNewWindowTitle);
  33.   SetConsoleTitle(pszOldWindowTitle);
  34.   exit(hwndFound);
  35. end;
  36.  
  37. function InstrRev(Src: string; s: char): integer;
  38. var
  39.   B: integer;
  40. begin
  41.   result := -1;
  42.   if length(src) = 0 then
  43.     exit;
  44.   for B := length(src) downto 0 do
  45.     if src[B] = s then
  46.       break;
  47.   result := B;
  48. end;
  49.  
  50. function map(a: double; b: double; _x_: double; c: double; d: double): double;
  51. begin
  52.   exit(((d) - (c)) * ((_x_) - (a)) / ((b) - (a)) + (c));
  53. end;
  54.  
  55. function Inkey: word;
  56. var
  57.   Save: word;
  58. begin
  59.   if KeyPressed then
  60.   begin
  61.     Save := Ord(ReadKey);
  62.     if Save = 0 then
  63.       Save := Ord(ReadKey) shl 8;
  64.     inkey := save;
  65.   end
  66.   else
  67.     Inkey := 0;
  68. end;
  69.  
  70. function SelectFile(): string;
  71. type
  72.   TFileName = array[0..Max_Path] of char;
  73. const
  74.   Filter: PChar = 'video files (*.avi)'#0'*.avi'#0 + 'video files (*.mpg)'#0'*.mpg'#0 +
  75.     'All files (*.*)'#0'*.*'#0#0;
  76. var
  77.   NameRec: OpenFileName;
  78.   FName: TFileName;
  79. begin
  80.   FillChar(NameRec, SizeOf(NameRec), 0);
  81.   FName[0] := #0;
  82.   with NameRec do
  83.   begin
  84.     LStructSize := SizeOf(NameRec);
  85.     LpStrFilter := Filter;
  86.     LpStrFile := @fname;
  87.     lpstrTitle := 'Movies';
  88.     NMaxFile := Max_Path;
  89.     Flags := OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST;
  90.   end;
  91.   GetOpenFileName(@NameRec);
  92.   exit(chr(34) + NameRec.lpstrFile + chr(34));
  93. end;
  94.  
  95. function getsize(_file: string; var _width: integer; var _height: integer; var l: integer): integer;
  96. type
  97.   chars = array[0..50] of char;
  98. var
  99.   mcidata, length: chars;
  100.   A: TStringArray;
  101.   temp: ansistring;
  102.   valDUMMY: integer;
  103.   Open, where, lngth: string;
  104. begin
  105.   Open := 'open  ' + _file + ' type mpegvideo alias file1';
  106.   where := 'Where file1 Destination max';
  107.   lngth := 'status file1 length';
  108.   mciSendString(PChar(Open), nil, 0, 0);
  109.   mciSendString(PChar(where), @MCIData, 50, 0);
  110.   temp := ansistring(mcidata);
  111.   if (temp = '') then
  112.     exit(0);
  113.   A := temp.split(' ');
  114.   val(ansistring(A[2]), _width, valDUMMY);
  115.   val(A[3], _height, valDUMMY);
  116.   mciSendString(PChar(lngth), @length, 50, 0);
  117.   val(length, l, valDUMMY);
  118.   exit(_width * _height * l);
  119. end;
  120.  
  121. procedure Vplay();
  122. var
  123.   k: double = 0.025;  //can be tweaked, video area destination on console
  124. type
  125.   chars = array[0..50] of char;
  126. var
  127.   fposition, ans: chars;
  128.   _file, s, title, key, xs, ys: string;
  129.   handle, player, pause, restart, finish, position, moveposition, destination, mode: string;
  130.   p1, p2, p3, p4, tot: string;
  131.   x, y, l, loop, pst, valDUMMY, instr: integer;
  132.   xpos, fx, fy: double;
  133.   diagonal, lastdiagonal: integer;
  134.   p: hwnd;
  135.   r: rect;
  136. begin
  137.   loop := 1;
  138.   fx := 1;
  139.   fy := 1;
  140.   _file := SelectFile;
  141.   if Getsize(_file, x, y, l) = 0 then
  142.   begin
  143.     writeln('Fail');
  144.     exit;
  145.   end;
  146.   p := GetConsoleHandle;
  147.   setwindowpos(p, HWND_TOPMOST, 0, 0, x, y, SWP_SHOWWINDOW);
  148.   SetWindowTheme(p, ' ', ' ');
  149.   ShowScrollBar(p, SB_BOTH, false);
  150.   getwindowrect(p, @r);
  151.   diagonal := trunc(sqrt((r.right - r.left) * (r.right - r.left) + (r.bottom - r.top) * (r.bottom - r.top)));
  152.   lastdiagonal := diagonal;
  153.   str(p, s);
  154.   handle := 'window file1 handle ' + s;
  155.   player := 'play file1';
  156.   pause := 'pause file1';
  157.   restart := 'play file1 from 0';
  158.   finish := 'close file1';
  159.   position := 'status file1 position';
  160.   destination := 'put file1 destination at ';
  161.   mode := 'status file1 mode ';
  162.   instr := InstrRev(_file, '\');
  163.   title := chr(34) + midstr(_file, instr + 1, 80);
  164.   title := title + '   p = pause, r = resume, s = restart, q = quit';
  165.   title := 'title ' + title;
  166.   shell(PChar(title));
  167.   mciSendString(PChar(handle), nil, 0, 0);
  168.   str(trunc(k * x), p1);
  169.   str(trunc(k * y), p2);
  170.   str(trunc(x - 2 * k * x), p3);
  171.   str(trunc(y - 8 - 2 * k * y), p4);
  172.   tot := destination + p1 + ' ' + p2 + ' ' + p3 + ' ' + p4 + ' ';
  173.   mcisendstring(PChar(tot), nil, 0, 0);
  174.   mciSendString(PChar(player), nil, 0, 0);
  175.   cursoroff;
  176.   while loop = 1 do
  177.   begin
  178.     key := chr(inkey);
  179.     if key = 'p' then
  180.       mciSendString(PChar(pause), nil, 0, 0);
  181.     if key = 'r' then
  182.       mciSendString(PChar(player), nil, 0, 0);
  183.     if key = 's' then
  184.       mciSendString(PChar(restart), nil, 0, 0);
  185.     if ((key = 'q') or (key = chr(27))) then
  186.     begin
  187.       mciSendString(PChar(finish), nil, 0, 0);
  188.       exit;
  189.     end;
  190.     mciSendString(PChar(position), @fposition, 50, 0);
  191.     val(fposition, pst, valDUMMY);
  192.     xpos := map(0, 1, pst / l, 0, x);
  193.     gotoxy(1, 1);
  194.     printf('%d%%', trunc(100 * xpos / x));
  195.  
  196.     getwindowrect(p, @r);
  197.     diagonal := trunc(sqrt((r.right - r.left) * (r.right - r.left) + (r.bottom - r.top) * (r.bottom - r.top)));
  198.  
  199.     if (lastdiagonal <> diagonal) then
  200.     begin
  201.       fx := (r.right - r.left) / x;
  202.       fy := (r.bottom - r.top) / y;
  203.       movewindow(p, r.left, r.top, r.right - r.left, r.bottom - r.top, true);
  204.       cursoroff;
  205.       ShowScrollBar(p, SB_BOTH, false);
  206.       str(trunc((r.right - r.left)), xs);
  207.       str(trunc((r.bottom - r.top)), ys);
  208.       str(trunc(k * x * fx), p1);
  209.       str(trunc(k * y * fy), p2);
  210.       moveposition := 'put file1 destination at ' + p1 + ' ' + p2 + ' ' + xs + ' ' + ys;
  211.       mcisendstring(PChar(moveposition), nil, 0, 0);
  212.     end;
  213.     lastdiagonal := diagonal;
  214.     mciSendString(PChar(mode), @ans, 50, 0);
  215.     if ans = 'stopped' then
  216.     begin
  217.       gotoxy(20, 1);
  218.       printf('%s', 'Ended');
  219.     end;
  220.     sleep(100);
  221.   end;
  222. end;
  223.  
  224. begin
  225.   Vplay;
  226.   writeln;
  227.   shell('pause');
  228. end.
  229.  
« Last Edit: August 28, 2020, 03:51:29 pm by BobDog »

metis

  • Full Member
  • ***
  • Posts: 205
Re: Video play on console
« Reply #1 on: September 08, 2020, 11:42:59 am »
Hi BobDog !
Could You post a screenshot of the running program, please ?
Life could be so easy, if there weren't those f*** Details.

BobDog

  • Jr. Member
  • **
  • Posts: 68
Re: Video play on console
« Reply #2 on: September 09, 2020, 01:05:49 am »

Did you get it working metis?


metis

  • Full Member
  • ***
  • Posts: 205
Re: Video play on console
« Reply #3 on: September 10, 2020, 02:14:30 pm »
@BobDog

Quote
Did you get it working metis?
No, because I'm still using WinXP, and Your Code depends on some newer Window-API-Calls.

Anyway, nice Idea. Finally, an Approach for a MediaPlayer-GUI, that I'havn't seen yet, though
doing it via 'MCI' is quite restrictive, because:
- it's Windows-dependent and
- it renders only very few MediaFormats.

BTW: If You'd like more People to try out Your App and maybe get more Answers, You should:
- put Spacelines and some Comments into Your Code to make it more readable
- write Code, that does not only compile & run on the latest Win-Versions
- put Your Code into a Project to open it right away, w/o Copy&Paste, etc.
- add Executables (32+64bit) to try out Your App, w/o the Need to compile it
- Put all of this into the Attachment, e.g. as a 7z-File.  ;)
« Last Edit: September 11, 2020, 03:15:35 pm by metis »
Life could be so easy, if there weren't those f*** Details.

BobDog

  • Jr. Member
  • **
  • Posts: 68
Re: Video play on console
« Reply #4 on: September 10, 2020, 03:49:16 pm »

Hello metis.
I think my window(api) version will work with XP.
It is in Freepascal windows at the top.
The percentage progress works slightly differently, not as good as the console.
I am so used to FreeBASIC where the source code is paramount, and posted in a simple way.
Thanks for testing, sorry about the lack of comments.



Otto

  • Full Member
  • ***
  • Posts: 225
Re: Video play on console
« Reply #5 on: September 10, 2020, 04:08:56 pm »
Hello everyone. I compiled the code and can confirm that it works correctly in Windows 10. I attach the project.
In my opinion it would be better not to attach the compiled files, as they could be considered unsafe by some antivirus.
Kind regards.

BobDog

  • Jr. Member
  • **
  • Posts: 68
Re: Video play on console
« Reply #6 on: September 10, 2020, 06:02:41 pm »

Hello Otto
The .lpr file is text, I can run that OK in my Dev-Ide, but what is the .lpi file.
I am not a Lazarus user, only freepascal, is it especially taylored for that ide?
Thanks for testing.


lucamar

  • Hero Member
  • *****
  • Posts: 3216
Re: Video play on console
« Reply #7 on: September 10, 2020, 06:32:53 pm »

Hello Otto
The .lpr file is text, I can run that OK in my Dev-Ide, but what is the .lpi file.

LPI files contain the "Lazarus Project Information" and yes, they are needed only if you use Lazarus; otherwise you can ignore them.

The LPR file, on the other hand, is the source for the "program" part of a project, i.e. the main program source, so it's needed whatever your tool-chain is.
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.10/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

 

TinyPortal © 2005-2018