• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1640
  • Last Modified:

Copy TImage Section to another TImage?

I setup coordinates, which change to be any size.  I need to be able to take what they mapped out and put into another TImage.

Problem: When I use Copyrect, then it will not resize the TImage, therefore leaving a border or cutting off part of the picture, depending on whether it is smaller or bigger than the TImage.

I need a solution that can update it without a lot of memory usage, because as they drag around the box (the mapped area) then it will change in another window simultaneously.

Note: If the 2nd TImage does not resize to the section I copy it to, then it will not work in the TScrollBox.  I cannot set the TImage to alClient because then it will cut off part of the picture and the scrollbars will not show the entire picture.  I need the Image2 to do AutoResize.
0
perkley
Asked:
perkley
  • 14
  • 8
  • 2
  • +3
1 Solution
 
westy100697Commented:
Hi there,
        Have you thought of saving what you copy to a file. Either .bmp or .wmf and then loading that file in Image2 with the AutoSize property set to true at Design time?? Obviously it has something to do with copying directly to the Canvas. I will look further and see what I can dig up.

WESTY :)
0
 
X_KaliburCommented:
perkley,

The solution to your problem is simple...

you have to set the "AutoSize" property on the second TImage object  to "True"..

This will then allow the object to automatically resize itself when it gets data into its canvas.

hth,

-x
0
 
westy100697Commented:
Hi there,
        Have you thought of saving what you copy to a file. Either .bmp or .wmf and then loading that file in Image2 with the AutoSize property set to true at Design time?? Obviously it has something to do with copying directly to the Canvas. I will look further and see what I can dig up.

WESTY :)
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

 
westy100697Commented:
X Kalibur,
          Have you actually tried this. I am using D3 and it doesn't autoresize if you use CopyRect. Try it. Even with that Property set.

WESTY :)
0
 
perkleyAuthor Commented:
Yes X Kalibur, I have tried setting AutoSize to True, but it is not effected when you use CopyRect.

Yes Westy, I have thought about saving it to a file, but remember that it will be changing simulataneously while you move your box around on the image below Image1.  Writing a file each time would be to much I think.
0
 
westy100697Commented:
perkley,
        What about creating a TMetafile object to store into and copy out of ?

I am trying this now.

WESTY :)
0
 
westy100697Commented:
perkley,
        Don't worry about the Autosize leave it as false then do this


Image2.Canvas.CopyRect(Rect(0,0,Round(Abs(X1-X2)),Round(Abs(Y1-Y2))),Image1.Canvas,Rect(X1,Y1,X2,Y2));
  Image2.Width := Round(Abs(X1-X2));
  Image2.Height := Round(Abs(Y1-Y2));

The co-ordinates I have here are X1,Y1
or top left corner of rectangle and
 X2,Y2 bottom left corner of rectangle.

Does that help at all ?

It seems to work for me without much processing for computer.

WESTY :)
0
 
westy100697Commented:
perkley,
        X2,Y2 should be bottom right corner. Sorry bout that

WESTY :}
0
 
perkleyAuthor Commented:
You know, that just about worked, but when I resize my top coordinates (width or height) then it will not resize the Image2.  It sizes it correct the first time, but it won't thereafter.  I have been playing around with it, but still cannot get it to work correctly.  When I step through my code, it seems as though it should, but for some reason Image1 will not take on the new Width and Height once set.
0
 
westy100697Commented:
perkley,
        Hang on I will try it here.
Are you using

 Image2.Canvas.CopyMode := cmSrcCopy ;

??

WESTY :|
0
 
westy100697Commented:
perkley,
        So how are you selecting your points, using a drag or two seperate mouse clicks ??

I have just been using to seperate clicks to capture both points individually and it works fine.
I will try it the other way now.

WESTY :)
0
 
perkleyAuthor Commented:
Here is what is happening.  I capture the points and put them in the edit boxes.

I then set these coordinates.

X1 := StrToInt(eLeft.Text);
X2 := StrToInt(eLeft.Text)+StrToInt(eWidth.Text);
Y1 := StrToInt(eTop.Text);
Y2 := StrToInt(eTop.Text)+StrToInt(eHeight.Text);

Then I call the Width and Height:

iPreview.Width := Round(Abs(X1-X2));
iPreview.Height := Round(Abs(Y1-Y2));

And finally the CopyRect:

iPreview.Canvas.CopyRect(Rect(0,0,Round(Abs(X1-X2)),Round(Abs(Y1-Y2))),iDisplay.Canvas,Rect(X1,Y1,X2,Y2));

It doesn't work when the EditBox Values Change and it recalls everything, but it doesn't resize it.  It gets the new picture, but only fills what the size was before.
0
 
westy100697Commented:
perkley,
        put iPreview.Width and
iPreview.Height after the call to CopRect and see what happens.

WESTY :)
0
 
westy100697Commented:
perkley,
        Here is the test code I am using

//Global variables
var
  P1,P2,X1,Y1,X2,Y2 : integer ;

implementation


//select the 2 points
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If P1 = -1 then
  begin
    X1 := X ;
    Y1 := Y ;
    P1 := 1 ;
  end
  else
  If (P1 <> -1) and (P2 = -1) then
  begin
    X2 := X ;
    Y2 := Y ;
  end
  else
   exit ;
