Solved

Screen Capture

Posted on 2000-02-19
36
422 Views
Last Modified: 2010-04-04
I need code for capturing the screen and the I need code for capturing the active window and storing it in an image box so when the image is saved, then the format can be decided.  If needs be, the image can be stored as a temporary bitmap so it can be desplayed.

I'll pay double points for good code.

Sorry for the bluntness, I'm new to delphi and VB just isn't working for this project.  It's due very soon!

Help :)
0
Comment
Question by:fibdev
  • 17
  • 16
  • +2
36 Comments
 
LVL 13

Expert Comment

by:Epsylon
ID: 2538910
Here's how to capture the de

procedure TForm1.Button1Click(Sender: TObject);
 var
    DeskTopDC: HDc;
    DeskTopCanvas: TCanvas;
    DeskTopRect: TRect;
 begin
    DeskTopDC := GetWindowDC(GetDeskTopWindow);
    DeskTopCanvas := TCanvas.Create;
    DeskTopCanvas.Handle := DeskTopDC;
    DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);
    Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);
    ReleaseDC(GetDeskTopWindow,DeskTopDC);
end;
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2538916
de = desktop


And to capture the active window:

procedure TForm1.Button1Click(Sender: TObject);
 var
    WndDC: HDc;
    WndCanvas: TCanvas;
    WndRect: TRect;
    Wnd: HWND;
 begin
    Wnd := GetActiveWindow;
    WndDC := GetWindowDC(Wnd);
    WndCanvas := TCanvas.Create;
    WndCanvas.Handle := WndDC;
    WndRect := Rect(0,0,Screen.Width,Screen.Height);
    Canvas.CopyRect(WndRect,WndCanvas,WndRect);
    ReleaseDC(Wnd,WndDC);
end;
0
 
LVL 3

Author Comment

by:fibdev
ID: 2538937
Where is the image data stored?
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
LVL 13

Expert Comment

by:Epsylon
ID: 2539016
Hmmm.... GetActiveWindow does not work. It only looks for the active window in the same thread.

But here's an example of the Desktop-part of your question that stores the image in a TImage:

procedure TForm1.Button1Click(Sender: TObject);
var
  WndDC: HDc;
  WndRect: TRect;
  WndCanvas: TCanvas;
  Wnd: HWND;
  WWidth, WHeight: Integer;
begin
  Wnd := GetDesktopWindow;
  WndDC := GetWindowDC(Wnd);
  WndCanvas := TCanvas.Create;
  WndCanvas.Handle := WndDC;
  GetWindowRect(Wnd, WndRect);

  WWidth := WndRect.Right - WndRect.Left;
  WHeight := WndRect.Bottom - WndRect.Top;
  Label1.Caption := IntToStr(WWidth);
  Label2.Caption := IntToStr(WHeight);

  Image1.Width := WWidth;
  Image1.Height := WHeight;
  Image1.Canvas.CopyRect(Rect(0, 0, WWidth, WHeight), WndCanvas, WndRect);
  WndCanvas.Free;
  ReleaseDC(Wnd,WndDC);
end;
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2539029
Another thing you can do is using the clipboard. To capture the whole desktop press PrtSc (Print Screen next to F12). To capture the active window press Alt-PrtSc. Then use this code to fetch the image from the clipboard:


uses Clipbrd;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Image1.AutoSize := true;
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Image1.Picture.Assign(Clipboard);
    Image1.Picture.SaveToFile('image.bmp');
  end
  else
    ShowMessage('No image data on clipboard');
end;


Regards,

Epsylon
0
 
LVL 3

Author Comment

by:fibdev
ID: 2539208
Is there a way to code my app to copy the active window to the clipboard?
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2539265
Use this to capture the entire screen:

    keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_EXTENDEDKEY or 0, 0);
    keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0 );


and this to capture a window:


    keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
    keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0 );
0
 
LVL 3

Expert Comment

by:bryan7
ID: 2539316
listenning
0
 
LVL 3

Author Comment

by:fibdev
ID: 2539695
[Error] uScreenShooter.pas(174): Undeclared identifier: 'Clipboard'
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2539705
Put Clipbrd in the uses clause.
0
 
LVL 3

Author Comment

by:fibdev
ID: 2539729
Epsylon,

Your code works, however, When I tried to shoot the active window a second time, I'm presented with the image data from the first shot.  Is there a way to clear the image data from the clipboard when I'm done with it?

Great job so far, you're a big help.  I'll make the points worth your time.
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2539790
You can clear the clipboard with

  Clipboard.Clear;

But that won't be enough to solve this problem. The point is that your program has to wait until the clipboard has been updated. See below for a complete example:



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Clipbrd;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure ClipboardChanged(var message: TMessage); message WM_DRAWCLIPBOARD;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_EXTENDEDKEY or 0, 0);
  keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0 );
end;

procedure TForm1.ClipboardChanged(var message: TMessage);
begin
  if Clipboard.HasFormat(CF_BITMAP) then
    Image1.Picture.Assign(Clipboard);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.AutoSize := true;
  SetClipboardViewer(Form1.Handle);
end;

end.
0
 
LVL 3

Author Comment

by:fibdev
ID: 2539836
Adjusted points to 200
0
 
