运行期可改变大小和移动的Image控件

Question

小弟在开发的时候,需要通过小的bmp图片连接为一个大的图片.现在想找一个类似image的控件,在运行时能够调整大小和支持鼠标拖动.请各位高手指点

Answer 1

var
  Old_X, Old_Y: Integer;procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Old_X:=X;
  Old_Y:=Y;
end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then
  begin
    Image1.Left:=Image1.Left+X-Old_X;
    Image1.Top:=Image1.Top+Y-Old_Y;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  //防止拖动是闪烁
  DoubleBuffered:=true;
end;

Answer 2

clasj 
这个只是拖动，调整大小怎么办？

Answer 3

unit PointImage;
//作者: 老农:
//运行时用户可自定义的图片,
interfaceuses
  SysUtils, Classes, Controls, Graphics, ExtCtrls, Dialogs, windows, messages;type
  TPointImage = class(TImage)
  private
    FAOwner: TComponent;
  //表示是缩放还是拖拉
    FIsScale, FIsDrag, FIsDown: boolean;
    //拖拽的起始和结束位置
    FDragStartPoint, FDragEndPoint, FScaleStartPoint, FScaleEndPoint: TPoint;
    FPointList: array[0..7] of TShape;
    FCurPointIndex: integer; //当前拖拽点
    procedure SetPointPos;
    procedure SetPointCursor(Sender: TObject);
    //--控件的处理
    procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer);
    procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    //--对点的处理
    procedure PointMouseDown(Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer);
    procedure PointMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PointMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    //----
    procedure MovePoint0;
    procedure AlignLeftTop;
    procedure MovePoint6;
    procedure AlignLeftBottom;
    procedure MovePoint2;
    procedure AlignRightTop;
    procedure MovePoint4;
    procedure AlignRightBottom;
    procedure MovePoint7;
    procedure AlignLeftMid;
    procedure MovePoint1;
    procedure AlignTopMid;
    procedure MovePoint3;
    procedure AlignRightMid;
    procedure MovePoint5;
    procedure AlignBottomMid;
    procedure ReSizeImage;  protected
    procedure Paint; override;
  public
    constructor create(AOwner: TComponent;FParent:TWinControl); overload;
    destructor Destroy; override;
  published
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Samples', [TPointImage]);
end;{ TSHapePoint }constructor TPointImage.create(AOwner: TComponent;FParent:TWinControl);
var
  i: integer;
  Point: TPoint;
begin
  inherited create(AOwner);
  FAOwner := AOwner;
  Parent := TWinControl(FParent);
  GetCursorPos(Point);
  Point := ScreenToClient(Point);
  Left := Point.X;
  Top := Point.Y;
  Cursor := crSize;
  AutoSize := true;
  for i := 0 to Length(FPointList) - 1 do
  begin
    FPointList[i] := TShape.Create(AOwner);
    FPointList[i].Parent := Parent;
    FPointList[i].Visible := true;
    FPointList[i].Height := 5;
    FPointList[i].Width := 5;
    FPointList[i].Brush.Color := clBlack;
    SetPointCursor(FPointList[i]);
    FPointList[i].OnMouseDown := PointMouseDown;
    FPointList[i].OnMouseMove := PointMouseMove;
    FPointList[i].OnMouseUp := PointMouseUp;
  end;
  OnMouseDown := ControlMouseDown;
  OnMouseMove := ControlMouseMove;
  OnMouseUp := ControlMouseUp;
end;destructor TPointImage.Destroy;
begin
  inherited;
end;procedure TPointImage.Paint;
begin
  inherited;
  SetPointPos;
end;procedure TPointImage.SetPointCursor(Sender: TObject);
begin
  Exit; //暂时先去掉鼠标拖拉缩放功能
  if Sender = FPointList[0] then
  begin
    FPointList[0].Cursor := crSizeNWSE;
  end;  if Sender = FPointList[1] then
  begin
    FPointList[1].Cursor := crSizeNS;
  end;  if Sender = FPointList[2] then
  begin
    FPointList[2].Cursor := crSizeNESW;
  end;  if Sender = FPointList[3] then
  begin
    FPointList[3].Cursor := crSizeWE;
  end;  if Sender = FPointList[4] then
  begin
    FPointList[4].Cursor := crSizeNWSE;
  end;  if Sender = FPointList[5] then
  begin
    FPointList[5].Cursor := crSizeNS;
  end;

Answer 4

  if Sender = FPointList[6] then
  begin
    FPointList[6].Cursor := crSizeNESW;
  end;  if Sender = FPointList[7] then
  begin
    FPointList[7].Cursor := crSizeWE;
  end;
end;procedure TPointImage.SetPointPos;
var
//四个点的处理
  TopLeftPoint, TopRigthPoint,
    BottomLeft, BottomRight: TPoint;
