急！怎么实现放大缩小！

Question

现在有个paintbox，一个控制放大倍数的控件，调节放大倍数，可以实现paintbox上图形整体放大，然后出现横拉条和纵拉条，类似word里显示比例的功能，求个位高手指点！！！

Answer 1

这个需要考虑使用gdi+来实现吧

Answer 2

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, ExtDlgs, StdCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    btn_Enlarge: TSpeedButton;
    btn_Narrow: TSpeedButton;
    ScrollBox1: TScrollBox;
    Img1: TImage;
    PB1: TPaintBox;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure btn_EnlargeClick(Sender: TObject);
    procedure btn_NarrowClick(Sender: TObject);
    procedure pb1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pb1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pb1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private    Multiples: Integer;
    pp: Integer;     //放大倍數    Canmove: Boolean; //移動標志
    BitmapTmp: TBitmap;  //臨時變量
    LeftTop: TPoint;  //第一次移動時截取原始圖像的左上角坐標
    SecondTop: TPoint; //記錄移動過程中要截取的原始圖像的左上角坐標
    MouseOrg: TPoint;     //記錄鼠標按下去的坐標
    procedure drawline;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.btn_EnlargeClick(Sender: TObject);
var
  SrcRect,DestRect: TRect;
  W,H:Integer;
  tempW,tempH: Integer;
begin
  Inc(Multiples,2);
  BitmapTmp.Free;
  BitmapTmp := TBitmap.Create;
  BitmapTmp.Width := pb1.Width;
  BitmapTmp.Height := pb1.Height;
  
  if Multiples >20 then
   begin
     pp := 20;
     Multiples := 20;
   end
  else pp := Multiples;  img1.Visible := False;  tempW := Img1.Width; //imgRB.X - imgLT.X;
  tempH := Img1.Height;// imgRB.Y - imgLT.Y;
  if (tempW * PP) <= pb1.Width then
    w := tempW
  else
    w := pb1.Width div PP;  if (tempH * PP) <= pb1.Height then
    h := tempH
  else
    h := pb1.Height div PP;  pb1.Refresh;
  SrcRect := Rect(0, 0, W, H);
  destRect := Rect(0,0,W * pp,H *pp);
  BitmapTmp.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
  if pp > 2 then
    drawline
  else
    pb1.Canvas.CopyRect(Rect(0,0,pb1.Width div pp * pp,pb1.Height div pp * pp),
             BitmapTmp.Canvas,Rect(0,0,BitmapTmp.Width div pp * PP,BitmapTmp.Height div pp * PP));
  //SecondTop := imgLT;
end;procedure TForm1.btn_NarrowClick(Sender: TObject);
var
  SrcRect,DestRect: TRect;
  W,H:Integer;
  tempW,tempH: Integer;
begin
  Dec(Multiples,2);
  BitmapTmp.Free;
  BitmapTmp := TBitmap.Create;
  BitmapTmp.Width := pb1.Width;
  BitmapTmp.Height := pb1.Height;  if Multiples >= 2 then
    begin
      pp := Multiples;      tempW := Img1.Width;
      tempH := Img1.Height;
      if (tempW * PP) <= pb1.Width then
        w := tempW
      else
        w := pb1.Width div PP;      if (tempH * PP) <= pb1.Height then
        h := tempH
      else
        h := pb1.Height div PP;      pb1.Refresh;
      SrcRect := Rect(0, 0, W, H);
      destRect := Rect(0,0,w *pp,h * pp);
      BitmapTmp.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
      if pp > 2 then
       drawline
      else
        pb1.Canvas.CopyRect(Rect(0,0,pb1.Width div pp * pp,pb1.Height div pp * pp),
                 BitmapTmp.Canvas,Rect(0,0,BitmapTmp.Width div pp * PP,BitmapTmp.Height div pp * PP));
    end
  else
    begin
      Multiples := 0;
      pp := 1;
      pb1.Canvas.CopyRect(Rect(0,0,pb1.Width,pb1.Height),img1.Canvas,Rect(0,0,img1.Width,img1.Height));
      SecondTop.X := 0;
      SecondTop.Y := 0;
   end;
end;procedure TForm1.pb1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbright then
    begin
      Canmove := True;
      MouseOrg.X := X;
      MouseOrg.Y := Y;
    end;
end;procedure TForm1.pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  SrcRect,destRect: TRect;
  setX,setY: Integer;
