Implementación de un Canvas para modificar Objetos en Delphi parte XI

En éste artículo me dedicaré a explicaros como he resuelto el problema de las etiquetas. Dado que las líneas expresan un concepto, deberíamos poder indicarlo de alguna manera mediante una etiqueta (label) indicando una pequeña descripción de ésta. El problema empieza por saber dónde tengo que poner ese texto (ubicación exacta en coordenadas) y el ángulo exacto de inclinación que existe sobre la recta. El cálculo es relativamente fácil, ya que solo tenemos que calcular el angulo formado por dos puntos del plano, y buscar el punto médio de un segmento. Mediante éstos 2 cálculos ya tenemos el 50% del trabajo hecho. El otro 50% lo tenemos que completar buscando alguna forma para dibujar éste texto en ése punto con la inclinación dada. Pero para ésto tampoco hay ningún problema. Si os acordáis de mi post : Mostrar el texto en la orientación que queramos en un canvas, aquí describo como funciona el tema de las fuentes para dibujarlas en la orientación que queramos.

• 1. Calcular el ángulo formado por dos puntos del plano:

Mediante éste pequeña función obtendremos el cálculo:

function TAbstractLine.CalcAngleTwoPoints(Source, Target: TPoint): double;
var
 angle: double;
begin
 angle := 180 * (1 + ArcTan2(Source.y - Target.y, Target.x - Source.x) / PI);
 if angle >= 360.0 then
     angle := angle - 360.0;
 result := angle;
end;

• 2. Calcular el punto medio de un segmento:

Con éste cálculo obtenemos el punto medio:

 Position := Point((target.x + source.x) div 2, (target.y + source.y) div 2);

Ahora, la función que nos permite dibujar el tema de las descripciones es el siguiente:

procedure TAbstractLine.DrawTextOrientation(Source, Target: TPoint);

  function iif(condition: boolean; resultTrue: integer; resultFalse: integer): integer;
  begin
      result := resultFalse;
      if Condition then
          result := resultTrue
  end;
var
  newFont, FontSelected: integer;
  ft: TFont;
  angle: double;
  iAngle: integer;
  Position: TPoint;
begin
  ft := TFont.Create;
  ft.Name := 'Arial';
  ft.Size := 12;
  ft.Style := ft.Style - [fsBold, fsItalic, fsUnderline, fsStrikeOut];
  angle := CalcAngleTwoPoints(Source, Target);
  iAngle := Round(angle);
  Position := Point((target.x + source.x) div 2, (target.y + source.y) div 2);
  if FDescription = '' then
      exit;
  SetBkMode(Fcanvas.handle, transparent);
  newFont := CreateFont(
      -ft.Size,
      0,
      iAngle * 10,
      0,
      iif(fsBold in ft.Style, FW_BOLD, FW_NORMAL),
      iif(fsItalic in ft.Style, 1, 0),
      iif(fsUnderline in ft.Style, 1, 0),
      iif(fsStrikeOut in ft.Style, 1, 0),
      ANSI_CHARSET,
      OUT_TT_PRECIS,
      CLIP_DEFAULT_PRECIS,
      PROOF_QUALITY,
      FF_DONTCARE,
      PChar(ft.Name));

  FontSelected := SelectObject(Fcanvas.handle, newFont);
  TextOut(Fcanvas.handle, position.x, position.y, PChar(FDescription), length(FDescription));
  SelectObject(Fcanvas.handle, FontSelected);
  DeleteObject(newFont);
  FreeAndNil(ft);
end;

El resultado final, lo podéis comprobar en la siguiente imagen:

Aquí os dejo la última versión de la aplicación ThundaxBoxManager v1.0.0 Build 71.exe para que le echéis un vistazo y comprobéis el estado de la aplicación, que poco a poco va dando sus frutos.

Implementación de un Canvas para modificar Objetos en Delphi parte V

En éste artículo os describo las diferentes mejoras que trae la aplicación. Llevo un rato trabajando sobre el proyecto y he conseguido diferentes cosas. En ésta versión, he implementado la mejora anterior del movimiento del mouse (ahora ya no se escapa ningún evento), también la mejora con el redimensionado de las cajas (ocurría lo mismo que con lo de mover la caja), y además he incorporado el dibujado de flechas entre cajas. Antes se dibujaban líneas de centro a centro de la cajas y ahora hago un pequeño cálculo para encontrar la intersección entre las 2 rectas. No es muy complicado, sabiendo un poco de matemáticas se resuelve rápido. En la wikipedia podréis encontrar información sobre las rectas.

