超级解霸中实现的视频广播很棒的,我想在自己的程序中实现这样的功能,不知道如何实现???另外我想知道如何在局域网中实现分组播放????

解决方案 »

  1.   

    一段源码:
    program Client;uses
      Forms,
      Main in 'Main.pas' {ClientForm},
      VFW in '..\VFW.pas',
      VideoConsts in '..\VideoConsts.pas';{$R *.res}begin
      Application.Initialize;
      Application.CreateForm(TClientForm, ClientForm);
      Application.Run;
    end.//Client main.pas
    unit Main;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ScktComp, VideoConsts, VFW, StdCtrls, ExtCtrls;type
      TClientForm = class(TForm)
        Image1: TImage;
        ClientSocket1: TClientSocket;
        edIPAddr: TEdit;
        btnConnect: TButton;
        mmReport: TMemo;
        procedure btnConnectClick(Sender: TObject);
        procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
          ErrorEvent: TErrorEvent; var ErrorCode: Integer);
        procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
        procedure ClientSocket1Connect(Sender: TObject;
          Socket: TCustomWinSocket);
        procedure ClientSocket1Connecting(Sender: TObject;
          Socket: TCustomWinSocket);
        procedure ClientSocket1Disconnect(Sender: TObject;
          Socket: TCustomWinSocket);
      private
        { 接收头信息, 一连接后,服务端发送头信息TServerControlInfo(two times),
          之后是_VEDEO_DATA数据 }
        FRecvHeaderTimes: Byte;
        FCV: TCOMPVARS;
        FOutBuf: PByte;
        FOutBufSize: DWORD;
        FInInfo: TBitmapInfo;
        FOutInfo: TBitmapInfo;
        FOutFormatSize: DWORD;
        {$HINTS OFF}
        procedure ShowImage(Buf: PByte);
        {$HINTS ON}
        procedure ExecuteServerCommand(msg: TServerControlInfo);
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
      end;var
      ClientForm: TClientForm;implementation{$R *.dfm}
    procedure TClientForm.ExecuteServerCommand(msg: TServerControlInfo);
    var
      Cmd: string;
    {  RetVal: Integer;
      hPalette: THandle;}
    begin
      Cmd := msg.strCommand;
      if SameText(Cmd, 'Set Bitmap Info') then
      begin
        Move(msg.strContent, FInInfo, SizeOf(FInInfo));
        mmReport.Lines.Add(Format('FInInfo.bmiHeader  .biHeight:%d, .biBitCount:%d',
          [FInInfo.bmiHeader.biHeight, FInInfo.bmiHeader.biBitCount]));
      end else
      if SameText(Cmd, 'Set COMPVARS') then
      begin
        Move(msg.strContent, FCV, SizeOf(FCV));
        mmReport.Lines.Add(FOrmat('FCV.cbSize: %d', [FCV.cbSize]));
        //FCV.hic := ICDrawOpen(FCV.fccType, FCV.fccHandler, @FInInfo.bmiHeader);
        FCV.hic := ICOpen(FCV.fccType, FCV.fccHandler, ICMODE_DECOMPRESS);
        if FCV.hic = 0 then
        begin
          mmReport.Lines.Add(Format('FCV.fccType: %d', [FCV.fccType]));
          raise Exception.Create('please install the proper decompressor!');
        end else
        begin
          {hPalette := GetCurrentObject(GetDC(Handle), OBJ_PAL);
          RetVal := ICDrawBegin(FCV.hic, ICDRAW_HDC, 0, Handle,
            GetDC(Handle), 0, 0, 200, 200, @FInInfo.bmiHeader,
            0, 0, FInInfo.bmiHeader.biWidth, FInInfo.bmiHeader.biHeight,
            FCV.lDataRate, FCV.lDataRate / FCV.lKey);
          if RetVal == ICERR_UNSUPPORTED then
          begin
            mmReport.Lines.Add('ICERR_UNSUPPORTED');
            MessageBox(Handle, 'ICERR_UNSUPPORTED', 'Error', MB_OK or MB_ICONERROR);
            // raise ??是抛出异常吧??
          end; }
          FOutFormatSize := ICDecompressGetFormatSize(FCV.hic, @FInInfo.bmiHeader);
          FillChar(FOutInfo, SizeOf(FOutInfo), 0);
          ICDecompressGetFormat(FCV.hic, @FInInfo, @FOutInfo);
          mmReport.Lines.Add(Format('Out Format Height: %d', [FOutInfo.bmiHeader.biHeight]));
          FOutBufSize := FOutInfo.bmiHeader.biSizeImage;
          if Assigned(FOutBuf) then FreeMem(FOutBuf);
          GetMem(FOutBuf, FOutBufSize);
          FillChar(FOutBuf^, FOutBufSize, 0);
          mmReport.Lines.Add(Format('Out buffer size:%d', [FOutBufSize]));
          ICDecompressBegin(FCV.hic, @FInInfo, @FOutInfo);
        end;
      end;
    end;procedure TClientForm.ShowImage(Buf: PByte);  //这句可能有错,试一下其它方法,如直接对Image1.Handle, Image1.Canvas.handle赋值之类.
      procedure SetImage(hBitmap: THandle);
      begin
        SendMessage(Image1.Picture.Bitmap.Handle, STM_SETIMAGE, IMAGE_BITMAP, Integer(hBitmap));
      end;var
      pData: Pointer;
      pDC, MemDC: THandle;
      hBitmap: THandle;
    {  FileStream: TFileStream;
      FileHeader: TBitmapFileHeader; }
    begin
      {FileStream := TFileStream.Create('D:\Ok.bmp', fmCreate);
      FillChar(FileHeader, SizeOf(FileHeader), 0);
      with FileHeader, FileStream do
      try
        bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader);
        bfSize := bfOffBits + FOutBufSize;
        bfType := $4D42;
        WriteBuffer(FileHeader, SizeOf(FileHeader));
        WriteBuffer(FOutInfo, SizeOf(FOutInfo));
        WriteBuffer(Buf^, FOutBufSize);
      finally
        Free;
      end;}
      mmReport.Lines.Add(Format('K = %d', [PByte(Integer(Buf) + 150)^]));
      pDC := GetDC(Handle);
      pData := nil;
      hBitmap := CreateDIBSection(0, FOutInfo, DIB_RGB_COLORS, pData, 0, 0);
      if not Assigned(pData) and (hBitmap = 0) then
      begin
        mmReport.Lines.Add(Format('CreateDIBSection Error, ErrCode: %d', [GetLastError]));
        Abort;
      end;
      pData := Buf;
      SetImage(hBitmap);
      GdiFlush;
      MemDC := CreateCompatibleDC(pDC);
      SelectObject(MemDC, hBitmap);
      BitBlt(pDC, 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight,
        MemDC, 0, 0, SRCCOPY);
      DeleteDC(MemDC);
    //  SetDIBitsToDevice(pDC, 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight,
    //    0, 0, 0, FOutInfo.bmiHeader.biHeight, Buf, FOutInfo, DIB_RGB_COLORS);
    end;procedure TClientForm.btnConnectClick(Sender: TObject);
    begin
      with ClientSocket1 do
      begin
        if Active then
        begin
          Close;
          Sleep(100);
        end;
        Address := edIPAddr.Text;
        Open;
      end;
    end;
      

  2.   

    procedure TClientForm.ClientSocket1Error(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    begin
      mmReport.Lines.Add(Format('Socket出错了,代码:%d, 信息:%s',
        [ErrorCode, SysErrorMessage(ErrorCode)]));
      ErrorCode := 0;
    end;procedure TClientForm.ClientSocket1Read(Sender: TObject;
      Socket: TCustomWinSocket);
    var
      Len, RetVal: Integer;
      VideoData: TVideoDataInfo;
      ServerCtrl: TServerControlInfo;
    begin
      Len := Socket.ReceiveLength;
      if FRecvHeaderTimes <= 1 then //发了两次控制信息
      begin
        FillChar(ServerCtrl, SizeOf(ServerCtrl), 0);
        if Len > SizeOf(ServerCtrl) then
          Len := SizeOf(ServerCtrl);
        Socket.ReceiveBuf(ServerCtrl, Len);
        ExecuteServerCommand(ServerCtrl);
        Inc(FRecvHeaderTimes);
      end else
      begin
        FillChar(VideoData, SizeOf(VideoData), 0);
        if Len > SizeOf(VideoData) then
          Len := SizeOf(VideoData);
        Socket.ReceiveBuf(VideoData, Len);
        if (VideoData.nUsedSize > 0) and (VideoData.nUsedSize < 8180) then
        begin
          mmReport.Lines.Add(Format('Get Compressed Data: %d', [VideoData.nUsedSize]));
          RetVal := ICDeCompress(FCV.hic, 0, @FInInfo.bmiHeader, @VideoData.Buf[0],
            @FOutInfo.bmiHeader, FOutBuf);
          if RetVal = ICERR_OK then
          begin
            //需不需要调用ShowImage??
            //ShowImage(FOutBuf);
            SetDIBitsToDevice(GetDC(Handle), 0, 0, FOutInfo.bmiHeader.biWidth,
              FOutInfo.bmiHeader.biHeight, 0, 0, 0, FOutInfo.bmiHeader.biHeight,
              FOutBuf, FOutInfo, DIB_RGB_COLORS);
          end;
        end;
      end;
    end;procedure TClientForm.ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    begin
      FRecvHeaderTimes := 0;
      mmReport.Lines.Add(Format('已经连接上:%s 主机', [Socket.RemoteAddress]))
    end;procedure TClientForm.ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    begin
      mmReport.Lines.Add(Format('请等待, 正在连接:%s 主机...', [Socket.RemoteAddress]))
    end;procedure TClientForm.ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    begin
      FRecvHeaderTimes := 0;
      mmReport.Lines.Add(Format('断开与%s 主机的连接', [Socket.RemoteAddress]))
    end;constructor TClientForm.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FOutBuf := nil;
      FillChar(FCV, SizeOf(FCV), 0);
      FillChar(FInInfo, SizeOf(FInInfo), 0);
      FIllChar(FOutInfo, SizeOf(FOutInfo), 0);
      FOutBufSize := 0;
      FOutFormatSize := 0;
      ClientSocket1.Port := CONNECTPORT;
    end;destructor TClientForm.Destroy;
    begin
      if Assigned(FOutBuf) then
        FreeMem(FOutBuf);
      if FCV.hic <> 0 then
        //ICDrawEnd(m_CV.hic);
        ICClose(FCV.hic);
      inherited Destroy;
    end;end.//Client Main.dfm
    object ClientForm: TClientForm
      Left = 87
      Top = 79
      Width = 440
      Height = 414
      Caption = 'ClientForm'
      Color = clBtnFace
      Font.Charset = ANSI_CHARSET
      Font.Color = clWindowText
      Font.Height = -12
      Font.Name = 'Courier New'
      Font.Style = []
      OldCreateOrder = False
      PixelsPerInch = 96
      TextHeight = 15
      object Image1: TImage
        Left = 0
        Top = 0
        Width = 432
        Height = 241
        Align = alTop
      end
      object edIPAddr: TEdit
        Left = 16
        Top = 256
        Width = 209
        Height = 23
        TabOrder = 0
        Text = '127.0.0.1'
      end
      object btnConnect: TButton
        Left = 232
        Top = 254
        Width = 97
        Height = 25
        Caption = '连接主机(&L)'
        TabOrder = 1
        OnClick = btnConnectClick
      end
      object mmReport: TMemo
        Left = 0
        Top = 288
        Width = 432
        Height = 99
        Align = alBottom
        ScrollBars = ssVertical
        TabOrder = 2
      end
      object ClientSocket1: TClientSocket
        Active = False
        ClientType = ctNonBlocking
        Port = 0
        OnConnecting = ClientSocket1Connecting
        OnConnect = ClientSocket1Connect
        OnDisconnect = ClientSocket1Disconnect
        OnRead = ClientSocket1Read
        OnError = ClientSocket1Error
        Left = 344
        Top = 256
      end
    end
      

  3.   

    http://tty.yyun.net/lovejingtao/htm/olddefault.htm
      

  4.   

    http://tty-1.51.net/cjt/Mpeg1Decode.zip
      

  5.   

    http://tty.yyun.net/lovejingtao/htm/olddefault.htm 不能访问?