Solved

Screen Capture

Posted on 2000-02-19
36
421 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
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

 
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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Suggested Solutions

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

803 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