Si observamos una imagen de la aplicación veréis de lo que hablo:

Un cálculo parecido al que hay que hacer es el siguiente:

m := 0;
if (RectaP2.x - RectaP1.x) <> 0 then
    m := (RectaP2.y - RectaP1.y) / (RectaP2.x - RectaP1.x);
d := RectaP1.y - m * (RectaP1.x);

m2 := 0;
if (Recta2P2.x - Recta2P1.x) <> 0 then
    m2 := (Recta2P2.y - Recta2P1.y) / (Recta2P2.x - Recta2P1.x);
d2 := Recta2P1.y - m2 * (Recta2P1.x);

x := 0;
if (m - m2) <> 0 then
    x := (d2 - d) / (m - m2);
y := m * x + d;

s := false;
if ((RectaP1.x - x) * (x - RectaP2.x) >= 0)
    and ((RectaP1.y - y) * (y - RectaP2.y) >= 0)
    and ((Recta2P1.x - x) * (x - Recta2P2.x) >= 0)
    and ((Recta2P1.y - y) * (y - Recta2P2.y) >= 0) then
    s := true;

Solo hay que adaptarlo para los 4 laterales de la caja, ya que las rectas son conocidas. Hay que buscar la intersección entre la recta 1 = Entre centros y le recta 2 que será uno de los laterales, vértices 1-2, 2-3, 3-4, 4-1. Una vez encontramos el que intersecciona dibujamos la flecha.

La flecha, ya la tenía implementada en uno de mis post antiguos: Drawing an Arrow.

Aquí podréis descargar la última versión de la aplicación ThundaxBoxManager v1.0.0 build 16.exe, espero que la disfrutéis.

Además de las modificaciones anteriores, también he cambiado el tema del solapamiento. Cuando tenemos un objeto seleccionado, sus eventos no interaccionan con los objetos que hay no seleccionados. Antes ocurría que ibas moviendo una caja y cuando pasabas por encima de otra se movía también. Ahora queda todo el conjunto bien definido con la posibilidad de cambiar el orden.

Algo que también se me olvidó en el artículo anterior es que he utilizado el DobleBuffering en la aplicación para evitar el parpadeo o flickering.

• Enlaces de interés:

Ecuación de la recta que pasa por 2 puntos.
Intersecting Lines algorithm.

Utilización de Visprint con Delphi (Visual FingerPrint Generator)

Visprint es un programa que permite generar un fractal en función del contenido de un fichero. Ésto nos permite crear una firma para nuestros ficheros de código fuente muy interesante. He creado una pequeña aplicación, llamada Thundax Visprint, que utiliza las herramientas de Visprint, para generar fractales a partir de código delphi. Podemos utilizar cualquier fichero, pero en general lo he utilizado para ver que tipo de diagramas genera mi código. Conocí visprint gracias a una entrada que creó Fernando Acero en Kriptópolis, uno de los blogs que sigo. La verdad es que he encontrado ésta aplicación muy interesante y mediante la utilización de un checksum MD5, visprint es capaz de generar el diagrama a partir de éste número de 32 bits.

Visprint utiliza la generación de fractales IFS de Michael Barnsley, y David Johnston ha creado la última implementación de la aplicación.

Por defecto he dejado los parámetros básicos de la generación del diagrama, con la modificación de dejar la imagen en 600x600 pixels. Desde la herramienta, podremos parsear el fichero de código fuente (.pas) generando el MD5, luego ejecutando los diferentes procesos de Visprint en segundo plano y luego cargar la imagen PPM (Portable Pixmap Format) en un TImage utilizando la clase (TAEPPMGraphic), de ésta manera no tengo que estar jugando con herramientas de conversión (PPMtoBMP o PPMtoJPEG) que aún me harían más complicado el trabajo. Una vez hecho ésto, veremos cargada la imagen en la aplicación y podremos guardar el resultado en un Bitmap (de ésta manera lo hacemos más portable).

Si instalamos la aplicación y la iniciamos, obtendremos:


Ésta es la imagen de presentación (Bonita, no???), pues es la imagen del código fuente de mi Canvas personalizado del último post que hice sobre la implementación de objetos.

