delphi – 如何正确缩放宽高比

概述这是我的目标。 使用鼠标左键滚动图像，鼠标右键 选择缩放矩形并双击恢复完全缩放。 我现在已经累了，到目前为止，发现它不是用我加载图像或显示图像的方式，而是与它的颜色有关。屏幕图像始终填充控件的客户区，无论窗体或源图像的形状如何，因此无法保留宽高比。我不知道如何改变这个或保持长宽比。所以给我一个干净漂亮的照片。 我正在发布我的ZImage单元的整个代码虽然我认为问题是在Zimage.paint或Zi 这是我的目标。
使用鼠标左键滚动图像，鼠标右键
选择缩放矩形并双击恢复完全缩放。

我现在已经累了，到目前为止，发现它不是用我加载图像或显示图像的方式，而是与它的颜色有关。屏幕图像始终填充控件的客户区，无论窗体或源图像的形状如何，因此无法保留宽高比。我不知道如何改变这个或保持长宽比。所以给我一个干净漂亮的照片。

我正在发布我的ZImage单元的整个代码虽然我认为问题是在Zimage.paint或Zimage.mouseup但是想到如果你需要看到其中一个功能，它将有助于它的所有发布。

unit ZImage;interfaceuses  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   @R_404_5107@ed;   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 FBitmapdestructor TZImage.Destroy;begin   FBitmap.Free;   @R_404_5107@ed;end;//This was a custom zoom i was using to give the automated zoom effectprocedure TZimage.zoom(Endleft,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,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,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),Y)) then Exit;   if PtInRect(Rect(ShowRect.Right,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,Max(starty,oldy)));       oldx:=x; oldy:=y;       Canvas.DrawFocusRect(Rect(Min(startx,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,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,FBitMap.Height);   Valueleft := 0;   ValueRight := FBitMap.WIDth;   Valuetop := 0;   ValueBottom := FBitMap.Height;   //PicRect:=Rect(0,FBitmap.WIDth,FBitmap.Height);   InvalIDate;end;procedure TZImage.SetBitmap(b:TBitmap);begin   FBitmap.Assign(b);   PicRect:=Rect(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.

使用此代码，您可以注册组件ZImage，并查看它如何运行..如果需要

解决方法 问题很清楚，但我认为回答问题是如何重写完整的代码是不可理解的。因为我更好的编码然后解释，我做到了。

我想你正在寻找如下的东西：

unit ZImage2;interfaceuses  windows,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 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;implementationfunction 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,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;  @R_404_5107@ed ChangeScale(M,D);  Anchors := SaveAnchors;end;constructor TZImage.Create(AOwner: TComponent);begin  @R_404_5107@ed 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,FPicture.WIDth,FPicture.Height));  @R_404_5107@ed DblClick;end;destructor TZImage.Destroy;begin  FPicture.Free;  FBuffer.Free;  @R_404_5107@ed 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,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;  @R_404_5107@ed MouseDown(button,Shift,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,Y)) then  begin    Canvas.DrawFocusRect(FSelRect);    FSelRect := normalizeRect(FSelPoint,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;  @R_404_5107@ed MouseMove(Shift,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;  @R_404_5107@ed MouseUp(button,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)  else if FProportional then    FimgRect := ClIEntRect  else    FimgRect := FitRect(ClIEntRect,FBuffer.WIDth,FBuffer.Height,FAlignment,FLayout);end;procedure TZImage.reset;begin  FCropRect := Rect(0,FPicture.Height);  FAnimRect := FCropRect;  UpdateBuffer;  RealignImage;  InvalIDate;end;procedure TZImage.Resize;begin  RealignImage;  @R_404_5107@ed 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.

示例代码：

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;

总结

以上是内存溢出为你收集整理的delphi – 如何正确缩放宽高比全部内容，希望文章能够帮你解决delphi – 如何正确缩放宽高比所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。