.
original commit: 1b72c54d45dcf763b0508c2759ab6be4533f6bb9
This commit is contained in:
parent
4cdc36eaae
commit
849da7c82b
|
@ -25,6 +25,7 @@
|
|||
brush%
|
||||
brush-list%
|
||||
button%
|
||||
can-get-page-setup-from-user?
|
||||
canvas%
|
||||
canvas<%>
|
||||
check-box%
|
||||
|
@ -89,6 +90,7 @@
|
|||
get-file
|
||||
get-file-list
|
||||
get-font-from-user
|
||||
get-page-setup-from-user
|
||||
get-panel-background
|
||||
get-ps-setup-from-user
|
||||
get-resource
|
||||
|
|
|
@ -239,6 +239,8 @@
|
|||
get-choices-from-user
|
||||
get-text-from-user
|
||||
get-ps-setup-from-user
|
||||
get-page-setup-from-user
|
||||
can-get-page-setup-from-user?
|
||||
play-sound
|
||||
get-display-size
|
||||
get-display-left-top-inset
|
||||
|
|
|
@ -1008,8 +1008,6 @@
|
|||
get-data
|
||||
on-replaced)
|
||||
(define-class ps-setup% object% ()
|
||||
show-native
|
||||
can-show-native?
|
||||
copy-from
|
||||
set-margin
|
||||
set-editor-margin
|
||||
|
@ -1033,6 +1031,8 @@
|
|||
get-preview-command
|
||||
get-file
|
||||
get-command)
|
||||
(define-function show-print-setup)
|
||||
(define-function can-show-print-setup?)
|
||||
(define-class pasteboard% editor% #f
|
||||
set-scroll-step
|
||||
get-scroll-step
|
||||
|
|
|
@ -19,6 +19,8 @@
|
|||
"mrtextfield.ss")
|
||||
|
||||
(provide get-ps-setup-from-user
|
||||
get-page-setup-from-user
|
||||
can-get-page-setup-from-user?
|
||||
get-text-from-user
|
||||
get-choices-from-user
|
||||
get-color-from-user)
|
||||
|
@ -139,6 +141,28 @@
|
|||
s)
|
||||
#f)]))
|
||||
|
||||
(define get-page-setup-from-user
|
||||
(case-lambda
|
||||
[() (get-page-setup-from-user #f #f #f null)]
|
||||
[(message) (get-page-setup-from-user message #f #f null)]
|
||||
[(message parent) (get-page-setup-from-user message parent #f null)]
|
||||
[(message parent pss) (get-page-setup-from-user message parent pss null)]
|
||||
[(message parent pss-in style)
|
||||
(check-label-string/false 'get-page-setup-from-user message)
|
||||
(check-top-level-parent/false 'get-page-setup-from-user parent)
|
||||
(check-instance 'get-page-setup-from-user wx:ps-setup% 'ps-setup% #t pss-in)
|
||||
(check-style 'get-page-setup-from-user #f null style)
|
||||
|
||||
(and (wx:can-show-print-setup?)
|
||||
(let ([s (make-object wx:ps-setup%)])
|
||||
(send s copy-from (or pss-in (wx:current-ps-setup)))
|
||||
(and (parameterize ([wx:current-ps-setup s])
|
||||
(wx:show-print-setup parent))
|
||||
s)))]))
|
||||
|
||||
(define (can-get-page-setup-from-user?)
|
||||
(wx:can-show-print-setup?))
|
||||
|
||||
(define get-text-from-user
|
||||
(case-lambda
|
||||
[(title message) (get-text-from-user title message #f "" null)]
|
||||
|
|
Loading…
Reference in New Issue
Block a user