Problema con drag and drop y con OnPaint

[astwin]

Hola,
estoy realizando una aplicacion que se debe encargar de interconectar de forma grafica una serie de bloque que poseen entradas y salidas. Desde un TreeView se debe escoger el bloque que se desee, con una operacion de drag and drop dibujar el bloque, y pinchando en las entradas y salidas de los bloques se deben interconectar mediante una linea.
Pues bien, he realizado una version muy primitiva de mi aplicacion y tengo un par de problemas.
1.- He intentado realizar la operacion de drag and drop con una imagen del bloque como imagen del drag, pero ella solo aparece cuando vas a insertar un bloque y pasas con el raton en la operacion de drag por encima de otro bloque ya insertado.

2.- Las lineas dibujadas desaparecen, pese a que he programado el evento onPaint del formulario. Ademas, cuando ya existe una linea dibujada y insertas algun bloque, se borra parte de esta.

Si pudierais darme alguna solucion para mis problemas, o decirme alguna otra forma de hacer mi aplicacion o algun consejo o sugerencia que me ayude en mi cometido os estaré eternamente agradecido.

Mi proyecto:
http://www.megaupload.com/?d=8KXZ26P0

[martinartaza]

Primero que nada quiero agradecerte por compartir tu código. Y quiero hacerte un par de preguntas.
¿Que versión de Delphi usas?
¿De que trata el proyecto?
¿Tienes una versión nueva del mismo, que puedas compartir?

Te cuento, algo que me gustaría hacer es un software muy chico de simulación de circuito, que consista en poner una batería, una resistencia y un foco, y que se pueda armar el circuito, creo que si logro realizar eso, puedo ponerme a trabajar en otros software más importantes, estos siempre lo encaro en mis tiempos libres y siempre averiguo un poco y me tranco.

Desde ya muchas gracias.

[beginner01]

Empezado por martinartaza

algo que me gustaría hacer es un software muy chico de simulación de circuito, que consista en poner una batería, una resistencia y un foco, y que se pueda armar el circuito, creo que si logro realizar eso, puedo ponerme a trabajar en otros software más importantes, estos siempre lo encaro en mis tiempos libres y siempre averiguo un poco y me tranco.

puedes comenzar por ver los jedi que tienen en la pestaña jv jans sim unos componetes como es el jvsimlogicbox con los cuales puedes simular
pequeños circuitos que quizas te sean de ayuda.

[rounin]

Un pequeño ejemplo.
He lo hago una vez para aprobar algunas ideas.
Puede ser estara útil.

[martinartaza]

Acá en el trabajo ya están instaladas las librerías y pude verlo, el código que me diste está buenísimo es justo lo que necesito. Sin falta el miércoles a la tarde lo instalo en mi casa, tengo reunión con mi tutora de tesis el miércoles a la siesta.
Muchísimas gracias.

[martinartaza]

Hola rounin, me puedes facilitar un enlace o libro que hayas utilizado para realizar el código que me diste?
Desde ya muchas gracias.

[rounin]

No se.. Nada especial.
Codigo es practicamente puro OOP, nada mas.
Booch, GoF, VCL, etc.

[martinartaza]

Hola eh leido Booch y creo que la VCL uno nunca deja de sorprenderse. Estuve estudiando tu código y en principio se entiende lo que realiza, pero cuando quise hacer una pequeña modificación, para desgracia no me anda, estuve viéndolo y tratando de buscarla la vuelta y nada.
Te comento la modificación que realize.
Declaro 2 variables publicas.

Código Delphi [-]
    insertar2x2: Boolean; // Presiono en boton 2x2.
    cuantos2x2: integer;  // Para llevar los nombres de los bloques

Le agrego un botón que dice Agregar 2x2.
En el evento onclick del boton pongo la bandera en true.

Código Delphi [-]
procedure TForm1.BInsertar2x2Click(Sender: TObject);
begin
insertar2x2:= True;
end;

Y por ultimo modifico el evento MouseDown del TPaintBox, tratando que solo tome el nuevo camino cuando se presiono el botón, o sea creo que deberia seguir andando igual cuando no se presiono en el botón.

Código Delphi [-]
procedure TForm1.PBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var h: Boolean;
nombre2x2: string;
bl : TBlock;
begin
if not insertar2x2 then
   begin
   FRoot.DoMouseDown(Button, Shift, X, Y, h);
   PBox.Refresh;
   end
else
   begin
   nombre2x2:= 'Block 2 x 2 - ' + IntToStr(cuantos2x2);
   inc(cuantos2x2);
   bl := TBlock.Create;
   bl.Rect := Rect(x, y, x+61, y+51);
   bl.Name := nombre2x2;
   TContact.Create(bl, ckInput);
   TContact.Create(bl, ckInput);
   TContact.Create(bl, ckOutput);
   TContact.Create(bl, ckOutput);
   FRoot.Add(bl);
   insertar2x2:= false;
   end;
end;

Se inserta los bloques, pero ya no funciona a la hora de dibujar nuevas lineas y es justo ahí donde se me quemo un par de cables.

Rounin, te comento que me gusta mucho tu código, creo que sobre este tipo de cosas hay poca documentación, mientras que DB se tiene Millones de lugares donde leer y preguntar, pero sobre diseñar software tipo CAD (Diseño Asistido por Computadora), no hay mucho .

Desde ya muchas gracias.

[rounin]

Es mi error. He olvidado inicializar h en PBoxMouseDown
h := False; // !!!!!
FRoot.DoMouseDown(Button, Shift, X, Y, h);

[rounin]

Pienso que mejor hacer objecto para toda esquema.
Aproximamante así:

Código Delphi [-]
 