begin
  LeftTop.X := SecondTop.X;
  LeftTop.Y := SecondTop.Y;
  if Canmove and (ssright in Shift) then
    begin
      if pb1.Cursor <> crHandPoint then  pb1.Cursor := crHandPoint;
      if pp = 0 then pp := 1;      //原始大小時
      setX := (MouseOrg.X - X) div pp;
      setY := (MouseOrg.Y - Y) div pp;      if Img1.Width * pp <= pb1.Width then  setX := 0;
      if Img1.Height * pp <= pb1.Height then setY := 0;       if setX > 0  then  //圖像左移顯示右邊看不到的部分(移動過程中)
        begin
          if LeftTop.X + setX + BitmapTmp.Width div pp > Img1.Width then
            LeftTop.X  := Img1.Width - BitmapTmp.Width div pp
          else
            LeftTop.X := LeftTop.X + setX;
        end;      if setX < 0 then   //圖像右移顯示左邊看不到的部分(移動過程中)
        begin
          if (LeftTop.X + setX < 0)then
            LeftTop.X := 0
          else
            LeftTop.X := LeftTop.X + setX;
        end;      if setY > 0  then  //圖像上移顯示下邊看不到的部分(移動過程中)
        begin
          if LeftTop.Y + setY + BitmapTmp.Height div pp > Img1.Height then
            LeftTop.Y := Img1.Height - BitmapTmp.Height div pp
          else
            LeftTop.Y := LeftTop.Y + setY;
        end;      if setY < 0 then   //圖像下移顯示上邊看不到的部分(移動過程中)
        begin
          if (LeftTop.Y + setY < 0) then
            LeftTop.Y := 0
          else
            LeftTop.Y := LeftTop.Y + setY;
        end;      SrcRect := Rect(LeftTop.X , LeftTop.Y, LeftTop.X + BitmapTmp.Width div PP, LeftTop.Y + BitmapTmp.Height div PP);  //在原始圖片上截取的大小
      destRect := Rect(0,0,BitmapTmp.Width div pp * pp,BitmapTmp.Height div pp * PP);   // div pp * PP 避免運算誤差
      BitmapTmp.Canvas.CopyRect(destRect,img1.Canvas,SrcRect);
      drawline;
    end
  else
    if pb1.Cursor <> crDefault then  pb1.Cursor := crDefault;end;procedure TForm1.pb1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Canmove and (ssright in Shift) then
    begin
      Canmove := False;
    end;
  if pb1.Cursor <> crDefault then  pb1.Cursor := crDefault;
  SecondTop.X := LeftTop.X;
  SecondTop.Y := LeftTop.Y;
end;procedure TForm1.pb1Paint(Sender: TObject);
begin
  if pp = 0 then   Exit;
  drawline;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Multiples := 0;    //初始化倍數
  pp := Multiples;
  BitmapTmp := TBitmap.Create;
  BitmapTmp.Width := pb1.Width;
  BitmapTmp.Height := pb1.Height;
end;procedure TForm1.drawline;
var
  i,j: Integer;
begin
  if PP >= 4 then
    begin
      i := 0;
      while i <= BitmapTmp.Width div pp * pp  do          // (...div pp * PP) 避免運算誤差
        begin
          BitmapTmp.Canvas.MoveTo(i,0);
          BitmapTmp.Canvas.LineTo(i,BitmapTmp.Height div pp * PP );
          Inc(i,pp);
        end;      j := 0;
      while j <= BitmapTmp.Height div pp * PP do
        begin
          BitmapTmp.Canvas.MoveTo(0,j);
          BitmapTmp.Canvas.LineTo(BitmapTmp.Width div pp * pp ,j);
          Inc(j,pp);
        end;
     end;
  if pp = 1 then
    pb1.Canvas.CopyRect(Rect(0,0,pb1.Width,pb1.Height),img1.Canvas,Rect(0,0,img1.Width,img1.Height))
  else
    pb1.Canvas.CopyRect(Rect(0,0,BitmapTmp.Width div pp * pp,BitmapTmp.Height div pp *pp),BitmapTmp.Canvas,Rect(0,0,BitmapTmp.Width div pp * PP,BitmapTmp.Height div pp * PP));end;procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
    Img1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;end.

Answer 3

FastMM 据说很牛叉的图形库，放大缩小图片可以试试，用的DIB设备无关，速度号称很快