谁有delphi写的抓屏软件源代码(200分)

您查询
抓屏 或 屏幕

有结果的！ ：）

http://www.delphibbs.com/delphibbs/dispq.asp?lid=118066
http://www.delphibbs.com/delphibbs/dispq.asp?lid=483853

....
多啦

9494 旧资料中有不少源码
或你可以到我的网站下载浏览包:
http://dbs.myrice.com/zip/dfw.chm

提问前检索前贴，可节约分，当然，如果老大分多气粗的话，那就不用了[]

给分吧.老兄.呵呵,正穷着了.

///vclient

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, NMUDP;

type
Tclient = class(TForm)
CUDP: TNMUDP;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: string; Port: Integer);
private
{ Private declarations }
public
procedure ScreenCap(LeftPos, TopPos, RightPos, BottomPos: integer);
{ Public declarations }
end;

var
client: Tclient;
BmpStream: TMemoryStream;
LeftSize: Longint;

implementation
const
BufSize = 2048;
{$R *.dfm}

procedure Tclient.FormCreate(Sender: TObject);
begin
BmpStream := TMemoryStream.Create;

end;

procedure Tclient.FormDestroy(Sender: TObject);
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.

///////////vserver
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, NMUDP, StdCtrls, Buttons, ExtCtrls;

type
Tserver = class(TForm)
SUDP: TNMUDP;
Image1: TImage;
BitBtn1: TBitBtn;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure SUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: string; Port: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
server: Tserver;
RsltStream, TmpStream: TMemoryStream;
implementation
const
BufSize = 2048;

{$R *.dfm}

procedure Tserver.FormCreate(Sender: TObject);
begin
RsltStream := TMemoryStream.Create;
TmpStream := TMemoryStream.Create;
end;

procedure Tserver.FormDestroy(Sender: TObject);
begin
RsltStream.Free;
TmpStream.Free;

end;

procedure Tserver.BitBtn1Click(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;
RsltStream.SaveToFile(extractfilepath(application.ExeName)+'tset.bmp');
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;

end.

用我这个
Fullscreen := TBitmap.Create; //创建一个BITMAP来存放图象
Fullscreen.Width := screen.width;
Fullscreen.Height := screen.Height;
DC := GetDC (0); //取得屏幕的 DC，参数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));
//把整个屏幕复制到BITMAP中
FullscreenCanvas.Free; //释放CANVAS对象
ReleaseDC (0, DC);

GetWindowsDirectory(SysDir,255);
Path:=SysDir+'/Desktop/';
fullscreen.SaveToFile(Path+'Good.bmp');
fullscreen.free;

厉害厉害。。。[]

接受答案了.