LVL 3

Author Comment

by:fibdev
ID: 2539838
Epsylon,

For some reason or another this isn't working:

if Clipboard.HasFormat(CF_BITMAP) then
  Image1.Picture.Assign(Clipboard);
  form1.visible := true;
end;

It gets as far as form1.visible := true;
but it never puts the graphic into image1
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2539946
Just one hint: Instead of GetActiveWindow you should use GetForegroundWindow...
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2539950
if Clipboard.HasFormat(CF_BITMAP) then
begin   // <---- don't forget
  Image1.Picture.Assign(Clipboard);
  form1.visible := true;
end;

0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2539956
Hi Madshi, I couldn't remember that one. Thanks!
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2540018
This should be it then:

procedure TForm1.Button2Click(Sender: TObject);
var
  WndDC: HDc;
  WndRect: TRect;
  WndCanvas: TCanvas;
  Wnd: HWND;
  WWidth, WHeight: Integer;
begin
  Sleep(3000); // 3 secs to make another window active
  Wnd := GetForegroundWindow; // or GetDesktopWindow to capture the desktop
  WndDC := GetWindowDC(Wnd);
  WndCanvas := TCanvas.Create;
  WndCanvas.Handle := WndDC;
  GetWindowRect(Wnd, WndRect);

  WWidth := WndRect.Right - WndRect.Left;
  WHeight := WndRect.Bottom - WndRect.Top;

  Image1.Width := WWidth;
  Image1.Height := WHeight;
  Image1.Canvas.CopyRect(Rect(0, 0, WWidth, WHeight), WndCanvas, Rect(0, 0, WWidth, WHeight));
  WndCanvas.Free;
  ReleaseDC(Wnd,WndDC);
end;
0
 
LVL 3

Author Comment

by:fibdev
ID: 2540043
Still no image :(
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2540165
Does this work?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Clipbrd;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Wnd: HWND;
    procedure ClipboardChanged(var message: TMessage); message WM_DRAWCLIPBOARD;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Clipboard.Clear;
  Wnd := SetClipboardViewer(Form1.Handle);
  keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_EXTENDEDKEY or 0, 0);
  keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0 );
end;

procedure TForm1.ClipboardChanged(var message: TMessage);
begin
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Image1.Picture.Assign(Clipboard);
    ChangeClipboardChain(Form1.Handle, Wnd);
  end;
end;

end.
0
 
LVL 3

Author Comment

by:fibdev
ID: 2540343
Access Violation at this point:
Wnd := SetClipboardViewer(Form1.Handle);
0
 
LVL 3

Author Comment

by:fibdev
ID: 2540471
Causes Access Violation:

Wnd := SetClipboardViewer(Form1.Handle);
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2540611
Strange, it works perfectly here. And you have been using 'SetClipboardViewer' before...
0
 
LVL 3

Author Comment

by:fibdev
ID: 2540701
I don't understand it :(

Now It won't even capture the desktop and it was before.

I'm going to scrap the whole thing and start a new project.
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2540758
How about going back to the last 'GetForegroundWindow/GetWindowDC' example..?

I've uploaded my demo (both versions) on

http://www3.ewebcity.com/joep/capture.zip

Please try it or show/mail me what you have right now.

epsylon3@hotmail.com
0
 
LVL 3

Author Comment

by:fibdev
ID: 2540768
I got it back to where it was.  I can shoot the desktop again.  I'll download your examples and look at them.  I don't know if this makes a diference, but  I'm using Delphi 5.

0
 
LVL 3

Author Comment

by:fibdev
ID: 2540772
hmmm,

Can't open it.

I'll send you mine.
0
 
LVL 13

Accepted Solution

by:
Epsylon earned 230 total points
ID: 2540778
What Delphi version do you have?
0
 
LVL 3

Expert Comment

by:gandalf_the_white
ID: 2542454
listening...
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2542765
Gandalf, did you try my demo at

http://www3.ewebcity.com/joep/capture.zip 

and can you get it to work?
0
 
LVL 3

Author Comment

by:fibdev
ID: 2544051
I tried your demo,  Couldn't load it. I'm looking at the one you sent me in the email.
0
 
LVL 3

Author Comment

by:fibdev
ID: 2544112
Thanks for all your help Epsylon
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2561852
0
 
LVL 3

Author Comment

by:fibdev
ID: 2561961
Epsylon,

mind if i send you an email?  I've ran into a bug.  That code you gave me won't release the canvas.  If I shoot a window, I can't shoot a window any larger because the whole image won't appear.  It won't size to fit the new, larger image.  I've tried to work around this, but I can't figure it out.

fibdev
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 2562019
Make sure that:

  Image1.AutoSize := true;


and change:

  Image1.Width := WWidth;
  Image1.Height := WHeight;

to

  Image1.Picture.Bitmap.Width := WWidth;
  Image1.Picture.Bitmap.Height := WHeight;

0
 
LVL 3

Author Comment

by:fibdev
ID: 2562040
Thanks Epsylon,

That did the trick!
0

Featured Post

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Internet Explorer View Settings Question 15 116
Downloading email attachments 2 79
Breakpoint doesn't stop in my variable 3 30
Delphi: sending SMS on android platform 1 34
A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question