Los pasos a seguir son muy simples, primero hay que seleccionar el fichero, y luego ir pulsando los diferentes botones en el orden establecido. Ya veréis que irán apareciendo diferentes mensajitos indicando que la operación está acabada.

Luego, una vez hecho, podremos ver nuestro fractal generado a partir del código fuente:

Como podéis ver, cuánto más entropía hay en fichero, más bonito es:

• Enlaces de Interés:

Conversor NetPBM.
Visor de PPM Cognaxon.
disp189a.zip (Display PPM).
Delphi Images.

Jugando con Elipses en Delphi

Hoy os traigo una pequeña aplicación didáctica en delphi que dibuja elipses (mejor dicho círculos, pero utilizo el metodo elipse del TCanvas para dibujarlo) y detecta las colisiones entre estas arrastrando el mouse por encima. Observareis que es muy simple pero sirve para jugar un poco con el canvas y el ratón y ver que tipo de aplicaciones visuales podemos llegar a hacer con delphi. Al pasar el mouse por encima del objeto detecta su paso y muestra un color de colisión. Además al mover una de las elipses hacia otro objeto, se detecta la colisión entre estos y se frena el movimiento si dejarte mover el objeto. La detección es muy sencilla, mediante la posición del mouse se comprueba que la distancia de éste con el centro de cualquiera de las otras elipses sea mayor que la distancia del objeto a arrastrar y las otras elipses, un principio muy simple pero que funciona muy bien y sin tener que hacer cálculos desorbitados. Aquí os dejo la aplicación Thundax Draw Ellipses, y parte del código fuente y un pantallazo de la aplicación:


La clase TEllipse:

unit ThundaxEllipse;

interface

uses
    types, Graphics, Classes, Controls;

type
    TEllipse = class(TObject)
    private
        FborderColor: TColor;
        Flength: integer;
        FlineWidth: integer;
        FCollisionColor: TColor;
        FColor: TColor;
        Fposition: TPoint;
        FCanvas: TCanvas;
        FDrag: boolean;
        Fid: string;
        Fradium: integer;
        FCenter: TPoint;
        procedure SetborderColor(const Value: TColor);
        procedure SetCollisionColor(const Value: TColor);
        procedure SetColor(const Value: TColor);
        procedure Setlength(const Value: integer);
        procedure SetlineWidth(const Value: integer);
        procedure Setposition(const Value: TPoint);
        procedure SetDrag(const Value: boolean);
        procedure SetCenter(const Value: TPoint);
        procedure Setid(const Value: string);
        procedure Setradium(const Value: integer);
    public
        property position: TPoint read Fposition write Setposition;
        property id: string read Fid write Setid;
        property Drag: boolean read FDrag write SetDrag;
        property length: integer read Flength write Setlength;
        property Color: TColor read FColor write SetColor;
        property borderColor: TColor read FborderColor write SetborderColor;
        property lineWidth: integer read FlineWidth write SetlineWidth;
        property CollisionColor: TColor read FCollisionColor write SetCollisionColor;
        constructor Create(Canvas: TCanvas; center: TPoint; length: integer);
        function PointInside(x, y: integer): boolean;
        procedure SetMousePosition(x, y: integer);
        procedure Draw(x, y: integer);
        procedure EnableDrag(x, y: integer);
        property Center: TPoint read FCenter write SetCenter;
        property radium: integer read Fradium write Setradium;
    end;
implementation

{ TEllipse }

constructor TEllipse.Create(Canvas: TCanvas; center: TPoint; length: integer);
begin
    FCanvas := Canvas;
    Fposition := center;
    FLength := length;
    FDrag := false;
    FCenter := point(Fposition.x + (Flength div 2), Fposition.y + (Flength div 2));
    FRadium := FLength div 2;
end;

procedure TEllipse.Draw(x, y: integer);
begin
    if FDrag then
        SetMousePosition(x, y);
    if PointInside(x, y) then
        FCanvas.Brush.Color := FCollisionColor
else
        FCanvas.Brush.Color := FColor;

    FCanvas.Pen.Color := FborderColor;
    FCanvas.Pen.Width := 1;
    FCanvas.Ellipse(Fposition.x, Fposition.y, Fposition.x + FLength, Fposition.y + FLength);
    FCanvas.Font.Color := clWhite;
    FCanvas.TextOut(Fposition.x + (Flength div 2) - 5, Fposition.y + (Flength div 2) - 7, FId);
end;

procedure TEllipse.EnableDrag(x, y: integer);
begin
    if PointInside(x, y) then
        Fdrag := true;
