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