Solved

Screen Capture

Posted on 2000-02-19
36
418 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
 
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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

757 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now