Prueba GUI

#lang racket
(require racket/gui)

;Ventana
(define ventana (new frame% [label "Ventana "]))

;Objetos de la ventana principal
(define texto (new message%
                   [parent ventana]
                   [label "Objeto 'tab-panel%':"]
                   ))

;Definicion de opciones
(define opciones (list "Botones" "Casillas de verificacion" "Opciones multiple"
                       "Listas" "Cuadros de texto" "Otros" "Pyafin"))
(define tab (new tab-panel%
                 [parent ventana]
                 [choices opciones]
                 [callback
                  (lambda(t c) ; una instancia de 'tab-panel% y de 'control-event%'
                    (let* ([ix (send tab get-selection)]
                           [ix-str (number->string ix)]
                           [nombre-ficha(send tab get-item-label ix)])
                           (send mensaje set-label (string-append "Se selecciono la ficha
"ix-str" con nombres '" nombre-ficha "'"))
                      (send tab delete-child (first(send tab get-children)))
                      (send tab add-child (list-ref lista-paneles ix))
                      )
                    )
                  ]
                 )
  )

;Definicion de mensaje
(define mensaje (new message%
                     [parent ventana]
                     [label "Aqui se mostrara los eventos del objecto"]
                     [auto-resize #t]
                     )
  )

;=========================== >>> Objectos paneles <<<======================;
(define panel0 (new vertical-panel% [parent tab]))
(define panel1 (new vertical-panel% [parent tab][style '(deleted)]))
(define panel2 (new vertical-panel% [parent tab][style '(deleted)]))
(define panel3 (new vertical-panel% [parent tab][style '(deleted)]))
(define panel4 (new vertical-panel% [parent tab][style '(deleted)]))
(define panel5 (new vertical-panel% [parent tab][style '(deleted)]))
(define panel6 (new vertical-panel% [parent tab][style '(deleted)]))

(define lista-paneles (list panel0 panel1 panel2 panel3 panel4 panel5
                            panel6))
;;Panel 0 - Botones
;--------------------------------------
(define panel-botones (new horizontal-pane% [parent panel0]))
(define(funcion-boton b c)
  (send mensaje set-label (string-append "Click en el boton'" (send b get-label)"'"))
  )
(define boton1 (new button%
                    [parent panel-botones]
                    [label "aqui"]
                    [callback funcion-boton]))
(define panel-botones2 (new vertical-pane%[parent panel-botones]))

(define boton2 (new button%
                    [parent panel-botones2]
                    [label "alla"]
                    [callback funcion-boton]))

(define boton3 (new button%
                    [parent panel-botones2]
                    [label "otro"]
                    [callback funcion-boton]))

(define boton4 (new button%
                    [parent panel-botones2]
                    [label "y otro"]
                    [callback funcion-boton]))

;Panel 1 -Casillas de verificacion
(define (funcion-chequeo c e) ;una instancia 'check-box% y de un 'control-event%
  (send mensaje set-label
        (string-append "Se"
                       (if(send c get-value) "selecciono" "deselecciono")
                       " la casilla '"(send c get-label)"'"))
  )
(define chequeo1 (new check-box%
                      [label "Chequeame"]
                      [parent panel1]
                      [value #f]
                      [callback funcion-chequeo]))
(define chequeo2 (new check-box%
                      [label "Este es otro 'check-box%'"]
                      [parent panel1]
                      [value #t]
                      [callback funcion-chequeo]
                      )
  )
(define chequeo3 (new check-box%
                      [label "Este no responde ningun evento,\ntiene tres
lineas\ny por defecto no esta marcado"]
                      [parent panel1]
                      )
  )

;;Panel 2-----------------------------------> Opciones multiple

(define (funcion-opcion-multiple r c)
  (send mensaje set-label
        (string-append "Se marco la opcion"
                       (number->string (send r get-selection))
                       "con texto' "
                       (send r get-item-label (send r get-selection))
                       "' del grupo '"
                       (let([t(send r get-label)])
                         (if t t "<sin-texto>"))
                       "'"
                       )
        )
  )
(send panel2 set-orientation #t)
(define panel-radio1(new radio-box%
                         [label "Verticales"]
                         [parent panel2]
                         [choices(list "Opcion 1" "Opcon 2")]
                         [callback funcion-opcion-multiple]
                         )
  )
(define panel-radio2 (new radio-box%
                          [label "Horizontales"]
                          [parent panel2]
                          [choices (list "Opcion1" "Opcion2")]
                          [callback funcion-opcion-multiple]
                          [style(list 'horizontal)]
                          [selection 1]
                          )
  )
(define panel-radio3 (new radio-box%
                          [label "Horizontales con la etiqueta arriba"]
                          [parent panel2]
                          [choices (list "Opcion 1" "Opcion 2")]
                          [callback funcion-opcion-multiple]
                          [style(list 'horizontal 'vertical-label)]
                          )
  )
(define panel-radio4(new radio-box%
                         [label "Verticales con la etiqueta arriba"]
                         [parent panel2]
                         [choices (list "Opcion 1" "Opcion 2")]
                         [callback funcion-opcion-multiple]
                         [style(list 'vertical 'vertical-label)]
                         ))
(define panel-radio5(new radio-box%
                         [label #f]
                         [parent panel2]
                         [choices(list "Sin etiqueta" "Solo estan los 'radio-box%'")]
                         [callback funcion-opcion-multiple]
                         )
  )


;;------------->Paneles 3 -Listas
(define(funcion-lista r c) ;instancia
  (send mensaje set-label
        (string-append "Se marco la opcion"
                       (number->string (send r get-selection))
                       "con texto '"
                       (send r get-string-selection)
                       "' de la lista'"
                       (let([t (send r get-label)])
                         (if t t "<sin-texto>"))
                       "'"
                       )
        )
  )
(define panel-lista1 (new horizontal-pane%[parent panel3]))
(define eleccion1 (new choice%
                       [label "Primera lista"]
                       [choices (list "Opcion 1" "Opcion 2" "etc.")]
                       [parent panel-lista1]
                       [callback funcion-lista]
                       [selection 2])
  )

(define eleccion2 (new choice%
                       [label "Segunda lista"]
                       [choices (list "Opcion 1" "Opcion 2" "etc.")]
                       [parent panel-lista1]
                       [callback funcion-lista]
                       )
  )

(define eleccion3 (new choice%
                       [label #f]
                       [choices (list "Opcion 1" "Opcion 2" "etc.")]
                       [parent panel-lista1]
                       [callback funcion-lista]
                       )
  )

(define panel-lista2 (new horizontal-pane%
                          [parent panel3]))
(define lista1 (new list-box%
                    [label "Primera lista"]
                    [choices (list "Opcion 1" "Opcion 2" "etc.")]
                    [parent panel-lista2]
                    [callback funcion-lista]
                    [selection 2]
                    )
  )
(define lista2 (new list-box%
                    [label "Segunda lista"]
                    [choices (list "Opcion 1" "Opcion 2" "etc.")]
                    [parent panel-lista2]
                    [callback funcion-lista]
                    [style(list 'multiple 'vertical-label)]
                    )
  )
(define lista3 (new list-box%
                    [label #f]
                    [choices (list "Opcion 1 " "Opcion 2" "etc.")]
                    [parent panel-lista2]
                    [callback funcion-lista]
                    [style(list 'extended 'vertical-label)]
                    )
  )
;ver adicionalmente, los metodos 'get-selections y 'is-selected?

;Panel 4 ---------------> Cuadros de texto
(define (funcion-texto t c)
  (send mensaje set-label(string-append "Texto: <<"(send t get-value)
                                        ">>"))
  )
(define texto1 (new text-field%
                    [label "Etiqueta"]
                    [parent panel4]
                    [init-value "Escriba algo"]
                    [callback funcion-texto]
                    ))
(define texto2 (new text-field%
                    [label "Etiqueta"]
                    [parent panel4]
                    [init-value "etiqueta arriba"]
                    [style[list 'vertical-label 'single]]
                    [callback funcion-texto]
                    )
  )
(define texto3 (new text-field%
                    [label #f]
                    [parent panel4]
                    [init-value "Etiqueta arriba"]
                    [style(list 'vertical-label 'single)]
                    [callback funcion-texto]
                    )
  )
(define combo1 (new combo-field%
                    [label "Combo 1"]
                    [parent panel4]
                    [choices(list "Opcion 1" "Opcion 2" "etc.")]
                    [init-value "por defecto"]
                    [callback(lambda (c e)
                               (send mensaje set-label
                                     (string-append "Evento del 'combo-field%'"
                                                    (send c get-label)
                                                    )))]
                    )
  )
(define combo2 (new combo-field%
                    [label "Agrega opciones al precionar Enter: "]
                    [parent panel4]
                    ;[choices(list "Opcion 1" "Opcion 2" "etc.")]
                    [choices null]
                    [callback
                     (lambda (c e)
                       (when (eqv? (send e get-event-type)'text-field-enter)
                         (begin
                           (send c append (send c get-value))
                           (send mensaje set-label
                                 (string-append "Texto agregado: '"
                                                (send c get-value)
                                                "'"))
                           )
                         )
                       )
                     ]
                    )
  )

;define panel 5 - Otros --------------------------------

(define msg-otros (new message%
                       [label "Slider: "]
                       [parent panel5]
                       )
  )
(define (evento-slider s e)
  (send mensaje set-label
        (string-append "Valor del slider '"
                       (send s get-label)
                       "': "
                       (number->string (send s get-value))))
  (if (object=? s slider1)
      (send gauge2 set-value (send s get-value))
      (send gauge2 set-value (send s get-value))
      )
  )
(define slider1 ( new slider%
                      [label "Valor1: "]
                      [parent panel5]
                      [min-value 0]
                      [max-value 100]
                      [init-value 30]
                      [callback evento-slider]
                      )
  )
(define slider2 (new slider%
                     [label "Valor2: "]
                     [parent panel5]
                     [min-value 0]
                     [max-value 100]
                     [style (list 'vertical 'plain)]
                     [callback evento-slider]
                     )
  )
(define msg-otros2(new message%
                       [label "Gauge: "]
                       [parent panel5]))

(define gauge2(new gauge%
                   [label "Gauge 2:"]
                   [parent panel5]
                   [style '(vertical)]
                   [range 100]
                   ))
(send gauge2 set-value (send slider2 get-value))
;;Panel 6 ---------------------------------------------->

(define canvas-hijo%
  (class canvas%
    (define/override (on-event evento)
      (send mensaje set-label
      (string-append "Evento de raton en el canvas: ("
                     (number->string (send evento get-x))
                     ","
                     (number->string (send evento get-y))
                     ")"
                     )
      )
      )
    (define/override (on-char evento)
      (send mensaje set-label
            (string-append "Evento de teclado en el canvas: "
                           (let([t(send evento get-key-code)])
                             (if(char? t)(string t)(symbol->string t))
                             )
                           )))
    (super-new)
    )
  )
(define c (new canvas-hijo%
               [parent panel6]
               )
  )
(send ventana show #t)