end;

function TEllipse.PointInside(x, y: integer): boolean;
var
    x0, y0, a, b: integer;
    point2: TPoint;
begin
    point2 := Point(Fposition.x + Flength, FPosition.y + Flength);
    x0 := (Fposition.x + point2.x) div 2;
    y0 := (Fposition.y + point2.y) div 2;
    a := (point2.x - Fposition.x) div 2;
    b := (point2.y - Fposition.y) div 2;
    result := (Sqr((x - x0) / a) + Sqr((y - y0) / b) <= 1);
end;

procedure TEllipse.SetborderColor(const Value: TColor);
begin
    FborderColor := Value;
end;

procedure TEllipse.SetCenter(const Value: TPoint);
begin
    FCenter := Value;
end;

procedure TEllipse.SetCollisionColor(const Value: TColor);
begin
    FCollisionColor := Value;
end;

procedure TEllipse.SetColor(const Value: TColor);
begin
    FColor := Value;
end;

procedure TEllipse.SetDrag(const Value: boolean);
begin
    FDrag := Value;
end;

procedure TEllipse.Setid(const Value: string);
begin
    Fid := Value;
end;

procedure TEllipse.Setlength(const Value: integer);
begin
    Flength := Value;
end;

procedure TEllipse.SetlineWidth(const Value: integer);
begin
    FlineWidth := Value;
end;

procedure TEllipse.SetMousePosition(x, y: integer);
begin
    FPosition := point(x - (Flength div 2), y - (Flength div 2));
    FCenter := point(Fposition.x + (Flength div 2), Fposition.y + (Flength div 2));
end;

procedure TEllipse.Setposition(const Value: TPoint);
begin
    Fposition := Value;
end;

procedure TEllipse.Setradium(const Value: integer);
begin
    Fradium := Value;
end;

end.

El cálculo de las colisiones:

procedure TForm3.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
    i, j: integer;
    Collide: boolean;
    textCollision: string;
    Collisions: array[1..20] of integer;
begin
    DrawRectangle(clWhite, clWhite);
    Memo1.lines.Clear;
    textCollision := '';
    Collide := false;
    for i := 1 to 20 do
        Collisions[i] := -1;

    for i := 1 to number do
    begin
        for j := 1 to number do
            if Ellipses[i].drag and
                distanciaMouse(Point(x, y), Ellipses[i].center, Ellipses[j].center) and
                Collision(ellipses[i], ellipses[j]) then
            begin
                Memo1.lines.add('Collide True ->' + inttostr(i) + ' ' + inttostr(j));
                Collide := true;
                Collisions[i] := i;
            end;
    end;

    for i := 1 to number do
    begin
        if Collisions[i] = -1 then
            ellipses[i].Draw(x, y)
        else
            ellipses[i].draw(ellipses[i].center.x, ellipses[i].center.y);
        Memo1.lines.add('Collision ' + inttostr(Collisions[i]));
    end;

    if collide then
        textCollision := 'Collision!';

    StatusBar1.Panels[0].Text := 'x : ' + inttostr(x) + ' y : ' + inttostr(y) + ' ' + textCollision;
end;

function TForm3.DistanciaMouse(p1, p2, p3: TPoint): boolean;
begin
    result := false;
    if (p2.x <> p3.x) and (p2.y <> p3.y) then
        result := (distancia(p1, p3) < distancia(p2, p3))
end;

function TForm3.Collision(p1, p2: TEllipse): boolean;
begin
    result := false;
    if p1 <> p2 then
        result := distancia(p1.center, p2.center) < (2 * (p1.radium));
end;

function TForm3.distancia(p1, p2: TPoint): double;
begin
    result := sqrt(sqr(p1.x - p2.x) + sqr(p1.y - p2.y));
end;

Implementando Diagramas de Voronoi en Delphi

Hoy os muestro uno de los últimos problemas de geometría computacional que me queda por mostrar y resolver. En éste caso se trata de los diagramas de Voronoi o Polígonos de Thiessen. Éste es el que me ha representado dificultad para su resolución, pero bueno con una buena base matemática es bastante posible. Además me he servido de mis anteriores aplicaciones Thundax Convex Hull y Spanning Tree, las cuales aparecen en ésta aplicación también. Los diagramas de voronoi se aplican en estudios en los que hay que determinar áreas de influencia (centros hospitalarios, estaciones de bomberos, bocas de metro, centros comerciales, control del tráfico aéreo, telefonía móvil, análisis de poblaciones de especies vegetales, etc.). Es una de las funciones de análisis básicas en los Sistemas de información geográfica. La aplicación que os dejo aquí aún está en fase de desarrollo, pero ya se pueden ver y calcular los diagramas correctamente. Aquí os dejo unas imágenes de la aplicación Thundax Voronoi.

