delphi - resolucion - Cómo hacer zoom manteniendo correctamente la relación de aspecto

relaciones de aspecto pantalla

Question

Pues este es mi objetivo. Use el botón izquierdo del mouse para desplazarse por la imagen, el botón derecho del mouse para elegir el rectángulo de zoom y haga doble clic para restaurar el zoom completo.

Actualmente me he cansado, hasta ahora he encontrado que NO tiene que ver con la forma en que cargo las imágenes o que muestro la imagen, sino algo con la forma en que pinta. La imagen en pantalla siempre llena el área del cliente del control, independientemente de la forma del formulario o la imagen de origen, por lo que la relación de aspecto no se puede conservar. No estoy seguro de cómo cambiar esto o mantener la relación de aspecto. Así me da una imagen bonita y limpia.

Estoy publicando el código completo para mi unidad ZImage. Aunque creo que el problema está en Zimage.paint o Zimage.mouseup, pero me di cuenta de que si necesitaba ver una función dentro de una de esas, ayudaría a tenerlo todo publicado.

unit ZImage;
interface
uses
Windows, Messages, SysUtils,jpeg, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TZImage = class(TGraphicControl)
private
FBitmap : Tbitmap;
PicRect : TRect;
ShowRect : TRect;
FShowBorder : boolean;
FBorderWidth : integer;
FForceRepaint : boolean;
FMouse : (mNone, mDrag, mZoom);
FProportional : boolean;
FDblClkEnable : boolean;
FLeft :integer;
FRight :integer;
FTop :integer;
FBottom :integer;
startx, starty,
oldx, oldy : integer;
procedure SetShowBorder(s:boolean);
procedure SetBitmap(b:TBitmap);
procedure SetBorderWidth(w:integer);
procedure SetProportional(b:boolean);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure DblClick; override;
published
procedure zoom(Endleft,EndRight,EndTop,EndBottom:integer);
property ValueLeft : integer read FLeft write FLeft;
property ValueRight : Integer read FRight write FRight;
Property ValueTop : Integer read FTop write FTop;
Property ValueBottom : Integer read FBottom write FBottom;
property ShowBorder : boolean
read FShowBorder
write SetShowBorder default true;
property KeepAspect : boolean
read FProportional
write SetProportional default true;
property Bitmap : TBitmap
read FBitmap
write Setbitmap;
property BorderWidth : integer
read FBorderWidth
write SetBorderWidth default 7;
property ForceRepaint : boolean
read FForceRepaint
write FForceRepaint default true;
property DblClkEnable : boolean
read FDblClkEnable
write FDblClkEnable default False;
property Align;
property Width;
property Height;
property Top;
property Left;
property Visible;
property Hint;
property ShowHint;
end;
procedure Register;
implementation
//This is the basic create options.
constructor TZImage.Create(AOwner:TComponent);
begin
inherited;
FShowBorder:=True;
FBorderWidth:=7;
FMouse:=mNone;
FForceRepaint:=true; //was true
FDblClkEnable:=False;
FProportional:=true; //was true
Width:=100; Height:=100;
FBitmap:=Tbitmap.Create;
FBitmap.Width:=width;
FBitmap.height:=Height;
ControlStyle:=ControlStyle+[csOpaque];
autosize:= false;
//Scaled:=false;
end;
//basic destroy frees the FBitmap
destructor TZImage.Destroy;
begin
FBitmap.Free;
inherited;
end;
//This was a custom zoom i was using to give the automated zoom effect
procedure TZimage.zoom(Endleft,EndRight,EndTop,EndBottom:integer);
begin
while ((Endbottom <> picrect.bottom) or (Endtop <> picrect.top)) or ((endleft <> picrect.left) or (endright <> picrect.right)) do
begin
if picrect.left > endleft then
picrect.left := picrect.left -1;
if picrect.left < endleft then //starting
picrect.left := picrect.left +1;
if picrect.right > endright then //starting
picrect.right := picrect.right -1;
if picrect.right < endright then
picrect.right := picrect.right +1;
if picrect.top > endtop then
picrect.top := picrect.top -1;
if picrect.top < endtop then //starting
picrect.top := picrect.top +1;
if picrect.bottom > endbottom then //starting
picrect.bottom := picrect.bottom -1;
if picrect.bottom < endbottom then
picrect.bottom := picrect.bottom +1;
self.refresh;
end;
end;
//this is the custom paint I know if i put
//Canvas.Draw(0,0,FBitmap); as the methond it displays
//perfect but the zoom option is gone of course and
//i need the Zoom.
procedure TZImage.Paint;
var buf:TBitmap;
coef,asps,aspp:Double;
sz,a : integer;
begin
buf:=TBitmap.Create;
buf.Width:=Width;
buf.Height:=Height;
if not FShowBorder
then ShowRect:=ClientRect
else ShowRect:=Rect(ClientRect.Left,ClientRect.Top,
ClientRect.Right-FBorderWidth,
ClientRect.Bottom-FBorderWidth);
ShowRect:=ClientRect;
with PicRect do begin
if Right=0 then Right:=FBitmap.Width;
if Bottom=0 then Bottom:=FBitmap.Height;
end;
buf.Canvas.CopyMode:=cmSrcCopy;
buf.Canvas.CopyRect(ShowRect,FBitmap.Canvas,PicRect);
Canvas.CopyMode:=cmSrcCopy;
Canvas.Draw(0,0,buf);
buf.Free;
end;
procedure TZImage.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
// if mbLeft<>Button then Exit;
if not PtInRect(ShowRect,Point(X,Y)) and
not PtInRect(Rect(ShowRect.Right,ShowRect.Bottom,
Width,Height),Point(X,Y)) then Exit;
if PtInRect(Rect(ShowRect.Right,ShowRect.Bottom,
Width,Height),Point(X,Y)) then begin
DblClick;
Exit;
end;
//here click is in the picture area only
startx:=x; oldx:=x;
starty:=y; oldy:=y;
if mbRight=Button then begin
MouseCapture:=True;
FMouse:=mZoom;
Canvas.Pen.Mode:=pmNot;
end else begin
FMouse:=mDrag;
Screen.Cursor:=crHandPoint;
end;
end;
function Min(a,b:integer):integer;
begin
if a<b then Result:=a else Result:=b;
end;
function Max(a,b:integer):integer;
begin
if a<b then Result:=b else Result:=a;
end;
procedure TZImage.MouseMove(Shift: TShiftState; X, Y: Integer);
var d,s:integer;
coef:Double;
begin
if FMouse=mNone then Exit;
if FMouse=mZoom then begin
Canvas.DrawFocusRect(Rect(Min(startx,oldx),Min(starty,oldy),Max(startx,oldx),Max(starty,oldy)));
oldx:=x; oldy:=y;
Canvas.DrawFocusRect(Rect(Min(startx,oldx),Min(starty,oldy),Max(startx,oldx),Max(starty,oldy)));
end;
if FMouse=mDrag then begin
//horizontal movement
coef:=(PicRect.Right-PicRect.Left)/(ShowRect.Right-ShowRect.Left);
d:=Round(coef*(x-oldx));
s:=PicRect.Right-PicRect.Left;
if d>0 then begin
if PicRect.Left>=d then begin
PicRect.Left:=PicRect.Left-d;
PicRect.Right:=PicRect.Right-d;
end else begin
PicRect.Left:=0;
PicRect.Right:=PicRect.Left+s;
end;
end;
if d<0 then begin
if PicRect.Right<FBitmap.Width+d then begin
PicRect.Left:=PicRect.Left-d;
PicRect.Right:=PicRect.Right-d;
end else begin
PicRect.Right:=FBitmap.Width;
PicRect.Left:=PicRect.Right-s;
end;
end;
//vertical movement
coef:=(PicRect.Bottom-PicRect.Top)/(ShowRect.Bottom-ShowRect.Top);
d:=Round(coef*(y-oldy));
s:=PicRect.Bottom-PicRect.Top;
if d>0 then begin
if PicRect.Top>=d then begin
PicRect.Top:=PicRect.Top-d;
PicRect.Bottom:=PicRect.Bottom-d;
end else begin
PicRect.Top:=0;
PicRect.Bottom:=PicRect.Top+s;
end;
end;
{There was a bug in the fragment below. Thanks to all, who reported this bug to me}
if d<0 then begin
if PicRect.Bottom<FBitmap.Height+d then begin
PicRect.Top:=PicRect.Top-d;
PicRect.Bottom:=PicRect.Bottom-d;
end else begin
PicRect.Bottom:=FBitmap.Height;
PicRect.Top:=PicRect.Bottom-s;
end;
end;
oldx:=x; oldy:=y;
if FForceRepaint then Repaint
else Invalidate;
end;
end;
procedure TZImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var coef:Double;
t:integer;
left,right,top,bottom : integer;
begin
if FMouse=mNone then Exit;
if x>ShowRect.Right then x:=ShowRect.Right;
if y>ShowRect.Bottom then y:=ShowRect.Bottom;
if FMouse=mZoom then begin //calculate new PicRect
t:=startx;
startx:=Min(startx,x);
x:=Max(t,x);
t:=starty;
starty:=Min(starty,y);
y:=Max(t,y);
FMouse:=mNone;
MouseCapture:=False;
//enable the following if you want to zoom-out by dragging in the opposite direction}
{ if Startx>x then begin
DblClick;
Exit;
end;}
if Abs(x-startx)<5 then Exit;
//showmessage(''picrect Left=''+inttostr(picrect.Left)+'' right=''+inttostr(picrect.Right)+'' top=''+inttostr(picrect.Top)+'' bottom=''+inttostr(picrect.Bottom));
//startx and start y is teh starting x/y of the selected area
//x and y is the ending x/y of the selected area
if (x - startx < y - starty) then
begin
while (x - startx < y - starty) do
begin
x := x + 100;
startx := startx - 100;
end;
end
else if (x - startx > y - starty) then
begin
while (x - startx > y - starty) do
begin
y := y + 100;
starty := starty - 100;
end;
end;
//picrect is the size of whole area
//PicRect.top and left are 0,0
//IFs were added in v.1.2 to avoid zero-divide
if (PicRect.Right=PicRect.Left)
then
coef := 100000
else
coef:=ShowRect.Right/(PicRect.Right-PicRect.Left); //if new screen coef= 1
left:=Round(PicRect.Left+startx/coef);
Right:=Left+Round((x-startx)/coef);
if (PicRect.Bottom=PicRect.Top)
then
coef := 100000
else
coef:=ShowRect.Bottom/(PicRect.Bottom-PicRect.Top);
Top:=Round(PicRect.Top+starty/coef);
Bottom:=Top+Round((y-starty)/coef);
//showmessage(inttostr(left)+'' ''+inttostr(Right)+'' ''+inttostr(top)+'' ''+inttostr(bottom));
zoom(left,right,top,bottom);
ValueLeft := left;
ValueRight := Right;
ValueTop := top;
ValueBottom := bottom;
end;
if FMouse=mDrag then begin
FMouse:=mNone;
Canvas.Pen.Mode:=pmCopy;
Screen.Cursor:=crDefault;
end;
Invalidate;
end;
procedure TZImage.DblClick;
begin
zoom(0,FBitMap.Width,0,FBitMap.Height);
ValueLeft := 0;
ValueRight := FBitMap.Width;
ValueTop := 0;
ValueBottom := FBitMap.Height;
//PicRect:=Rect(0,0,FBitmap.Width,FBitmap.Height);
Invalidate;
end;
procedure TZImage.SetBitmap(b:TBitmap);
begin
FBitmap.Assign(b);
PicRect:=Rect(0,0,b.Width, b.Height);
Invalidate;
end;
procedure TZImage.SetBorderWidth(w:integer);
begin
FBorderWidth:=w;
Invalidate;
end;
procedure TZImage.SetShowBorder(s:boolean);
begin
FShowBorder:=s;
Invalidate;
end;
procedure TZImage.SetProportional(b:boolean);
begin
FProportional:=b;
Invalidate;
end;
procedure Register;
begin
RegisterComponents(''Custom'', [TZImage]);
end;
end.

