demo.tcl 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. package require Tk
  2. package require zint
  3. wm title . "ZINT Demo"
  4. wm minsize . 480 320
  5. if {[info command sdltk] eq "sdltk"} {
  6. wm attributes . -fullscreen 1
  7. set padx 30
  8. set pady 20
  9. } else {
  10. wm geometry . 480x320
  11. set padx 5
  12. set pady 5
  13. }
  14. image create photo ::zintimg
  15. pack [::ttk::combobox .c -values [lsort [zint symbologies]] -state readonly] \
  16. -side top -fill x -padx $padx -pady $pady
  17. .c set Datamatrix
  18. pack [::ttk::entry .e] -side top -fill x -padx $padx -pady $pady
  19. .e insert end 12345
  20. bind .e <Return> Generate
  21. pack [::ttk::entry .o] -side top -fill x -padx $padx -pady $pady
  22. .o insert end "-bold 1"
  23. bind .o <Return> Generate
  24. pack [::ttk::button .b -text Generate -command Generate] -fill x -side top \
  25. -padx $padx -pady $pady
  26. proc Generate {} {
  27. ::zintimg blank
  28. ::zintimg configure -width 1 -height 1
  29. ::zintimg blank
  30. ::zintimg configure -width 0 -height 0
  31. if {[catch {zint encode [.e get] ::zintimg -barcode [.c get] {*}[.o get]} e]} {
  32. tk_messageBox -message $e -title "Zint error"
  33. } else {
  34. set w [image width ::zintimg]
  35. set h [image height ::zintimg]
  36. set lw [winfo width .l]
  37. set lh [winfo height .l]
  38. set sx [expr {int(1.0 * $lw / $w)}]
  39. set sy [expr {int(1.0 * $lh / $h)}]
  40. if {$sy < $sx} {
  41. set sx $sy
  42. }
  43. if {$sx <= 0} {
  44. set sx [expr {1.1 * $lw / $w}]
  45. set sy [expr {1.1 * $lh / $h}]
  46. if {$sy < $sx} {
  47. set sx $sy
  48. }
  49. }
  50. ::zintimg blank
  51. ::zintimg configure -width 1 -height 1
  52. ::zintimg blank
  53. ::zintimg configure -width 0 -height 0
  54. catch {
  55. zint encode [.e get] ::zintimg -barcode [.c get] -scale $sx {*}[.o get]
  56. }
  57. }
  58. }
  59. pack [label .l -image ::zintimg -bg white] -side top -fill both -expand 1 \
  60. -padx $padx -pady $pady
  61. bind .e <Configure> {
  62. after cancel Generate
  63. after idle Generate
  64. }
  65. bind .c <<ComboboxSelected>> {
  66. after cancel Generate
  67. after idle Generate
  68. }
  69. bind all <Break> exit
  70. bind all <Control-q> exit
  71. bind all <Alt-q> exit