end;

//Reset Button Here
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  P1 := -1 ;
  P2 := -1 ;
end;

//Copy the area from image 1 to 2
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Image2.Canvas.CopyMode := cmSrcCopy ;
  Image2.Width := Round(Abs(X1-X2));
  Image2.Height := Round(Abs(Y1-Y2));
  Image2.Canvas.CopyRect(Rect(0,0,Round(Abs(X1-X2)),Round(Abs(Y1-Y2))),Image1.Canvas,Rect(X1,Y1,X2,Y2));
end;
//initialise the Points to false
procedure TForm1.FormCreate(Sender: TObject);
begin
  P1 := -1 ;
  P2 := -1 ;
end;


I do use global variables too.


WESTY :)

0
 
perkleyAuthor Commented:
I did, but when I do it after, then it doesn't even do it the first time.  I am using Delphi 5 Professional, in case that makes a difference.
0
 
westy100697Commented:
perkley,
        See if my code helps. it definitely does copy the area it is supposed to. I have 2 buttons on the form and click my two points into the variables with the OnMouseUp event. Then I click the second button to copy from on image to the other. It can be all put under the OnMouseUp if required.

WESTY :)
0
 
perkleyAuthor Commented:
Westy,

I tried your code exactly and it still has problems.

Try this yourself.  In design mode, make Image2.Width = 10, and Image2.Height = 10 - Then choose some points on Image1 that are bigger than 10x10.  Notice it will not change Image2 to fit.
0
 
westy100697Commented:
perkley,
        You were right about that however here is the solution. Put the Width and Height before the cmSrcCopy line. It must make it readonly after setting

 Image2.Canvas.Copymode := cmSrcCopy ;

so just do this

 Image2.Height :=
 Image2.Width :=
 Image2.Canvas.CopyMode :=
 Image2.Canvas.CopyRect();

WESTY :)
0
 
perkleyAuthor Commented:
Is this what you have?

    Image2.Width := Round(Abs(X1-X2));
    Image2.Height := Round(Abs(Y1-Y2));
    Image2.Canvas.CopyMode := cmSrcCopy ;
    Image2.Canvas.CopyRect(Rect(0,0,Round(Abs(X1-X2)),Round(Abs(Y1-Y2))),Image1.Canvas,Rect(X1,Y1,X2,Y2));

I tried it with making the Width and Height before, and it seems to be getting a smaller than what my Image2 in design mode is, even when selecting bigger.  It is strange.  How about you send me your working demo to douglas@rexburg.com
0
 
MadshiCommented:
Try using this:

  Image2.Width := newWidth;
  Image2.Height := newHeight;
  Image2.Picture.Bitmap.Width := newWidth;
  Image2.Picture.Bitmap.Height := newHeight;

If that still doesn't work, try using this before the code from above:

  Image2.Picture.Bitmap.Assign(nil);

Regards, Madshi.
0
 
westy100697Commented:
Madshi,
       Yeh I figured it out and e-mailed perkley what I came up with. Plays up a treat the canvas doen't it. It just needs to be assigned nil or overwritten with an image and it works fine.

WESTY :}
0
 
AswCommented:
listening...
0
 
westy100697Commented:
Madshi,
       You should lock this question as your answer is the best solution.

WESTY :)
0
 
mullet_attackCommented:
Set the destination TImage Autosize to True, and then only resize the underlying bitmap.

image1.picture.bitmap.width := x1 - x2;
image1.picture.bitmap.height := y2 - y1;
image1.canvas.CopyRect(image1.clientrect,image2.canvas,rect(x1,y1,x2,y2));

make sure copymode etc are correct also
0
 
perkleyAuthor Commented:
This is the best solution so far, and it seems to work just great, no more problems.

  X1 := StrToInt(Edit1.Text);
  X2 := StrToInt(Edit2.Text);
  Y1 := StrToInt(Edit3.Text);
  Y2 := StrToInt(Edit4.Text);
  Image2.Width := Y1-X1;
  Image2.Height := Y2-X2;
  Image2.Picture.Bitmap.Width := Y1-X1;
  Image2.Picture.Bitmap.Height := Y2-X2;
  Image2.Canvas.CopyMode := cmSrcCopy ;
  Image2.Canvas.CopyRect(Rect(0,0,Y1-X1,Y2-X2), Image1.Canvas, Rect(X1,X2,Y1,Y2));

I set the Image2.AutoSize = True and assigned both the picture.bitmap and the canvas Width and Height.

Thanks Madshi
0
 
mullet_attackCommented:
With AutoSize set to true, the lines
Image2.Width := Y1-X1;
Image2.Height := Y2-X2;
are completely redundant. Also, why use
"Rect(0,0,Y1-X1,Y2-X2)", when
"clientrect" is more readable, and would probably execute faster?
0
 
perkleyAuthor Commented:
I knew it was simpler than what we were all trying to make it out as.  Thanks for the comment.
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.

Join & Write a Comment

Featured Post

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.

  • 14
  • 8
  • 2
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now