Aquí os dejo un documento muy interesante que explica el cálculo de las celdas: voronoi.pdf. También os dejo unos cuantos applets los cuales podréis probar online:

Voronoi/Delaunay Applet:
Voronoi Game Applet:

• Enlaces de interés:

Colección applets voronoi.

Implementando automated linked objects con Delphi parte III

Bueno, continuando con la misma línea de ayer, esta vez he hecho un par de cambios que determinan que las conexiones o enlaces también son objetos. De ésta manera al seleccionar un enlace este se marca como seleccionado y nos aparecen sus propiedades aún muy austeras pero la base ya está fabricada. Los cambios más importantes de diseño radican en la modificación de la clase TLinkPainter que ahora recoge los datos de TConnector que éste es el que recoge los puntos de la conexión. Si observamos el diagrama de diseño obtenemos:

Como podéis observar en el diagrama, ahora existe TConector que tiene una lista de vértices. Éstos vértices son los puntos de conexión creados por el Controlador. Una vez tengo la lista de los puntos, o sea que he calculado los vectores de conexión entre líneas, los puedo enviar al TLinkPainter para que los dibuje sobre el canvas. La modificación es importante ya que he eliminado parte importante del TLinkPainter ya que éste solo dibujaba líneas sobre el canvas y ahora es un "objeto".

Si observamos la aplicación, nos aparecen las propiedades del enlace de la siguiente manera:

Ahora, al hacer click sobre una de las cajas o sobre la línea de unión, podemos reconocer el objeto que tenemos bajo el mouse. Aquí os dejo la última versión de la aplicación ThundaxGeometricLinks v1.0.0 build 36.

Aquí os dejo también la definición de la clase TConnector:

type
    TVertexList = class(TObjectList)
    protected
        function GetItem(Index: Integer): TVertex; overload;
        procedure SetItem(Index: Integer; AObject: TVertex);
    public
        property Items[Index: Integer]: TVertex read GetItem write SetItem; default;
    end;

    TConnector = class(TPersistent)
    private
        vertexList: TVertexList;
        Fcolor: TColor;
        FPenWidth: integer;
        FSelectedColor: TColor;
        FSelected: boolean;
        procedure Setcolor(const Value: TColor);
        procedure SetPenWidth(const Value: integer);
        procedure SetSelected(const Value: boolean);
        procedure SetSelectedColor(const Value: TColor);
    published
        property color: TColor read Fcolor write Setcolor;
        property PenWidth: integer read FPenWidth write SetPenWidth;
        property SelectedColor: TColor read FSelectedColor write SetSelectedColor;
    public
        property Selected: boolean read FSelected write SetSelected;
        constructor Create(color: TColor; SelectedColor: TColor);
        procedure Add(vertex: TVertex);
        function isInside(vertex: TVertex): boolean;
        procedure EmptyList();
        destructor Destroy(); override;
    end;

Palabras de búsqueda:

Connect two objects.
Draw line between two points
Draw connector

• Enlaces de interés:

Computational Geometry.
Algorithmic Geometry.

Implementando automated linked objects con Delphi parte II

Como podéis comprobar la aplicación sigue adelante. En éste caso he mejorado todo el tema de las propiedades y su edición implementando un MVC (Modelo vista controlador) en el TBox. Ahora existe un TBoxView que se encarga de la visualización y de manejar los eventos de éste y mediante el TBoxManager crearemos el controlador para el TBox. Si observamos la nueva distribución de clases en nuestra aplicación tenemos:

Nuestro modelo Tbox es gestionado por el TboxManager y visualizado por el TBoxView. Encontraréis muchas referencias sobre éste patrón (MVC) en diversos libros y en las referencias que dejaré en éste artículo. El problema del diseño original es que al querer modificar las propiedades de la Tbox desde la pantalla, eso requiere que modifiques directamente este objeto y no debería de ser así. Para eso se crea un visualizador, que es el que gestiona la vista de la Tbox sobre la pantalla, y las modificaciones de estado se gestionan sobre el manager y así de vuelta al modelo. De esta manera tenemos separados la lógica de programa, la interfaz de usuario y la lógica de control. En mi caso el visor se implementa sobre un TImage, y se controlan los eventos sobre éste.

