www.pudn.com > AVideoCapture.rar > LiveSrvCastUnt.pas

unit LiveSrvCastUnt; 
 
interface 
 
uses 
  Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, OleCtrls, SFLIVESERVERLib_TLB, ExtCtrls, Menus, Inifiles; 
 
type 
  TLiveSrvCast = class(TForm) 
    Panel1: TPanel; 
    LiveSrv: TSFLiveServer; 
    LiveSrvPopMenu: TPopupMenu; 
    MainVideoMItem: TMenuItem; 
    SubVideoMItem: TMenuItem; 
    MainSource1MItem: TMenuItem; 
    MainSource2MItem: TMenuItem; 
    MainSource3MItem: TMenuItem; 
    SubSource1MItem: TMenuItem; 
    SubSource2MItem: TMenuItem; 
    SubSource3MItem: TMenuItem; 
    AudeoMItem: TMenuItem; 
    SubAudeoSource0MItem: TMenuItem; 
    SubAudeoSource1MItem: TMenuItem; 
    SubAudeoSource2MItem: TMenuItem; 
    SubAudeoSource3MItem: TMenuItem; 
    StopCastMItem: TMenuItem; 
    MainSource4MItem: TMenuItem; 
    MainSource5MItem: TMenuItem; 
    SubSource4MItem: TMenuItem; 
    SubSource5MItem: TMenuItem; 
    SubAudeoSource4MItem: TMenuItem; 
    SubAudeoSource5MItem: TMenuItem; 
    SubAudeoSource6MItem: TMenuItem; 
    MainSource6MItem: TMenuItem; 
    MainSource7MItem: TMenuItem; 
    MainSource8MItem: TMenuItem; 
    MainSource9MItem: TMenuItem; 
    MainSource10MItem: TMenuItem; 
    SubSource6MItem: TMenuItem; 
    SubSource7MItem: TMenuItem; 
    SubSource8MItem: TMenuItem; 
    SubSource9MItem: TMenuItem; 
    SubSource10MItem: TMenuItem; 
    SubAudeoSource7MItem: TMenuItem; 
    SubAudeoSource8MItem: TMenuItem; 
    SubAudeoSource9MItem: TMenuItem; 
    procedure FormResize(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, 
      Y: Integer); 
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure VideoMItemClick(Sender: TObject); 
    procedure AudeoMItemClick(Sender: TObject); 
    procedure LiveSrvCatchFileEnd(ASender: TObject; nChannelNO: Smallint); 
    procedure StopCastMItemClick(Sender: TObject); 
    procedure LiveSrvPopMenuChange(Sender: TObject; Source: TMenuItem; 
      Rebuild: Boolean); 
  private 
    { Private declarations } 
  public 
    procedure AppMessageHandler(var msg: TMsg; 
      var Handled: Boolean); 
    { Public declarations } 
  end; 
 
var 
  LiveSrvCast: TLiveSrvCast; 
  IsFirst: Boolean; 
  ReSetSize: Boolean; 
  ReSizeData: Tpoint; 
  ReSizeMode, ReSizeMode2: Integer; 
  OtherOK: Boolean; 
  BsId: Integer; 
 
implementation 
 
uses MainUnt, LogonUnt, AVideoFunctionUnt, AVideoStatusUnt, CastOprUnt, UserPowerUnt; 
 
{$R *.dfm} 
 
procedure TLiveSrvCast.AppMessageHandler(var msg: TMsg; 
  var Handled: Boolean); 
var 
  X, Y: Integer; 
