[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

draging and dropping dots around the canvas.

Posted on 2004-11-13
5
Medium Priority
?
177 Views
Last Modified: 2012-05-05
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
Comment
Question by:lopem
  • 3
5 Comments
 
LVL 5

Expert Comment

by:paulb1989
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

by:lopem
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

by:paulb1989
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;

    // Redraw your dots here
  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

by:paulb1989
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

by:
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

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

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

591 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question