Flytte tshape

Du kan bruge OnMouseDown, OnMouseMove og OnMouseUp, dvs. du trykker på shapen og får en OnMouseDown hvor du så starter dit drag. I OnMouseMove sker selve flytningen som så afslutter når du får en OnMouseUp.

Her er lige et forslag til de 3 procedurer, jeg bruger Shapens Tag felt til at gemme x og y værdierne for musens position når drag startes, x gemmes i HiWord og y gemmes i LoWord. De $4000 (bit 15) jeg ligger til når tag sættes er for at fortælle OnMouseMove at vi er i gang med et drag.

procedure TForm1.ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Shape.Tag:=((x shl 16)+y) + $4000;
end;

procedure TForm1.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    if Shape.Tag and $4000=$4000 then //jep bit 15 er sat hvis true
  begin
        Shape.Left:=Shape.Left+(X-HiWord(Shape.Tag));
    Shape.Top:=Shape.Top+(Y-LoWord(Shape.Tag)+$4000);
  end;
end;

procedure TForm1.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    Shape.Tag:=0;
end;

Det virker ganske glimrende...

Hvis jeg opretter flere shapes dynamisk, kan jeg så sætte samme event på, således at jeg kan flytte alle shapes...

Og hvordan resizer jeg - kan jeg lave så jeg kan trække firkanten større eller mindre??

Eller er det et andet komponent end tshape jeg skal bruge til det???

At kunne resize kræver kun en smule mere kode i ShapeOnMouseMove, her skal du tage højde for de 8 muligheder der findes dvs. NV, N, NØ, Ø, SØ, S, SV, V. Jeg har en ide om hvordan det kan laves rimelig let så hvis du vil kan jeg godt lave et eks.?

Hvis du opretter dem dynamisk og skal bruge procedurene til alle skal der blot en lille ændring til således:

procedure TForm1.ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    (Sender as TShape).Tag:=((x shl 16)+y) + $4000;
end;

procedure TForm1.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    with (Sender as TShape) do
        if Tag and $4000=$4000 then //jep bit 15 er sat hvis true
        begin
            Left:=Left+(X-HiWord(Tag));
            Top:=Top+(Y-LoWord(Tag)+$4000);
    end;
end;

procedure TForm1.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    (Sender as TShape).Tag:=0;
end;

En anden ting. Hvis du opretter dine shapes at runtime så kunne du jo lave din egen Shape klasse og tilføje nogle Move, resize værdier således at man ikke behøver bruge Tag til at gemme X,Y værdierne i.

lige på det punkt er jeg nok lidt ny - så har du eksempelvis en forklaring på at lave sin egen class??

Og har du evt en måde at lave NV, N, NØ, Ø, SØ, S, SV, V-trækpunkterne på shapen??

En ny shape class:

  TMyShape = class(TShape)
  private
      MoveStartX, MoveStartY : integer;
  end;

Man kan så bruge MoveStartX, MoveStartY til at gemme x,y start værdierne, men hvis det virker fint med Tag og man ikke skal bruge Tag til andet så er der jo ingen grund til det, det skulle da kun lige være for at gøre koden lettere at forstå.
Jeg kikker lige på det med trækpunkterne og vender tilbage.

har du et forslag til hvordan jeg laver det med at resize??

Her har jeg lavet en ny Shape class som kan flyttes og resizes, cursoren ændres sig også afhængig af hvor mus markøren befinder sig, man kan resize shapen på 8 forskellige steder. Du kan så evt. gemme class´en af vejen i en unit.

unit MoveShapeUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  // den nye Shape class
  TMyShape = class(TShape)
  private
      MoveStartX, MoveStartY : integer;
    DoMove : boolean;
    FMoveMode    : integer;

    procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
        procedure SetMoveMode(AMoveMode : integer);
    procedure MoveShape(x,y : integer);
    procedure SizeShape(x,y : integer);
    public
    { Public declarations }
        property MoveMode : integer read FMoveMode write SetMoveMode;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// *** Start på koden for TMyShape
procedure TMyShape.SetMoveMode(AMoveMode : integer);
begin
  FMoveMode:=AMoveMode;
    case FMoveMode of
      0    : Cursor:=crSize;
    1,2 : Cursor:=crSizeWE;
    4,8 : Cursor:=crSizeNS;
    5,10    : Cursor:=crSizeNWSE;
        6,9    : Cursor:=crSizeNESW;
  end;
end;

procedure TMyShape.MoveShape(x,y : integer);
begin
    Left:=Left+x;
    Top:=Top+y;
end;

procedure TMyShape.SizeShape(x,y : integer);
begin
    Width:=Width+x;
    Height:=Height+y;
end;

procedure TMyShape.ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    MoveStartX:=X;
  MoveStartY:=Y;
  DoMove:=true;
end;

procedure TMyShape.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    bs    : byte;
begin
    if DoMove then
    begin
      if MoveMode=0 then // flyt
        MoveShape(x-MoveStartX,y-MoveStartY);

    if MoveMode and 1=1 then // size venstre
    begin
            MoveShape(x-MoveStartX,0);
            SizeShape(-x+MoveStartX,0);
    end;
        if MoveMode and 2=2 then // size højre
    begin
            SizeShape(x-MoveStartX,0);
            MoveStartX:=x;
    end;
    if MoveMode and 4=4 then // size top
    begin
            MoveShape(0,y-MoveStartY);
            SizeShape(0,-y+MoveStartY);
    end;
      if MoveMode and 8=8 then // size bund
    begin
            SizeShape(0,y-MoveStartY);
            MoveStartY:=y;
    end;
    exit;
  end;

    MoveMode:=0;
  bs:=10; // afstand fra kant i pixel
  if x<bs then
      MoveMode:=MoveMode+1; // venstre
    if x>Width-bs then
      MoveMode:=MoveMode+2; // højre
  if y<bs then
      MoveMode:=MoveMode+4; // top
  if y>Height-bs then
      MoveMode:=MoveMode+8; // bund;
end;

procedure TMyShape.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    DoMove:=false;
end;
// *** Slut på koden for TMyShape

procedure TForm1.Button1Click(Sender: TObject);
begin
    with TMyShape.Create(Self) do
  begin
      Left:=10;
    Top:=10;
    OnMouseDown:=ShapeMouseDown;
    OnMouseMove:=ShapeMouseMove;
    OnMouseUp:=ShapeMouseUp;
    Parent:=Self;
  end;
end;

end.