[Webinar] Streamline your web hosting managementRegister Today

x
Solved

# draging and dropping dots around the canvas.

Posted on 2004-11-13
Medium Priority
177 Views
Hi guys,

Here is what I want to do: I have an array of dots (I know the coordinates X,Y of each dot), on the canvas of a window [in fact, I am working over a TImage]. I want to move these points around the canvas with the mouse. Any ideas to accomplish this task?

best regards
Manuel Lopez (lopem)
0
Question by:lopem
• 3

LVL 5

Expert Comment

ID: 12578023
Could you tell me more?

What are the dots? Are they controls or do you draw them on the canvas?
How are the dots declared and how do you position them?
0

LVL 3

Author Comment

ID: 12579128
Dots can be just pixels that I write on canvas. Dots are declared as an array of coordinates[x,y]. Of course, they can be images or buttons. I mean, I just need some little points (imagine little red circles (2 pixel radius)) with the property of drag and drop.

Am I explaining to you?
best regards
Manuel Lopez (lopem)
0

LVL 5

Assisted Solution

paulb1989 earned 200 total points
ID: 12579595
var
Dots: array[0..9] of TPoint;
CurrentDot: Integer;

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
CurrentDot:=-1;

for i:= 0 to 9 do
begin
if (X-Dots[i].X>3) and
(X-Dots[i].X>-1) and
(Y-Dots[i].Y>3) and
(Y-Dots[i].Y>-1) then
begin
CurrentDot:=i;
end;
end;
end;

procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if CurrentDot>-1 then
begin
Dots[CurrentDot].X:=X;
Dots[CurrentDot].Y:=Y;

end;
end;

I havent tried that, just typed it straight in here, so I don't guarantee that it works.
0

LVL 5

Expert Comment

ID: 12579601
oops... Change the MouseDown one to this. Should use <3 rather than >3.

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
CurrentDot:=-1;

for i:= 0 to 9 do
begin
if (X-Dots[i].X<3) and
(X-Dots[i].X>-1) and
(Y-Dots[i].Y<3) and
(Y-Dots[i].Y>-1) then
begin
CurrentDot:=i;
end;
end;
end;
0

LVL 17

Accepted Solution

mokule earned 400 total points
ID: 12579912
Hi,
Place image on a form and try this

unit Unit1;

interface

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

const
MAXPT = 20;

type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
pts: array[0..MAXPT] of TPoint;
ptCnt: integer;
Xprev, Yprev: integer;
PtSel: integer;
procedure DrawPoints;
procedure DrawPointsSel;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
PtSel := -1;
XPrev := -1;
// set some arbitrary points
pts[0] := Point(20,20);
pts[1] := Point(40,20);
pts[2] := Point(20,40);
ptCnt := 3;

DrawPoints;
end;

procedure TForm1.DrawPoints;
var
i: integer;
bmp:TBitmap;
begin
bmp := TBitmap.Create;
bmp.Width := Image1.Width;
bmp.Height := Image1.Height;
bmp.PixelFormat := pf24bit;
Image1.Picture.Bitmap.Canvas.Pen.Mode := pmCopy;
Image1.Picture.Bitmap.Canvas.Pen.Color := clBlack;
for i := 0 to ptCnt-1 do
bmp.Canvas.Ellipse(pts[i].X-2,pts[i].Y-2,pts[i].X+2,pts[i].Y+2);
Image1.Picture.Bitmap.Assign(bmp);
bmp.Free;
end;

procedure TForm1.DrawPointsSel;
var
i: integer;
bmp:TBitmap;
begin
if PtSel >= 0 then
begin
Image1.Picture.Bitmap.Canvas.Pen.Mode := pmNot;
Image1.Picture.Bitmap.Canvas.Pen.Color := clRed;
if XPrev >= 0 then
Image1.Picture.Bitmap.Canvas.Ellipse(Xprev-2,Yprev-2,Xprev+2,Yprev+2);
Image1.Picture.Bitmap.Canvas.Ellipse(pts[PtSel].X-2,pts[PtSel].Y-2,pts[PtSel].X+2,pts[PtSel].Y+2);
Xprev := pts[PtSel].X;
Yprev := pts[PtSel].Y;
end;

end;

// select nearest point if it is near enough
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: integer;
d: integer;
dmin: integer;
begin
if mbLeft = Button then
begin
dmin := 15;
for i := 0 to ptCnt-1 do
begin
d := (X-pts[i].X)*(X-pts[i].X) + (Y-pts[i].Y)*(Y-pts[i].Y);
if d < dmin then
begin
dmin := d;
PtSel := i;
Xprev := pts[PtSel].X;
Yprev := pts[PtSel].Y;
end;
end;
end;
end;

// move selected point
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if PtSel >= 0 then
begin
pts[PtSel].X := X;
pts[PtSel].Y := Y;
DrawPointsSel;
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if mbLeft = Button then
begin
if PtSel >= 0 then
begin
pts[PtSel].X := X;
pts[PtSel].Y := Y;
end;
DrawPoints;
PtSel := -1;
XPrev := -1;
end;
end;

end.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Hi, this video explains a free download that you can incorporate into your Access databases, or use stand-alone for contact management. Contacts -- Names, Addresses, Phone Numbers, eMail Addresses, Websites, Lists, Projects, Notes, Attachments…
Get the source code for a fully functional Access application shell with several popular security features that Access VBA application developers desire, but find difficult or impossible to figure out how to code. You get the source code for managi…
###### Suggested Courses
Course of the Month9 days, 7 hours left to enroll