18
Bueno, este es mi objetivo. Use el botón izquierdo del mouse para desplazarse por la imagen, haga clic con el botón derecho del mouse en y elija Zoom rectangle y haga doble clic para restablecer el zoom completo.Cómo hacer zoom manteniendo la relación de aspecto correctamente
Actualmente estoy cansado, hasta ahora ha encontrado que NO tiene que ver con la forma en que carga las imágenes o muestra la imagen, sino algo con lo 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. Por lo tanto, me da una buena imagen limpia.
Estoy publicando todo el código para mi unidad ZImage Aunque creo que el problema está en el Zimage.paint o Zimage.mouseup Pero pensé que si necesitabas ver una función dentro de uno de esos, ayudaría a tenerlo todo al corriente.
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 se puede registrar el CompoNet zImage y ver cómo se ejecuta .. si es necesario
tengo que darle crédito por la perseverancia. :-) Me habría roto y gastado el dinero para una biblioteca de imágenes buena y barata por ahora en lugar de reinventar la rueda. –
¿Cuál es la diversión en que ... siendo como lo hago para divertirme (suena loco) disfruto aprendiendo cosas nuevas ... solo enseñándote a ti mismo a veces te encuentras con cosas que simplemente no hacen sentido ... una vez que logro descifrar esto algo de ayuda: D ya no tendrá que volver a visitar este tema. –
Por esa lógica, entonces, no deberías estar usando imágenes '.jpg'; Debería usar su propio formato de imagen, y no debería usar Delphi, pero debería usar su propio IDE e idioma. :-) Herramientas adecuadas para el trabajo adecuado: ¿no podría dedicar mejor su tiempo probando una mejor experiencia de interfaz de usuario en lugar de ampliar/escalar la imagen? –