如何实现图像的放大和漫游

Question

问题如上，请高手指导

Answer 1

不是技术问题，只是时间问题。如果有MONEY，肯定有人帮你做。
因为俺没时间帮你写代码，所以只能帮你UP了。

Answer 2

我也不知道什么是漫游，那位高手给讲讲要是 图片的放大，如要求不高的话，用image的width和height属性就可以啊

Answer 3

是不是拖动图像？下面是用鼠标拖动图像的代码  procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ix0:=x;
  iy0:=y;
end;procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ix0:=1;
  iy0:=1;
end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  lx,ly:integer;
begin
  if ssleft in shift then
  begin
    if ix0<>1 then
     begin
       lx:=x-ix0;
       ly:=y-iy0;
       if lx<>0 then
       begin
         image1.Left:=image1.Left +lx;
         image1.Top:=image1.Top+ly;
       end;
   end;
 end;
end;

Answer 4

//放大
procedure TfrmPicView.N1Click(Sender: TObject);
var
  i:single;
begin
  image1.Cursor := crDefault;
  if (sender as TMenuItem).name = 'N1' then
    i := 1.6
  else
    i := 0.625;
  image1.Width := round((image1.Width / image1.Picture.Width * i) * image1.Picture.Width);
  image1.height := round((image1.height / image1.Picture.height * i) * image1.Picture.height);
  if image1.Width >= width then
  begin
    if image1.Left > 0 then
      image1.Left := 0;
    image1.Cursor := crHandPoint;
  end
  else
    image1.Left := round((width - image1.Width)/2);
  if image1.height >= height then
  begin
    if image1.Top > 0 then
      image1.top := 0;
    image1.Cursor := crHandPoint;
  end
  else
    image1.top := round((height - image1.height)/2);  if image1.Width / image1.Picture.Width > 10 then
    n1.Enabled := false
  else
    n1.Enabled := true;
  if image1.Width / image1.Picture.Width < 0.1 then
    n2.Enabled := false
  else
    n2.Enabled := true;
end;//缩小
procedure TfrmPicView.N1Click(Sender: TObject);
var
  i:single;
begin
  image1.Cursor := crDefault;
  if (sender as TMenuItem).name = 'N1' then
    i := 1.6
  else
    i := 0.625;
  image1.Width := round((image1.Width / image1.Picture.Width * i) * image1.Picture.Width);
  image1.height := round((image1.height / image1.Picture.height * i) * image1.Picture.height);
  if image1.Width >= width then
  begin
    if image1.Left > 0 then
      image1.Left := 0;
    image1.Cursor := crHandPoint;
  end
  else
    image1.Left := round((width - image1.Width)/2);
  if image1.height >= height then
  begin
    if image1.Top > 0 then
      image1.top := 0;
    image1.Cursor := crHandPoint;
  end
  else
    image1.top := round((height - image1.height)/2);  if image1.Width / image1.Picture.Width > 10 then
    n1.Enabled := false
  else
    n1.Enabled := true;
  if image1.Width / image1.Picture.Width < 0.1 then
    n2.Enabled := false
  else
    n2.Enabled := true;
end;

Answer 5

矢量图形的漫游和放大很简单，矢量图形显示在一个TIMAGE中控制，漫游控制即对TIMAGE控制，放大就重画，对应的坐标、尺寸扩大对于的倍数即可！

Answer 6

//==============================================================================
//Bitmap.在画布上调整图像大小***************************************************
//==============================================================================
procedure BitmapStretch(Bitmap: TBitmap; Canvas: TCanvas; Rect: TRect);
var DIBWidth, DIBHeight: Longint;
    InfoSize, ImageSize: DWORD;
    Info: PBitmapInfo;
    Image: Pointer;
    Bits: HBITMAP;
begin
  try
    Bits := Bitmap.Handle;
    GetDIBSizes(Bits, InfoSize, ImageSize);
    GetMem(Info, InfoSize);//Info := MemAlloc(InfoSize);
    try
      GetMem(Image, ImageSize);//Image := MemAlloc(ImageSize);
      try
        GetDIB(Bits, 0, Info^, Image^);
        with Info^.bmiHeader do
        begin
          DIBWidth := biWidth;
          DIBHeight := biHeight;
        end;
        StretchDIBits(Canvas.Handle, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0, DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
      finally
        FreeMem(Image, ImageSize);
      end;
    finally
      FreeMem(Info, InfoSize);
    end;
  except
    On E:Exception do
    begin
      raise;
      exit;
    end;
  end;
end;//==============================================================================
//Bitmap.调整图像文件大小并保存*************************************************
//==============================================================================
procedure BitmapZoom(const Source, Target: string; const X, Y:integer; const ColorBit: TPixelFormat);
var aBMP, bBMP: TBitmap;
    ScaleX, ScaleY: real;
begin
  aBMP := TBitmap.Create;
  bBMP := TBitmap.Create;
  try
    aBMP.LoadFromFile(Source);
    ScaleY := aBMP.Height/Y;
    ScaleX := aBMP.Width/X;
    bBMP.Width := Round(aBMP.Width/ScaleX);
    bBMP.Height := Round(aBMP.Height/ScaleY);
    bBMP.PixelFormat := pf8bit;
    SetStretchBltMode(bBMP.Canvas.Handle,COLORONCOLOR);
    Stretchblt(bBMP.Canvas.Handle,0,0,bBMP.Width,bBMP.Height,aBMP.Canvas.Handle,0,0,aBMP.Width,aBMP.Height,srccopy);
    bBMP.SaveToFile(Target);
  finally
    aBMP.Free;
    bBMP.Free;
  end;
end;

Answer 7

huangrenguang(湖)的代码好象只是放大了Timage的大小，即image1.width和image1.height而不是image1.picture,width和image1.picture.height，所以并不能做到真正的图象放大，我做一个看图软件，也遇到了这个问题，而且，image1.picture.width和image1.picture.height这2个属性是只读的

Answer 8

同意quark, 你要考虑窗口坐标和世界坐标的关系，可查阅图形学相关内容

Answer 9

大概是做GIS显示地图的吧？如果是我倒有写过一个显示图形的控件。可以实现放大，缩小，漫游。