Con este código puede registrar el componente ZImage y ver cómo se ejecuta ... si es necesario

Answer 1

La pregunta es clara, pero creo que el problema para responderla es cómo no volver a escribir el código completo para que sea comprensible para usted. Y como soy mejor programando y luego explicando, lo hice.

Creo que estás buscando algo como lo siguiente:

unit ZImage2;
interface
uses
Windows, Messages, Classes, Controls, Graphics, StdCtrls, ExtCtrls, Math;
const
DefAnimDuration = 500;
type
TZImage = class(TGraphicControl)
private
FAlignment: TAlignment;
FAnimDuration: Cardinal;
FAnimRect: TRect;
FAnimStartTick: Cardinal;
FAnimTimer: TTimer;
FBuffer: TBitmap;
FCropRect: TRect;
FImgRect: TRect;
FLayout: TTextLayout;
FPicture: TPicture;
FPrevCropRect: TRect;
FProportional: Boolean;
FProportionalCrop: Boolean;
FScale: Single;
FSelColor: TColor;
FSelecting: Boolean;
FSelPoint: TPoint;
FSelRect: TRect;
procedure Animate(Sender: TObject);
function HasGraphic: Boolean;
procedure PictureChanged(Sender: TObject);
procedure RealignImage;
procedure SetAlignment(Value: TAlignment);
procedure SetLayout(Value: TTextLayout);
procedure SetPicture(Value: TPicture);
procedure SetProportional(Value: Boolean);
procedure UpdateBuffer;
protected
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
procedure ChangeScale(M: Integer; D: Integer); override;
procedure DblClick; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Reset;
function ScreenToGraphic(R: TRect): TRect;
procedure Zoom(const ACropRect: TRect);
procedure ZoomSelection(const ASelRect: TRect);
published
property Alignment: TAlignment read FAlignment write SetAlignment
default taLeftJustify;
property AnimDuration: Cardinal read FAnimDuration write FAnimDuration
default DefAnimDuration;
property Layout: TTextLayout read FLayout write SetLayout default tlTop;
property Picture: TPicture read FPicture write SetPicture;
property Proportional: Boolean read FProportional write SetProportional
default False;
property ProportionalCrop: Boolean read FProportionalCrop
write FProportionalCrop default True;
property SelColor: TColor read FSelColor write FSelColor default clWhite;
published
property Align;
property Anchors;
property AutoSize;
property Color;
end;
implementation
function FitRect(const Boundary: TRect; Width, Height: Integer;
CanGrow: Boolean; HorzAlign: TAlignment; VertAlign: TTextLayout): TRect;
var
W: Integer;
H: Integer;
Scale: Single;
Offset: TPoint;
begin
Width := Max(1, Width);
Height := Max(1, Height);
W := Boundary.Right - Boundary.Left;
H := Boundary.Bottom - Boundary.Top;
if CanGrow then
Scale := Min(W / Width, H / Height)
else
Scale := Min(1, Min(W / Width, H / Height));
Result := Rect(0, 0, Round(Width * Scale), Round(Height * Scale));
case HorzAlign of
taLeftJustify:
Offset.X := 0;
taCenter:
Offset.X := (W - Result.Right) div 2;
taRightJustify:
Offset.X := W - Result.Right;
end;
case VertAlign of
tlTop:
Offset.Y := 0;
tlCenter:
Offset.Y := (H - Result.Bottom) div 2;
tlBottom:
Offset.Y := H - Result.Bottom;
end;
OffsetRect(Result, Boundary.Left + Offset.X, Boundary.Top + Offset.Y);
end;
function NormalizeRect(const Point1, Point2: TPoint): TRect;
begin
Result.Left := Min(Point1.X, Point2.X);
Result.Top := Min(Point1.Y, Point2.Y);
Result.Right := Max(Point1.X, Point2.X);
Result.Bottom := Max(Point1.Y, Point2.Y);
end;
{ TZImage }
procedure TZImage.Animate(Sender: TObject);
var
Done: Single;
begin
Done := (GetTickCount - FAnimStartTick) / FAnimDuration;
if Done >= 1.0 then
begin
FAnimTimer.Enabled := False;
FAnimRect := FCropRect;
end
else
with FPrevCropRect do
FAnimRect := Rect(
Left + Round(Done * (FCropRect.Left - Left)),
Top + Round(Done * (FCropRect.Top - Top)),
Right + Round(Done * (FCropRect.Right - Right)),
Bottom + Round(Done * (FCropRect.Bottom - Bottom)));
UpdateBuffer;
RealignImage;
Invalidate;
end;
function TZImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or HasGraphic then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Round(FScale * FPicture.Width);
if Align in [alNone, alTop, alBottom] then
NewHeight := Round(FScale * FPicture.Height);
end;
end;
procedure TZImage.ChangeScale(M, D: Integer);
var
SaveAnchors: TAnchors;
begin
SaveAnchors := Anchors;
Anchors := [akLeft, akTop];
FScale := FScale * M / D;
inherited ChangeScale(M, D);
Anchors := SaveAnchors;
end;
constructor TZImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks];
FAnimTimer := TTimer.Create(Self);
FAnimTimer.Interval := 15;
FAnimTimer.OnTimer := Animate;
FAnimDuration := DefAnimDuration;
FBuffer := TBitmap.Create;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FProportionalCrop := True;
FScale := 1.0;
FSelColor := clWhite;
end;
procedure TZImage.DblClick;
begin
if not HasGraphic then
Reset
else
Zoom(Rect(0, 0, FPicture.Width, FPicture.Height));
inherited DblClick;
end;
destructor TZImage.Destroy;
begin
FPicture.Free;
FBuffer.Free;
inherited Destroy;
end;
function TZImage.HasGraphic: Boolean;
begin
Result := (Picture.Width > 0) and (Picture.Height > 0);
end;
procedure TZImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if (Button = mbRight) and HasGraphic and PtInRect(FImgRect, Point(X, Y)) then
begin
FSelPoint.X := X;
FSelPoint.Y := Y;
FSelRect := Rect(X, Y, X, Y);
FSelecting := True;
Canvas.Brush.Color := FSelColor;
Canvas.DrawFocusRect(FSelRect);
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TZImage.MouseMove(Shift: TShiftState; X, Y: Integer);
const
HorzAlign: array[Boolean] of TAlignment = (taLeftJustify, taRightJustify);
VertAlign: array[Boolean] of TTextLayout = (tlTop, tlBottom);
begin
if FSelecting and PtInRect(FImgRect, Point(X, Y)) then
begin
Canvas.DrawFocusRect(FSelRect);
FSelRect := NormalizeRect(FSelPoint, Point(X, Y));
if (not FProportionalCrop) then
FSelRect := FitRect(FSelRect, FPicture.Graphic.Width,
FPicture.Graphic.Height, True, HorzAlign[X < FSelPoint.X],
VertAlign[Y < FSelPoint.Y]);
Canvas.DrawFocusRect(FSelRect);
end;
inherited MouseMove(Shift, X, Y);
end;
procedure TZImage.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if FSelecting then
begin
FSelecting := False;
Canvas.DrawFocusRect(FSelRect);
if (Abs(X - FSelPoint.X) > Mouse.DragThreshold) or
(Abs(Y - FSelPoint.Y) > Mouse.DragThreshold) then
ZoomSelection(FSelRect);
end;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TZImage.Paint;
begin
Canvas.Brush.Color := Color;
if HasGraphic then
begin
Canvas.StretchDraw(FImgRect, FBuffer);
if FSelecting then
Canvas.DrawFocusRect(FSelRect);
with FImgRect do
ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
end;
Canvas.FillRect(Canvas.ClipRect);
end;
procedure TZImage.PictureChanged(Sender: TObject);
begin
Reset;
end;
procedure TZImage.RealignImage;
begin
if not HasGraphic then
FImgRect := Rect(0, 0, 0, 0)
else if FProportional then
FImgRect := ClientRect
else
FImgRect := FitRect(ClientRect, FBuffer.Width, FBuffer.Height, True,
FAlignment, FLayout);
end;
procedure TZImage.Reset;
begin
FCropRect := Rect(0, 0, FPicture.Width, FPicture.Height);
FAnimRect := FCropRect;
UpdateBuffer;
RealignImage;
Invalidate;
end;
procedure TZImage.Resize;
begin
RealignImage;
inherited Resize;
end;
function TZImage.ScreenToGraphic(R: TRect): TRect;
var
CropWidth: Integer;
CropHeight: Integer;
ImgWidth: Integer;
ImgHeight: Integer;
begin
CropWidth := FCropRect.Right - FCropRect.Left;
CropHeight := FCropRect.Bottom - FCropRect.Top;
ImgWidth := FImgRect.Right - FImgRect.Left;
ImgHeight := FImgRect.Bottom - FImgRect.Top;
IntersectRect(R, R, FImgRect);
OffsetRect(R, -FImgRect.Left, -FImgRect.Top);
Result := Rect(
FCropRect.Left + Round(CropWidth * (R.Left / ImgWidth)),
FCropRect.Top + Round(CropHeight * (R.Top / ImgHeight)),
FCropRect.Left + Round(CropWidth * (R.Right / ImgWidth)),
FCropRect.Top + Round(CropHeight * (R.Bottom / ImgHeight)));
end;
procedure TZImage.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RealignImage;
Invalidate;
end;
end;
procedure TZImage.SetLayout(Value: TTextLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
RealignImage;
Invalidate;
end;
end;
procedure TZImage.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;
procedure TZImage.SetProportional(Value: Boolean);
begin
if FProportional <> Value then
begin
FProportional := Value;
RealignImage;
Invalidate;
end;
end;
procedure TZImage.UpdateBuffer;
begin
if HasGraphic then
begin
FBuffer.Width := FAnimRect.Right - FAnimRect.Left;
FBuffer.Height := FAnimRect.Bottom - FAnimRect.Top;
FBuffer.Canvas.Draw(-FAnimRect.Left, -FAnimRect.Top, FPicture.Graphic);
end;
end;
procedure TZImage.Zoom(const ACropRect: TRect);
begin
if HasGraphic then
begin
FPrevCropRect := FAnimRect;
FCropRect := ACropRect;
if FAnimDuration = 0 then
begin
FAnimRect := FCropRect;
UpdateBuffer;
RealignImage;
Invalidate;
end
else
begin
FAnimStartTick := GetTickCount;
FAnimTimer.Enabled := True;
end;
end;
end;
procedure TZImage.ZoomSelection(const ASelRect: TRect);
begin
Zoom(ScreenToGraphic(ASelRect));
end;
end.

Código de muestra:

procedure TForm1.FormCreate(Sender: TObject);
begin
FImage := TZImage.Create(Self);
FImage.SetBounds(10, 10, 200, 300);
FImage.Picture.LoadFromFile(''D:/Pictures/Mona_Lisa.jpg'');
FImage.Alignment := taCenter;
FImage.Layout := tlCenter;
FImage.AutoSize := True;
FImage.Parent := Self;
end;