Advertisement
Guest User

Untitled

a guest
Mar 21st, 2019
83
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.53 KB | None | 0 0
  1. unit ScreenCapClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8. Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ssockets ,windows;
  9.  
  10. type
  11.  
  12. { TForm1 }
  13.  
  14. TForm1 = class(TForm)
  15. Button1: TButton;
  16. procedure Button1Click(Sender: TObject);
  17. private
  18. FAbort: Boolean;
  19. public
  20.  
  21. end;
  22.  
  23. var
  24. Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
  33. var
  34. HCursor : THandle;
  35. begin
  36. HCursor := GetCursor;
  37. DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  38. HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  39. end;
  40.  
  41. function CaptureWindow(const WindowHandle: HWnd): Graphics.TBitmap;
  42. var
  43. DC: HDC;
  44. wRect: TRect;
  45. CurPos: TPoint;
  46. begin
  47. DC := GetWindowDC(WindowHandle);
  48. Result := Graphics.TBitmap.Create;
  49. Result.PixelFormat := pf32bit;
  50. try
  51. GetWindowRect(WindowHandle, wRect);
  52. Result.Width := wRect.Right - wRect.Left;
  53. Result.Height := wRect.Bottom - wRect.Top;
  54. BitBlt(Result.Canvas.Handle,
  55. 0,
  56. 0,
  57. Result.Width,
  58. Result.Height,
  59. DC,
  60. 0,
  61. 0,
  62. SRCCOPY);
  63. GetCursorPos(CurPos);
  64. DrawCursor(Result.Canvas, CurPos);
  65. finally
  66. ReleaseDC(WindowHandle, DC);
  67. end;
  68. end;
  69.  
  70. procedure DoCapture;
  71. var
  72. Socket: TInetSocket;
  73. Bmp: Graphics.TBitmap;
  74. FAbort: Boolean;
  75. begin
  76. { Create the socket now and free it only when you're done with it}
  77. Socket:= TInetSocket.Create('loopback',4800);
  78. try
  79. { You need some "scape". Infinite loops are ... bad }
  80. while (not FAbort) and (not Application.Terminated) do begin
  81. Bmp := CaptureWindow(GetDesktopWindow);
  82. try
  83. Bmp.Canvas.Changed;
  84. Socket.Write(Bmp,1000553);
  85. finally
  86. {If you don't do this, you'll consume all the memory}
  87. Bmp.Free;
  88. end;
  89. Application.ProcessMessages;
  90. end;
  91. finally
  92. Socket.Free;
  93. end;
  94. end;
  95.  
  96. procedure TForm1.Button1Click(Sender: TObject);
  97. begin
  98. if Assigned(Sender) and Sender.InheritsFrom(TControl) then begin
  99. { Use the button to start/stop capture,
  100. using the button's Tag as a flag to know in which mode we are. }
  101. if (Sender as TControl).Tag < 0 then begin
  102. FAbort := True;
  103. (Sender as TControl).Caption := '&Start capture';
  104. (Sender as TControl).Tag := 0;
  105. end else begin
  106. FAbort := False;
  107. (Sender as TControl).Caption := '&Stop capture';
  108. (Sender as TControl).Tag := -1;
  109. end;
  110. DoCapture;
  111. end;
  112. end;
  113.  
  114. end.
  115.  
  116. unit screenShowClassEx;
  117.  
  118. {$mode objfpc}{$H+}
  119.  
  120. interface
  121.  
  122. uses
  123. Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  124. windows, ssockets;
  125.  
  126. type
  127.  
  128. { TMyServer }
  129.  
  130. TMyServer=class(TInetServer)
  131. public
  132. end;
  133.  
  134. { TMyServer }
  135.  
  136. { TForm1 }
  137.  
  138. TForm1 = class(TForm)
  139. Button1: TButton;
  140. Image1: TImage;
  141. procedure Button1Click(Sender: TObject);
  142. procedure FormCreate(Sender: TObject);
  143. private
  144.  
  145. public
  146.  
  147. end;
  148.  
  149. var
  150. Form1: TForm1;
  151.  
  152. implementation
  153.  
  154. {$R *.lfm}
  155.  
  156. procedure receiveImage();
  157. var
  158. Server: TInetServer;
  159. Bmp: Graphics.TBitmap;
  160. JpegImage: TJpegImage;
  161.  
  162. begin
  163. Server := TMyServer.Create('loopback', 4800);
  164. showmessage('ok i am receiving now');
  165. while true do
  166. begin
  167. Server.StartAccepting;
  168. // show image on imagebox where Image1 :Timage
  169. JpegImage.Assign(Bmp);
  170. Form1.Image1.Canvas.Draw(0,0,JpegImage);
  171. end;
  172. end;
  173.  
  174. { TForm1 }
  175.  
  176. procedure TForm1.Button1Click(Sender: TObject);
  177. begin
  178. receiveImage();
  179. end;
  180.  
  181. procedure TForm1.FormCreate(Sender: TObject);
  182. begin
  183.  
  184. end;
  185. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement