Selecting an area of the screen (outside my window)

Ok,

I'll pay 100 pts for this answer so don't let the 20 fool you.

I've created a screen capture utility, nice little program ... but I've been asked to add the ability to select an area of the screen to be captured in stead of the entire desktop.  I've already added the ability to shoot the active window so this isn't what I'm looking for, just to clear that up ahead of time.

If I need a special control or I can do this with just good ol' fashion code please let me know.

Thank you for your effort ahead of time.
LVL 3
fibdevAsked:
Who is Participating?
 
DrDelphiConnect With a Mentor Commented:
Fibdev,
   why don't we carry this on via email? This is getting a little beyond the scope of your original question and I am positive that the other folks in this loop aren't all that interested, unless of course they have downloaded the control as well.

-DrDelphi
0
 
BegliCommented:
Listening...
0
 
rene100Commented:
why don't you just capture the whole screen and then cut the desired area out of it?

regards
rene
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
jeurkCommented:
hello,
If nobody answers that question.
I'll bring you my unit on monday.
It let's you select the part of the screen you want to catch. It's not hard
to do.
Basically you use the fonction drawfocusrect and the capture of the mouse.

And, what is your technique about the 20 points that are 100 in reality. If you have the 100 and want to spend them on that question, you should give them immediately, because I suppose that some people would rather answer a 100 points questions instead of a 20 points question...
CU
0
 
fibdevAuthor Commented:
jeurk,

I use the 20 - 100 technique in cases where nobody can answer the question.  I've been doing this since before you could have a question deleted, and since I'm not to keen on the whole deleting questions thing, I still use this method ... kinda' a habit I guess.

:)
0
 
DrDelphiCommented:
You could downl;oad my TScreenGrab component from www.drdelphi.com OR

procedure TForm1.Button1Click(Sender: TObject);
begin
grabdesktoprect(rect(0,0,100,100),'C:\windows\desktop\test.bmp');
end;

function TForm1.GrabDesktopRect(rect: Trect; Fname: string): Boolean;
var tempbmp:Tbitmap;
    tempcanvas:Tcanvas;
begin
    tempbmp:=TBitmap.create;
    with tempbmp do
    begin
      height:=rect.bottom-rect.top;
      width:=rect.right-rect.left;
    end;
    tempcanvas:=TCanvas.create;
    TempCanvas.handle:= GetWindowDc(GetDeskTopwindow);
    tempbmp.Canvas.CopyRect(rect,tempcanvas,rect);
    tempbmp.savetofile(fname);
    tempbmp.Free;
    TempCanvas.free;
end;

end.


Your choice.

Good luck!!

0
 
fibdevAuthor Commented:
how much does TScreengrab cost?
0
 
DrDelphiCommented:
nothing! (no source however and it supports only BMP and WMF formats... for Jpg and source, drop me an email).
0
 
fibdevAuthor Commented:
Bitmap is okay, but I want to save the captured area to memory in an imagebox instead of a file or the clipboard, if that's possible.  I can convert it to jpg if it's in memory as a bitmap.
0
 
GwenaCommented:
listening :-)
0
 
GwenaCommented:
listening :-)
0
 
fibdevAuthor Commented:
All these people listening ... looks like I'm paying for other peoples questions ...

:)

All of you owe me!  You better start asking some questions I need answers to!
0
 
DrDelphiCommented:
Not a problem.... TScreenGrab will save to the clipboard as well.... just use '*.*' for the filename. I think of *everything* <g>

Good luck!!
0
 
fibdevAuthor Commented:
Well ...

I tryed installing the setup package for tScreenGrab, but it keeps saying files are missing.  The strange thing is, I see them in the included statement, so, go figure?
0
 
DrDelphiCommented:
Did you follow the installation instructions? All you really need are the DCU files. The BPL, et al are there to make your life easier, but you can simply add the DCU to a new package if you find that easier. It works, really.

-DrDelphi
0
 
fibdevAuthor Commented:
Ok DrDelphi,

Treat me like the amature that I am and give me detailed instructions to install this thing please.

