procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
   r:TRect;
begin
  R := BoundsRect;
  ChangeScale(Self.Width,Round(Self.Width*1.04));
  SetBounds(R.Left, R.Top, Width, Height);
//   self.SetBounds(self.Left,Top,Round(Self.Width*1.04)+self.left,Round(Self.Height*1.04)+self.height);
//Self.ScaleBy(Self.Height,Round(Self.Height*1.04));
//Self.ChangeScale(Self.Width,Round(Self.Width*1.04));
//  Self.Height:=Round(Self.Height*1.04);
//  Self.Width:=Round(Self.Width*1.04);
  Application.ProcessMessages;
  getpic;
end;
procedure TForm1.getpic();
var
  i:Integer;
begin
  begin
    if OpenDialog1.FileName='' then Exit;
    try
    pic:=TGPImage.Create(OpenDialog1.FileName);
    if firstopen then
    begin
      Self.Width:=pic.Width;
      Self.Height:=pic.Height;
      firstopen:=False;
      g:=TGpGraphics.Create(Self.Handle);
    end; 
    g.DrawImage(pic, 0,0, Self.Canvas.ClipRect.Right-Self.Canvas.ClipRect.Left,
      Self.Canvas.ClipRect.Bottom-Self.Canvas.ClipRect.Top);
  end;end;

解决方案 »

  1.   

    xiaolanniao;想讨教讨教...我说的这个看图功能就是 QQ 最新版本自带的;挺好用.
     不过自己在做的时候,始终无法十全十美; 我无法实现的功能:
    1:图片无限放大 [其实也不算无限,就是尽量放大]
    2:窗体的top 不能超越顶部;总是被弹回来
    3:....
      

  2.   

    这个效果很好实现啊,边缘的阴影应该是唯一的难点了,不过早有人实现了,代码拿来USES用之即可。没有发现难度。