Solved

Capturing an object or window on screen!

Posted on 2003-11-11
10
718 Views
Last Modified: 2010-04-05
Hi!

I want write a program that user able to capture a window or a object on screen. user must be able to move cursor around screen and then a border apear around object or window that cursur over it!
A Known feature that you can find in almost all capture program like SnagIt(www.techsmith.com), HyperSnap DX (http://www.hyperionics.com), etc!

My Idea was this code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ExtCtrls, StdCtrls, Dialogs, Types, Math, DBCtrls;

type
  TForm1 = class(TForm)
    img: TImage;
    btnStart: TButton;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnStartClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  TickTime: Cardinal;
  hJHook: THandle;
  Hooked: Boolean;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Window, WindowTemp: HWND;
  Rect: TRect;
  WindowText: array [0..1024] of char;
begin
  Window := WindowFromPoint(Point(Mouse.CursorPos.X, Mouse.CursorPos.Y));
  GetWindowRect(Window, Rect);
  GetClassName(Window, WindowText, 1024);

  Window := RealChildWindowFromPoint(Window, Point(Mouse.CursorPos.X - Rect.Left - GetSystemMetrics(SM_CXEDGE) - GetSystemMetrics(SM_CXBORDER) - 1, Mouse.CursorPos.Y - Rect.Top - GetSystemMetrics(SM_CYCAPTION) - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER) - 1));


  GetClassName(Window, WindowText, 1024);
  GetWindowRect(Window, Rect);

  if (Window = Form2.TopPanel.Handle) or (Window = Form2.BottomPanel.Handle) or (Window = Form2.RightPanel.Handle) or (Window = Form2.LeftPanel.Handle) then exit;

  GetWindowRect(Window, Rect);

  Form2.BoundsRect := Rect;
  Form2.Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnhookWindowsHookEx(hJHook);
end;

