关于Timage的缩放问题。(100分)

H

hnzzq

Unregistered / Unconfirmed
GUEST, unregistred user!
我现在要在Scrollbox中加入一张Timage图像,我要在程序运行的时候进行缩放和移动。我的源代码如下:
代码:
var
  Mousedowned, ImageSelected: Boolean;
  Oldx, Oldy, Oldw, Oldh, Oldl, Oldt: integer;
  RectList: array[1..8] of TRect;
  PPoint: array[1..8] of Boolean;

procedure TConfigure_frm.DrawFrame;
var
  i: integer;
begin
  RectList[1] := Rect(0, 0, 5, 5);
  RectList[2] := Rect(BackgroundImage.Width div 2 - 3, 0,
    BackgroundImage.Width div 2 + 2, 5);
  RectList[3] := Rect(BackgroundImage.Width - 5, 0, BackgroundImage.Width, 5);
  RectList[4] := Rect(BackgroundImage.Width - 5, BackgroundImage.Height div 2 - 3,
    BackgroundImage.Width, BackgroundImage.Height div 2 + 2);
  RectList[5] := Rect(BackgroundImage.Width - 5, BackgroundImage.Height - 5,
    BackgroundImage.Width, BackgroundImage.Height);
  RectList[6] := Rect(BackgroundImage.Width div 2 - 3, BackgroundImage.Height - 5,
    BackgroundImage.Width div 2 + 2, BackgroundImage.Height);
  RectList[7] := Rect(0, BackgroundImage.Height - 5, 5, BackgroundImage.Height);
  RectList[8] := Rect(0, BackgroundImage.Height div 2 - 3,
    5, BackgroundImage.Height div 2 + 2);
  with BackgroundImage.Canvas do
  begin
   // BackgroundImage.Picture:=nil;
    BackgroundImage.Refresh;
    Brush.Color := clyellow;
    Fillrect(ClientRect);
    //    StretchDraw(Rect(0, 0, BackgroundImage.Width, BackgroundImage.Height), ImageBmpTemp);
    Brush.Color := clBlack;
    Brush.Style := bsSolid;
    for i := 1 to 8 do
    begin
      FillRect(RectList[i]);
    end;
  end;

end;

procedure TConfigure_frm.ImageOnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: integer;
  p: TPoint;
begin
  if Button = mbleft then
  begin
    if not ImageSelected then
    begin
      Scrollbox1.OnMouseDown(Self, Button, Shift, x, y);
      BackgroundImage.Stretch := False;
      BackgroundImage.AutoSize := False;
      BackgroundImage.Transparent := False;
      if not Assigned(ImageBmpTemp) then
      begin
        ImageBmpTemp := TBitmap.Create;
        ImageBmpTemp.Assign(BackgroundImage.Picture.Bitmap);
        BackgroundImage.Picture := nil;
      end;
      DrawFrame;
      ImageSelected := True;
    end
    else
    begin
      Mousedowned := True;
      for i := 1 to 8 do
        PPoint[i] := PtInRect(RectList[i], Point(x, y));
      GetCursorPos(P);
      Oldx := p.x;
      oldy := p.y;
      Oldw := BackgroundImage.Width;
      Oldh := BackgroundImage.Height;
      Oldt := BackgroundImage.Top;
      Oldl := BackgroundImage.Left;
    end;
  end;
end;

procedure TConfigure_frm.ImageOnMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Mousedowned := False;
end;

procedure TConfigure_frm.ImageOnMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  p: TPoint;
  NewX, NewY: integer;
  R: TRect;
