如何以内存流方式传送图像(100分)

  • 主题发起人 主题发起人 dali2000
  • 开始时间 开始时间
D

dali2000

Unregistered / Unconfirmed
GUEST, unregistred user!
如何用D7的idUDPcleint/server或idTCPcleint/server传送远端主机屏幕的图象,我想做的是一个远程屏幕查看软件,查了以前的贴子,都不是用INDY控件做的,我不会改呀,呵呵,我是笨点
 
先捕获屏幕画面,然后回传给客户机,由于画面的数据量很大所以,很多程序都是在画面改变的时候才回传改变部分的画面,常用的手段是最小矩形法,最小矩形法的delphi的代码有吗
 
我也来听课中!那位给出我另开贴给100分!
 
要找个好点的图形压缩算法和回传改变部分的画面,将屏幕分成多块传输。
相关讨论贴子很多噢, 具体实现不多。VNC有公开源码,是C++,如果你功底强,
可以参考。
 
////读///////////
with TCPClient do
begin
Connect;
while Connected do
begin
try
ReadStream(AStream, -1, True);//AStream是接收流
finally
Disconnect;
end;
end;
end;
////写//////////////////
with AThread.Connection do
begin
try
OpenWriteBuffer;
WriteStream(AStream);//AStream 是发送的流
CloseWriteBuffer;
finally
Disconnect;
end;
end;
 
Client
//抓屏函数,DrawCur表示抓鼠标图像与否
procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
R := Rect(0, 0, screen.Width, screen.Height);
Mybmp.PixelFormat:=pf16bit; //图像为 16位真彩色,也可根据实际需要调整
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R); //捕捉整个屏幕图像
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;
if DrawCur then {画上鼠标图象}
begin
GetCursorPos(DrawPos);
MyCursor := TIcon.Create;
getcursorpos(mp);
hld := WindowFromPoint(mp);
Threadld := GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle := Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx := DrawPos.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画上鼠标}
DeleteObject(pIconInfo.hbmColor);{GetIconInfo 使用时创建了两个bitmap对象. 需要手工释放这两个对象}
DeleteObject(pIconInfo.hbmMask);{否则,调用他后,他会创建一个bitmap,多次调用会产生多个,直至资源耗尽}
Mycursor.ReleaseHandle; {释放数组内存}
MyCursor.Free; {释放鼠标指针}
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
MyBmp: TBitmap;
Myjpg: TJpegimage;
MyStream :TMemorystream;
begin
MyStream := TMemorystream.Create;{建立内存流}
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
Cjt_GetScreen(MyBmp, True); {True表示抓鼠标图像}
Myjpg.Assign(MyBmp); {将BMP图象转成JPG格式,便于在互联网上传输}
Myjpg.CompressionQuality:=40; {JPG文件压缩百分比设置,数字越大图像越清晰,但数据也越大}
Myjpg.SaveToStream(MyStream); {将JPG图象写入流中}
Myjpg.free;
// MyBmp.Free;
MyStream.Position := 0;
try
if IdTCPClient1.connected then IdTCPClient1.DisConnect;
IdTCPClient1.Host :='127.0.0.1';
IdTCPClient1.Connect();
IdTCPClient1.OpenWriteBuffer();
IdTCPClient1.WriteStream(MyStream, True, False);
IdTCPClient1.CloseWriteBuffer();
IdTCPClient1.Disconnect;
finally
MyStream.free;
end;
end;


Server:
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
//MyBmp: TBitmap;
Myjpg: TJpegimage;
ThisCon: TIdTCPServerConnection;
begin
try
MyStream:=TMemorystream.Create;
Myjpg := TJpegimage.Create;
ThisCon := AThread.Connection;
while ThisCon.connected do ThisCon.ReadStream(MyStream, -1 , True);
MyStream.Position := 0;
Myjpg.LoadFromStream(MyStream);
Image1.Picture.Assign(Myjpg);
finally
MyStream.Free;
Myjpg.Free;
end;

end;
 
要找个好点的图形压缩算法和回传改变部分的画面,将屏幕分成多块传输。
相关讨论贴子很多噢, 具体实现不多。VNC有公开源码,是C++,如果你功底强,
可以参考。

是呀,还没找到DELPHI的源码
 
INDY自己就带一个用流发图片的例子
 
我用TIMER加TCPServer做,好慢呀,占的资源也很多,郁闷
 
线程,不是timer
 
线程?这样不是一直接发吗
 
一直接发是什么意思?
你要求什么样的>?
抓屏然后发送?
抓屏部分
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, TrayIcon, ExtCtrls, AppEvnts, IdTCPServer,
StdCtrls,jpeg;

