Solved

# Scaling rectangle

Posted on 2003-12-08
661 Views
Hi,

I drew a rectangle in a TImage object.

The size of TImage is for example width = W and Height = H.

The rectangle has 4 coordinate positions, X1, Y1, X2, Y2.

Then, I proportionally shrink the TImage to be this size: width = W1 and Height = H1.

So, anyone know a formula to calculate the new X1, Y1, X2, and Y2, so the rectangle will still be proportional ?

Thanks
0
Question by:muis2002
• 5
• 4

LVL 27

Expert Comment

just from head, not tested, and maybe possible wrong

scalingfactor := NewHeight/OldHeight;

newX1 := x1*scalingfactor;
newY1 := y1*scalingfactor;
newX2 := y2*scalingfactor;
newY2 := y2*scalingfactor;

meikl ;-)
0

LVL 22

Expert Comment

x := X*W1 div W;
x1 := X1*W1 div W;
y := y*H1 div H;
y1 := y1*H1 div H;

F68 ;-)
0

LVL 22

Expert Comment

this time you're the faster meikl :))
0

LVL 27

Expert Comment

i'm not sure, if my calculation is correct, f68 :-)
0

LVL 22

Expert Comment

infact looking better in your calculation y must depend on Width scaling factor, that could be different from the height one...
SO

WSCalingFactor := NewWIdth/OldWIdth;
HSCalingFactor := NewHeight/OldHeight;

x1 := x1*WSCalingFactor;
x2 := x2*WScalingFactor;
y1 := y1*HSCalingFactor;
y2 := y2*HScalingFactor;

F68 ;-)
0

LVL 22

Expert Comment

ops...NewWIdth div OldWIdth...etc. etc. (result must be integer, not real)
0

LVL 27

Expert Comment

>ops...NewWIdth div OldWIdth...etc. etc. (result must be integer, not real)

just use round or trunc

>WSCalingFactor := NewWIdth/OldWIdth;
>HSCalingFactor := NewHeight/OldHeight;

i decided to use one scalingfactor, because
if the image is scaled proportional, then
WSCalingFactor and HSCalingFactor
should have the same value

meikl ;-)
0

Author Comment

Well, after I tried, it does not works :( not because the calculation, but because of the way TImage stretching :(

I cant get the W1 and H1 (width and height after stretched proportionally).

Original TImage size W * H

then I have newTImage with "smaller" size (let say Wx and Hx).
I assigned TImage to the newTImage, so that newTImage contains TImage bitmap.

But then, I cant get the stretched image size in newTImage.

I checked newTImage.Width , it will always Wx
I checked newTImage.Picture.Width, it will always W (the same with TImage.Width).
0

LVL 27

Expert Comment

the picture width never changes,
only the visualizing of the TImage
is adjusted (autostretch-property is set to true)

if you want the picture scaled physically,
then use canvas-methods like

- Stretchdraw
- copyrect

or api like
- BitBlt

to create a new scaled picture

meikl ;-)
0

LVL 27

Accepted Solution

kretzschmar earned 50 total points
instead of autostretch i meant autosize

a sample

unit image_scale_u;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
Panel3: TPanel;
Image1: TImage;
Image2: TImage;
Button1: TButton;
TrackBar1: TTrackBar;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
procedure scale;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.dfm}

//scaling routine, craeting a scaled image
procedure TForm1.scale;
var bmp : TBitmap;
begin
image2.Picture := nil; //clear content;
bmp := TBitmap.Create;
try
bmp.Width := round(image1.Picture.Bitmap.Width*(trackbar1.Position/100));
bmp.Height := round(image1.Picture.Bitmap.Height*(trackbar1.Position/100));
//draw, not the fastest routine
bmp.Canvas.CopyRect(Rect(0,0,bmp.Width, bmp.height),
image1.Picture.Bitmap.Canvas,
Rect(0,0,image1.Picture.Bitmap.width,image1.Picture.Bitmap.height));
image2.Picture.Assign(bmp);  //show
finally
bmp.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
scale;
end;
end;

//scale on trackbarchange (range: 0%-500%)
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
scale;
end;

end.

meikl ;-)
0

## Featured Post

### 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…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.