DragnDrop / HitPointTest

[DW]

After discovering problems with HitPointTest and high-resolution monitors, I came across this post which was helpful to bring to attention the registry key AppliedDPI - thanks honkinberry. Tried to add a reply to the post but seems a database error is preventing it...

If anyone else is searching for a solution to the issue of HitPointTest giving incorrect results at varying screen resolutions, I found the following approach to work.

Where screen resolution varies from 96dpi (which seems to be the default for correct operation),  I use the scale factor between 96dpi and the higher resolution to recalculate the value returned by DropPoint.  HitPointTest then processes the adjusted value.

In my case, I'm using a ListView control and need both coordinates...

Code Select Expand

(defun c:xlsfmt_to_OnDragnDropFromControl
       (ProjectName FormName ControlName DropPoint / rc dpi)
  ;; get screen resolution
  (setq dpi
(vl-registry-read
  "HKEY_CURRENT_USER\\Control Panel\\Desktop\\WindowMetrics"
  "AppliedDPI"
)
  )
  (if (< 96 dpi)
    ;; the difference in resolution of a 1080p monitor and anything else is calculated
    ;; say 1080p @ 100% = 96 dpi, 3840 x 2160 @ 150% = 144 dpi
    ;; 96 / 144 = 0.66667 which is the scaling factor applied to DropPoint
    (setq DropPoint
   (mapcar '(lambda (x) (roundval (* (/ (float 96) (float dpi)) x) 1))
   DropPoint
   )
    )
    ;; otherwise do nothing
  )
  ;; HitPointTest then reports the correct relative coordinates
  (setq rc (dcl_ListView_HitPointTest xlsfmt_to (car DropPoint) (cadr DropPoint)))
    ; do something with rc ...
)   ; end defun

(defun RoundVal (value to)
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
-
+
      )
       value
       (* to 0.5)
     )
     to
  )
     )
  )
)