H
hnzzq
Unregistered / Unconfirmed
GUEST, unregistred user!
我现在要在Scrollbox中加入一张Timage图像,我要在程序运行的时候进行缩放和移动。我的源代码如下:
缩放在原来Image大小的范围内都没有问题,但是在缩放大于原尺寸时图像就不能够正常的画出来了,只能画到原来尺寸大小,怎么办?[8D]
代码:
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;