[Ayas]

всем привет!
помогите пожалуйста реализовать код перемещения визуального объекта на форме по сетке

Код:

unit Unit1;

interface

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

type
  TMouseAction = (maNone, maMove, maResize);
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private

    FMouseAction: TMouseAction;
    FGridX, FGridY: Integer;
    FSnapToGrid: Boolean;
    FMoveStart: TPoint;
    FComponent: record
      X, Y, Width, Height: Integer;
    end;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  with FComponent do
  begin
    X := 23;
    Y := 47;
    Width := 278;
    Height := 138;
  end;
  FMouseAction := maNone;
  FGridX := 10;
  FGridY := 10;
  FSnapToGrid := True;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMoveStart := Point(X, Y);
  if (X >= FComponent.X) and (X <= FComponent.X + FComponent.Width) and
     (Y >= FComponent.Y) and (Y <= FComponent.Y + FComponent.Height) then
    FMouseAction := maMove;
  FormPaint(Sender);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MX, MY, GX, GY: Integer;
begin
  if FMouseAction = maMove then
  begin
    MX := FComponent.X - FMoveStart.X + X;
    MY := FComponent.Y - FMoveStart.Y + Y;
    if FSnapToGrid then
    begin
      // перемещение по сетке
      GX := Round(MX / FGridX) * FGridX;
      GY := Round(MY / FGridY) * FGridY;
      if Abs(FComponent.X - MX) >= FGridX then
        FComponent.X := GX;
      if Abs(FComponent.Y - MY) >= FGridY then
        FComponent.Y := GY;
    end
    else
    begin
      FComponent.X := MX;
      FComponent.Y := MY;
    end;
  end;
  FMoveStart := Point(X, Y);
  Repaint;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMouseAction := maNone;
end;

procedure TForm1.FormPaint(Sender: TObject);
var I, J: Integer;
begin
  I := 0;
  while I < Height do
  begin
    J := 0;
    while J < Width do
    begin
      Canvas.Pixels[J, I] := clBlack;
      Inc(J, FGridX);
    end;
    Inc(I, FGridY);
  end;
  Canvas.Rectangle(FComponent.X, FComponent.Y,
                   FComponent.X + FComponent.Width,
                   FComponent.Y + FComponent.Height);
end;

end.

проблема здесь:

Код:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MX, MY, GX, GY: Integer;
begin
  if FMouseAction = maMove then
  begin
    MX := FComponent.X - FMoveStart.X + X;
    MY := FComponent.Y - FMoveStart.Y + Y;
    if FSnapToGrid then
    begin
      // перемещение по сетке
      GX := Round(MX / FGridX) * FGridX;
      GY := Round(MY / FGridY) * FGridY;
      if Abs(FComponent.X - MX) >= FGridX then
        FComponent.X := GX;
      if Abs(FComponent.Y - MY) >= FGridY then
        FComponent.Y := GY;
    end
    else
    begin
      FComponent.X := MX;
      FComponent.Y := MY;
    end;
  end;
  FMoveStart := Point(X, Y);
  Repaint;
end;

этот код работает, но не так как надо, перемещение объекта происходит только при резком перемещении мыши, парюсь уже двое суток и ничто не могу придумать, гугл ничего существенного не находит, если кто сталкивался с такой проблемой или знает решение - помогите плиз!

заранее благодарен!

[Nyctos Kasignete]

Так попробуйте.

Код:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MX, MY, GX, GY: Integer;
begin
  if FMouseAction = maMove then
  begin
    MX := FComponent.X - FMoveStart.X + X;
    MY := FComponent.Y - FMoveStart.Y + Y;
    if FSnapToGrid then
    begin
      // перемещение по сетке
      GX := Round(MX / FGridX) * FGridX;
      GY := Round(MY / FGridY) * FGridY;
      FMoveStart := Point(GX - FComponent.X + FMoveStart.X,
                          GY - FComponent.Y + FMoveStart.Y);
      FComponent.X := GX;
      FComponent.Y := GY;
    end
    else
    begin
      FComponent.X := MX;
      FComponent.Y := MY;
      FMoveStart := Point(X, Y);
    end;
  end;
  Repaint;
end;

[Ayas]

это не помогает

[Nyctos Kasignete]

Вы уверены? o_O Я же проверяю прежде чем советовать.
Или я не поняла, что требуется? У меня после внесенных изменений прямоугольник стал перемещаться без рывков мыши, в точности как в Delphi по форме во время дизайна...

P.S. Просто возьмите свой исходный код, который вы выложили выше и замените процедуру FormMouseMove на ту, что с моими исправлениями. Работает как надо, вроде...

[Ayas]

ой, сорри, сенк, просто предоставленый мной код для одной фигуры, в оригинальном их много и обрабатывается в цикле, запутался там, сенк, сенк, сенк

[mskvkin]

а как сделать такое же перемещение для компонентов???

[Nyctos Kasignete]

Точно так же, с той лишь оговоркой, что при возникновении события OnMouseDown/OnMouseMove координаты курсора будут относительно верхнего левого угла компонента, а не формы.
Например, вот для панельки:

Код:

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  with Panel1 do
  begin
    Left := 23;
    Top := 47;
    Width := 278;
    Height := 138;
  end;
  FMouseAction := maNone;
  FGridX := 10;
  FGridY := 10;
  FSnapToGrid := True;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMoveStart := Point(X + Panel1.Left, Y + Panel1.Top);
  if (X >= 0) and (X <= Panel1.Width) and
     (Y >= 0) and (Y <= Panel1.Height) then
    FMouseAction := maMove;
  Form1.Invalidate;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MX, MY, GX, GY: Integer;
begin
  if FMouseAction = maMove then
  begin
    MX :=  Panel1.Left shl 1 - FMoveStart.X + X;
    MY := Panel1.Top shl 1 - FMoveStart.Y + Y;
    if FSnapToGrid then
    begin
      GX := Round(MX / FGridX) * FGridX;
      GY := Round(MY / FGridY) * FGridY;
      FMoveStart := Point(GX - Panel1.Left + FMoveStart.X,
                          GY - Panel1.Top + FMoveStart.Y);
      Panel1.Left := GX;
      Panel1.Top := GY;
    end
    else
    begin
      Panel1.Left := MX;
      Panel1.Top := MY;
      FMoveStart := Point(X + Panel1.Left, Y + Panel1.Top);
    end;
  end;
  Form1.Invalidate;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMouseAction := maNone;
end;

[mskvkin]

Спасибо все работает но как убрать мерцание Panel при наведении мышки на него и при пперемещении(тоже немного мерцает)

[Nyctos Kasignete]

А у меня не мерцает. ^_^ Двигается «дёрганно» от узла к узлу — это правда, но не мерцает.
Попробуйте при создании формы указать

Код:

Panel1.DoubleBuffered := True;