begin
  if ImageSelected then
  begin
    BackgroundImage.Cursor := crSize;
    if PtInRect(RectList[1], Point(x, y)) or PtInRect(RectList[5], Point(x, y)) then
      BackgroundImage.Cursor := crSizeNWSE;
    if PtInRect(RectList[2], Point(x, y)) or PtInRect(RectList[6], Point(x, y)) then
      BackgroundImage.Cursor := crSizeNs;
    if PtInRect(RectList[3], Point(x, y)) or PtInRect(RectList[7], Point(x, y)) then
      BackgroundImage.Cursor := crSizeNESW;
    if PtInRect(RectList[4], Point(x, y)) or PtInRect(RectList[8], Point(x, y)) then
      BackgroundImage.Cursor := crSizeWE;
  end;
  if Mousedowned then
  begin
    GetCursorPos(p);
    Newx := p.x;
    NewY := p.y;
    Label1.Caption := IntToStr(p.x) + ',' + IntToStr(p.y);
    label2.Caption := ' ' + IntToStr(Newx - oldx);
    label3.Caption := ' ' + IntToStr(Newy - oldy);
    Label4.Caption := ' Left:' + IntToStr((Sender as TImage).Left) + 'Top:' + IntToStr((Sender as
      TImage).Top) + 'Width:' + IntToStr((Sender as TImage).Width) + 'Height:' + IntToStr((Sender as
        TImage).Height);
    if PPoint[1] then
    begin
      (Sender as TImage).Left := Oldl + Newx - oldx;
      (Sender as TImage).Top := Oldt + NewY - oldy;
      (Sender as TImage).Width := Oldw + oldx - Newx;
      (Sender as TImage).Height := Oldh + oldy - Newy;
      DrawFrame;
      Exit;
    end;
    if PPoint[2] then
    begin
      (Sender as TImage).Top := OldT + NewY - oldy;
      (Sender as TImage).Height := OldH + oldy - Newy;
      DrawFrame;
      Exit;
    end;
    if PPoint[3] then
    begin
      (Sender as TImage).Top := Oldt + Newy - oldy;
      (Sender as TImage).Width := Oldw + Newx - oldx;
      (Sender as TImage).Height := Oldh + oldy - Newy;
      DrawFrame;
      Exit;
    end;
    if PPoint[4] then
    begin
      (Sender as TImage).Width := Oldw + Newx - oldx;
      DrawFrame;
      Exit;
    end;
    if PPoint[5] then
    begin
      (Sender as TImage).Width := Oldw + Newx - oldx;
      (Sender as TImage).Height := Oldh + Newy - oldy;
      DrawFrame;
      Exit;
    end;
    if PPoint[6] then
    begin
      (Sender as TImage).Height := Oldh + Newy - oldy;
      DrawFrame;
      Exit;
    end;
    if PPoint[7] then
    begin
      (Sender as TImage).Left := Oldl + Newx - oldx;
      (Sender as TImage).Width := Oldw + oldx - Newx;
      (Sender as TImage).Height := Oldh + Newy - oldy;
      DrawFrame;
      Exit;
    end;
    if PPoint[8] then
    begin
      (Sender as TImage).Left := Oldl + Newx - oldx;
      (Sender as TImage).Width := Oldw + oldx - Newx;
      DrawFrame;
      Exit;
    end;
    if PtInRect(ClientRect, Point(x, y)) then
    begin
      (Sender as TImage).Left := OldL + Newx - oldx;
      (Sender as TImage).Top := OldT + Newy - oldy;
    end;
  end;
end;
缩放在原来Image大小的范围内都没有问题,但是在缩放大于原尺寸时图像就不能够正常的画出来了,只能画到原来尺寸大小,怎么办?[8D]
 
这怎么办,我自己搞定了,原来要在每次画Image画布前要将Picture属性赋空,哎[:D]
 
斑主,可以给自己加100分不
 
要不,我再问一个其他的问题???[8D]
 
有谁知道Win-Tech的Socketspy32的注册码,小声告诉我,100分相送[:D][:D][:D]
 
SocketSpy Pro

Version: 7.A01
URL: www.win-tech.com

Name: RyDeR_H00k! Company: UCF s/n: IHJGL35N5KJ3J352
可以吗?
 
感谢,感谢,我找了N久没找到,送分,送[:D][:D][:D][:D][:D][:D][:D]
 
谢谢hnzzq,真是太感谢了,困扰了那么长时间的问题,终于找到了答案
 
顶部