One event for multiple shapes.

Hey,

I want to have one event for all shapes on a form. All shapes are already added to the form.
I want that if you click on the shape that it will turn red and that it will turn white if it already is red.
Ofcourse this would be easy if you just go to each OnMouseDown of every shape but I just want one OnMouseDown event for all the shapes, so that event should be able to recognize what shape was being clicked on.

Thnx!
TonyJizAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

kretzschmarCommented:
yep, create one event-proc like

procedure ShapeClick(sender : TObject);
begin
  if (sender is TShape) then
    if TShape(sender).Brush.Color = clRed then
      TShape(sender).Brush.Color := clWhite
    else
      TShape(sender).Brush.Color := clRed;
end;

assign this proc to  all shapes
(currently i dont know if a TShape has an onClick-event)

meikl ;-)

 
0
Wim ten BrinkSelf-employed developerCommented:
@Meikl, A TShape has NO onClick event in Delphi 5. Not sure about D7. However, as Tony said, it does have an OnMouseDown event that you can respond to. :-)

Btw, if you want a funny, alternative solution then use TWO events! Something like this:

procedure TFormMain.ShapeMouseDownWhite( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  if ( Sender is TShape ) then begin
    ( Sender as TShape ).Brush.Color := clRed;
    ( Sender as TShape ).OnMouseDown := ShapeMouseDownRed;
  end;
end;

procedure TFormMain.ShapeMouseDownRed( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  if ( Sender is TShape ) then begin
    ( Sender as TShape ).Brush.Color := clWhite;
    ( Sender as TShape ).OnMouseDown := ShapeMouseDownWhite;
  end;
end;

But as Meikl suggested, it is easier to use this:

procedure TFormMain.ShapeMouseDownWhite( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  if ( Sender is TShape ) then begin
    ( Sender as TShape ).Brush.Color := clRed;
    ( Sender as TShape ).OnMouseDown := ShapeMouseDownRed;
  end;
end;

procedure TFormMain.ShapeMouseDownRed( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  if ( Sender is TShape ) then begin
    if ( ( Sender as TShape ).Brush.Color = clWhite ) then begin
      ( Sender as TShape ).Brush.Color := clRed;
    end
    else begin
      ( Sender as TShape ).Brush.Color := clWhite;
    end;
  end;
end;

Or if you want it look very neat for your teacher (if this is a homework assignment):

procedure TFormMain.ShapeMouseDownWhite( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
const
  Colors: array[ False..True ] of TColor = ( clWhite, clRed );
begin
  if ( Sender is TShape ) then ( Sender as TShape ).Brush.Color := Colors[ ( Sender as TShape ).Brush.Color = clWhite ];
end;
0
esoftbgCommented:
Hi meikl,
TShape has not event OnClick, but has event OnMouseDown:

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) then
  begin
    if (Sender is TShape) then
      if TShape(Sender).Brush.Color = clRed then
        TShape(Sender).Brush.Color := clWhite
      else
        TShape(Sender).Brush.Color := clRed;
  end;
end;
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TonyJizAuthor Commented:
Thnx!
0
kretzschmarCommented:
:-)) well, ok, no onClick-event
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.