Re: AW: capi:top-level-interface-geometry
There are also some issues with multiple monitors. I have found I have to check, say, if the monitor geometry
has moved, or a display is completely gone.
Here is some code... In general the interface geometry is stored when the destroy-callback is invoked
and it restored with my force-display function. (winapi:monitor-from-point follows).
Wade
(defun force-display (interface &rest keys &key best-x best-y &allow-other-keys)
(let* ((display (apply #'capi:display interface :allow-other-keys t keys)))
(multiple-value-bind (actual-x actual-y)
(capi:top-level-interface-geometry display)
(unless best-x (setf best-x actual-x))
(unless best-y (setf best-y actual-y))
(when (and (winapi::monitor-from-point best-x best-y)
(or (/= best-x actual-x)
(/= best-y actual-y)))
(capi:set-top-level-interface-geometry display :x best-x :y best-y))
display)))
(capi:define-interface run-report-interface ()
((running-log-interface :initarg :running-log-interface :accessor running-log-interface)
(report-last-selected-date :initform nil)
(report-start-date :initform nil)
(report-end-date :initform nil))
(:panes
(report-annotation capi::text-input-pane
:title "Annotation"
:title-position :left
:font *report-entry-font*
:background :white)
(report-type-choice capi:list-panel
:items '(|Diary Report|
|Weekly Distance Report|
|Schedule Report|
|Race Report|)
:font *report-entry-font*
:visible-min-width 150
:visible-max-height 75)
(report-interval-type capi:radio-button-panel
:items '(|Current Year|
|Current Month|
|Selected Dates|)
:layout-class 'capi:column-layout
:font *report-entry-font*
:selection-callback
(lambda (interval log)
(with-slots (report-start-pane report-end-pane) log
(case interval
(|Selected Dates|
(setf (capi:simple-pane-background report-start-pane) :white
(capi:simple-pane-background report-end-pane) :white
(capi:simple-pane-foreground report-start-pane) :black
(capi:simple-pane-foreground report-end-pane) :black
(capi:simple-pane-enabled report-start-pane) t
(capi:simple-pane-enabled report-end-pane) t))
(otherwise
(setf (capi:simple-pane-background report-start-pane) :lightgrey
(capi:simple-pane-background report-end-pane) :lightgrey
(capi:simple-pane-foreground report-start-pane) :grey
(capi:simple-pane-foreground report-end-pane) :grey
(capi:simple-pane-enabled report-start-pane) nil
(capi:simple-pane-enabled report-end-pane) nil))))))
(report-start-pane capi:title-pane
:enabled nil
:visible-min-width 100
:font *report-entry-font*
:background :lightgrey
:foreground :grey)
(report-end-pane capi:title-pane
:enabled nil
:visible-min-width 100
:font *report-entry-font*
:background :lightgrey
:foreground :grey)
(report-start-set-current-button capi:push-button
:text "<< Current Date"
:font *small-font*
:callback-type :interface
:callback (lambda (log) (set-report-start-current (running-log-interface log))))
(report-end-set-current-button capi:push-button
:text "<< Current Date"
:font *small-font*
:callback-type :interface
:callback (lambda (log) (set-report-end-current (running-log-interface log))))
(report-in-browser-panel capi:radio-button-panel
:items '(t nil)
:font *report-entry-font*
:print-function (lambda (item)
(if item "Yes" "No"))
:layout-class 'capi:row-layout
:title "View Report After Generation"
:title-position :left)
(generate-report-button capi:push-button
:text "Generate Report"
:font *display-font*
:max-width :screen-width
:callback-type :interface
:callback 'generate-report))
(:layouts
(report-dialog capi:column-layout
'(report-row-1
report-grid
report-in-browser-panel
report-annotation
generate-report-button)
:y-gap 5)
(report-row-1 capi:row-layout
'(report-type-choice report-interval-type)
:x-gap 10)
(report-grid capi:grid-layout
'("Start Date:"
report-start-pane
report-start-set-current-button
"End Date:"
report-end-pane
report-end-set-current-button)
:rows 1 :columns 6
:x-adjust '(:right :center :center :right :center :center)
:y-adjust :center))
(:default-initargs
:auto-menus nil
:destroy-callback (lambda (run-report)
(setf (getf (runner-plist (runner (running-log-interface run-report))) :report-interface-geometry)
(multiple-value-bind (best-x best-y)
(capi:top-level-interface-geometry run-report)
(list :best-x best-x :best-y best-y)))
(setf (run-report-interface (running-log-interface run-report)) nil))))
(defun show-report-tool (log)
(if (run-report-interface log)
(capi:show-interface (run-report-interface log))
(destructuring-bind (&key (best-x nil) (best-y nil))
(getf (runner-plist (runner log)) :report-interface-geometry)
(setf (run-report-interface log)
(force-display (make-instance 'run-report-interface :running-log-interface log
:best-x best-x
:best-y best-y
:title (format nil "Running Log Report Tool for ~A" (runner-name (runner log))))
:best-x best-x
:best-y best-y
:owner log)))))
(in-package :winapi)
(defconstant MONITOR_DEFAULTTONULL 0)
(defconstant MONITOR_DEFAULTTOPRIMARY 1)
(defconstant MONITOR_DEFAULTTONEAREST 2)
(defconstant MONITORINFOF_PRIMARY 1)
(fli:define-c-struct MONITORINFO
(cbsize dword)
(rcmonitor rect)
(rcwork rect)
(dwflags dword))
(fli::define-precompiled-foreign-object-accessor-functions (((:struct monitorinfo) :no-alloc-p t :size t)))
(defstruct monitor
display-area
work-area
primary-p)
(defun monitorinfo-to-monitor (monitorinfo)
(let ((display-area-rect (fli:foreign-slot-value monitorinfo 'rcmonitor :copy-foreign-object nil))
(work-area-rect (fli:foreign-slot-value monitorinfo 'rcwork :copy-foreign-object nil)))
(make-monitor :display-area
(list
(fli:foreign-slot-value display-area-rect 'left)
(fli:foreign-slot-value display-area-rect 'top)
(fli:foreign-slot-value display-area-rect 'right)
(fli:foreign-slot-value display-area-rect 'bottom))
:work-area
(list
(fli:foreign-slot-value work-area-rect 'left)
(fli:foreign-slot-value work-area-rect 'top)
(fli:foreign-slot-value work-area-rect 'right)
(fli:foreign-slot-value work-area-rect 'bottom))
:primary-p
(= (fli:foreign-slot-value monitorinfo 'dwflags) MONITORINFOF_PRIMARY))))
(winapi-function |MonitorFromPoint|
((pt point)
(dwFlags dword))
handle
:module "user32")
(winapi-function |GetMonitorInfoW|
((hmonitor handle)
(lpmi (:pointer monitorinfo)))
:boolean
:module "user32")
(defun monitor-from-point (x y &optional (default-return nil))
(fli:with-dynamic-foreign-objects ()
(let ((point (fli:allocate-dynamic-foreign-object :type 'point)))
(setf (fli:foreign-slot-value point 'x) x)
(setf (fli:foreign-slot-value point 'y) y)
(let ((handle (|MonitorFromPoint| (fli:dereference point :copy-foreign-object nil)
(ecase default-return
(:nearest MONITOR_DEFAULTTONEAREST)
(:primary MONITOR_DEFAULTTOPRIMARY)
((nil) MONITOR_DEFAULTTONULL)))))
(if (zerop handle)
nil
(let ((monitorinfo (fli:allocate-dynamic-foreign-object :type 'monitorinfo)))
(setf (fli:foreign-slot-value monitorinfo 'cbsize)
(fli:size-of 'monitorinfo))
(|GetMonitorInfoW| handle monitorinfo)
(monitorinfo-to-monitor monitorinfo)))))))