Tk - Klick auf Canvas erkennen (gelöst) (Graphische Oberflächen)

[thread]16517[/thread]

Tk - Klick auf Canvas erkennen [gelöst]

Tags: perl5 GUI Tk Ähnliche Threads

Leser: 17

Articles: hide open all | hide show old branches

+3 replies
Gast Thomas

2011-07-11 18:52
Hallo,
ich erstelle in meinen Script eine Ansammlung von Kreisen wenn ich auf deinen Kreis klicke soll sich die Farbe des Kreises ändern.

Wie erkenne ich diesen Klick?
Code (perl): (dl )

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

#!/usr/bin/perl use strict; use warnings; use Tk; my $scale_faktor = 1.5; my $window = MainWindow->new(); my $c1 = $window->Canvas(-width => 958 * $scale_faktor, -height => 150 * $scale_faktor, ) ->pack(); ... my $oval = $c1->createOval($x1, $y1, $x2, $y2, -fill => 'gray'); ...
danke
Last edited: 2011-07-11 19:12:32 +0200 (CEST)
- pktm
  
  2011-07-11 23:28
  User since
  2003-08-07
  2921 Artikel
  BenutzerIn
  Du musst den Klick abfangen und eine Methode daran knüpfen, die auswertet, wohin geklickt wurde und welche Kreise sich mit diesen Koordinaten überlappen.
  
  Das abfangen macht man mit bind(), die Koordinaten werden bei diesem Event mitgeliefert (s. Buch Mastering Perl/Tk):
  
  Code: (dl )
  
  1 2 3 4 5 6 7
  
  $c = $mw->Scrolled("Canvas")->pack( ); $canvas = $c->Subwidget("canvas"); $canvas->CanvasBind("<Button-1>", [ \&print_xy, Ev('x'), Ev('y') ]); sub print_xy { my ($canv, $x, $y) = @_; print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n"; }
  
  Fehlt nur noch das mit dem Überlappen. Hier ein Schnipselchen dazu.
  
  Code: (dl )
  
  my $w = $canvas->find("overlapping", $x, $y, $x, $y);
  
  http://www.intergastro-service.de (mein erstes CMS :) )
- pq
  
  2011-07-16 12:47
  
  User since
  2003-08-04
  12208 Artikel
  Admin1
  
  Thomas, hat dir die antwort von pktm geholfen?
  ich setz den status erst mal auf gelöst.
  Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live. -- Damian Conway in "Perl Best Practices"
  lesen: Wie frage ich & perlintro brian's Leitfaden für jedes Perl-Problem

View all threads created 2011-07-11 18:52.