unit1.pas

《Delphi百例》源码?禗elphi百例》源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,JPEG,
  ExtCtrls, ScktComp;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  m1:tmemorystream;
  
implementation

{$R *.DFM}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s,s1:string;
  desk:tcanvas;
  bitmap:tbitmap;
  jpg:tjpegimage;
begin
  s:=socket.ReceiveText;
  if s='gets' then //file://客户端发出申请
  begin
   try
    m1:=tmemorystream.Create;
    bitmap:=tbitmap.Create;
    jpg:=tjpegimage.Create;
    desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
    desk.Handle:=getdc(hwnd_desktop);
    with bitmap do
    begin
        width:=screen.Width;
        height:=screen.Height;
        canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
    end;
    jpg.Assign(bitmap); //file://将图象转成JPG格式
    jpg.CompressionQuality:=10;//文件压缩大小设置
    //m1.clear;
    jpg.SaveToStream(m1); //file://将JPG图象写入流中
    jpg.free;
    m1.Position:=0;
    s1:=inttostr(m1.size);
    Socket.sendtext(s1); //file://发送图象大小
   finally
    bitmap.free;
    desk.free;
   end;
  end;
  if s='okok' then //file://客户端已准备好接收图象
  begin
    m1.Position:=0;
    Socket.SendStream(m1); //file://发送JPG图象
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 ServerSocket1.open;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.close;
end;

end.