哪位大侠知道服务程序模式下的抓图方法 ？(100分)

Mybmp := Tbitmap.Create;
Mycan := TCanvas.Create; //屏幕截取
dc := GetwindowDC(0);
try
Mycan.Handle := dc;
cx := GetSystemMetrics(SM_CXSCREEN);
cy := GetSystemMetrics(SM_CYSCREEN);
R := Rect(0, 0, cx, cy);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.PixelFormat := FPixFmt;
//BitBlt(Mybmp.Canvas.Handle, 0, 0, cx, cy, Mycan.Handle, 0, 0, SRCCOPY);
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;

这是一段抓屏代码， 在普通模式下工作的蛮正常的， 但是我现在要做成服务程序，在服务模式下， 抓出来的是一幅空白的位图。 哪位大侠知道服务程序模式下的抓图方法 ？？

我现在也遇到这个问题。高手们有什么解决办法吗？

经过测试，使用TextOut，可以显示到图片上，别的就一片空白了。
fbitmap.Canvas.TextOut(10,30,name+' '+formatdatetime('yyyy-mm-dd hh:nn',now));

问题已经处理了。只需要
回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以抓到图了。

to dangde:
你的那個在普通環境下。也不正常阿。FPixFmt這個對象。你還沒對它進行操作呢。。能提供完整的嗎？效果是跟QQ的截圖一樣嗎？

sxdthonda大哥。。能提供完整的嗎？整理份完整的出來嗎？剛好想把截圖加到我聊天上去。。幫幫忙吧。。讓我學習學習。。好嗎？

问题已经解决，就是打开桌面的交互模式

将（Snapscreen窗体的）Interactive设置为True。

program udpdll;

uses
SvcMgr,
udpservers in 'udpservers.pas' {snapscreen: TService};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(Tsnapscreen, snapscreen);
Application.Run;
end.

unit udpservers;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient, ExtCtrls,jpeg,forms;

type
Tsnapscreen = class(TService)
Timer1: TTimer;
IdUDPClient1: TIdUDPClient;
procedure ServiceCreate(Sender: TObject);
procedure ServiceDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
snapscreen: Tsnapscreen;
FStream : TMemoryStream;

implementation

const bufsize=4096-1;

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
snapscreen.Controller(CtrlCode);
end;

function Tsnapscreen.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure Tsnapscreen.ServiceCreate(Sender: TObject);
begin
Timer1.Interval:=60000;
FStream:=TMemoryStream.Create;
IdUdpClient1.Host:='172.16.88.3';
IdUdpClient1.Port:=9090;
end;

procedure Tsnapscreen.ServiceDestroy(Sender: TObject);
begin
FStream.Free;
end;

procedure Tsnapscreen.Timer1Timer(Sender: TObject);
var
receivedstring,filename:string;
dc:hdc;
fjpeg:tjpegimage;
fscreencanvas:tcanvas;
fbitmap:Tbitmap;
buf:array[0..bufsize] of char;
sendlen:integer;
intoffset:int64;
sRect,Drect:TRect;
namechar;
len:dword;
begin
try
filename:=formatdatetime('yyyymmddhhnnsszzz',now);
idudpclient1.Send('send'+filename);
receivedstring:=idudpclient1.ReceiveString();
if uppercase(receivedstring)='OK' then
begin
dc:=getdc(0);
fScreencanvas:=Tcanvas.Create;
Fscreencanvas.Handle:=dc;
fbitmap:=tbitmap.Create;
fbitmap.Width:=screen.Width;
fbitmap.Height:=screen.Height;
sRect:=Rect(0,0,screen.Width,screen.Height);
dRect:=Rect(0,0,screen.Width,screen.Height);
fbitmap.Canvas.CopyRect(sRect,fscreencanvas,dRect);
fbitmap.Canvas.Brush.Style:=bsClear;
fbitmap.Canvas.Font.Color:=clRed;
fbitmap.Canvas.Font.Size:=30;
getmem(name,30);
len:=30;
getcomputername(name,len);
fbitmap.Canvas.TextOut(10,30,name+' '+formatdatetime('yyyy-mm-dd hh:nn',now));
freemem(name);
fjpeg:=Tjpegimage.Create;
fjpeg.Assign(fbitmap);
fjpeg.CompressionQuality:=8;
fjpeg.SaveToStream(fstream);
fstream.Position:=0;
intoffset:=0;
while true do
begin
if intoffset>=fstream.Size then break;
fstream.Position:=intoffset;
sendlen:=fstream.Read(buf,sizeof(buf));
idudpclient1.SendBuffer(buf,sendlen);
application.ProcessMessages;
intoffset:=intoffset+sendlen;
end;
end;
releasedc(0,dc);
fbitmap.Free;
fjpeg.Free;
fstream.Clear;
idudpclient1.Send('end');
except
end;
end;