function JhookProc(Code, wParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
var
  ScreenDC: THandle;
  Bitmap: TBitmap;
  R: TRect;
begin
  // this is the JournalRecordProc, which has a TEVENTMSG with the messages in it}
  Result := CallNextHookEx( hJHook, Code, wParam, Integer(@EventStrut));
  // the CallNextHookEX is not really needed for journal hook since it it not
  // really in a hook chain, but it's standard for a Hook}
  if Code < 0 then exit;
  if Code = HC_ACTION then
  begin
    if (EventStrut.message = WM_LBUTTONDOWN) then
      TickTime := GetTickCount// on the L button down get the tick time}
    else
      // to make sure it is a click and not a drag and drop
      // test the tick time, then Take a Picture
      if (EventStrut.message = WM_LBUTTONUP) and (GetTickCount - TickTime < 400) then
      begin
        Form1.Timer1.Enabled := False;


        GetWindowRect(Form2.Handle, R);
        Application.ProcessMessages;
        ScreenDC := GetDC(0);
        Bitmap := TBitmap.Create;
        Bitmap.Width := R.Right;
        Bitmap.Height := R.Bottom;
        BitBlt(Bitmap.Canvas.Handle, 0, 0, R.Right - R.Left, R.Bottom - R.Top, ScreenDC, R.Left, R.Top, SRCCOPY);
        Form1.Show;
        Form1.img.Picture.Bitmap := Bitmap;

        // this button click Ends the J Hook
        UnhookWindowsHookEx(hJHook);
        Hooked := False;
      end;
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  // this button click starts the J Hook
  if Hooked then
  begin
    MessageBox(0, 'Mouse tracking has already been started', 'No can Restart', MB_OK or MB_ICONQUESTION);
    exit;
  end;
  hJHook := SetWindowsHookEx(WH_JOURNALRECORD , @JhookProc, hInstance, 0);
  if hJHook > 0 then Hooked := True;
  Hide;
  Timer1.Enabled := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  EnumWindows(@EnumWindowsProc, 1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  EnumWindows(@EnumWindowsProc, 0);
end;

end.

-------------------> form2 untis:
unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    TopPanel: TPanel;
    RightPanel: TPanel;
    BottomPanel: TPanel;
    LeftPanel: TPanel;
    Timer1: TTimer;
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure MakeTransparent;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Types;

{$R *.dfm}

procedure TForm2.MakeTransparent;
var
   FormRegion, TempRegion: HRGN;
   i: Integer;
   Rect: TRect;
Begin
     FormRegion := 0;
     for i := 0 to ControlCount - 1 do
     begin
          Rect := Controls[i].BoundsRect;
          OffsetRect(Rect, ClientOrigin.X - Left, ClientOrigin.Y -  Top);
          TempRegion := CreateRectRgnIndirect(Rect);
          if FormRegion = 0 then
             FormRegion := TempRegion
          else
          begin
               CombineRgn(FormRegion, FormRegion, TempRegion, RGN_OR);
               DeleteObject(TempRegion);
          end;
     end;
     DeleteObject(TempRegion);
     SetWindowRgn(Handle, FormRegion, True);
end;

procedure TForm2.FormResize(Sender: TObject);
begin
     MakeTransparent;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
     if TopPanel.Height = 4 then
     begin
          TopPanel.Height := 0;
          BottomPanel.Height := 0;
          LeftPanel.Width := 0;
          RightPanel.Width := 0;
          MakeTransparent;
     end
     else
     begin
          TopPanel.Height := 4;
          BottomPanel.Height := 4;
          LeftPanel.Width := 4;
          RightPanel.Width := 4;
          MakeTransparent;
     end;
end;

end.

---------------> and it's DFM:
object Form2: TForm2
  Left = 204
  Top = 74
  BorderStyle = bsNone
  Caption = 'Form2'
  ClientHeight = 407
  ClientWidth = 430
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object TopPanel: TPanel
    Left = 0
    Top = 0
    Width = 430
    Height = 3
    Align = alTop
    BevelOuter = bvNone
    Color = 8388863
    TabOrder = 0
  end
  object RightPanel: TPanel
    Left = 427
    Top = 3
    Width = 3
    Height = 401
    Align = alRight
    BevelOuter = bvNone
    Color = 8388863
    TabOrder = 1
  end
  object BottomPanel: TPanel
    Left = 0
    Top = 404
    Width = 430
    Height = 3
    Align = alBottom
    BevelOuter = bvNone
    Color = 8388863
    TabOrder = 2
  end
  object LeftPanel: TPanel
    Left = 0
    Top = 3
    Width = 3
    Height = 401
    Align = alLeft
    BevelOuter = bvNone
    Color = 8388863
    TabOrder = 3
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 300
    OnTimer = Timer1Timer
    Left = 8
    Top = 8
  end
end

for testing this program at first click at "Button2"! This button disable all of window currently are avaialable then press Start Capture! When you clicked on your desired window, it captured!
Dont forget to click on Button1 for enable all windoews otherwise you will unable to access to opened windows!

Does anybody can consider the source code and help me?

Thankx
0
Comment
Question by:Mamouri
  • 6
  • 3
10 Comments
 
LVL 3

Expert Comment

by:Bijith
ID: 9730798
Hi

Try this code

Form should conatin following compoants
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    ClientArea: TCheckBox;



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    ClientArea: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure DrawHighLightedRectangle(pInValidatePreRectangle: Boolean; HighLight: Boolean);
    { Private declarations }
  public
    PreWndHandle: HWND;
    CtrlPressed: Boolean;
    StateChanged: Boolean;
    lWnd :HWND;
    PreWindowRect: TRect;
    PrePixColor: COLORREF;
  end;
  function Call_Back_RepaintAll(hand:HWND;Lpa:LPARAM):Bool;stdcall;
var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  lPreWndRect,lPreWndInside: TRect;
  lpt :TPoint;
  lORgn, lWRgn,lIRgn: HRGN;
  lBrush: HBRUSH;
  lDC: HDC;
begin
  GetCursorPos(lpt);
  lWnd := WindowFromPoint(lpt);
  if (lWnd = PreWndHandle) then exit;
  if not ClientArea.Checked then
  begin
    {Here the region to which the Rectangle is prevoiusly drawn is find out and
     Write a rectangle with the color stored before the first rectangle is drawn }
{    lPreWndInside.Top := PreWindowRect.Top + 2;
    lPreWndInside.Left := PreWindowRect.Left + 2;
    lPreWndInside.Right := PreWindowRect.Right - 2;
    lPreWndInside.Bottom := PreWindowRect.Bottom - 2;
    lWRgn := 0;
    lIRgn := CreateRectRgnIndirect(lPreWndInside);
    lDc := GetDC(0);
    lBrush := CreateSolidBrush(PrePixColor);
    Selectobject(ldc,LbRUSH);
    lOrgn := CreateRectRgnIndirect(PreWindowRect);
    lWRgn := CreateRectRgn(0, 0, 0, 0);
    CombineRgn(lWRgn,lOrgn,lIrgn,RGN_XOR);
    FillRgn(lDC,lWrgn,lBrush);
    dELETEoBJECT(LbRUSH);
//    EnumDeskTopWindows(0,@Call_Back_RepaintAll,0);}
    InvalidateRect(0,0,True);
///    InvalidateRect(PreWndHandle,0,True);
  end
  else
    InvalidateRect(PreWndHandle,0,True);
  DrawHighLightedRectangle(False,True);
end;


procedure TForm1.DrawHighLightedRectangle(pInValidatePreRectangle: Boolean;HighLight: Boolean);
var
  lWndRect,lWidthRect :TRect;
  lDC :HDC;
  lBrush: HBrush;
  lpt1,lpt2: TPoint;
begin
  lBrush := CreateSolidBrush(clred);
  Selectobject(ldc,LbRUSH);
  if pInValidatePreRectangle then
  begin
    if not ClientArea.Checked then
    begin
      PreWindowRect.Top := PreWindowRect.Top - 1;
      PreWindowRect.Left := PreWindowRect.Top - 1;
      PreWindowRect.Right := PreWindowRect.Top + 1;
      PreWindowRect.Bottom := PreWindowRect.Top + 1;
      InvalidateRect(0,@PreWindowRect,False)
    end
    else
    begin
      InvalidateRect(PreWndHandle,0,True);
      lWnd := 0;
    end;
  end;
  if ClientArea.Checked then
  begin
    Windows.GetClientRect(lWnd,lWndRect);
    lDC := GetDC(lWnd);
  end
  else
  begin
    Windows.GetWindowRect(lWnd,lWndRect);
    lDC := GetDC(0);
  end;
  PrePixColor := GetPixel(lDC,lWndRect.left,lWndRect.Top);
  FrameRect(lDC,lWndRect,lBrush);
  SetTextColor(lDC,clWhite);
  SetBkColor(lDC,clRed);
  TextOut(lDC,lWndRect.left +5,lWndRect.Top-12,'CTRL + Enter',Length('CTRL + Enter'));
  if HighLight then
  begin
    lWidthRect.Left := lWndRect.Left + 1;
    lWidthRect.Top := lWndRect.Top + 1;
    lWidthRect.Right := lWndRect.Right - 1;
    lWidthRect.Bottom := lWndRect.Bottom - 1;
    FrameRect(lDC,lWidthRect,lBrush);
  end;
  dELETEoBJECT(LbRUSH);
  PreWndHandle := lWnd;
  PreWindowRect := lWndRect;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled := true;
  DrawHighLightedRectangle(False,True);
  Application.Minimize;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := False;
end;

function Call_Back_RepaintAll(hand:HWND;Lpa:LPARAM):Bool;
begin
  Windows.SendMessage(hand,WM_NCPAINT,0,0);
  Windows.SendMessage(hand,WM_ERASEBKGND,0,0);
  Result := true;
end;

end.

Try it and let me know


Cheers
Bijith
0
 
LVL 3

Author Comment

by:Mamouri
ID: 9730902
Hi Bijith!

I tried your code!
It work But it has not different with my own!

I want user can click in any part of screen not clicking "Ctrl+Enter" hot-keys!

In fact I find a solution for this problem last night from one of previous answr of Slick812.

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20628408.html

For solving this problem we need some kind of HOOK that Stick used in that sample

Please his answer can help you for finding better solution!

BTW Thankx for your helps!
Regards
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9741867
Hello Mamouri. . . . .  
What are you trying to do? ?, I can not tell what you want to do with a Left Click? With a HotKey? or what you want to put a "Hilight
 Rectangle" on, A Child Window, The Main Window (Form),

If you could give some more information about WHAT  you want your program to do, I do not have the SnagIt or HyperSnap DX, , so I do not know what they do
0
 
LVL 3

Author Comment

by:Mamouri
ID: 9746063
Hi Slick812!

In fact this is a well known feature that all of screen capture program have!

In my previes question you teach me how set a hook and disable mouse interation for creating a rectangle on screen!

In source code that you see in my question using WindowFromPoint and GetWindowRect funtion I determine window Rectangle that mouse is over it! then I draw a red rectangle over active window!

But when user click on rectangle that program drew, to capture that area from screen , buttons or anything under the mouse cursor in that side of screen click and I dont need that!

In fact a Timer with 100 interval check for WindwoFromPoint and draw a rectangle around the current window. When User click inside this rectable it mean he/she want to capture this area!

But The buttons or any objects that exist in the mouse position press to and work and I dont want it happen!

I think Hook can help for disable mouse interaction in other program!

If you have time download HyperSnap DX (http://www.hyperionics.com) to see this fearure!

And If you consider my source code you can understand what is problem.

I hope you understand my mean.
And sorry for my poor english!

Best Regards
0
 
LVL 33

Accepted Solution

by:
Slick812 earned 250 total points
ID: 9749797
I do not have time to get the  HyperSnap DX and try and set it up and see what it does . . .

In the EE question for your Drawing a rectangle on screen at

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20628408.html

that I answered for you about getting and blocking Mouse Messages. . . This uses a DLL with a mouse hook started by

hMouseHook := SetWindowsHookEx(WH_MOUSE, @mHookProc, GetModuleHandleFromInstance, 0);

And I believe that you would be ALOT BETTER if you did NOT use the Journal hook that you showed in the code above and used a DLL mouse hook

(I am guessing that you are already using this DLL in the program that you showed the code for above)

in the code on that other question, you should have some understanding of what the Mouse Hook function

function mHookProc(Code, wParam: Integer; var MouseStrut: TMOUSEHOOKSTRUCT): Integer; stdcall;

is Doing. and how it blocks the mouse messages if you set the PMapRec1.BlockMouse to 32 in your program, and you test for this "Mouse Block" in the mHookProc with
 if PMapRec1.BlockMouse = 32 then

I am guessing you should set another HotKey so when you press this second HotKey, you will start your screen window area Highlight, and move your window "HighLite" around the screen with your mouse using the same DLL that you already have. .  I am guessing that you do NOT understand what this mouse hook DLL code is doing? And how to change it to block the mouse messages for your "New" operation in this question.
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 33

Expert Comment

by:Slick812
ID: 9749827
Oh, if you block the mouse, then you maybe can just draw on the screen to do your "Highlite" rectangle, instead of Creating a Form with a Region
0
 
LVL 3

Author Comment

by:Mamouri
ID: 9751321
Thankx Slick812
You are correct. understanding DLL Hock is not easy for me! But with your help i will correct my code and use of DLL hock instead of Journal hook and my problem will solve!

Slick, can you change the code in previos question to draw a polygon instead of rectangle:

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20628408.html

In fact I changed the code! it draw a polygon but it have flicker. myself code dont close polygon with double click!
If you have time to change that code for drawing a polygon instead a rectangle help me a lot!

tHANX fROM yOUR kINDNESS aND pATIENT
rEgArDs
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9752907
2: begin
{mouse Move, you need to draw a Focus Rectangle Twice, once to Erase the old Rect and then again in the new
mouse Position}
     if (SmallInt(HIWord(Msg.Wparam)) <> DrawRect1.Right) and (SmallInt(LoWord(Msg.Wparam)) <> DrawRect1.Bottom) then
       begin
       ScreenDC := GetDC(0);
       DrawFocusRect(ScreenDC, DrawRect1);
{you DrawRect1 needs to have lower numbers in the Left and Top, then the Right and Bottom
based on the DrawStart}
       if X >= DrawStart.x then
         begin
         if DrawRect1.Left <> DrawStart.x then
           DrawRect1.Left := DrawStart.x;
         DrawRect1.Right := X
         end else
         begin
         if DrawRect1.Right <> DrawStart.x then
         DrawRect1.Right := DrawStart.x;
         DrawRect1.Left := X;
         end;
       if Y >= DrawStart.y then
         begin
         if DrawRect1.Top <> DrawStart.y then
           DrawRect1.Top := DrawStart.y;
         DrawRect1.Bottom := Y;
         end else
         begin
         if DrawRect1.Bottom <> DrawStart.y then
         DrawRect1.Bottom := DrawStart.y;
         DrawRect1.Top := Y;
         end;
      DrawFocusRect(ScreenDC, DrawRect1);
      ReleaseDC(0, ScreenDC);
      end;
     end;
  end;
  end;

 = = = = = = = = = = = = = = = =  = = = = =

the code above draws a "Focus Rectangle" when you drag the mouse cursor, starting with a Mouse Down and ending with a mouse up. . .

but I do NOT have any Idea of what you want, when you say
"draw a polygon instead of rectangle"

you will need to help me, if you want me to help you. . . a polygon can have as few as THREE sides and as many as a BILLION sides, ,  and can be ANY Shape and ANY size. .  how am I suppose to know wwhat you mean by draw a polygon? ? ? ? ? ? ? ? ? ? ? ? ?  ? ?  ?
This does not mean anything to me, because a I can draw a Triangle (a type of polygon) or a Square (a type of polygon) or a Pentangle (a type of polygon) or a shape like a space ship (a type of polygon) I can draw it so that it covers the entire screen or so small you can barly see it. . .

here is some code to draw a polygon

var
PntArray: Array[0..5] of TPoint;


PntArray[0].x := 278;
PntArray[0].y := 112;
  PntArray[1].x := 220;
  PntArray[1].y := 125;
PntArray[2].x := 220;
PntArray[2].y := 200;
  PntArray[3].x := 280;
  PntArray[3].y := 218;
PntArray[4].x := 336;
PntArray[4].y := 198;
  PntArray[5].x := 336;
  PntArray[5].y := 125;
Polygon(ScreenDC,PntArray, 6);
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9752972
???
???
???
I will guess that the only reason you are asking this, is because you want to do a "Free Hand" Draw on the desktop, where the user holds down the mouse and then moves it to draw a shape of anything that they need on the screen. . . you will need to just draw a single Line with eash mouse move message, from the point of the last mouse move to the point of the new mouse move, not a polygon
0
 
LVL 33

Expert Comment

by:Slick812
ID: 9755033
I have some code that will draw a "Free Hand" drawing on the screen, instead of the Rectangle that the first one drew, , if you want to see it
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

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

24 Experts available now in Live!

Get 1:1 Help Now