[plt-scheme] Multi-column list box control?
Hello,
Let me add my encouragement for such a widget. Almost
every app I use has this, often as the main interface.
Something this basic should've been a part of mred from
the beginning.
What I end up doing is simulating columns by feeding
fixed-width text to the canvas, but this leaves a lot
to be desired (no easy way to resize the columns).
Below is my initial attempt to get to first base on this.
It's been mentioned a few times that side-by-side list-boxes
could be used, but on winxp I can't eliminate the unsightly
column borders, even with border size set to zero. So I've
used side-by-side editor-canvases.
There's a couple of problems here: rows, as opposed to
columns, can't be selected. And code has to be added to
resize the headings/columns when the mouse is dragged :)
Lots of easy stuff has been omitted, like sorting the
columns when a heading is clicked and using non-editable
text.
As you can see, I'm a complete novice - here's hoping
that someone who knows what they're doing can work up
a widget.
regards,
praimon
--------------------------------------------------------
#lang scheme/gui
(define dir-pane%
(class horizontal-panel%
(init-field parent)
(init cols)
(define colnums cols)
(init input)
(define wrapped-input
(map (lambda (li)
(map (lambda (s)
(string-append s "\n")) li)) input))
(init headings)
(define heads headings)
(super-new [parent parent])
(let loop ([n 0])
(cond
[(= n colnums) (void)]
[else
(letrec ([vpan (new vertical-panel% [parent this])]
[but (new dir-button% [parent vpan]
[label (list-ref heads n)])]
[canv (new dir-canvas% [parent vpan])]
[txt (new text%)])
(send canv set-editor txt)
(send txt insert (apply string-append
(map (lambda (s) (list-ref s n))
wrapped-input)))
(loop (add1 n)))]))))
(define dir-canvas% (class editor-canvas%
(super-new
[style '(no-border hide-hscroll hide-vscroll)])))
(define dir-button%
(class button%
(super-new
[vert-margin 0]
[horiz-margin 0]
[stretchable-width #t])
(define/override (on-subwindow-event rec ev)
(let ([b-width (send rec get-width)])
(cond [(or (send ev entering?) (send ev moving?))
(when (not ;don't understand why 'not' is needed?
(or (< (send ev get-x) 4) (< (- b-width (send ev
get-x)) 5)))
(send rec set-cursor (make-object cursor% 'size-e/w)))
;to do: while the arrows cursor is visible,
;dragging the mouse should, at the very least,
;resize the adjacent buttons and canvases
]
[else (super on-subwindow-event rec ev)])))))
;;testing
(define f (new frame% [label "dir test"]
[width 200]
[height 200]))
(define test (new dir-pane% [cols 3] [parent f]
[headings '("field 1" "field 2" "field 3")]
[input '(("first" "second" "third")
("fourth" "fifth" "sixth")
("seventh" "eighth" "ninth"))]))
(send f show #t)