end.

将接收端也传上来吧。不过程序还没完全写完。下一步还要增加的功能是：
一、检查磁盘是否已满，如磁盘快满将清除最前面的数据；
二、文件现在只是分IP存放，有时间还想在IP目录下增加一个日期目录，将抓到的图分日期存放，这样删除时也方便。

如果大家还有什么其它更好的建议，欢迎一起讨论。


unit serverUnit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPServer, StdCtrls,IdSocketHandle, IdThreadMgr,
IdThreadMgrDefault;

type
Tfrmserver = class(TForm)
Button1: TButton;
IdUDPServer1: TIdUDPServer;
IdAntiFreeze1: TIdAntiFreeze;
Button2: TButton;
IdThreadMgrDefault1: TIdThreadMgrDefault;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmserver: Tfrmserver;
mem : Tfilestream;

implementation

{$R *.dfm}

procedure Tfrmserver.Button1Click(Sender: TObject);
begin
idudpserver1.DefaultPort:=9090;
idudpserver1.Active:=true;
end;

procedure Tfrmserver.Button2Click(Sender: TObject);
begin
idudpserver1.Active:=false;
end;

procedure Tfrmserver.FormDestroy(Sender: TObject);
begin
idudpserver1.Active:=false;
if mem<>nil then mem.Free;
mem:=nil;
end;

procedure Tfrmserver.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
var
str,dirname,filename:string;
begin
try
if not directoryexists('d&quot;/temp') then createdir('d:/temp');
adata.Seek(0,0);
setlength(str,adata.size);
adata.Read(str[1],adata.Size);
if uppercase(str)='END' then
if mem<>nil then begin mem.free;mem:=nil;exit; end;
if pos('SEND',uppercase(str))>0 then
begin
filename:=str;
delete(filename,1,length('SEND'));
dirname:=filename;
delete(dirname,9,9);
if not directoryexists('d:/temp/'+abinding.PeerIP) then createdir('d:/temp/'+abinding.PeerIP);
filename:='d:/temp/'+abinding.PeerIP+'/'+filename+'.jpg';
if fileexists(filename) then deletefile(filename);
str:='OK';
Abinding.SendTo(abinding.PeerIP,abinding.PeerPort,str[1],length(str));
if mem<>nil then
begin
mem.free;
mem:=nil;
end;
if not fileexists(filename) then
mem:=TFilestream.Create(filename,fmopenreadwrite or fmcreate)
else
mem:=TFilestream.Create(filename,fmopenreadwrite);
end
else
if uppercase(str)<>'END' THEN
begin
if mem<>nil then
begin
adata.Seek(0,0);
mem.CopyFrom(adata,adata.Size);
end;
end;
except

end;
end;

procedure Tfrmserver.FormCreate(Sender: TObject);
begin
try
if not directoryexists('d:/temp') then createdir('d:/temp');
except
application.MessageBox('应用程序创建目录时出错，程序将退出运行！！！','警告');
application.Terminate;
end;
end;

end.