unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    _VidCodec: TComboBox;
    CheckBox1: TCheckBox;
    _VidBitrate: TComboBox;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    GroupBox2: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    _AuxCodec: TComboBox;
    _AuxFormat: TComboBox;
    _AuxBitrate: TComboBox;
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    Timer1: TTimer;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure _AuxCodecChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var Form1: TForm1;

implementation

uses BassVideo, Bass24;

{$R *.dfm}
var chan : DWORD;

procedure VideoAction(Handle : DWORD; Action, param1, param2 : DWORD; param : POinter); stdcall;
begin
 case Action of
  BassVideo_EndStream :
   begin
    BassVideo_StreamFree(chan);
    ShowMessage('Done');
   end;

  BassVideo_PlayEvent :
   begin
     case param1 of
      BassVideo_Is_Play   : Form1.Memo1.Lines.Add('Play');
      BassVideo_Is_Pause  : Form1.Memo1.Lines.Add('Pause');
      BassVideo_Is_Stop   : Form1.Memo1.Lines.Add('Stop');
     end;
   end;
  BassVideo_DShow_Event :
    begin
     Form1.Memo1.Lines.Add(BassVideo_EventToString(param1));
     if Param1 = $01 then
       begin
        BassVideo_StreamFree(chan);
        ShowMessage('Done');
       end;
    end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var cc, fc, i, j : integer;
    P : PWideChar;
begin
 Bass_Init(-1, 44100, 0, Handle, nil);
 BassVideo_Init();
  cc := -1; fc := -1;
  if BassVideo_Encoder_GetWMSettingCount(EncoderType_Video, cc, fc) then
   begin
    for i := 0 to cc - 1 do
     begin
      P := nil;
      j := i;
        if BassVideo_Encoder_GetWMSetting(EncoderType_Video, j, -1, pointer(p)) then
         if P <> nil then
           _VidCodec.Items.Add(P);
     end;
   end;

  cc := -1; fc := -1;
  if BassVideo_Encoder_GetWMSettingCount(EncoderType_Audio, cc, fc) then
   begin
    for i := 0 to cc - 1 do
     begin
      P := nil; j := i;
      if BassVideo_Encoder_GetWMSetting(EncoderType_Audio,j, -1, pointer(p)) then
       if P <> nil then
         _AuxCodec.Items.Add(P);
     end;
   end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 BassVideo_Free;
 Bass_Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
// if not OpenDialog1.Execute then exit;
 BassVideo_StreamFree(chan);
 //chan := BassVideo_StreamCreateFile(PChar(OpenDialog1.FileName), 0, 0, @VideoAction, nil);
 chan := BassVideo_DVD_StreamCreate(nil, 0, 0, @VideoAction, nil);
end;

procedure TForm1.Button2Click(Sender: TObject);
var ASF : TASFConfig;
    s : string;
    h, w : integer;
    fout : WideString;
begin
 if (_VidCodec.ItemIndex = -1) or
    (_VidBitrate.ItemIndex = -1) or
    (_AuxCodec.ItemIndex = -1) or
    (_AuxFormat.ItemIndex = -1) or
    (_AuxBitrate.ItemIndex = -1) or (chan = 0) then
     begin
      ShowMessage('Not enough information');
      exit;
     end;
 if not SaveDialog1.Execute then exit;
 BassVideo_GetVideoInfo(chan, h, w);
 ASF.Version := 1;
 ASF.Has_Audio := TRUE;
 ASF.Has_Video := TRUE;
 s := _VidBitrate.Text;
 delete(s, length(s) - 4, length(s));
 ASF.VideoBitrate := strtoint(s) * 1000;
 ASF.useVideoVBR := CheckBox1.Checked;
 ASF.VBRQuality := TrackBar1.Position;
 ASF.VideoCodec := _VidCodec.ItemIndex;
 ASF.SrcVideoFrameHeight := h;
 ASF.SrcVideoFrameWidth := w;
 ASF.DestVideoFrameHeight := h;
 ASF.DestVideoFrameWidth := w;
 ASF.VideoQuality := TrackBar2.Position;
 ASF.AudioCodec := _AuxCodec.ItemIndex;
 ASF.AudioCodecFormat := _AuxFormat.ItemIndex;
 s := _AuxBitrate.Text; delete(s, length(s) - 4, length(s));
 ASF.AudioBitrate := strtoint(s) * 1000;
 fout := SaveDialog1.FileName;
 BassVideo_Play(chan);
 BassVideo_DVD_Play(chan, 12, 1, -1);
 BassVideo_Stop(chan);
 chan := BassVideo_Encoder_Create(chan, PWideChar(fout), Video_WMV, @ASF);
 if chan <> 0 then
  begin
   BassVideo_Play(chan);
   BassVideo_DVD_Play(chan, 12, 1, -1);
    Timer1.Enabled := TRUE;
  end
 else
  ShowMessage('Failed');
end;

procedure TForm1._AuxCodecChange(Sender: TObject);
var i, codec, fc : integer;
    p : Pointer;
    T : TWMAudioFormat;
    s : string;
begin
 _AuxFormat.Clear;
 Codec := _AuxCodec.ItemIndex;
 if BassVideo_Encoder_GetWMSettingCount(EncoderType_Audio, Codec, fc) then
  begin
   for i := 0 to fc - 1 do
    begin
     if BassVideo_Encoder_GetWMSetting(EncoderType_Audio, codec, i, pointer(p)) then
      if p <> nil then
       begin
        T := PWMAudioFormat(P)^;
        s := inttostr(T.wBitPerSample) + ' bit';
        s := inttostr(T.Bitrate div 1000) + ' Kbps , ' + inttostr(T.Freq) + ' hz , ' +
             inttostr(T.nChan) + ' channel , ' + s;
        _AuxFormat.Items.Add(s);
       end;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var p, l : double;
begin
 if chan = 0 then exit;
 p := BassVideo_GetPosition(chan);
 l := BassVideo_GetLength(chan);
 Form1.Caption := floattostr(p) + ' / ' + floattostr(l);
 progressbar1.Position := Round((p/l) * 100)
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 BassVideo_DVD_Play(chan, 9, 1, -1);
//BassVideo_DVD_PlayChapterAndStop(chan, 9, 1, 1);
end;

end.