Tell me what to click from beginning to end because I am having real problems with this :(
0
 
fibdevAuthor Commented:
jeurk,

I'd still like to see that unit :)
0
 
DrDelphiCommented:
Okay.... first off, you need to unzip the archive (of course) into a directory located on the Delphi search path. I'd suggest BIN or LIB, but that's up to you. Next, go to Component/Install Packages. Select ADD, find the BPL file from the archive you just unzipped, close and code! If for some reason this doesn't work for you, then add the ScreenGrab to a new package with Rebuild as needed set to false.

Good luck!!

0
 
jeurkCommented:
Yup, I forgot the stuff, and here in france, monday is not a working day.
I promiss you'll get it tommorow.
You'll get 3 units, one that let's you select an area on the desktop, one that let's you grab a window you click on the screen, and the last that grabs a bitmap of a given size.I also had a nice app sample but can't put my paws on it...
CU
0
 
fibdevAuthor Commented:
DrDelphi,

Could you now give me an example on how to use the screengrab?

Say for example:

You click a button ...
select the area of the screen ...
and assign the clipboard contents to image1 (as a bitmap)

You help is very appreciated!
0
 
fibdevAuthor Commented:
If possible, I would like to have the area of the screen selected, then click inside the area to assign it to Image1.

This way you would be able to redraw the area if you made a mistake.  I'll be sure to give you your due recognision for your help in the about box (and a link to your site :)
0
 
DrDelphiCommented:
fibdev,

 procedure Button1Click(sender:Tobject);
 begin
  ScreenGrab1.GrabMouse('*.*');
 end;


That's it!

-DrDelphi
0
 
DrDelphiCommented:
Sorry, I didn't see the se cond question at first. Save to clipboard and assign to a Timage:


procedure TForm1.BitBtn1Click(Sender: TObject);
var clip:TClipboard;
begin
 screengrab1.GrabMouse('*.*');
 clip:=Tclipboard.Create;
 image1.picture.bitmap.handle:=Clip.GetAsHandle(Cf_Bitmap);
 Clip.Free;
  end;

end.


Good luck!!
0
 
DrDelphiCommented:
Sorry, I didn't see the se cond question at first. Save to clipboard and assign to a Timage:


procedure TForm1.BitBtn1Click(Sender: TObject);
var clip:TClipboard;
begin
 screengrab1.GrabMouse('*.*');
 clip:=Tclipboard.Create;
 image1.picture.bitmap.handle:=Clip.GetAsHandle(Cf_Bitmap);
 Clip.Free;
  end;

end.


Good luck!!
0
 
DrDelphiCommented:
Sorry, I didn't see the se cond question at first. Save to clipboard and assign to a Timage:


procedure TForm1.BitBtn1Click(Sender: TObject);
var clip:TClipboard;
begin
 screengrab1.GrabMouse('*.*');
 clip:=Tclipboard.Create;
 image1.picture.bitmap.handle:=Clip.GetAsHandle(Cf_Bitmap);
 Clip.Free;
  end;

end.


Good luck!!
0
 
DrDelphiCommented:
Whoops! Looks like I stuttered a bit there...
0
 
fibdevAuthor Commented:
TClipboard  Undeclaired Identifier?

I told you I was an amature :)

DrDelphi,

We are so close here.  I can safely say the points are yours, please just help me through this :)

I'm trying to hide the form before the call for ScreenGrab1.GrabMouse('*.*');  but when I do this, the pointer does not change to the crosshair, how do I force this?

Thank you so much!
0
 
DrDelphiCommented:
Include Clipbrd in your Uses section for the clipboard... my fault, I should have told you that. As for the other...
it seems to be a timing issue. I was able to move the ScreenGrab method over to the form's OnHide event and it works perfectly. Using it in the Button Click event however, seems not to. The ScreenGrab works, but as you noted, the cursor does not appear. There may or may not be something there that I need to fix.
0
 
fibdevAuthor Commented:
can I use some call to just change the mousepointer before I hide the form?
0
 
DrDelphiCommented:
I'll have to look into for you.... I change the cursor by default with the GrabMouse method, so I have control of it for the life of the method. You probably won't be able to do too much with it without some code modification in the component.


-DrDelphi
0
 
fibdevAuthor Commented:
Hey Doc,

I got around the problem with the pointer by placing all the calls to the screengrab into a timer.  It works great, just the way I want it to, except one thing ...

Now when the pointer turns into the crosshair, I get a dragbox from the far left of the screen, down about 50 pixels and over to where the pointer is?

Have you seen this bug before and do you know a way around it?

Gabe
0
 
DrDelphiCommented:
again, you have a timing issue....
0
 
fibdevAuthor Commented:
Doc,

The before mentioned problem with the selection box occures only when the pointer drops below the half-way mark on the screen?  could a setting be causing this?

I guess what these are:

CAP_LEFT
CAP_TOP

but what are these?

CAP_HEIGHT
CAP_WIDTH

0
 
fibdevAuthor Commented:
Adjusted points from 20 to 150
0
 
fibdevAuthor Commented:
DrD,

expert@fibdev.com

You got it.
0
 