Aquí os dejo el siguiente build de la aplicación Thundax Geometric Links v1.0.0 build 20. Comprovaréis que la aplicación ha augmentado su tamaño (más de 5 Mb), eso es debido al componente RTTI que carga mucha parte de la VCL de DevExpress. Aquí os dejo unas imágenes para que podáis ver el resultado:

Aún queda mucho trabajo por hacer y muchos módulos por encajar pero ya llegará. Ya lo iréis viendo!.

Veamos un poco la codificación creada:

Creación de la aplicación MVC:

procedure TForm1.FormCreate(Sender: TObject);
begin
    BoxP := TBoxPainter.Create(image1);
    BoxL := TLinkPainter.Create(image1, SourceBox, TargetBox);
    BoxW := TBoxView.Create(image1, SourceBox, TargetBox, BoxP, BoxM, BoxL);
    BoxM := TBoxManager.Create(SourceBox, TargetBox);
    BoxW.OffsetBox := offsetBox;
    BoxW.SetInspector(cxRTTIInspector1);
    BoxW.Draw();
end;

Modificación de la clase TBox:

    TVertex = class(TPersistent)
    private
        Fx: integer;
        Fy: integer;
        procedure Setx(const Value: integer);
        procedure Sety(const Value: integer);
    published
        property x: integer read Fx write Setx;
        property y: integer read Fy write Sety;
    public
        constructor Create(x: integer; y: integer); overload;
        constructor Create(point: TPoint); overload;
        function getPoint(): TPoint;
        procedure setPoint(point: TPoint);
    end;

    TBox = class(TPersistent)
    private
        FColor: TColor;
        FSize: integer;
        FOffset: integer;
        FDirection: TDirection;
        FlinkColor: TColor;
        Flink: TVertex;
        Fcenter: TVertex;
        Fvertex: array[0..3] of TVertex;
        FIntersection: TVertex;
        FColisionColor: TColor;
        FDrawColor: TColor;
        function getIntersectionPoint(): TVertex;
        procedure SetColor(const Value: TColor);
        procedure SetOffset(const Value: integer);
        procedure SetSize(const Value: integer);
        procedure SetDirection(const Value: TDirection);
        procedure SetlinkColor(const Value: TColor);
        procedure SetcenterPoint(const Value: TVertex);
        procedure SetlinkPoint(const Value: TVertex);
        procedure Setvertex(Index: integer; value: TVertex);
        function Getvertex(Index: integer): TVertex;
        procedure SetLink(point: TVertex);
        procedure SetColisionColor(const Value: TColor);
        procedure SetDrawColor(const Value: TColor);
    published
        property vertex0: TVertex index 0 read Getvertex write Setvertex;
        property vertex1: TVertex index 1 read Getvertex write Setvertex;
        property vertex2: TVertex index 2 read Getvertex write Setvertex;
        property vertex3: TVertex index 3 read Getvertex write Setvertex;
        property center: TVertex read Fcenter write SetcenterPoint;
        property link: TVertex read Flink write SetlinkPoint;
        property Direction: TDirection read FDirection write SetDirection;
        property intersection: TVertex read getIntersectionPoint;
        property Offset: integer read FOffset write SetOffset;
        property Size: integer read FSize write SetSize;
        property Color: TColor read FColor write SetColor;
        property linkColor: TColor read FlinkColor write SetlinkColor;
        property ColisionColor: TColor read FColisionColor write SetColisionColor;
        property DrawColor: TColor read FDrawColor write SetDrawColor;
    public
        function BetweenX(point: TPoint): boolean; overload;
        function BetweenY(point: TPoint): boolean; overload;
        function BetweenX(point: TVertex): boolean; overload;
        function BetweenY(point: TVertex): boolean; overload;
        procedure SetCentre(vertex: TPoint);
        procedure SetLinkDirection(up, down, left, right: boolean);
        function PointInside(point: TPoint): boolean;
        constructor Create(centerPoint: TPoint; Size: integer; Offset: integer; Color: integer; linkColor: integer; ColisionColor: integer);
        destructor Destroy(); override;
    end;

Implementación de los eventos de Mouse en la vista:

