Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi - moving overlapping TShapes

I've needed own triangle shape so, I inherited my triangle class form TShape and override paint method. Everything works fine, but I need to move this shapes with mouse. I set the method for every shape handling onMouseDown event. Moving work also fine. But If two shapes overlaps (shapes are in fact rectangles with some transparent areas), that the top's shape transparent area is over another shape, then the top shape moves instead of the shape below. It's correct, that is how Delphi works. But it's not intuitive for the user. How can I achieve that? Is there possibility to not remove the event from event queue and sent it to underlying shapes, if yes it would be simple?

like image 295
uiii Avatar asked Aug 28 '11 20:08

uiii


1 Answers

A 'simple sample redesign' per my comment follows.

unit Unit4;

interface

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

const
  NUM_TRIANGLES = 10;
  COLORS: array[0..12] of integer = (clRed, clGreen, clBlue, clYellow, clFuchsia,
    clLime, clGray, clSilver, clBlack, clMaroon, clNavy, clSkyBlue, clMoneyGreen);

type
  TTriangle = record
    X, Y: integer; // bottom-left corner
    Base, Height: integer;
    Color: TColor;
  end;

  TTriangles = array[0..NUM_TRIANGLES - 1] of TTriangle;

  TForm4 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FTriangles: TTriangles;
    FDragOffset: TPoint;
    FTriangleActive: boolean;
    function GetTriangleAt(AX, AY: Integer): Integer;
    function IsMouseDown: boolean;
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

uses Math;

{$R *.dfm}


procedure TForm4.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  FTriangleActive := false;
  Randomize;
  for i := 0 to NUM_TRIANGLES - 1 do
    with FTriangles[i] do
    begin
      base := 40 + Random(80);
      height := 40 + Random(40);
      X := Random(ClientWidth - base);
      Y := height + Random(ClientHeight - height);
      Color := RandomFrom(COLORS);
    end;
end;

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TriangleIndex: integer;
  TempTriangle: TTriangle;
  i: Integer;
begin
  TriangleIndex := GetTriangleAt(X, Y);
  if TriangleIndex <> -1 then
  begin
    FDragOffset.X := X - FTriangles[TriangleIndex].X;
    FDragOffset.Y := Y - FTriangles[TriangleIndex].Y;
    TempTriangle := FTriangles[TriangleIndex];
    for i := TriangleIndex to NUM_TRIANGLES - 2 do
      FTriangles[i] := FTriangles[i + 1];
    FTriangles[NUM_TRIANGLES - 1] := TempTriangle;
    Invalidate;
  end;
  FTriangleActive := TriangleIndex <> -1;
end;

function TForm4.IsMouseDown: boolean;
begin
  result := GetKeyState(VK_LBUTTON) and $8000 <> 0;
end;

procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if IsMouseDown and FTriangleActive then
  begin
    FTriangles[high(FTriangles)].X := X - FDragOffset.X;
    FTriangles[high(FTriangles)].Y := Y - FDragOffset.Y;
    Invalidate;
  end;
end;

procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FTriangleActive := false;
end;

procedure TForm4.FormPaint(Sender: TObject);
var
  i: Integer;
  Vertices: array of TPoint;
begin
  SetLength(Vertices, 3);
  for i := 0 to NUM_TRIANGLES - 1 do
    with FTriangles[i] do
    begin
      Canvas.Brush.Color := Color;
      Vertices[0] := Point(X, Y);
      Vertices[1] := Point(X + Base, Y);
      Vertices[2] := Point(X + Base div 2, Y - Height);
      Canvas.Polygon(Vertices);
    end;
end;

function TForm4.GetTriangleAt(AX, AY: Integer): Integer;
var
  i: Integer;
begin
  result := -1;
  for i := NUM_TRIANGLES - 1 downto 0 do
    with FTriangles[i] do
      if InRange(AY, Y - Height, Y) and
        InRange(AX, round(X + (Base / 2) * (Y - AY) / Height),
          round(X + Base - (Base / 2) * (Y - AY) / Height)) then
        Exit(i);
end;

end.

Don't forget to set the form's DoubleBuffered to true.

Compiled sample demo: https://privat.rejbrand.se/MovingTriangles.exe

like image 197
Andreas Rejbrand Avatar answered Nov 15 '22 09:11

Andreas Rejbrand