Solved

Capturing an object or window on screen!

Posted on 2003-11-11
10
756 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 34

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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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 34

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
 
LVL 34

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 34

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 34

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 34

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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
DBGrid or StringGrid ? 6 136
PHP preg_replace code convert to Delphi 14 98
Delphi: making a BW image transparent 10 137
Get weeknumber and year from date 4 56
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
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…
Finding and deleting duplicate (picture) files can be a time consuming task. My wife and I, our three kids and their families all share one dilemma: Managing our pictures. Between desktops, laptops, phones, tablets, and cameras; over the last decade…

739 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