procedure TBoxView.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if FTargetBox <> nil then
        if FTargetBox.pointInside(point(x, y)) then
        begin
            activeDragTarget := true;
            cxRTTIInspector1.InspectedObject := nil;
            cxRTTIInspector1.InspectedObject := FTargetBox;
        end;
    if FSourceBox <> nil then
        if FSourceBox.pointInside(point(x, y)) then
        begin
            activeDragSource := true;
            cxRTTIInspector1.InspectedObject := nil;
            cxRTTIInspector1.InspectedObject := FSourceBox;
        end;
    if (not activeDragSource) and (not activeDragTarget) then
        cxRTTIInspector1.InspectedObject := nil;
end;

procedure TBoxView.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
    if activeDragTarget then
    begin
        FTargetBox.SetCentre(Point(x, y));
        Draw();
    end;
    if activeDragSource then
    begin
        FSourceBox.SetCentre(Point(x, y));
        Draw();
    end;
end;

procedure TBoxView.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    activeDragTarget := false;
    activeDragSource := false;
end;

• Enlaces de Interés:

Framework MVC para Delphi por EazySoft. Descarga directa del eMVC.
MVP por Joanna Carter. Descarga directa del MVPSource.
Java Model View Controller.

Implementando automated linked objects con Delphi parte I

Hoy os traigo una nueva aplicación con la que llevo peleándome 1 semana y que corresponde a la solución de la conexión automática entre objetos (visualizarlo por pantalla). Muchas veces me he encontrado con aplicaciones gráficas que permiten insertar un objeto en pantalla y conectarlo con otro y que ésta conexión sea automática y que busque una forma posible sin tocar los 2 objetos. Pues bien, ésto es lo que he conseguido con mi aplicación. Aún está en una fase de desarrollo pero empiezo mostrando el patrón utilizado para la correcta composición de las clases evitando codificaciones tediosas y haciendo el código altamente inteligible. Aquí os dejo unos pantallazos de mi aplicación:


Desde la aplicación, podemos variar las propiedades de las cajas e indicar la salida del conector. El diagrama UML para su codificación os lo presento aquí:

• Presentación del diseño:

Mi solución consiste en disponer de una clase TBox, que es la que se presenta en pantalla. Cada caja tiene sus propiedades, vértices, color, centro, punto de conexión, tamaño, etc. Pero ella misma no se puede pintar en ningún sitio. Ése trabajo se lo transmite al TBoxManager. Éste se encarga de los cálculos matemáticos correspondientes al recubrimiento del área. Hace los cálculos correspondientes sobre detección de puntos en el plano, en el área interior de la caja.
Luego disponemos de 2 clases que se encargan pintado en un TCanvas. En este caso el TBoxPainter y el TLinkPainter se encargar de hacer el pintado de las cajas y los enlaces en la pantalla. Es el propio TBoxPainter el que llama a la caja para pintarla y no la propia caja (Principio de Hollywood, no me llames tú ya te llamaremos nosotros). El mismo funcionamiento para el TLinkPainter, que recoge 2 cajas y realiza el enlace entre ellas mediante sus funciones internas.

Aquí os dejo la aplicación en una primera fase de desarrollo, Thundax Geometric Links v1.0.0 build 3. Aún me queda todo el tema de las propiedades y corregir alguno de los movimientos y posición que no se resuelve correctamente. Una vez tenga hecho el algoritmo lo podré fusionar con mi anterior aplicación Thundax NeuralLinking.


Aquí os muestro parte del código para la generación de la aplicación y la configuración de las clases diseñadas:

procedure DrawAll;
begin
    SourceBox := TBox.Create(Point(StrToInt(edit1.text), StrToInt(edit2.text)), 8, StrToInt(Edit5.text), clYellow, clAqua);
    SourceBox.SetLinkDirection(up1.checked, down1.checked, left1.checked, right1.checked);
    TargetBox := TBox.Create(Point(StrToInt(edit3.text), StrToInt(edit4.text)), 8, StrToInt(Edit5.text), clLime, clAqua);
    TargetBox.SetLinkDirection(up2.checked, down2.checked, left2.checked, right2.checked);

    BoxM := TBoxManager.Create(SourceBox, TargetBox);
    BoxP := TBoxPainter.Create(image1);
    BoxL := TLinkPainter.Create(image1, SourceBox, TargetBox);

    BoxP.DrawBox(SourceBox);
    BoxP.DrawBox(TargetBox);