begin
//得到四角的位置
  TopLeftPoint := BoundsRect.TopLeft;
  //----------------
  TopRigthPoint.X := BoundsRect.Right;
  TopRigthPoint.Y := BoundsRect.Top;
  //---------------
  BottomRight := BoundsRect.BottomRight;
  //------------
  BottomLeft.X := BoundsRect.Left;
  BottomLeft.Y := BoundsRect.Bottom;
  //-----------------------  FPointList[0].Left := TopLeftPoint.X - 2;
  FPointList[0].Top := TopLeftPoint.Y - 2;  FPointList[1].Left := FPointList[0].Left + (TopRigthPoint.X - TopLeftPoint.X)
    div 2 - 2;
  FPointList[1].Top := FPointList[0].Top;  FPointList[2].Left := TopRigthPoint.X - 2;
  FPointList[2].Top := FPointList[0].Top;
  FPointList[3].Left := FPointList[2].Left;
  FPointList[3].Top := FPointList[2].Top + (BottomRight.Y - TopRigthPoint.Y)
    div 2 - 2;  FPointList[4].Left := FPointList[3].Left;
  FPointList[4].Top := BottomRight.Y - 2;  FPointList[5].Left := FPointList[1].Left;
  FPointList[5].Top := FPointList[4].Top;  FPointList[6].Left := FPointList[0].Left;
  FPointList[6].Top := FPointList[5].Top;  FPointList[7].Left := FPointList[0].Left;
  FPointList[7].Top := FPointList[3].Top;
end;procedure TPointImage.ControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FIsDown := True;
    GetCursorPos(FDragStartPoint);
  end;
end;procedure TPointImage.ControlMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  offsetX, offsetY: integer;
begin
  if FIsDown then
  begin
    GetCursorPos(FDragEndPoint);
    offsetX := FDragEndPoint.X - FDragStartPoint.X;
    offSetY := FDragEndPoint.Y - FDragStartPoint.Y;
    Left := Left + offSetX;
    Top := Top + offSetY;
    FDragStartPoint := FDragEndPoint;
    SetPointPos;
    Invalidate;
  end;
end;procedure TPointImage.ControlMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FIsDown := false;
end;procedure TPointImage.PointMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FIsDown := True;
    GetCursorPos(FScaleStartPoint);    if Sender = FPointList[0] then
      FCurPointIndex := 0;    if Sender = FPointList[1] then
      FCurPointIndex := 1;    if Sender = FPointList[2] then
      FCurPointIndex := 2;    if Sender = FPointList[3] then
      FCurPointIndex := 3;    if Sender = FPointList[4] then
      FCurPointIndex := 4;    if Sender = FPointList[5] then
      FCurPointIndex := 5;    if Sender = FPointList[6] then
      FCurPointIndex := 6;    if Sender = FPointList[7] then
      FCurPointIndex := 7;
  end;
end;procedure TPointImage.PointMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  offsetX, offsetY: integer;
begin
  if FIsDown then
  begin
    if FCurPointIndex = 0 then
    begin
      MovePoint0;
      ReSizeImage
    end;
    if FCurPointIndex = 1 then
    begin
      MovePoint1;
      ReSizeImage
    end;
    if FCurPointIndex = 2 then
    begin
      MovePoint2;
      ReSizeImage
    end;
    if FCurPointIndex = 3 then
    begin
      MovePoint3;
      ReSizeImage
    end;
    if FCurPointIndex = 4 then
    begin
      MovePoint4;
      ReSizeImage
    end;    if FCurPointIndex = 5 then
    begin
      MovePoint5;
      ReSizeImage
    end;    if FCurPointIndex = 6 then
    begin
      MovePoint6;
      ReSizeImage
    end;    if FCurPointIndex = 7 then
    begin
      MovePoint7;
      ReSizeImage
    end;  end;
end;procedure TPointImage.PointMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FIsDown := false;
end;procedure TPointImage.AlignBottomMid;
beginend;procedure TPointImage.AlignLeftBottom;
beginend;procedure TPointImage.AlignLeftMid;
beginend;procedure TPointImage.AlignLeftTop;
begin
  FPointList[6].Left := FPointList[0].Left;
  FPointList[2].Top := FPointList[0].Top;  FPointList[7].Left := FPointList[0].Left;
  FPointList[7].Top := FPointList[0].Top + (FPointList[6].Top -
    FPointList[0].Top) div 2;  FPointList[1].Top := FPointList[0].Top;
  FPointList[1].Left := FPointList[0].Left + (FPointList[2].Left -
    FPointList[0].Left) div 2;  FPointList[3].Top := FPointList[7].Top;
  FPointList[5].Left := FPointList[1].Left;end;procedure TPointImage.AlignRightBottom;
beginend;procedure TPointImage.AlignRightMid;
beginend;procedure TPointImage.AlignRightTop;
beginend;procedure TPointImage.AlignTopMid;
beginend;procedure TPointImage.MovePoint5;
beginend;procedure TPointImage.MovePoint6;
beginend;procedure TPointImage.MovePoint7;
beginend;procedure TPointImage.MovePoint0;
var
  offsetX, offsetY: Integer;
begin
  GetCursorPos(FScaleEndPoint);
  offsetX := FScaleEndPoint.X - FScaleStartPoint.X;
  offSetY := FScaleEndPoint.Y - FScaleStartPoint.Y;  FPointList[0].Left := FPointList[0].Left + offsetX;
  FPointList[0].Top := FPointList[0].Top + offsetY;  FScaleStartPoint := FScaleEndPoint;
  AlignLeftTop;
end;procedure TPointImage.MovePoint4;
beginend;procedure TPointImage.MovePoint3;
beginend;procedure TPointImage.MovePoint2;
beginend;procedure TPointImage.MovePoint1;
beginend;procedure TPointImage.ReSizeImage;
begin
  Left := FPointList[0].Left + 2;
  Top := FPointList[0].Top + 2;
  Width := FPointList[2].Left - FPointList[0].Left;
  Height := FPointList[6].Top - FPointList[0].Top;
end;
end.我只写了一部分，调整大小你仿照我的拖动来控制吧，比较简单