begin 
  if (msg.hwnd = LiveSrv.Handle) then 
    if msg.message = WM_LBUTTONDOWN then begin 
      ReleaseCapture; 
      SendMessage(Handle, WM_SYSCOMMAND, $F012, 0); 
    end 
    else if msg.message = WM_MouseMove then begin 
      X := msg.pt.X - self.Left; 
      Y := msg.pt.Y - self.Top; 
      if Main.AutoCBox.Checked then 
        if (Y > Round(X * (Height / Width))) and (Y < Height - Round(X * (Height / Width))) 
          or (Y > Round((Width - X) * (Height / Width))) and (Y < Height - Round((Width - X) * (Height / Width))) then {//上下动}  begin 
          if Top = 0 then 
            Top := Screen.Height - self.Height - 25 
          else Top := 0; 
        end 
        else if (X > Round(Y * (Width / Height))) and (X < Width - Round(Y * (Width / Height))) 
          or (X > Round((Height - Y) * (Width / Height))) and (X < Width - Round((Height - Y) * (Width / Height))) then {//左右动}  begin 
          if Left = 0 then 
            Left := Screen.Width - self.Width 
          else Left := 0; 
        end; 
    end; 
  inherited; 
end; 
 
procedure TLiveSrvCast.FormResize(Sender: TObject); 
begin 
  LiveSrv.SetWndSize(1, 0, 0, self.LiveSrv.Width, self.LiveSrv.Height); 
end; 
 
procedure TLiveSrvCast.FormCreate(Sender: TObject); 
begin 
  BsId := GlobalAddAtom('hotkey'); 
  RegisterHotKey(Handle, BsId, 0, 123); 
  ReSetSize := False; 
  IsFirst := True; 
  SetWindowPos(self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); 
end; 
 
procedure TLiveSrvCast.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, 
  Y: Integer); 
begin 
  if (X in [0, 1, 3, 4]) and (Y in [0, 1, 3, 4]) then begin 
    Panel1.Cursor := crSizeNWSE; 
    ReSizeMode := 1; 
  end 
  else if (X in [0, 1, 3, 4]) and (Y > Panel1.Height - 4) then begin 
    ReSizeMode := 2; 
    Panel1.Cursor := crSizeNESW; 
  end 
  else if (X in [0, 1, 3, 4]) and (not (Y > Panel1.Height - 4)) then begin 
    ReSizeMode := 3; 
    Panel1.Cursor := crSizeWE; 
  end 
  else if (X > Panel1.Width - 4) and (Y in [0, 1, 3, 4]) then begin 
    ReSizeMode := 4; 
    Panel1.Cursor := crSizeNESW; 
  end 
  else if (X > Panel1.Width - 4) and (Y > Panel1.Height - 4) then begin 
    ReSizeMode := 5; 
    Panel1.Cursor := crSizeNWSE; 
  end 
  else if (X > Panel1.Width - 4) and (not (Y > Panel1.Height - 4)) then begin 
    ReSizeMode := 6; 
    Panel1.Cursor := crSizeWE; 
  end 
  else if (Y in [0, 1, 3, 4]) and (not (X > Panel1.Width - 4)) then begin 
    ReSizeMode := 7; 
    Panel1.Cursor := crSizeNS 
  end 
  else if (Y > Panel1.Height - 4) and (not (X > Panel1.Width - 4)) then begin 
    ReSizeMode := 8; 
    Panel1.Cursor := crSizeNS; 
  end 
  else Panel1.Cursor := crSizeAll; 
end; 
 
procedure TLiveSrvCast.Panel1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Panel1.Cursor = crSizeAll then begin 
    ReleaseCapture; 
    SendMessage(Handle, WM_SYSCOMMAND, $F012, 0); 
    ReSetSize := False; 
  end 
  else begin 
    ReSetSize := True; 
    ReSizeMode2 := ReSizeMode; 
    ReSizeData.X := X; 
    ReSizeData.Y := Y; 
  end; 
end; 
 
procedure TLiveSrvCast.Panel1MouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if ReSetSize then 
    case ReSizeMode2 of 
      1: begin 
          Width := Width + (0 - X); 
          Left := Left + X; 
          Height := Height + (0 - Y); 
          Top := Top + Y; 
        end; 
      2: begin 
          Width := Width + (0 - X); 
          Left := Left + X; 
          Height := Height + (Y - Panel1.Height); 
        end; 
      3: begin 
          Width := Width + (0 - X); 
          Left := Left + X; 
        end; 
      4: begin 
          Width := Width + (X - Panel1.Width); 
          Height := Height + (0 - Y); 
          Top := Top + Y; 
        end; 
      5: begin 
          Width := Width + (X - Panel1.Width); 
          Height := Height + (Y - Panel1.Height) 
        end; 
      6: Width := Width + (X - Panel1.Width); 
      7: begin 
          Height := Height + (0 - Y); 
          Top := Top + Y; 
        end; 
      8: Height := Height + (Y - Panel1.Height); 
    end; 
end; 
 
procedure TLiveSrvCast.VideoMItemClick(Sender: TObject); 
var 
  MItem: array[0..1] of TMenuItem; 
  i: Integer; 
begin 
  try 
    for i := 0 to 2 do begin 
      MItem[0] := FindComponent('MainSource' + IntToStr(i + 1) + 'MItem') as TMenuItem; 
      if MItem[0] <> nil then 
        MItem[0].Checked := False; 
      MItem[1] := FindComponent('SubSource' + IntToStr(i + 1) + 'MItem') as TMenuItem; 
      if MItem[1] <> nil then 
        MItem[1].Checked := False; 
    end; 
    TMenuItem(Sender).Checked := True; 
    with LiveSrv do begin 
      if IsChannelPreviewing(1) then 
        StopPreview(1); 
      SetWndSize(1, 0, 0, Width, Height); 
      CastFileName[1] := ''; //设置广播文件路径 不广播文件 为空运行之前 
      CapAudioDevice[1] := -1; // 指定音频卡 - 1 ~ 10 - 1 不捕捉 运行之前 
      ShowVideo[1] := True; //显示画面 运行之前 
      SaveFileName[1] := ''; // ExtractFileDir(Application.ExeName) + '\aas.asf'; //长度255 为0不录像，反之要录像 任何时间 
      RunMode[1] := 0; //运行模式 0 只监听 1 只组播 2 组播&监听 运行之前 
      ShowVideo[1] := True; 
      MySetForm(1, LiveSrvCast.LiveSrv, Main.TVFormat.Text, 25); 
      case TMenuItem(Sender).tag of 
        11..20: begin 
            CapVideoDevice[1] := Main.VideoBox.ItemIndex; // 指定视频卡 - 1 不捕捉，100桌面 运行之前 
            Main.VideoSource.ItemIndex := TMenuItem(Sender).tag - 11; 
            VideoSource[1] := Main.VideoSource.ItemIndex; //视频来源 - 10 不设置，只查看是否使用老式接口 任何时间 
          end; 
        21..30: begin 
            CapVideoDevice[1] := Main.OtherCBox.ItemIndex; // 指定视频卡 - 1 不捕捉，100桌面 运行之前 
            Main.OVideoSource.ItemIndex := TMenuItem(Sender).tag - 21; 
            VideoSource[1] := Main.OVideoSource.ItemIndex; //视频来源 - 10 不设置，只查看是否使用老式接口 任何时间 
          end; 
      end; 
      StartPreview(1, -1); 
    end; 
  except 
    Application.MessageBox('请检测视频卡是否支持这些端口.', '设置未成功', mb_okcancel); 
    Exit; 
  end; 
end; 
 
procedure TLiveSrvCast.AudeoMItemClick(Sender: TObject); 
var 
  i: Integer; 
  MItem: TMenuItem; 
begin 
  try 
    LiveSrv.AudioSource[0] := TMenuItem(Sender).tag - 31; 
    for i := 0 to 9 do begin 
      MItem := FindComponent('SubAudeoSource' + IntToStr(i) + 'MItem') as TMenuItem; 
      if MItem <> nil then 
        MItem.Checked := False; 
    end; 
    TMenuItem(Sender).Checked := True 
  except 
    Application.MessageBox('请检测音频卡是否支持这些端口.', '设置未成功', mb_okcancel); 
    Exit; 
  end; 
end; 
 
procedure TLiveSrvCast.LiveSrvCatchFileEnd(ASender: TObject; 
  nChannelNO: Smallint); 
var 
  StopCastTimer: TTimer; 
begin 
  with Main do 
    StopCastTimer := FindComponent('StopCast' + IntToStr(nChannelNO) + 'Timer') as TTimer; 
  if StopCastTimer.Enabled then begin 
    if FilesId[nChannelNO] < FilesList[nChannelNO].Count - 1 then 
      FilesId[nChannelNO] := FilesId[nChannelNO] + 1 
    else if FilesId[nChannelNO] = FilesList[nChannelNO].Count - 1 then 
      if If_RePlay[nChannelNO] then 
        FilesId[nChannelNO] := 0 
      else Exit; 
    Sleep(5000); 
    LiveSrv.CastFileName[nChannelNO] := FilesList[nChannelNO].Strings[FilesId[nChannelNO]]; 
    LiveSrv.BeginCast(nChannelNO); 
  end; 
end; 
 
procedure TLiveSrvCast.StopCastMItemClick(Sender: TObject); 
begin 
  Main.MyStopDesktopCast; 
end; 
 
procedure TLiveSrvCast.LiveSrvPopMenuChange(Sender: TObject; 
  Source: TMenuItem; Rebuild: Boolean); 
var 
  i: Integer; 
  MItem: array[0..2, 0..9] of TMenuItem; 
begin 
  try 
    if Main.Teacherch.Checked and (Main.VideoBox.ItemIndex >= 0) then begin 
      MainVideoMItem.Enabled := True; 
      for i := 0 to 9 do begin 
        MItem[0, i] := FindComponent('MainSource' + IntToStr(i + 1) + 'MItem') as TMenuItem; 
        if (MItem[0, i] <> nil) and (videoCard[Main.VideoBox.ItemIndex].Source[i] <> '') then begin 
          MItem[0, i].Enabled := True; 
          MItem[0, i].Caption := videoCard[Main.VideoBox.ItemIndex].Source[i]; 
        end 
        else MItem[0, i].Enabled := False 
      end; 
    end 
    else if not Main.Teacherch.Checked then 
      MainVideoMItem.Enabled := False; 
    if Main.Otherch.Checked and (Main.OtherCBox.ItemIndex >= 0) then begin 
      SubVideoMItem.Enabled := True; 
      for i := 0 to 9 do begin 
        MItem[1, i] := FindComponent('SubSource' + IntToStr(i + 1) + 'MItem') as TMenuItem; 
        if (MItem[1, i] <> nil) and (videoCard[Main.OtherCBox.ItemIndex].Source[i] <> '') then begin 
          MItem[1, i].Enabled := True; 
          MItem[1, i].Caption := videoCard[Main.OtherCBox.ItemIndex].Source[i]; 
        end 
        else MItem[1, i].Enabled := False; 
      end; 
    end 
    else if not Main.Otherch.Checked then 
      SubVideoMItem.Enabled := False; 
    for i := 0 to 9 do begin 
      MItem[2, i] := FindComponent('SubAudeoSource' + IntToStr(i) + 'MItem') as TMenuItem; 
      if (MItem[2, i] <> nil) and (audeoCard[0].Source[i] <> '') then begin 
        MItem[2, i].Enabled := True; 
        MItem[2, i].Caption := audeoCard[0].Source[i]; 
      end 
      else 
        MItem[2, i].Enabled := False; 
    end; 
  except 
  end; 
end; 
 
end.