هذا يعمل على دلفي 7 لكن على xe2 لا يعمل هل نستيطع التعديل عليه ليعمل على اكس اي 2
كود :
private
Reciving: boolean;
DataSize: integer;
Data: TMemoryStream;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap) ;
var
w,h : integer;
DC : HDC;
hWin : Cardinal;
r : TRect;
begin
if activeWindow then
begin
hWin := GetForegroundWindow;
dc := GetWindowDC(hWin);
GetWindowRect(hWin,r);
w := r.Right - r.Left;
h := r.Bottom - r.Top;
end
else
begin
hWin := GetDesktopWindow;
dc := GetDC(hWin);
w := GetDeviceCaps (DC, HORZRES);
h := GetDeviceCaps (DC, VERTRES);
end;
try
destBitmap.Width := 160;//w;
destBitmap.Height := 160;//h;
BitBlt(destBitmap.Canvas.Handle,
0,
0,
destBitmap.Width,
destBitmap.Height,
DC,
0,
0,
SRCCOPY) ;
finally
ReleaseDC(hWin, DC) ;
end;
end;
procedure TForm1.TakeShot(activeWindow : boolean);
var
b:TBitmap;
begin
b := TBitmap.Create;
try
ScreenShot(activeWindow, b);
Image1.Picture.Bitmap.Assign(b);
finally
b.FreeImage;
FreeAndNil(b);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Active:= true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ms: TMemoryStream;
var DCDesk: HDC; // hDC of Desktop
begin
TakeShot(false);
sleep(6);
ms:= TMemoryStream.Create;
try
Image1.Picture.Graphic.SaveToStream(ms);
ms.Position:= 0;
serversocket1.Socket.Connections[0].SendText(IntToStr(ms.Size) + #0);
// Send it (the socket owns the stream from now on).
serversocket1.Socket.Connections[0].SendStream(ms);
except
ms.Free;
ReleaseDC(GetDesktopWindow, DCDesk);
end;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s, sl: string;
begin
s:= Socket.ReceiveText;
// If we're not in recieve mode:
if not Reciving then
begin
// Now we need to get the length of the data stream.
SetLength(sl, StrLen(PChar(s))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(s), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
// Delete the size information from the data.
Delete(s, 1, Length(sl));
Reciving:= true;
end;
// Store the data to the file, until we've received all the data.
try
Data.Write(s[1], length(s));
if Data.Size = DataSize then
begin
Data.Position:= 0;
advpicture1.Picture.LoadFromStream(Data);
Data.Free;
Reciving:= false;
// Socket.Close;
end;
except
Data.Free;
end;
end;
السلام عليكم
الكود يعمل على XE2 يكفي إضافة مكونات الSockets على IDE للإضافة : إذهب إلى Component | Install Packages | Add (/bin/dclsockets160.bpl).
مرفق الكود الذي وضعته مع بعض التعديل
كود :
advpicture1.Picture.LoadFromStream(Data);
وضعتها
كود :
Image1.Picture.Graphic.LoadFromStream(Data);
ممكن لك التحقق منها لاحقا
أدبني الدهر فأراني نقص عقلي وإذا ما ازددت علما زادني علما بجهلي
اخي الكريم انا منصب المكونات واستعملها في المشروع استعمل نسخة xe2
لكن هذا الكود يعمل على دلفي 7 لكن على نسخة xe2 لا يعمل
انا اريــده ان يعمل على نسخة xe2
