Recent

Author Topic: Screencapture shows black screen  (Read 217 times)

Darken

  • Newbie
  • Posts: 4
Screencapture shows black screen
« on: July 12, 2019, 05:19:05 pm »
I am trying to make a screencapture application, it saves but a totally black screen is displayed. I am quite new hence i want to ask maybe i am not doing something correctly.

Code be looking like this  :

Code: Pascal  [Select]
  1. unit ScreenCapLib2Unit;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Windows, Forms, Controls, Graphics, Dialogs, LCLType,
  9.   LCLIntf, StdCtrls;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     procedure Button1Click(Sender: TObject);
  18.   private
  19.  
  20.   public
  21.  
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.lfm}
  30.  
  31. { TForm1 }
  32.  
  33. procedure CaptureScreen();
  34. var
  35.   DCDesk: HDC;
  36.   bmp: TBitmap;
  37. begin
  38.      bmp := TBitmap.Create;
  39.      bmp.Height := Screen.Height;
  40.      bmp.Width := Screen.Width;
  41.      DCDesk := GetWindowDC(GetDesktopWindow);
  42.      BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0, SRCCOPY);
  43.      bmp.SaveToFile('C:\Users\******\Desktop\ScreenShot.bmp');
  44.      ReleaseDC(GetDesktopWindow, DCDesk);
  45.      showmessage('Done check Desktop');
  46.      bmp.Free;
  47. end;
  48.  
  49. procedure TForm1.Button1Click(Sender: TObject);
  50. begin
  51.      CaptureScreen();
  52. end;
  53.  
  54. end.
  55.  
  56.  

Why is this so?

howardpc

  • Hero Member
  • *****
  • Posts: 3210
Re: Screencapture shows black screen
« Reply #1 on: July 12, 2019, 05:55:35 pm »
The following works well here:
Code: Pascal  [Select]
  1. uses Graphics, LCLIntf, LCLType;
  2.  
  3. procedure SaveScreenshotToFile(const aFilename: String);
  4. var
  5.   bmp: TBitmap;
  6.   ScreenDC: HDC;
  7. begin
  8.   Assert(aFilename<>'','You must supply a valid file name');
  9.   bmp := TBitmap.Create;
  10.   try
  11.     ScreenDC := GetDC(0);
  12.     bmp.LoadFromDevice(ScreenDC);
  13.     bmp.SaveToFile(aFilename);
  14.   finally
  15.     ReleaseDC(0, ScreenDC);
  16.     bmp.Free;
  17.   end;
  18. end;

Darken

  • Newbie
  • Posts: 4
Re: Screencapture shows black screen
« Reply #2 on: July 12, 2019, 06:06:56 pm »
Well thanks i managed to fix it , i just have one small worry left. It shows the screen mouse as a circle! i want it to draw the main mouse icon.

Code looks like this  :
Code: Pascal  [Select]
  1. unit ScreenCapLib2Unit;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Windows, Forms, Controls, Graphics, Dialogs, LCLType,
  9.   LCLIntf, StdCtrls;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     procedure Button1Click(Sender: TObject);
  18.     procedure FormCreate(Sender: TObject);
  19.   private
  20.  
  21.   public
  22.  
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.lfm}
  31.  
  32. { TForm1 }
  33.  
  34. procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
  35. var
  36.   HCursor : THandle;
  37. begin
  38.   HCursor := GetCursor;
  39.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  40.               HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  41. end;
  42.  
  43. procedure CaptureScreen();
  44. var
  45.   DCDesk: HDC;
  46.   bmp: TBitmap;
  47.   CurPos: TPoint;
  48. begin
  49.      Form1.Hide;
  50.      bmp := TBitmap.Create;
  51.      bmp.Height := Screen.Height;
  52.      bmp.Width := Screen.Width;
  53.       DCDesk := GetDC(0);
  54.       bmp.LoadFromDevice(DCDesk);
  55.      BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0, SRCCOPY);
  56.      GetCursorPos(CurPos);
  57.      DrawCursor(bmp.Canvas, CurPos);
  58.      bmp.SaveToFile('C:\Users\******************\Desktop\ScreenShot.bmp');
  59.      ReleaseDC(GetDesktopWindow, DCDesk);
  60.      showmessage('Done check Desktop');
  61.      bmp.Free;
  62.      Form1.Show;
  63. end;
  64.  
  65. procedure TForm1.Button1Click(Sender: TObject);
  66. begin
  67.      //CaptureScreen();
  68. end;
  69.  
  70. procedure TForm1.FormCreate(Sender: TObject);
  71. begin
  72.            Form1.Hide;
  73.            CaptureScreen();
  74. end;
  75.  
  76. end.
  77.  
  78.  

Attached is the screenshot it shows, dont know why it is so

[image]https://i.postimg.cc/yYksKj6S/Screen-Shot.png[/image]
« Last Edit: July 12, 2019, 06:08:45 pm by Darken »