![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
![]() всем привет!
помогите пожалуйста реализовать код перемещения визуального объекта на форме по сетке Код:
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; этот код работает, но не так как надо, перемещение объекта происходит только при резком перемещении мыши, парюсь уже двое суток и ничто не могу придумать, гугл ничего существенного не находит, если кто сталкивался с такой проблемой или знает решение - помогите плиз! заранее благодарен! |