const
READY='00000';
FASONG='11111';
ZHUNBEI='22222';
type
TForm1 = class(TForm)
TrayIcon1: TTrayIcon;
IdAntiFreeze1: TIdAntiFreeze;
Image1: TImage;
ApplicationEvents1: TApplicationEvents;
s: TIdTCPServer;
Edit1: TEdit;
c: TIdTCPClient;
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure sExecute(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
procedure BMPToJPG(BmpFileName:string);
end;

var
Form1: TForm1;
m:TMemoryStream;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
s.Active :=true;
form1.WindowState:=wsMinimized;
end;

procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
TRAYICON1.Visible :=true;
end;

procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
trayicon1.Visible :=false;
end;

procedure TForm1.sExecute(AThread: TIdPeerThread);
var
Temp:String;
Fullscreen : TBitmap;
FullscreenCanvas : TCanvas;
DC : HDC;
begin
edit1.Text :=athread.Connection.ReadLn();
temp:=edit1.Text ;
if temp=READY then
begin
c.Connect();
C.WriteLn(ZHUNBEI);
Fullscreen:=TBitmap.Create;
Fullscreen.Width := Screen.Width;
Fullscreen.Height := Screen.Height;
DC:=GetDC(0);
FullscreenCanvas := TCanvas.Create;//创建一个CANVAS对象
FullscreenCanvas.Handle := DC;
Fullscreen.Canvas.CopyRect
(Rect(0,0,Screen.Width,Screen.Height),FullScreenCanvas,
Rect(0,0,Screen.Width,Screen.Height));
FullScreenCanvas.Free;
ReleaseDC(0,DC);
image1.Picture.Bitmap := FullScreen;//拷贝下的图象赋给IMAGE对象en
image1.Picture.SaveToFile('d:/1.bmp') ;
BMPToJPG('d:/1.bmp');
DeleteFile('d:/1.bmp');
image1.Picture.LoadFromFile('d:/1.jpg');
end;
if temp=FASONG then
begin

m:=TMemoryStream.Create;
Image1.Picture.Graphic.SaveToStream(m);
c.WriteLn(FASONG);
c.writestream(m);
m.Free ;
c.Disconnect ;
end;
end;

procedure Tform1.BMPToJPG(BmpFileName:string);
var
Jpeg : TJPEGImage;
Bmp : TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(BmpFileName);
Jpeg := TJPEGImage.Create;
try
Jpeg.Assign(Bmp);
Jpeg.Compress;
Jpeg.SaveToFile('d:/1.jpg');
finally
Jpeg.Free;
end;
finally
Bmp.Free;
end;
end;
end.
 
接受部分
unit c;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdTCPServer, ExtCtrls, StdCtrls, IdTCPConnection, IdTCPClient,
IdIntercept, jpeg;
const
READY='00000';
FASONG='11111';
ZHUNBEI='22222';
type
Tclient = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
Image1: TImage;
c: TIdTCPClient;
Label2: TLabel;
s: TIdTCPServer;
Edit2: TEdit;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure sExecute(AThread: TIdPeerThread);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
client: Tclient;

implementation

{$R *.dfm}

procedure Tclient.Button1Click(Sender: TObject);
begin
c.Host :=edit1.Text ;
c.Connect();
c.WriteLn(READY);
c.Disconnect ;
end;

procedure Tclient.Button2Click(Sender: TObject);
//var
//t:TMemoryStream;
begin
//if c.Connected =true then
//c.WriteLn(FASONG);
//t:=TMemoryStream.Create ;
//c.ReadStream(t,-1,true);
//t.SaveToFile('c:/1.bmp');
//image1.Picture.LoadFromFile('c:/1.bmp');
//c.Disconnect
c.Connect();
c.WriteLn(FASONG);
c.Disconnect ;
end;


procedure Tclient.sExecute(AThread: TIdPeerThread);
var
t:string;
b:TMemoryStream;
begin
t:=athread.Connection.ReadLn();
edit2.Text :=t;
if t=ZHUNBEI then
label2.Caption :='准备好了';
if t=FASONG then
begin
b:=Tmemorystream.Create ;
AThread.Connection.ReadStream(b,1,true);
b.SaveToFile('e:/1.jpg');
b.Free ;
button3.Click ;

end;
end;

procedure Tclient.Button3Click(Sender: TObject);
begin
image1.Picture.LoadFromFile('e:/1.jpg');
end;

end.
 
是可以传送了,但效率好低,在网络中传输好慢,
 
不知道lz对屏幕的颜色有没有要求。
我的想法:
发送端:不要整屏整屏的读,要1水平线1水平线的读,好像有个函数可以一个读一个线,然后进行颜色转换,变为256色,这个简单;然后加入自己的简单的压缩算法,把结果送出去,判断当前的连接情况,正常就再读下一线。
接收端:接收,解压,还原颜色,写屏。

我想这样速度就比较能接受吧。
 
不知道lz对屏幕的颜色有没有要求。
我的想法:
发送端:不要整屏整屏的读,要1水平线1水平线的读,好像有个函数可以一个读一个线,然后进行颜色转换,变为256色,这个简单;然后加入自己的简单的压缩算法,把结果送出去,判断当前的连接情况,正常就再读下一线。
接收端:接收,解压,还原颜色,写屏。

我想这样速度就比较能接受吧。


有没有代码可参照?
 
思路整理一下,自己写应该不会很难吧?
很急吗?如果静下心写不会超过1小时吧。

而且自己写的 毕竟和 别人写的 不同啊,至少经验不一样。
LZ试试吧,别整个项目都要别人完成吧。

里面几个关键的上面贴子都有写:
DC:=GetDC(0);
TMemorystream.Create.....

还有个补充的想法,本地最好有一个用来对比的图像流,如果不同了,再把整个水平线内容发出去。
 
线程,不是timer

如何写?
 
使用线程理论上CPU占用率应该低一点,而你用TIMER好像也是一样啊,做好适当的APPLICATION.PROCESSMESSAGE应该没问题的啊。
感觉好像运算的东西是一样的,省不了多少,而且多线程进行控制比较麻烦点,这个得听听下面高手的高见。

学习ing....
 
后退
顶部