Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
649 views
in Technique[技术] by (71.8m points)

events - 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?

Question&Answers:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

2.1m questions

2.1m answers

60 comments

57.0k users

...