(*
This example is demonstrate how to read the video use custom buffer (same as Bass "PUSH" way).
This example stream a video/audio from internet use own reader (WinInet)

Create 2 thread:

+ Thread 1 :
<Source> -> <Read> -> Put it to Buffer until end of file

+ Thread 2 :
BassVideo -> BASS_FILEPROCS =>  Read   <->  read the buffer if it the buffer have enough data
                            =>	Get Length <-> return the media file length
                            =>	Do Seek  <-> allow seek or not , if the buffer have
                                             the data size > the seek pos then
                                             seek if not we wait or skip it
                                             (please note if we allow to seek the
                                             video need to seek to the end of file.
                                             And AVI need to seek to be rendered, that's why we
                                             can't stream avi >_<, with mpeg just skip the seek command (except
                                             seek to 0), FLV Spliter by Gabest doesn't allow to stream FLV)
                            =>	CloseFile

Note : Other programming language can use CopyMemory instead of  TMemoryStream

*)
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Buttons, ImgList, ToolWin, ExtCtrls, Menus, StdCtrls,
  AppEvnts;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    ImageList: TImageList;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    TrackBar2: TTrackBar;
    ToolButton1: TToolButton;
    PaintBox1: TPaintBox;
    VisTimer: TTimer;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    Source1: TMenuItem;
    N431: TMenuItem;
    N1691: TMenuItem;
    Free1: TMenuItem;
    ToolButton9: TToolButton;
    SoundLevel: TTrackBar;
    ToolButton10: TToolButton;
    SaveDialog1: TSaveDialog;
    N1: TMenuItem;
    Filter1: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    Label2: TLabel;
    Button1: TButton;
    CheckBox1: TCheckBox;
    SpeedButton1: TSpeedButton;
    Edit1: TEdit;
    ProgressBar1: TProgressBar;
    CheckBox2: TCheckBox;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure VisTimerTimer(Sender: TObject);
    procedure SoundLevelChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure Source1Click(Sender: TObject);
    procedure N431Click(Sender: TObject);
    procedure N1691Click(Sender: TObject);
    procedure Free1Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure CheckBox1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
    isFullScreen : Boolean;
    OldRect : TRect;
    OldStyle : Longint;
    procedure WndProc(var Msg : TMessage); override;
    procedure ActiveSomeStuff;
    procedure WhenFormResize;

  end;

var
  Form1: TForm1;
  chan : DWORD;
  source : WideString;
  Data : TMemoryStream;
  stop : BOOL;
  wait : BOOL;
implementation

uses BassVideo, bass, osc_vis, WinInet;

var Vis : TOcilloScope;
    hFile : THandle;
    CR: TRTLCriticalSection;
    len : int64;
    FPos : int64;
    hThread : THandle;
{$R *.dfm}

const WM_THREAD_DONE = WM_USER + 1;
(**)
type
DAFCallBack = function(Buffer : pointer; size : DWORD; Downloaded, Total : DWORD) : BOOL ;stdcall;

function DownloadAFile(lpURL : WideString; CallBackFunction : Pointer) : BOOL;
const BufferSize = 1024;
var P : DAFCallBack;
    hSession, hURL: HInternet;
    Buffer: array[1..BufferSize] of Byte;
    BufferLen, reserved, Size: DWORD;
    c, t, b : DWORD;
    pBuf : Pointer;
    dwcode, dwcodeLen, dwIndex : DWORD;
    res : PChar;
