program playvideoconsole;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
uses
Windows,
strutils,
SysUtils,
crt;
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 shell(s: PChar): integer; cdecl external 'msvcrt.dll' Name 'system';
function Printf(mask: PChar): integer; cdecl; varargs; external 'msvcrt.dll' Name 'printf';
function GetConsoleHandle(): HWND;
type
StringName = array[0..1024] of char;
var
hwndFound: hwnd;
pszNewWindowTitle, pszOldWindowTitle: StringName;
begin
GetConsoleTitle(pszOldWindowTitle, 1024);
wsprintf(pszNewWindowTitle, '%d/%d');
SetConsoleTitle(pszNewWindowTitle);
Sleep(40);
hwndFound := FindWindow(nil, pszNewWindowTitle);
SetConsoleTitle(pszOldWindowTitle);
exit(hwndFound);
end;
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 Inkey: word;
var
Save: word;
begin
if KeyPressed then
begin
Save := Ord(ReadKey);
if Save = 0 then
Save := Ord(ReadKey) shl 8;
inkey := save;
end
else
Inkey := 0;
end;
function SelectFile(): string;
type
TFileName = array[0..Max_Path] of char;
const
Filter: PChar = 'video files (*.avi)'#0'*.avi'#0 + 'video files (*.mpg)'#0'*.mpg'#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';
NMaxFile := Max_Path;
Flags := OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST;
end;
GetOpenFileName(@NameRec);
exit(chr(34) + NameRec.lpstrFile + chr(34));
end;
function getsize(_file: string; var _width: integer; var _height: integer; var l: integer): integer;
type
chars = array[0..50] of char;
var
mcidata, length: chars;
A: TStringArray;
temp: ansistring;
valDUMMY: integer;
Open, where, lngth: string;
begin
Open := 'open ' + _file + ' type mpegvideo alias file1';
where := 'Where file1 Destination max';
lngth := 'status file1 length';
mciSendString(PChar(Open), nil, 0, 0);
mciSendString(PChar(where), @MCIData, 50, 0);
temp := ansistring(mcidata);
if (temp = '') then
exit(0);
A := temp.split(' ');
val(ansistring(A[2]), _width, valDUMMY);
val(A[3], _height, valDUMMY);
mciSendString(PChar(lngth), @length, 50, 0);
val(length, l, valDUMMY);
exit(_width * _height * l);
end;
procedure Vplay();
var
k: double = 0.025; //can be tweaked, video area destination on console
type
chars = array[0..50] of char;
var
fposition, ans: chars;
_file, s, title, key, xs, ys: string;
handle, player, pause, restart, finish, position, moveposition, destination, mode: string;
p1, p2, p3, p4, tot: string;
x, y, l, loop, pst, valDUMMY, instr: integer;
xpos, fx, fy: double;
diagonal, lastdiagonal: integer;
p: hwnd;
r: rect;
begin
loop := 1;
fx := 1;
fy := 1;
_file := SelectFile;
if Getsize(_file, x, y, l) = 0 then
begin
writeln('Fail');
exit;
end;
p := GetConsoleHandle;
setwindowpos(p, HWND_TOPMOST, 0, 0, x, y, SWP_SHOWWINDOW);
SetWindowTheme(p, ' ', ' ');
ShowScrollBar(p, SB_BOTH, false);
getwindowrect(p, @r);
diagonal := trunc(sqrt((r.right - r.left) * (r.right - r.left) + (r.bottom - r.top) * (r.bottom - r.top)));
lastdiagonal := diagonal;
str(p, s);
handle := 'window file1 handle ' + s;
player := 'play file1';
pause := 'pause file1';
restart := 'play file1 from 0';
finish := 'close file1';
position := 'status file1 position';
destination := 'put file1 destination at ';
mode := 'status file1 mode ';
instr := InstrRev(_file, '\');
title := chr(34) + midstr(_file, instr + 1, 80);
title := title + ' p = pause, r = resume, s = restart, q = quit';
title := 'title ' + title;
shell(PChar(title));
mciSendString(PChar(handle), nil, 0, 0);
str(trunc(k * x), p1);
str(trunc(k * y), p2);
str(trunc(x - 2 * k * x), p3);
str(trunc(y - 8 - 2 * k * y), p4);
tot := destination + p1 + ' ' + p2 + ' ' + p3 + ' ' + p4 + ' ';
mcisendstring(PChar(tot), nil, 0, 0);
mciSendString(PChar(player), nil, 0, 0);
cursoroff;
while loop = 1 do
begin
key := chr(inkey);
if key = 'p' then
mciSendString(PChar(pause), nil, 0, 0);
if key = 'r' then
mciSendString(PChar(player), nil, 0, 0);
if key = 's' then
mciSendString(PChar(restart), nil, 0, 0);
if ((key = 'q') or (key = chr(27))) then
begin
mciSendString(PChar(finish), nil, 0, 0);
exit;
end;
mciSendString(PChar(position), @fposition, 50, 0);
val(fposition, pst, valDUMMY);
xpos := map(0, 1, pst / l, 0, x);
gotoxy(1, 1);
printf('%d%%', trunc(100 * xpos / x));
getwindowrect(p, @r);
diagonal := trunc(sqrt((r.right - r.left) * (r.right - r.left) + (r.bottom - r.top) * (r.bottom - r.top)));
if (lastdiagonal <> diagonal) then
begin
fx := (r.right - r.left) / x;
fy := (r.bottom - r.top) / y;
movewindow(p, r.left, r.top, r.right - r.left, r.bottom - r.top, true);
cursoroff;
ShowScrollBar(p, SB_BOTH, false);
str(trunc((r.right - r.left)), xs);
str(trunc((r.bottom - r.top)), ys);
str(trunc(k * x * fx), p1);
str(trunc(k * y * fy), p2);
moveposition := 'put file1 destination at ' + p1 + ' ' + p2 + ' ' + xs + ' ' + ys;
mcisendstring(PChar(moveposition), nil, 0, 0);
end;
lastdiagonal := diagonal;
mciSendString(PChar(mode), @ans, 50, 0);
if ans = 'stopped' then
begin
gotoxy(20, 1);
printf('%s', 'Ended');
end;
sleep(100);
end;
end;
begin
Vplay;
writeln;
shell('pause');
end.
Recent
