]> wagner.pp.ru Git - sites/home_page.git/blob - software/tcl/measure_screen.tcl
grandpa picture
[sites/home_page.git] / software / tcl / measure_screen.tcl
1 #!/usr/bin/wish
2 canvas .c -width 11c -height 11c
3 grid .c - - -sticky news
4 .c create rectangle 5m 5m 105m 105m
5 foreach i {1 2 3 4 5 6 7 8 9} {
6   .c create line 5m $i.5c 105m $i.5c
7   .c create line $i.5c 5m $i.5c 105m
8 }  
9
10 #foreach i { 1 2 3 4 5 6 7 8 9 10} {
11 #  .c create line 5m ${i}c 105m ${i}c
12 #  .c create line ${i}c 5m ${i}c 105m
13 #}  
14
15 set width 100
16 label .l -text "éÚÍÅÒÅÎÎÁÑ ÛÉÒÉÎÁ, ÍÍ" -anchor e
17 entry .e -width 5 -textvar width 
18 button .b -text "÷ÙÞÉÓÌÉÔØ" -command compute
19 grid .l .e .b 
20 grid configure .l -sticky news
21 grid configure .e -sticky nws
22 grid configure .b -sticky ns
23 bind .e <Key-Return> compute
24 set result [winfo fpixels . 1i]
25 label .lr -text "òÁÚÒÅÛÅÎÉÅ, dpi"  -anchor e
26 label .r -textvar result -anchor w 
27 grid .lr .r - -sticky news
28 focus .e
29 .e icursor end
30 .e selection range 0 end
31 proc compute {} {
32   global width result
33   set result [expr {100.0/$width*[winfo fpixels . 1i]}]
34 }
35