如果您只需要在客户要求时显示最新图像,则可以执行以下操作:
type
TGetImageStream = class(TIdSync)
protected
FStream: TStream;
procedure DoSynchronize; override;
public
class procedure GetImage(Stream: TStream);
end;
procedure TGetImageStream.DoSynchronize;
begin
Form1.Image1.Bitmap.SaveToStream(FStream);
end;
class procedure TGetImageStream.GetImage(Stream: TStream);
begin
with Create do
try
FStream := Stream;
Synchronize;
finally
Free;
end;
end;
Run Code Online (Sandbox Code Playgroud)
procedure TForm1.HTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Strm: TMemoryStream;
begin
Strm := TMemoryStream.Create;
try
TGetImageStream.GetImage(Strm);
Strm.Position := 0;
except
Strm.Free;
raise;
end;
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentType := 'image/bmp';
AResponseInfo.ContentStream := Strm;
end;
Run Code Online (Sandbox Code Playgroud)
但是,如果您需要实时地实时传输摄像机图像,那将变得有些棘手。您可以通过几种不同的方式进行操作。例如,使用客户端请求:
procedure TForm1.HTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Strm: TMemoryStream;
begin
if ARequestInfo.Document = '' then
begin
AResponseInfo.Redirect('/');
end
else if ARequestInfo.Document = '/' then
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentType := 'text/html';
AResponseIno.ContentText := '<html>'+EOL+
'<head>'+EOL+
'<title>Camera Image</title>'+EOL+
'<meta http-equiv="Refresh" content=5>'+EOL+
'</head>'+EOL+
'<body>'+EOL+
'<img src="/image">'+EOL+
'</body>'+EOL+
'</html>'+EOL;
end
else if ARequestInfo.Document = '/image' then
begin
Strm := TMemoryStream.Create;
try
TGetImageStream.GetImage(Strm);
Strm.Position := 0;
except
Strm.Free;
raise;
end;
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentType := 'image/bmp';
AResponseInfo.ContentStream := Strm;
end else begin
AResponseInfo.ResponseNo := 404;
end;
end;
Run Code Online (Sandbox Code Playgroud)
使用服务器推送:
procedure TForm1.HTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Strm: TMemoryStream;
begin
Strm := TMemoryStream.Create;
try
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentType := 'multipart/x-mixed-replace; boundary=imgboundary';
AResponseInfo.CloseConnection := False;
AResponseInfo.WriteHeader;
AContext.Connection.IOHandler.WriteLn('--imgboundary');
repeat
Strm.Clear;
TGetImageStream.GetImage(Strm);
AContext.Connection.IOHandler.WriteLn('Content-type: image/bmp');
AContext.Connection.IOHandler.WriteLn;
AContext.Connection.IOHandler.Write(Strm);
AContext.Connection.IOHandler.WriteLn;
AContext.Connection.IOHandler.WriteLn('--imgboundary');
Sleep(5000);
until False;
finally
Strm.Free;
end;
end;
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
3437 次 |
| 最近记录: |