Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Draw a line between two Tshape

Posted on 1999-07-30
8
Medium Priority
?
481 Views
Last Modified: 2010-04-04
Hi Experts
Just as the title I'd like to connect to TShape objects with a line.
Thank you
0
Comment
Question by:borgo
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
  • 2
8 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 1392026
hi andrea,

from my paq a sample, which draws a line between two shapes,
the shapes can be freely moved on the form, the line is recalculated by this. it works with an image as background, therefore the line is drawn with xor to the image pixels, but you can give a color in the drawline-method and must then code a clearline-method.

      unit shapes_u;

      interface

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

      type
        TForm1 = class(TForm)
          Shape1: TShape;
          Shape2: TShape;
          Image1: TImage;  //a image as background, align = alclient
          Button1: TButton;
          procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
            Y: Integer);
          procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
          procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
          procedure Button1Click(Sender: TObject);
        private
          { Private-Deklarationen }
        public
          { Public-Deklarationen }
        end;

      var
        Form1: TForm1;

      implementation

      {$R *.DFM}

      Type
        TLine = Record
                  LineBegin : TPoint;
                  LineEnd   : TPoint;
                end;

      var xx,yy : Integer;
          M : TPenMode;
          R : Trect;
          L : TLine;


      //Calculates the shortest line from the sides
      Function CalculateLine(T1,T2 : TControl) : TLine;
      Var
        Points : Array[1..2,1..4] of TPoint;
        i,j,ii,jj : Integer;
        LineLen : Double;
      begin
        Points[1,1] := Point(t1.left + (t1.width div 2),t1.Top - 1);
        Points[1,2] := Point(t1.left + t1.width + 1, t1.top + (t1.Height div 2));
        Points[1,3] := Point(t1.left + (t1.width div 2), t1.top + t1.Height + 1);
        Points[1,4] := Point(t1.Left - 1, t1.top + (t1.Height div 2));

        Points[2,1] := Point(t2.left + (t2.width div 2),t2.Top - 1);
        Points[2,2] := Point(t2.left + t2.width + 1, t2.top + (t2.Height div 2));
        Points[2,3] := Point(t2.left + (t2.width div 2), t2.top + t2.Height + 1);
        Points[2,4] := Point(t2.Left - 1, t2.top + (t2.Height div 2));
        LineLen := MaxLongint;
        for i := 1 to 4 do
          for J := 1 to 4 do
            If LineLen > Sqrt(Sqr(Points[1,i].x - Points[2,j].x)+Sqr(Points[1,i].y - Points[2,j].y)) then
            begin
              LineLen := Sqrt(Sqr(Points[1,i].x - Points[2,j].x)+Sqr(Points[1,i].y - Points[2,j].y));
              ii := i;
              jj := j;
            end;
        Result.LineBegin := Points[1,ii];
        Result.LineEnd   := Points[2,jj];
      end;

      //Draws a line
      Procedure DrawLine(A,B : TPoint);
      begin
        M := Form1.Canvas.Pen.Mode;
        Form1.Canvas.Pen.Mode := pmNotXor;
        Form1.Canvas.MoveTo(A.x,A.y);
        Form1.Canvas.LineTo(B.x,B.y);
        Form1.Canvas.Pen.Mode := M;
      end;

      //is also assigned to shape2
      procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
      begin
        if ssleft in shift then
        begin
          If Sender is TShape then
          begin
            L := CalculateLine(Shape1,Shape2);
            DrawLine(L.LineBegin,L.LineEnd);          //Clears the current line
            TShape(Sender).Top := TShape(Sender).Top+y-yy;
            TShape(Sender).left := TShape(Sender).left+x-xx;
            L := CalculateLine(Shape1,Shape2);
            DrawLine(L.LineBegin,L.LineEnd);         //Draws the new line
          end;
        end;
      end;

      //is also assigned to shape2
      procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      begin
        if Button = mbleft then
        begin
          xx := x;
          yy := y;
        end;
      end;

      //is also assigned to shape2
      procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      begin
        if button = mbleft then
        begin
          Refresh;  //Repaints
          Button1.Click;
        end;
      end;

      //Draws or erase a line
      procedure TForm1.Button1Click(Sender: TObject);
      begin
        L := CalculateLine(Shape1,Shape2);
        DrawLine(L.LineBegin,L.LineEnd);
      end;

      end.

have fun

meikl
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 1392027
This draws a line on your form:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.MoveTo(10,10);
  Canvas.LineTO(100,100);
end;

Does that answer your question?

Eps.
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 1392028
:o)
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Expert Comment

by:kretzschmar
ID: 1392029
hi borgo,
whats going on ?
meikl
0
 

Author Comment

by:borgo
ID: 1392030
Hi kretzschmar
I'm sorry bjut I think that the hot weather has touched my head, and I have forgot to reply you that your answer is exactly what I'm looking for.
Thank you very much and please answer for the points.

Andrea.
0
 

Author Comment

by:borgo
ID: 1392031
Hi kretzschmar
I'm sorry bjut I think that the hot weather has touched my head, and I have forgot to reply you that your answer is exactly what I'm looking for.
Thank you very much and please answer for the points.

Andrea.
0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 40 total points
ID: 1392032
hi andrea,

not at all, here its also hot.

well glad that this helps you
good luck again

meikl ;-)
0
 

Author Comment

by:borgo
ID: 1392033
:-)

Have a nice day Kretzschmar.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
This course is ideal for IT System Administrators working with VMware vSphere and its associated products in their company infrastructure. This course teaches you how to install and maintain this virtualization technology to store data, prevent vuln…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
Suggested Courses

721 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