我目前正在编写一个程序（在Racket中），我使用多个标签。
为此，我使用＆＃34;标签面板％＆＃34;。 对于每个标签我，然后制作一个新的垂直面板。 当有人点击标签时，我的回调程序被称为，我更改了＆＃34;标签面板％＆＃34;所以现在标签的垂直面板（用户点击）被设置为标签面板的子项。
我是通过发送以下消息来实现的：
(send tab-panel change-chidren (lambda (x) '())) ; Deletes all childs
(send tab-pannel add-child vertical-panel-of-the-clicked-tab)
我之所以这样做是因为如果我只为所有标签使用一个垂直面板，那么当我创建小部件时，它们会被放置在现有的小部件下。如果那时我只显示所选选项卡的小部件并隐藏其他小部件，小部件将不会从我的选项卡顶部开始（因为其他选项卡也有小部件，可能在此之前创建，因此位于此小部件之上（从我们正在使用垂直面板））。所以我发现每个选项卡使用一个垂直面板并将选项卡面板的子项更改为所选选项卡的垂直面板可以解决此问题。
但是因为我这样做了，所以我不能在我的＆＃34; text-field％＆＃34;小部件.. 当我点击它时没有任何反应（甚至没有调用回调）。 只有当我右键单击然后选择例如＆＃34;粘贴＆＃34;它会将其粘贴到文本字段中，然后调用我的回调过程。
长话短说：我的垂直面板全部用于一个特定的标签，并且所有标签面板都作为父标签。单击选项卡时，我将选项卡面板的子项更改为所选选项卡的垂直面板。
有谁知道为什么我不能在文本字段小部件中写？
我在文档中搜索了阻止/激活文本输入的消息（可能更改了选项卡面板的子项阻止了文本字段）但是没有找到。
编辑：请注意，除文本字段外，所有其他小部件都能正常工作。
以下是代码：
; Remark the code below belongs to 2 different files. The "make-tab-beheerder" and "simple-widgets" procedures belong in one file, the rest belongs to another file which uses the first one.
; "make-tab-beheerder" is an abstraction to easily open and close tabs
; It's an ad-hoc object constructor. The return value is a closure
; that exposes the internal defines as methods.
(define (make-tab-beheerder list-of-tab-names widget-maker)
(let* ((idx-of-current-tab -1)
(nr-of-tabs (length list-of-tab-names))
(tabs (make-vector nr-of-tabs '()))
(tab-panel '())
(panels (make-vector nr-of-tabs '())))
; Before opening/closing a tab the tab-panel has to be set. It's the parent of all vertical panels
(define (set-tab-panel! t-panel)
(set! tab-panel t-panel)
(vector-map! (lambda (elmt) (let ((panel ((widget-maker 'make-vertical-panel) tab-panel 'center 'top)))
(send panel enable #f)
panel))
panels))
; Not relevant
(struct tab-element (widget enable-proc disable-proc))
(define (make-tab-widget widget enable-proc disable-proc)
(tab-element widget enable-proc disable-proc))
; Not relevant (when I add widgets to a tab I give a "enable" and "disable" procedure, to enable/disable them in a generic way
(define (add-widget-to-tab tab-name widget enable-widget-proc disable-widget-proc)
(let* ((idx (zoek-index tab-name list-of-tab-names string=?))
(already-added-widgets (vector-ref tabs idx)))
(send widget show #f) ; Widget hidden
(vector-set! tabs idx (cons (make-tab-widget widget enable-widget-proc disable-widget-proc) already-added-widgets))))
(define (open-tab idx)
(let ((elements-to-open (if (or (< idx 0) (> idx (- (vector-length tabs) 1)))
'()
(vector-ref tabs idx)))
(panel (vector-ref panels idx)))
; Eerst de vorige tab sluiten
(close-tab idx-of-current-tab)
(define (open-all elements-lst)
(when (not (null? elements-lst)) ; There still are widgets (belonging to the tab) we have to open.
(let* ((elmt (car elements-lst))
(widget (tab-element-widget elmt))
(enable-proc (tab-element-enable-proc elmt)))
(enable-proc widget)
(open-all (cdr elements-lst)))))
; Change children to set the vertical panel of the chosen tab as child.
(send tab-panel change-children (lambda (x) '())) ; We deleten alle kinderen
(send tab-panel add-child panel)
(open-all elements-to-open)
(set! idx-of-current-tab idx)))
; Not relevant
(define (close-tab idx)
(let ((tab-elements-to-close (if (or (= idx -1) (> idx (- (vector-length tabs) 1)))
'()
(vector-ref tabs idx))))
(for-each (lambda (tab-elmt) (let ((disable-proc (tab-element-disable-proc tab-elmt))
(widget (tab-element-widget tab-elmt)))
(disable-proc widget))) tab-elements-to-close)
(set! idx-of-current-tab -1)))
; ...
(define (dispatch msg)
(cond ((eq? msg 'open-tab) open-tab)
((eq? msg 'add-widget-to-tab) add-widget-to-tab)
((eq? msg 'clear-tab!) clear-tab!)
((eq? msg 'get-tab-panel) get-tab-panel)
((eq? msg 'set-tab-panel!) set-tab-panel!)
(else (display "Bericht werd niet verstaan! -- make-tab-panel - Graphics") (newline))))
dispatch))
; This is an abstraction I wrote on top of the Racket GUI
(define (simple-widgets)
; Irrelevant code omitted
(define (add-panel parent alignment min-width min-height stretchable-width? stretchable-height?)
(new panel%
[parent parent]
[style (list 'border)]
[enabled #t]
;[vert-margin vert-margin]
;[horiz-margin horiz-margin]
;[border border]
;[spacing spacing]
[alignment alignment]
[min-width min-width]
[min-height min-height]
[stretchable-width stretchable-width?]
[stretchable-height stretchable-height?]))
(define (add-vertical-panel parent links-midden-of-rechts boven-midden-of-onder)
(new vertical-panel% [parent parent]
[alignment (list links-midden-of-rechts boven-midden-of-onder)]))
(define (add-horizontal-panel parent links-midden-of-rechts boven-midden-of-onder . extra)
(let ((min-width (if (null? extra)
#f
(car extra)))
(min-height (if (or (null? extra) (null? (cdr extra)))
#f
(cadr extra))))
(new horizontal-panel%
[parent parent]
[alignment (list links-midden-of-rechts boven-midden-of-onder)]
[min-width min-width]
[min-height min-height]
[stretchable-width #t]
[stretchable-height #f])))
(define (add-tab-panel list-of-labels callback-proc parent alignment-arg min-width min-height stretchable-width? stretchable-height?)
(new tab-panel%
[choices list-of-labels]
[parent parent]
[callback callback-proc]
[enabled #t]
[alignment alignment-arg]
[min-width min-width]
[min-height min-height]
[stretchable-width stretchable-width?]
[stretchable-height stretchable-height?]))
(define (add-text-field label parent callback init-value)
(new text-field%
[label label]
[parent parent]
[callback callback]
[init-value init-value]
;[style style]
;[font font]
[enabled #t]
;[vert-margin vert-margin]
;[horiz-margin horiz-margin]
;[min-width min-width]
;[min-height min-height]
[stretchable-width #f]
[stretchable-height #f]))
(define (add-editor-canvas parent label)
(new editor-canvas%
(parent parent)
(label label)))
; Irrelevant code omitted
(define (dispatch msg)
(cond ((eq? msg 'make-dialog) add-dialog)
((eq? msg 'make-editor-canvas) add-editor-canvas)
((eq? msg 'make-menu-bar) add-menu-bar)
((eq? msg 'make-menu) add-menu-to-menu-bar)
((eq? msg 'make-menu-item) add-menu-item)
((eq? msg 'make-text) add-text)
((eq? msg 'make-message) add-message)
((eq? msg 'append-text) append-text)
((eq? msg 'make-button) add-button)
((eq? msg 'set-button-label!) set-button-label!)
((eq? msg 'make-panel) add-panel)
((eq? msg 'make-vertical-panel) add-vertical-panel)
((eq? msg 'make-horizontal-panel) add-horizontal-panel)
((eq? msg 'make-slider) add-slider)
((eq? msg 'make-gauge) add-gauge)
((eq? msg 'setGaugeValue!) setGaugeValue!)
((eq? msg 'make-tab-panel) add-tab-panel)
((eq? msg 'make-choice) add-choice)
((eq? msg 'add-choice) add-choice-to-choice-widget)
((eq? msg 'make-text-field) add-text-field)
(else (display "Bericht werd niet verstaan -- dispatch - simple-widgets") (newline))))
dispatch)
; Second file, uses the abstraction ("simple-widgets") built on top of the Racket GUI.
(define (addWidgetToTab tabName widget)
((tabBeheerder 'add-widget-to-tab) tabName widget
(lambda (widget) (send widget show #t))
(lambda (widget) (send widget show #f))))
(define (makeTrainTabWidgets tabPaneel tabBeheerder)
(let ((nameOfNewTrain '()))
; Callback for the text field
(define (trainNameCallback tekstVeldje controleEvenement)
(set! nameOfNewTrain (send tekstVeldje get-value)))
(let* ((trainNameField ((widgetMaker 'make-text-field) "Name" tabPaneel trainNameCallback "Write train name here")))
; Stuff omitted
(addWidgetToTab "Train" trainNameField)))))
; Define the necessary things and make the "train" tab which contains the text field.
(define tabBeheerder (make-tab-beheerder (list "Simulatie" "Train" "Traject" "Settings") widgetMaker))
((tabBeheerder 'set-tab-panel!) tabPaneel) ; "tabPaneel" is just a tab-panel%
(makeTrainTabWidgets ((tabBeheerder 'get-tab-panel) "Train") tabBeheerder)
答案 0 :(得分：1)
我现在让你的代码工作了，我发现在编辑文本字段之前我需要(send the-vertical-panel enable #t)。这是因为您浏览了set-tab-panel!中的所有面板并对其进行了(send panel enable #f)，如果您还要使用change-children将其从视图中删除，这似乎是不必要的。
似乎没有必要在每个小部件上执行(send widget show #f)和(send widget enable #f)，因为小部件只有在父级vertical-panel%可见时才可见且是交互式的。
此外，您可以通过编写宏来为您执行此操作，从而避免在每个闭包结束时编写cond块：
(define-syntax define-closure-class
(syntax-rules (define struct)
((_ (constructor-name . constructor-args)
((member-name member-value) ...)
(define (method-name . method-args) . method-body) ...)
(define (constructor-name . constructor-args)
(let* ((member-name member-value) ...)
(define (method-name . method-args) . method-body) ...
(define (dispatch method)
(case method
((method-name) method-name)
...
(else (error (format "No such method: ~a" method)))))
dispatch)))))
然后你可以这样做：
(define-closure-class (make-simple-object arg1 arg2)
((local-var1 1)
(local-var2 2))
(define (set-local1 new-value)
(set! local-var1 new-value))
(define (set-local2 new-value)
(set! local-var2 new-value))
(define (get-sum) (+ local-var1 local-var2 arg1 arg2)))
然后make-simple-object就像您的make-tab-beheerder一样。如何在不诉诸struct的情况下让syntax-case在该表单中工作是读者的一项练习。
或者您可以使用Racket的classes，并扩展tab-panel%课程以包含您放入make-tab-beheerder的所有内容。
答案 1 :(得分：0)
@Throwaway Account 3 Mil：感谢您的帮助！但是作为文本字段的父级的“tabPaneel”不是选项卡面板。它是程序的正式参数（参数），我为该参数选择的名称也是“tabPaneel”，有点令人困惑。
(define (makeTrainTabWidgets tabPaneel tabBeheerder)
当我调用“makeTrainTabWidgets”程序时，我将该选项卡的垂直面板作为实际参数传递。
(makeTrainTabWidgets ((tabBeheerder 'get-tab-panel) "Train") tabBeheerder)
“get-tab-panel”消息将返回右侧垂直面板。
(define (get-tab-panel name)
(if (null? panels) ; Not yet initialized
(begin (display "De panelen werden nog niet geïnitialiseerd. Het paneel van een tab kan dus nog niet worden opgevraagd.")(newline))
(let ((idx (search-index name list-of-tab-names string-ci=?)))
(if (>= idx 0)
(vector-ref panels idx) ; Return the right vertical panel
(begin (display "Er bestaat geen tab genaamd ") (display name)(newline))))))
我在这里选择的名称应该是“get-vertical-panel”，以免混淆标签面板和垂直面板。