jeurkCommented:
I'm always too late !!!
Here is my answer, I'm posting it anyway so that if someone buys that question he will have something for his points....

procedure TForm1.Button1Click(Sender: TObject);
begin
 with TForm2.Create( Application ) do
      try
         if ShowModal = mrOK then
         with fRect do
         begin
         // Exit if improper rectangle drawn
         if ( Right > Left ) and ( Bottom > Top ) then
         begin
            // Give system time to refresh
            // Capture desktop
            ABitmap := TBitmap.Create;
            ABitmap.Assign( CaptureScreenRect( fRect ) );
            // Copy the image to the Image component
            Image1.Picture.Bitmap := ABitmap;
            // Free the bitmap
            ABitmap.Free;
         end
         else
         begin
            MessageDlg( 'Error selecting rectangle, try again!', mtInformation, [mbOk], 0 );
            Exit;
         end; {If}
      end; {fRect}
   finally {ShowModal}
      Free;
   end;
end;

and TForm2 is  ===================
{******************************************************************************}
{*                                                                            *}
{*             Adirondack Software & Graphics Capture Form Unit               *}
{*          (C) Copyright Adirondack Software & Graphics 1996-1998            *}
{*                                                                            *}
{******************************************************************************}

unit capture2;

interface

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

type
  TForm2 = class( TForm )
    procedure FormCreate( Sender: TObject );
    procedure FormMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer );
    procedure FormMouseMove( Sender: TObject; Shift: TShiftState; X,
      Y: Integer );
    procedure FormMouseUp( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer );
    procedure FormPaint( Sender: TObject );
    procedure FormDestroy( Sender: TObject );
  private
    { Private declarations }
    fDragging: Boolean;

    procedure WMEraseBkGnd(  Var Msg: TWMEraseBkGnd  ); message WM_ERASEBKGND;
  public
    { Public declarations }
    fRect: TRect;
    fBmp: TBitmap;
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}
{==============================================================================}
procedure TForm2.FormCreate( Sender: TObject );
{==============================================================================}
var
  aDC: HDC;
begin
  fBMP        := TBitmap.Create;
  fBMP.Width  := Screen.Width;
  fBMP.Height := Screen.Height;
  aDC         := GetDC(  0  );
  BitBlt(  fBMP.Canvas.handle, 0, 0, Screen.Width, Screen.Height,
          aDC, 0, 0, srcCopy  );
  ReleaseDC(  0, aDC  );
  SetBounds(  0, 0, Screen.Width, Screen.Height  );
end;

{==============================================================================}
procedure TForm2.FormMouseDown( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer );
{==============================================================================}
begin
  if mbLeft = Button then begin
    fDragging := True;
    SetRect(  fRect, X, Y, X, Y  );
    Canvas.DrawFocusrect(  fRect  );
  end;
end;

{==============================================================================}
procedure TForm2.FormMouseMove( Sender: TObject; Shift: TShiftState; X,
  Y: Integer );
{==============================================================================}
begin
  if fDragging then begin
    Canvas.DrawFocusrect(  fRect  );
    fRect.Right  := X;
    fRect.Bottom := Y;
    Canvas.DrawFocusrect(  fRect  );
  end;
end;

{==============================================================================}
procedure TForm2.FormMouseUp( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer );
{==============================================================================}
begin
  if fDragging then begin
    Canvas.DrawFocusrect(  fRect  );
    fDragging := False;
  end;
  ModalResult := mrOK;
end;

{==============================================================================}
procedure TForm2.FormPaint( Sender: TObject );
{==============================================================================}
begin
  Canvas.Draw(  0, 0, fBMP  );
end;

{==============================================================================}
procedure TForm2.FormDestroy( Sender: TObject );
{==============================================================================}
begin
  fBMP.Free;
end;

{==============================================================================}
Procedure TForm2.WMEraseBkGnd(  var Msg: TWMEraseBkGnd  );
{==============================================================================}
begin
  Msg.Result := 1;
end;

end.

CU...
0
 
fibdevAuthor Commented:
Thanks J,

I was urged to accept DrDelphi's answer and I'm still having bug issues with his/her component :(

I'll try your solution and hopefully it will work for me because now it seems DrDelphi has dropped off the face of the Earth and won't answer my E-mail.

I'll get back with you on how this works for me J.  Maybe I can give you some points.  If this works for me, I won't forget it.
0
 
jeurkCommented:
Hello,
I sent the whole project and stuff to
expert@fibdev.com...
Is this ok ?
CU
0
 
fibdevAuthor Commented:
Thanks J,

I'll look at it tonight.

Gabe
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.