unit Schem;
interface
uses
  Windows, Classes, Messages, Controls, Graphics, Contnrs,
  Fig, Elem;
type
  TCreateFigureFunc = function({?}): TFigure of object;
  TScheme = class(TCustomControl)
  private
    FRoot: TFigure;
    //FMouseCaptured: Boolean;
    FAddNewFigureMode: Boolean;
    FCreateNewFigureFunc: TCreateFigureFunc;
    procedure DrawGrid;
  protected
    function CreateRoot: TFigure; virtual; abstract;
  public
    property Root: TFigure read FRoot;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {----------------------}
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    {----------------------}
    procedure AddNewFigureNextClick(ACreateNewFigureFunc: TCreateFigureFunc);
    procedure AddFigure(Figure: TFigure); virtual;
  end;
implementation
uses SysUtils;
{---------------------------------- TScheme -----------------------------------}
constructor TScheme.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := True;
  ControlStyle := ControlStyle + [csOpaque];
  FRoot := CreateRoot;
end;
destructor TScheme.Destroy;
begin
  FRoot.Free;
  inherited;
end;
procedure TScheme.AddNewFigureNextClick(ACreateNewFigureFunc: TCreateFigureFunc);
begin
  FAddNewFigureMode := True;
  FCreateNewFigureFunc := ACreateNewFigureFunc;
end;
procedure TScheme.AddFigure(Figure: TFigure);
begin
  if FRoot is TFigureList then
    (FRoot as TFigureList).Add(Figure)
  else
    raise Exception.Create('You nee to override AddFigure');
end;
procedure TScheme.DrawGrid;
var i, j, H, W: Integer;
    R: TRect;
begin
  R := ClientRect;
  W := R.Right - R.Left;
  H := R.Bottom - R.Top;
  Canvas.Pen.Color := clBlack;
  for i := 0 to W div SNAP_SIZE do
    for j := 0 to H div SNAP_SIZE do
      Canvas.Pixels[i*SNAP_SIZE, j*SNAP_SIZE] := clBlack;
end;
procedure TScheme.Paint;
begin
  inherited;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Rectangle(ClientRect);
  DrawGrid;
  FRoot.DoDraw(Canvas);
end;
procedure TScheme.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  FRoot.DoKeyDown(Key, Shift);
  Invalidate;
end;
type
  THackFigure = class(TFigure);
procedure TScheme.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Handled: Boolean;
    NewFigure: TFigure;
    R: TRect;
begin
  inherited;
  Handled := False;
  if FAddNewFigureMode then
  begin
    if Assigned(FCreateNewFigureFunc) then
    begin
      NewFigure := FCreateNewFigureFunc;
      R := NewFigure.Rect;
      OffsetRect(R, X - R.Left, Y - R.Top);
      NewFigure.Rect := R;
      AddFigure(NewFigure);
    end;
    FAddNewFigureMode := False;
    Handled := True;
    THackFigure(FRoot).SetAgent(nil);
    Invalidate;
    Exit;
  end;
  FRoot.DoMouseDown(Button, Shift, X, Y, Handled);
  Invalidate;
end;
procedure TScheme.MouseMove(Shift: TShiftState; X, Y: Integer);
var cr: TCursor;
begin
  inherited;
  FRoot.DoMouseMove(Shift, X, Y, cr);
  Invalidate;
end;
procedure TScheme.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FRoot.DoMouseUp(Button, Shift, X, Y, {FMouseCaptured}GlobalMouseCaptured);
  Invalidate;
end;
end.
 
//--------------------------------------------------------------
 
unit main;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, 
  Fig, Elem, Schem;
type
  TBlockScheme = class;
  TForm1 = class(TForm)
    BNew2x2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure BNew2x2Click(Sender: TObject);
  private
    FScheme: TBlockScheme;
    FLast2x2Index: Integer;
  public
    function CreateBlock2x2: TFigure;
  end;
  TBlockScheme = class(TScheme)
  private
    function GetRoot: TBlockList;
  protected
    function CreateRoot: TFigure; override;
  public
    property Root: TBlockList read GetRoot;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
{---------------------------- TBlockScheme ------------------------------------}
function TBlockScheme.CreateRoot: TFigure;
begin
  Result := TBlockList.Create;
end;
function TBlockScheme.GetRoot: TBlockList;
begin
  Result := inherited Root as TBlockList;
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
var bl: TBlock;
begin
  BNew2x2.GroupIndex := 1;
  BNew2x2.AllowAllUp := True;
  FScheme := TBlockScheme.Create(Self);
  FScheme.Parent := Self;
  FScheme.BoundsRect := Rect(30, 50, 650, 420);
end;
function TForm1.CreateBlock2x2: TFigure;
var bl: TBlock;
begin
  Inc(FLast2x2Index);
  bl := TBlock.Create;
  bl.Rect := Rect(420, 120, 480+1, 165+1);
  bl.Name := 'Test Block 3';
  TContact.Create(bl, ckInput);
  TContact.Create(bl, ckInput);
  TContact.Create(bl, ckOutput);
  TContact.Create(bl, ckOutput);
  bl.Name := 'Block 2x2 - ' + IntToStr(FLast2x2Index);
  Result := bl;
  BNew2x2.Down := False; 
end;
procedure TForm1.BNew2x2Click(Sender: TObject);
begin
  BNew2x2.Down := True;
  FScheme.AddNewFigureNextClick(CreateBlock2x2);
end;
end.

[martinartaza]

Ya eh probado de poner la bandera en false y funciona a la perfección, pero como veo que eres realmente un maestro voy a hacerte caso y voy estudiar el segundo código que me diste.

Desde ya muchas gracias.