求救：关于图像整体放大局部显示功能

Question

高手们赶快帮帮忙啊！我现在做关于图像放大遇到问题了，老板让我做一个图像缩放功能的程序，跟acdsee看图软件的缩放功能差不多，并且支持鼠标拖动一个矩形区域进行整体放大，但窗体只显示矩形框住的放大图像。

Answer 1

//图片的容器是 Timgview32 这样不会有闪动效果
//没有定义的变量都自个加上吧
procedure TC_ReportF.imageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if Button = mbright then
  begin
    MouseDragging := True;
    Image.Cursor := crHandPoint;
    OldMousePos := Point(X, Y);
  end;
  mx := mouse.CursorPos.x;
  my := mouse.CursorPos.y;
  bx := x;
  by := y;
  if (not PicDraging) and (button = mbLeft) then
  begin
    mouse2down := true;
    Origin := mouse.CursorPos;          // ClientToScreen(Point(X, Y));
    MovePt := Origin;
  end;
end;procedure TC_ReportF.imageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer; Layer: TCustomLayer);
begin
  if mouse2down then
  begin
    if (x > bx) and (y > by) then
      Scrn_Rect.Pen.Color := COLOR_KUANG_BIG
    else
      Scrn_Rect.Pen.Color := COLOR_KUANG_AUTO;    DrawShape(Origin, MovePt, pmNotXor);
    Origin := mouse.CursorPos;
    DrawShape(Origin, MovePt, pmNotXor);
  end;  if MouseDragging or PicDraging then
  begin
    Image.Scroll(OldMousePos.X - X, OldMousePos.Y - Y);
    OldMousePos := Point(X, Y);
    Image.Update;
  end;end;procedure TC_ReportF.imageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  dx, dy            : integer;
  rx, ry, r         : single;
  ux, uy            : integer;
  cw, ch, pw, ph    : integer;
  nowScale          : single;
begin
  if mouse2down then
  begin
    mouse2down := false;
    DrawShape(Origin, MovePt, pmNotXor);
  end;  if Button = mbRight then
  begin
    MouseDragging := False;
    if PicDraging then
      Image.Cursor := crHandPoint
    else
      Image.Cursor := crDefault
  end;  if (not PicDraging) and (Button = mbLeft) and (image.Bitmap.Width > 10) then
  begin
    nowScale := image.scale;    ux := mouse.CursorPos.X;
    uy := mouse.CursorPos.y;    if (uX > mx) and (uy > my) then     //ÏòÓÒϽŻ®£¬·Å´óͼƬ¡£
    begin
      dx := uX - mx;
      dy := uy - my;      rx := image.Width / dx;
      ry := image.Height / dy;      if rx <= ry then r := rx else r := ry;      NowScale := image.scale * r;      ScaleBar.Repaint;
      if (NowScale < Power(10, ScaleBar.MaxValue / 100)) then
      begin
         //image.scale := NowScale;
        scalebar.Position := round(logN(10, NowScale) * 100);
      end;
      image.Scroll(round(((bx + dx div 2) - image.Width div 2) * r), round(((by + dy div 2) - image.Height div 2) * r));
    end
    else
    begin
      NowScale := image.Width / image.Bitmap.Width;
      if NowScale > (image.height / image.Bitmap.height) then
        NowScale := (image.height / image.Bitmap.height);
      image.Scale := NowScale;
      scalebar.Position := round(logN(10, Image.Scale) * 100);
    end;
  end;
end;

Answer 2

procedure TC_ReportF.ScaleBarChange(Sender: TObject);
var
  NewScale          : Single;
begin
  NewScale := Power(10, scalebar.Position / 100);
  ScaleBar.Repaint;                     // update the scale bar before the image is repainted
  image.Scale := NewScale;
  Scale_l.Caption := formatfloat('0', NewScale * 100) + '% ';  btnScal_B.Enabled := not (scalebar.Position = scalebar.MaxValue);
  btnScal_s.Enabled := not (scalebar.Position = scalebar.MinValue);
  ScaleBar.Hint := '&Euml;&otilde;·&Aring;±&Egrave;&Agrave;&yacute;&pound;&ordm;' + (formatfloat('0', NewScale * 100)) + '%'; ;
end;

Answer 3

非常感谢flashtong(阿木)的帮忙，我试试看！ ：）

Answer 4

to flashtong(阿木):
   不好意思，我是新手，你上面写的代码我不怎么看的懂！你能不能给个完整的代码啊？有些地方我加不好！谢谢哦！

Answer 5

private
    mousedown: bool;
    OldMousePos: TPoint;
    MouseDragging, PicDraging: Boolean;
    mx, my, bx, by: integer;
    mouse2down: bool;
    Origin, MovePt: tPoint;
    Scrn_Rect: TCanvas;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
....
const
  COLOR_KUANG_BIG   = $00FF6000;
  COLOR_KUANG_AUTO  = $000060FF;procedure TC_ReportF.FormCreate(Sender: TObject);
begin
  Scrn_Rect := TCanvas.Create;
  Scrn_Rect.Handle := GetDC(0); 
end;procedure TC_ReportF.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  with scrn_rect do
  begin
    Pen.Mode := AMode;
    Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
  end;
end;procedure TC_ReportF.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Scrn_Rect.Free;
end;
//把上面的代码加上去，然后把我第一次发的链接上就可以了
//这些代码是我自己先前写的，乱了点。但是思路很简单的，应该能看懂

Answer 6

flashtong(阿木):
delphi 7 里有scaleBar这个控件吗，我怎么找半天没有找到啊？还有执行这里时NowScale := image.Width / image.Bitmap.Width 怎么出错，说没有定义image，

Answer 7

scalebar是个滚动条或者trackbar都行，只要把onChange事件链接上去就行了
image是Timage32，这个三方控件，之所以用到它，是因为它封装的很好，图片扩大的时候还不闪动。这个控件网上有下的。你百度下吧。
如果还有不明白的，我也帮不上忙了。