Date: 02-16-2022
Return to Index
created by gbSnippets
'Compiler Comments:
'This code is written to compile in PBWin10. To compile in PBWin9, split pt
'into pt.x and pt.y as arguments wherever the PtinRect() API is used (1 place).
'Compilable Example: (Jose Includes)
' still messing about with transparent dialogs
' this uses a transparent dialog to display a crosshair cursor
' over a graphic drawn on an underlying graphic
'
' click on the graphic to move the cursor,
' click on the caption to move or close the dialog
'
' Chris Holbrook Feb 2010
'
#Compiler PBWin 9, PBWin 10
#Compile EXE
#dim all
#include "WIN32API.INC"
%IDD_DIALOG1 = 101
' X and Y axis limits. In practice these would be derived from data
%Xmax = 23
%xmin = 0
%Ymax = 100
%Ymin = 0
'------------------------------------------------------------------------
' this is the callback for the transparent dialog on which the cursor is drawn
callback function CCB()
static hparent as dword
static pt as pointapi
local pt1 as pointapi
local w, h as long
local hdc as dword
local PS as paintstruct
local holdpen as long
select case as long cbmsg
case %wm_initdialog
hparent = getparent(cb.hndl)
SetLayeredWindowAttributes( cb.hndl, %blue, 60, %LWA_ALPHA)
dialog post cb.hndl, %wm_user + 500, 0, 0
'
case %wm_ncactivate
static hWndSaveFocus as dword
if isfalse cbwparam then
hWndSaveFocus = GetFocus()
elseif hWndSaveFocus then
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
setcursor 0
setcapture hparent ' send mouse messages to the main dialog
end if
'
case %wm_destroy
'
case %wm_user + 500 ' syncronize position of mask & main window
clienttoscreen(hparent, pt1)
dialog get client hparent to W, H
movewindow cb.hndl, pt1.x, pt1.y, w, h, %true
'
case %wm_user + 510 ' syncronize cursor poition
getcursorpos pt
screentoclient cb.hndl, pt
invalidaterect cb.hndl, byval 0, %true
'
case %wm_paint ' draw the cursor
hDC = beginpaint(cb.hndl, PS)
SetROP2 hdc, %R2_notxorpen
holdPen=SelectObject(hDC,createpen(%PS_SOLID,3,%blue))
moveto (hDC, 0, pt.y)
lineto hDC, 1000, pt.y
moveto (hDC, pt.x,0)
lineto hDC, pt.x, 1000
deleteObject (SelectObject (hDC, holdPen))
SetROP2 hDC, %R2_copypen
endpaint(cb.hndl, PS)
end select
end function
'------------------------------------------------------------------------
callback function ACB()
static hcursordlg as dword
local i, l, w, h as long
local j as single
local r as rect
local wmin, wmax as single
local pt as pointapi
local s as string
select case as long cbmsg
case %wm_initdialog
' CREATE OVERLAY DIALOG FOR CROSSHAIR CURSOR
dialog new pixels, cb.hndl, "", 0,0,0,0, _
%ws_popup or %ws_visible, %ws_ex_layered to hCursorDlg
dialog show modeless hCursorDlg, call CCB
'SET UP GRAPHIC CONTROL
graphic attach cb.hndl, 1001, redraw
graphic scale (%xmin,%ymax) - (%xmax, %ymin)
graphic print " IT COULD BE ANY OLD GRAPHIC"
graphic set pos (0, 10)
for i = %xmin to %xmax
j = 3.5 * i + 10
j = j * (90 + rnd(0, 20))/100 ' add a wobble
graphic line step -(i, j), %red
next
graphic redraw
setcapture cb.hndl
setcursor byval 0
'
case %wm_ncactivate
static hWndSaveFocus as dword
if isfalse cbwparam then
hWndSaveFocus = GetFocus()
elseif hWndSaveFocus then
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
' setcursor 0
' setcapture cb.hndl
end if
'
case %wm_mousemove
getclientrect cb.hndl, r
pt.x = lo(word, cb.lparam)
pt.y = hi(word, cb.lparam)
if ptinrect(r, pt) then
dialog send hCursorDlg, %wm_user + 510, 0, 0
SetCursor byval 0
else
SetCursor(LoadCursor(%NULL, byval %IDC_ARROW))
releasecapture
setfocus cb.hndl
end if
'
' SYNCRONISE THE OVERLAY DIALOG'S POSITION WITH OUR OWN
case %wm_move
dialog send hCursordlg, %wm_user + 500, 0, 0
end select
end function
'-----------------------------------------------------------------------------
function pbmain()
local w, h as long
local pt as pointapi
local hMaskDlg, hDlg as dword
local hFont as dword
dialog new pixels, 0, "Layered Cursor", 0, 0, 190, 170, _
%ws_popup or %ws_visible or %ds_center or %ws_caption or %ws_sysmenu, to hDlg
dialog get client hDlg to w, h
control add graphic, hDlg, 1001, "", 0, 0, w, h
dialog show modal hDlg call ACB
end function
'gbs_00757
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm