suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tool-tip frame size

Browse Source 
svn: r9711

original commit: f77bd13540583d2f9ad1753e716d83edb353f52e
This commit is contained in:
Matthew Flatt 2008-05-07 00:51:07 +00:00
parent 127b74a6be
commit 0508c7d55d
1 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mrlib/switchable-button.ss
View File

@ -16,10 +16,11 @@
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(let ([pen (send dc get-pen)] (let ([pen (send dc get-pen)]
[brush (send dc get-brush)] [brush (send dc get-brush)]
[font (send dc get-font)]) [font (send dc get-font)]
[yellow (make-object color% 255 255 200)])
(send dc set-pen "yellow" 1 'transparent) (send dc set-pen yellow 1 'transparent)
(send dc set-brush "yellow" 'solid) (send dc set-brush yellow 'solid)
(let-values ([(cw ch) (get-client-size)]) (let-values ([(cw ch) (get-client-size)])
(send dc draw-rectangle 0 0 cw ch) (send dc draw-rectangle 0 0 cw ch)
@ -126,9 +127,11 @@
(unless float-window (unless float-window
(set! float-window (new frame% (set! float-window (new frame%
[label ""] [label ""]
[style '(no-caption float)])) [style '(no-caption float)]
[stretchable-width #f]
[stretchable-height #f]))
(new yellow-message% [parent float-window] [label label])) (new yellow-message% [parent float-window] [label label]))
;; position the floating window ;; position the floating window
(let loop ([window this] (let loop ([window this]
[x 0] [x 0]