请问如何用Delphi或C++Builder实现屏幕画面的截取?

Question

参考一下这段远程监控的客户端代码，ScreenCap为屏幕画面的截取functionunit ClnUnit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NMUDP;type
  TClient = class(TForm)
    CUDP: TNMUDP;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: string; Port: Integer);
  private
    { Private declarations }
    procedure ScreenCap(LeftPos, TopPos,
      RightPos, BottomPos: integer);
  public
    { Public declarations }
  end;var
  Client: TClient;implementationconst BufSize = 2048; { 发送每一笔数据的缓冲区大小 }
var
  BmpStream: TMemoryStream;
  LeftSize: Longint; { 发送每一笔数据后剩余的字节数 }{$R *.dfm}procedure TClient.FormCreate(Sender: TObject);
begin
  BmpStream := TMemoryStream.Create;
end;procedure TClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BmpStream.Free;
end;procedure TClient.CUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: string; Port: Integer);
var
  CtrlCode: array[0..29] of char;
  Buf: array[0..BufSize - 1] of char;
  TmpStr: string;
  SendSize, LeftPos, TopPos, RightPos, BottomPos: integer;
begin
  CUDP.ReadBuffer(CtrlCode, NumberBytes); { 读取控制码 }
  if CtrlCode[0] + CtrlCode[1] + CtrlCode[2] + CtrlCode[3] = 'show' then
  begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
    if BmpStream.Size = 0 then { 没有数据可发，必须截屏生成数据 }
    begin
      TmpStr := StrPas(CtrlCode);
      TmpStr := Copy(TmpStr, 5, Length(TmpStr) - 4);
      LeftPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));
      TmpStr := Copy(TmpStr, Pos(':', TmpStr) + 1, Length(TmpStr)
        - Pos(':', TmpStr));
      TopPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));
      TmpStr := Copy(TmpStr, Pos(':', TmpStr) + 1, Length(TmpStr) -
        Pos(':', TmpStr));
      RightPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));
      BottomPos := StrToInt(Copy(TmpStr, Pos(':', TmpStr
        ) + 1, Length(TmpStr) - Pos(':', TmpStr)));
      ScreenCap(LeftPos, TopPos, RightPos, BottomPos); {截取屏幕 }
    end;
    if LeftSize > BufSize then
      SendSize := BufSize
    else
      SendSize := LeftSize;
    BmpStream.ReadBuffer(Buf, SendSize);
    LeftSize := LeftSize - SendSize;
    if LeftSize = 0 then
      BmpStream.Clear; { 清空流 }
    CUDP.RemoteHost := FromIP; { FromIP为主控机IP地址 }
    CUDP.SendBuffer(Buf, SendSize); { 将数据发到主控机的2222口 }
  end;
end;procedure TClient.ScreenCap(LeftPos, TopPos,
  RightPos, BottomPos: integer);
var
  RectWidth, RectHeight: integer;
  SourceDC, DestDC, Bhandle: integer;
  Bitmap: TBitmap;
begin
  RectWidth := RightPos - LeftPos;
  RectHeight := BottomPos - TopPos;
  SourceDC := CreateDC('DISPLAY', '', '', nil);
  DestDC := CreateCompatibleDC(SourceDC);
  Bhandle := CreateCompatibleBitmap(SourceDC,
    RectWidth, RectHeight);
  SelectObject(DestDC, Bhandle);
  BitBlt(DestDC, 0, 0, RectWidth, RectHeight, SourceDC,
    LeftPos, TopPos, SRCCOPY);
  Bitmap := TBitmap.Create;
  Bitmap.Handle := BHandle;
  BitMap.SaveToStream(BmpStream);
  BmpStream.Position := 0;
  LeftSize := BmpStream.Size;
  Bitmap.Free;
  DeleteDC(DestDC);
  ReleaseDC(Bhandle, SourceDC);
end;end.

Answer 1

捕获屏幕并存成bitmap文件很简单。在你的程序中加入以下函数。function CaptureScreen:TBitmap; 
var 
DC : HDC; 
ABitmap:TBitmap; 
begin 
DC := GetDC (GetDesktopWindow); 
ABitmap:=TBitmap.Create; 
try 
ABitmap.Width := GetDeviceCaps (DC, HORZRES); 
ABitmap.Height := GetDeviceCaps (DC, VERTRES); 
BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, 
ABitmap.Height,DC, 0, 0, SRCCOPY); 
finally 
ReleaseDC (GetDesktopWindow, DC); 
end; 
Result:=ABitmap; 
end;

Answer 2

luoweicaisd(笑三少) ，先谢谢了

Answer 3

unit serUnit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, NMUDP;type
  TServer = class(TForm)
    SUDP: TNMUDP;
    Panel1: TPanel;
    Image1: TImage;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure SUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: string; Port: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Server: TServer;implementationconst BufSize = 2048;var
  RsltStream, TmpStream: TMemoryStream;{$R *.dfm}procedure TServer.FormCreate(Sender: TObject);
begin
  RsltStream := TMemoryStream.Create;
  TmpStream := TMemoryStream.Create;
end;procedure TServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  RsltStream.Free;
  TmpStream.Free;
end;procedure TServer.Button1Click(Sender: TObject);
var
  ReqCode: array[0..29] of char; ReqCodeStr: string;
begin
  ReqCodeStr := 'show' + Edit1.Text;
  StrpCopy(ReqCode, ReqCodeStr);
  TmpStream.Clear;
  RsltStream.Clear;
  SUDP.RemoteHost := Edit2.Text;
  SUDP.SendBuffer(ReqCode, 30);
end;procedure TServer.SUDPDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: string; Port: Integer);
var
  ReqCode: array[0..29] of char; ReqCodeStr: string;
begin
  ReqCodeStr := 'show' + Edit1.text;
  StrpCopy(ReqCode, ReqCodeStr);
  SUDP.ReadStream(TmpStream);
  RsltStream.CopyFrom(TmpStream, NumberBytes);
  if NumberBytes < BufSize then { 数据已读完 }
  begin
    RsltStream.Position := 0;
    Image1.Picture.Bitmap.LoadFromStream(RsltStream);
    TmpStream.Clear;
    RsltStream.Clear;
  end
  else
  begin
    TmpStream.Clear;
    ReqCode := 'show';
    SUDP.RemoteHost := Edit2.Text;
    SUDP.SendBuffer(ReqCode, 30);
  end;
end;procedure TServer.Timer1Timer(Sender: TObject);
begin
  Button1.Click;
end;procedure TServer.Button2Click(Sender: TObject);
begin
  Timer1.Enabled :=true;
end;procedure TServer.Button3Click(Sender: TObject);
begin
  Timer1.Enabled :=false;
end;end.