begin
  result := false;
  len := 0;
  P := CallBackFunction;
  hSession := InternetOpenW('KNet/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if hSession = nil then exit;
    hURL := InternetOpenURLW(hSession, PWideChar(lpURL), nil, 0,
                             INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_COOKIES, 0);
    if hUrl = nil then
      begin
       InternetCloseHandle(hSession);
       exit;
      end;
    dwIndex  := 0;
    dwCodeLen := 10;
    HttpQueryInfo(hURL, HTTP_QUERY_STATUS_CODE,
                  @dwcode, dwcodeLen, dwIndex);
    res := PChar(@dwCode);
    if (res = '200') or (res = '320') then
      begin
       c := 0; {current buf }
       Reserved := 0;
       Size := 1024; GetMem(pBuf, Size);

       HttpQueryInfo(hURL, HTTP_QUERY_CONTENT_LENGTH, pBuf, Size, Reserved);

       t := StrToInt(StrPas(pBuf));
       len := t;
       FreeMem(pBuf, Size);
       repeat
        InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
        b := BufferLen;
        inc(c, b);
        if @p <> nil then
        if not P(@Buffer, b, c, t) then break;
       until BufferLen = 0;
       Result:=True;
      end;
  try InternetCloseHandle(hURL); except end;
  try InternetCloseHandle(hSession); except end;
end;

function Download_CallBack(Buffer : pointer; size : DWORD; Downloaded, Total : DWORD) : BOOL ;stdcall;
begin
 EnterCriticalSection(CR);
 Data.Write(Buffer^, size);
 LeaveCriticalSection(CR);
 Form1.ProgressBar1.Position := Round((Downloaded / Total) * 100);
 Form1.Caption := 'Downloading ' + inttostr(Form1.ProgressBar1.Position) + ' % - ' + inttostr(Downloaded) ;
 if (Form1.ProgressBar1.Position > 10) or (Downloaded > 500000) then
  Wait := FALSE;
 result := TRUE;
end;
// thread download
function DownloadData(param : pointer): DWORD;
var s : string;
//    tg : TFileStream;
begin
 s := Form1.Edit1.Text;
 DownloadAFile(s, @Download_CallBack);

 PostMessage(Form1.Handle, WM_THREAD_DONE, 0, 0);
 result := 0;
end;
// function to convert time to string data
function FormatNum(i, num : integer): string;
begin
 str(i, result);
 while length(result) < num do result := '0' + result;
end;

function TimeToStr5(sec : Double) : string;
var Hours, Minutes, Seconds : Double;
begin
  Hours := Trunc(sec / 3600);
  sec := sec - (Hours * 3600);
  Minutes := Trunc(sec / 60);
  sec := sec - (Minutes * 60);
  Seconds := Trunc(sec);
//  sec := (sec - Seconds) * 1000;
  Result := FormatNum(Trunc(Hours), 2) + ':' + FormatNum(Trunc(Minutes), 2) + ':'
           + FormatNum(Trunc(Seconds), 2);// + ':' + FormatNum(Trunc(sec), 3);
end;

function myVideoProc(Handle : DWORD; Action, param1, param2 : DWORD; user : Pointer): BOOL; stdcall;
var R : TRect;
begin
 case Action of
  BassVideo_FoundVideo :
    begin
      R := Form1.ClientRect;
      R.Left := 0;
      R.Top := 0;
      R.Bottom := R.Bottom - Form1.Panel1.Height - Form1.StatusBar1.Height;
      BASSVideo_SetVideoWindow(Handle, Form1.Handle, R, 0);
    end;
  BassVideo_EndStream :
   begin
    Form1.StatusBar1.Panels[2].Text := 'End of stream';
   end;
 end;
 result := TRUE;
end;

{ TForm1 }
procedure TForm1.WndProc(var Msg: TMessage);
var dc : HDC;
    ps : TPaintStruct;
begin
  if chan <> 0 then
  case Msg.Msg of
   WM_MOVE  : begin
                // apply for Windowed Renderer
                BassVideo_WindowMove(chan, Msg.Msg, Msg.WParam, Msg.LParam, 0);
              end;

   WM_SIZE  : begin
               WhenFormResize;
              end;

   WM_PAINT : begin
                 // this apply for application that use VMR9-Windowless
                 dc := BeginPaint(Handle, ps);
                 BASSVideo_Repaint(chan, Handle, DC, 0);
                 EndPaint(Handle, ps);
              end;
   WM_THREAD_DONE : begin
                      sleep(100);
                      CloseHandle(hThread);
                      hThread := 0;
                    end;

  end;
   inherited;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if Shift = [ssLeft] then
  begin
   ReleaseCapture;
   Perform(WM_SYSCOMMAND, $f012, 0);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 InitializeCriticalSection(CR);
 source := '';
 Bass_Init(-1, 44100, 0, Handle, nil);
 BassVideo_Init();
 Vis := TOcilloScope.Create(PaintBox1.Width, PaintBox1.Height);
 Data := TMemoryStream.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 BassVideo_Stop(chan);
 if hThread <> 0 then
  begin
   TerminateThread(hThread, 0);
   CloseHandle(hThread);
  end;
 BassVideo_Free;
 Bass_Free;
 Data.Free;
 Vis.Free;
end;

(* user proc *)
procedure FILECLOSEPROC(user: Pointer); stdcall;
begin
// CloseHandle(THandle(user^));
end;

function FILELENPROC(user: Pointer): QWORD; stdcall;
begin
 repeat
  sleep(100);
 until len <> 0;
 result :=len;
end;

function FILEREADPROC(buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
begin
 result := 0;
 Form1.StatusBar1.Panels[1].Text := '';
 while (FPos + length) > Data.Size do
  begin
   sleep(100);
   Application.ProcessMessages;
   Form1.StatusBar1.Panels[1].Text := 'Wait For Read ' + inttostr(length) + ' (FPos = ' + inttostr(FPos) + ')';
   if stop then
    exit;
  end;
 EnterCriticalSection(CR);
 Data.Position := FPos;
 result := Data.Read(PByte(Buffer)^, length);
 inc(FPos, length);
 Data.Position := Data.Size;
 LeaveCriticalSection(CR);

end;

function FILESEEKPROC(offset: QWORD; user: Pointer): BOOL; stdcall;
begin
 result := TRUE;
 Form1.StatusBar1.Panels[1].Text := 'Seek to ' + inttostr(offset);
 while offset > Data.Size do
  begin
   if not Form1.CheckBox2.Checked then
    begin
     Application.ProcessMessages;
     result := FALSE;
     exit;
    end;
   sleep(100);
   Application.ProcessMessages;
   Form1.StatusBar1.Panels[1].Text := 'Wait for seek ' + inttostr(offset) + ' (FPos = ' + inttostr(FPos) + ')';
   if stop then exit;
  end;
 FPos := offset;
end;

function isAVI(s :string): BOOL;
begin
 result := (Pos('.avi', s) > 0) or (Pos('.AVI', s) > 0);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var h, w : integer;
    B : BASS_FILEPROCS;
    videotype : DWORD;
    id : DWORD;
begin
//http://kenshin1101.googlepages.com/BeautyExplosive.avi
 wait := TRUE;
 stop := FALSE;
 FPos := 0;
 hThread := CreateThread(nil, 0, @DownloadData, nil, 0, id);
 if chan <> 0 then
  begin
    BassVideo_CloseWindow(chan, 0);
    BassVideo_Stop(chan);
    BassVideo_StreamFree(chan);
  end;
 (*
   create a user stream
 *)
{ // wait for the download about 10% or get some data
 repeat
  Application.ProcessMessages;
  Sleep(100);
 until not wait;
 }
 if isAVI(Edit1.Text) then
  videotype := BASSVIDEO_MEDIA_AVI
 else
  videotype := 0;

 B.close := FILECLOSEPROC;
 B.length := FILELENPROC;
 B.read := FILEREADPROC;
 B.seek := FILESEEKPROC;

 chan := BassVideo_StreamCreateFileUser(B, videotype, 0, 0, @myVideoProc, @hFile);

// chan := BassVideo_StreamCreateFile(PChar(Edit1.Text), 0, 0, @myVideoProc, nil);
 if chan <> 0 then
  begin
   ActiveSomeStuff;
   BassVideo_Play(chan);
   source := Edit1.Text;
   BassVideo_GetVideoInfo(chan, h, w);
   if (h <> 0) and (w <> 0) then
    begin
      Height := h + Panel1.Height + StatusBar1.Height;
      Width := w;
    end;
  end
 else source := '';
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
 isFullScreen := not isFullScreen;
 if isFullScreen then
  begin
    OldRect.Left := Left;
    OldRect.Top := Top;
    OldRect.Right := Width;
    OldRect.Bottom := Height;
    OldStyle := GetWindowLong(Handle, GWL_STYLE);
    SetWindowLong(Handle, GWL_STYLE, integer(WS_POPUPWINDOW or WS_VISIBLE));
    Left := 0;
    Top := 0;
    Height := Screen.Height;
    Width := Screen.Width;
  end
 else
  begin
   SetWindowLong(Handle, GWL_STYLE, OldStyle);
   SetWindowPos(Handle, 0, OldRect.Left , OldRect.Top, OldRect.Right, OldRect.Bottom , 0);
  end;
end;

procedure TForm1.VisTimerTimer(Sender: TObject);
var Data : TWaveData;
begin
 if chan = 0 then exit;
 Bass_ChannelGetData(chan, @Data, 2048 + 1);
 Vis.Draw(PaintBox1.Canvas.Handle, Data, 0, PaintBox1.Height div 2);
end;

procedure TForm1.SoundLevelChange(Sender: TObject);
begin
BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, SoundLevel.Position / 10000);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var p : Double;
begin
 if chan = 0 then exit;

 p := BASSVideo_GetPosition(chan);

 StatusBar1.Panels[0].Text := TimeToStr5(p) + ' / ' + TimeToStr5(TrackBar2.Max);
 TrackBar2.OnChange := nil;
 TrackBar2.Position := Round(p);
 TrackBar2.OnChange := TrackBar2Change;
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
 BassVideo_SetPosition(chan, Bass_ChannelSeconds2Bytes(chan, Form1.TrackBar2.Position));
end;

function FilterProc(Handle : DWORD; FilterName : PChar; Filter : Pointer; User : Pointer): BOOL; stdcall;
var mt : TMenuItem;
begin
 result := TRUE;
 mt := TMenuItem.Create(Form1);
 mt.Caption := FilterName;
 mt.Enabled := BassVideo.BassVideo_HasFilterPropertyPage(Handle, Filter, 0); //
 Form1.Filter1.Insert(0, mt);
end;

procedure TForm1.ActiveSomeStuff;
var p : Double;
    i : integer;
begin
 p := BASSVideo_GetLength(chan);
 TrackBar2.Max := Round(p);
 TrackBar2.Frequency := Round(p/100);
 TrackBar2.Min := 0;
 SoundLevelChange(nil); // set vol
 // Enum all filter in the graph and show it for user
 for i := 0 to Filter1.Count - 1 do
  Filter1.Delete(0);
 BassVideo.BassVideo_EnumFilter(chan, @FilterProc, nil);
 CheckBox1Click(nil);
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
 TrackBar2.Position := TrackBar2.Position + 5;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
 if Bass_ChannelIsActive(chan) = BASS_ACTIVE_PLAYING then
  BassVideo_Pause(chan)
 else
  BassVideo_Play(chan);
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
 BassVideo_Stop(chan)
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
 TrackBar2.Position := TrackBar2.Position - 5;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
 BassVideo_Play(chan);
end;

procedure TForm1.Source1Click(Sender: TObject);
begin
 BassVideo_SetRatio(chan, RSource, 0, 0);
 WhenFormResize; // should call it if you use windowed mode
end;

procedure TForm1.WhenFormResize;
var R : TRect;
begin
  R := Form1.ClientRect;
  R.Left := 0; R.Top := 0;
  R.Bottom := R.Bottom - Form1.Panel1.Height - Form1.StatusBar1.Height;
  BassVideo_WindowResize(chan, R, 0);
end;

procedure TForm1.N431Click(Sender: TObject);
begin
 BassVideo_SetRatio(chan, R43, 0, 0);
 WhenFormResize; // should call it if you use windowed mode

end;

procedure TForm1.N1691Click(Sender: TObject);
begin
 BassVideo_SetRatio(chan, R169, 0, 0);
 WhenFormResize; // should call it if you use windowed mode

end;

procedure TForm1.Free1Click(Sender: TObject);
begin
 BassVideo_SetRatio(chan, RFree, 0, 0);
 WhenFormResize; // should call it if you use windowed mode

end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
 BassVideo_Pause(chan);
 BassVideo_FrameStep(chan)
end;

procedure TForm1.ToolButton10Click(Sender: TObject);
var s : widestring;
    pos : Double;
begin
 if chan = 0 then exit;
 pos := BassVideo_GetPosition(chan);
 if not SaveDialog1.Execute then exit;
 s := SaveDialog1.FileName;
 BassVideo.BassVideo_CaptureBitmap(PWideChar(source), pos, PWideChar(s), BASS_UNICODE); // use unicode file name
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
  var id, i : integer;
begin
 if Msg.message = WM_COMMAND  then
             begin
              id := Msg.WParam;
              for i := 0 to Filter1.Count - 1 do
               begin
                if Filter1.Items[i].Command = id then
                 if Filter1.Items[i].Enabled then
                 begin
                   BassVideo.BassVideo_ShowFilterPropertyPage(chan, PChar(Filter1.Items[i].Caption), Handle, BASSVIDEO_FILTERNAME);
                   exit;
                 end;
               end;
             end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 if chan <> 0 then
  begin
    BassVideo.BassVideo_SetTempoEnable(chan, checkbox1.Checked);
    TrackBar1Change(nil);
  end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 Label2.Caption := inttostr(Trackbar1.Position);
 if chan <> 0 then
 BassVideo.BassVideo_SetTempoValue(chan, Trackbar1.Position)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 trackbar1.Position := 1000;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 stop := TRUE;
end;

end.