end;

type
    TDirection = (isUp, isDown, isLeft, isRight);

    TBox = class(TObject)
    private
        FColor: integer;
        FSize: integer;
        FOffset: integer;
        FDirection: TDirection;
        FlinkColor: integer;
        FlinkPoint: TPoint;
        FcenterPoint: TPoint;
        function getIntersectionPoint(): TPoint;
        procedure SetColor(const Value: integer);
        procedure SetOffset(const Value: integer);
        procedure SetSize(const Value: integer);
        procedure SetDirection(const Value: TDirection);
        procedure SetlinkColor(const Value: integer);
        procedure SetcenterPoint(const Value: TPoint);
        procedure SetlinkPoint(const Value: TPoint);
    public
        vertex: array[0..3] of TPoint;
        property centerPoint: TPoint read FcenterPoint write SetcenterPoint;
        property linkPoint: TPoint read FlinkPoint write SetlinkPoint;
        property Direction: TDirection read FDirection write SetDirection;
        property intersection: TPoint read getIntersectionPoint;
        property Offset: integer read FOffset write SetOffset;
        property Size: integer read FSize write SetSize;
        property Color: integer read FColor write SetColor;
        property linkColor: integer read FlinkColor write SetlinkColor;
        constructor Create(centerPoint: TPoint; Size: integer; Offset: integer; Color: integer; linkColor: integer);
        procedure SetLink(point: TPoint);
        function BetweenX(point: TPoint): boolean;
        function BetweenY(point: TPoint): boolean;
        procedure SetLinkDirection(up, down, left, right: boolean);
        function PointInside(point : TPoint) : boolean;
    end;


type
    TBoxManager = class(TObject)
    private
        FSourceBox: TBox;
        FTargetBox: TBox;
        procedure SetSourceBox(const Value: TBox);
        procedure SetTargetBox(const Value: TBox);
        function PointInsideRegion(testPoint: TPoint): boolean;
    public
        sourceNodes: array[0..3] of TPoint;
        targetNodes: array[0..3] of TPoint;
        property SourceBox: TBox read FSourceBox write SetSourceBox;
        property TargetBox: TBox read FTargetBox write SetTargetBox;
        constructor Create(SourceBox: TBox; TargetBox: TBox);
        function intersected(): boolean;
    end;

type
    TBoxPainter = class(TObject)
    private
        Fimage: TImage;
        FlinkColor: integer;
        procedure Setimage(const Value: TImage);
        procedure DrawLine(point1, point2: TPoint; colorLine: integer);
        procedure DrawRectangle(BackGroundColor, RectangleColor: integer);
    public
        property image: TImage read Fimage write Setimage;
        constructor Create(image: TImage);
        procedure DrawBox(Box: TBox);
    end;
   
type
    TLinkPainter = class(TObject)
    private
        SourceBox: TBox;
        TargetBox: TBox;
        FlinkColor: integer;
        Fimage: TImage;
        procedure DrawLine(point1, point2: TPoint; colorLine: integer);
        procedure SetlinkColor(const Value: integer);
        procedure Setimage(const Value: TImage);
        procedure DrawX(var SourcePoint: TPoint; TargetPoint: TPoint);
        procedure DrawY(var SourcePoint: TPoint; TargetPoint: TPoint);
        procedure DrawMidXY(var SourcePoint: TPoint; TargetPoint: TPoint);
        procedure DrawOffsetX(var SourcePoint: TPoint; TargetPoint: TPoint; Offset: integer);
        procedure DrawXYXOffsetX_target(var SourcePoint: TPoint; TargetPoint: TPoint; OffSet: integer);
        procedure DrawXYXOffsetX_Source(var SourcePoint: TPoint; TargetPoint: TPoint; OffSet: integer);
        procedure DrawYXYOffset(var SourcePoint: TPoint; TargetPoint: TPoint; OffSet: integer);
        procedure DrawXY(var SourcePoint: TPoint; TargetPoint: TPoint);
        procedure DrawOffsetY(var SourcePoint: TPoint; TargetPoint: TPoint; Offset: integer);
    public
        property image: TImage read Fimage write Setimage;
        property linkColor: integer read FlinkColor write SetlinkColor;
        constructor Create(image: TImage; SourceBox, TargetBox: TBox);
        procedure Draw(var SourcePoint: TPoint; TargetPoint: TPoint; OffSet: integer);
    end;

espero que os guste!.