Tweet
Over the past few months there have been a few posts - I think that Guy Dombrowski started it - about using subclassing in conjunction with Graphic Windows. This evidently worked when the communication with the main program is through globals, and was restricted to the cursor position, mouse clicks, and keys pressed. However, when the concept was pushed a little further, problems arose - when I started to put graphic statements into the subclass code, I found that the GW needed to be re-attached - although the main program knew about the "graphic attachment" - the subclass routine did not, and had to issue its own GRAPHIC ATTACH.
Since then I have managed to break the principal feature of GWs - their persistence. The GW is drawn OK, but superimpose another window, or move the client area off-screen, and - goodbye, drawing!
If I can't find a work-around for this, my ambition of devising applications using window-like boxes on a GW will be thwarted - oh well, no great loss.
The moral of the story may well be - don't mix DDT techniques with SDK techniques. In particular,
But then again, by not using GWs, instead using standard API functions and writing WM_PAINT and WM_ERASEBKGND handlers, the same results can be achieved by drawing on a STATIC window. The only graphic drawing commands I use are Print, Box and Clear. These can be replaced with API calls.
Big thanks to PowerBasic Inc and Jeff Daniels for patient assistance with my struggle. A couple of documentation features were exposed so I hope it was not too one-sided.
If anyone would care to try the code, here it is. There are draw, drag and size functions which work in a fairly intuitive way, and a right-click menu for deletion and z-ordering. If the screen needs to be refreshed because of the problem noted above, just click it.
Since then I have managed to break the principal feature of GWs - their persistence. The GW is drawn OK, but superimpose another window, or move the client area off-screen, and - goodbye, drawing!
If I can't find a work-around for this, my ambition of devising applications using window-like boxes on a GW will be thwarted - oh well, no great loss.
The moral of the story may well be - don't mix DDT techniques with SDK techniques. In particular,
from PowerBasic Support: PowerBASIC cannot be responsible for handling the graphics if you are subclassing the graphic window.
Big thanks to PowerBasic Inc and Jeff Daniels for patient assistance with my struggle. A couple of documentation features were exposed so I hope it was not too one-sided.
If anyone would care to try the code, here it is. There are draw, drag and size functions which work in a fairly intuitive way, and a right-click menu for deletion and z-ordering. If the screen needs to be refreshed because of the problem noted above, just click it.
Code:
'
' Drawing, dragging and resizing boxes on a Graphic Window (revisited)
' investigation into using objects. Needs PBCC V5.xx
'
' version 1.1
'
' Chris Holbrook Jan 2009
'
#compile exe
#dim all
#break on
#include "win32api.inc"
global hGW as dword
global gOriginalProc as dword
global gBX() as ICtlBox
'--------------------------------------------------------------------------------
' colours
%DEFAULT_COLOR = %white
%DRAW_COLOR = &H00e8e8FF
%DRAG_COLOR = &H00e8ffe8
%SIZE_COLOR = &H00ffe8e8
%RCLICKSUBJECT_COLOR = &H0080e8FF
'
' drawmodes
%RCLICKSUBJECT = 4
%SIZING = 3
%DRAWING = 2
%DRAGGING = 1
%IDLING = 0
'
' dimensions
%BOXLINEWIDTH = 1
%SIZEBORDERWIDTH = 10
%MINVIABLEBOXSIDE = 25
'
class CtlboxClass
instance X as long
instance Y as long
instance W as long
instance H as long
instance boxtype as long
instance title as string
instance lx as long
instance z as long
instance bgcolor as long ' background color, different for default/drag/draw
instance DDOX as long ' Draw Drag Origin X, last point clicked
instance DDOY as long ' Draw Drag Origin Y, last point clicked
instance drawmode as long ' current drawing mode
'-------------------------------------------
class method create ()
bgcolor = %DEFAULT_COLOR
end method
'-------------------------------------------
class method SetDDO ( iX as long, iY as long)
DDOX = iX
DDOY = iY
end method
'-------------------------------------------
class method GetDDO as long
method = mak(dword,DDOX, DDOY)
end method
'-------------------------------------------
interface ICtlBox
inherit iunknown
'-------------------------------------------
method SetLoc ( iX as long, iY as long )
X = iX
Y = iY
end method
'-------------------------------------------
method GetLoc as dword
method = mak(dword, X, Y)
end method
'-------------------------------------------
method SetSize ( lW as long, lH as long)
W = lW
H = lH
end method
'-------------------------------------------
method GetSize as dword
method = mak(dword, W, H)
end method
'-------------------------------------------
method SetType ( ltype as long)
boxtype = ltype
end method
'-------------------------------------------
method GetType as long
method = boxtype
end method
'-------------------------------------------
method SetTitle ( s as string)
title = s
end method
'-------------------------------------------
method SetIndex (lindex as long)
lx = lindex
end method
'-------------------------------------------
method GetIndex as dword
method = lx
end method
'-------------------------------------------
method SetZPos ( lz as long)
z = lz
end method
'-------------------------------------------
method GetZPos as long
method = z
end method
'-------------------------------------------
method SetDrawMode ( lmode as long)
drawmode = lmode
select case drawmode
case %RCLICKSUBJECT
bgcolor = %RCLICKSUBJECT_COLOR
case %SIZING
bgcolor = %SIZE_COLOR
case %DRAWING
bgcolor = %DRAW_COLOR
case %DRAGGING
bgcolor = %DRAG_COLOR
case %IDLING
bgcolor = %DEFAULT_COLOR
end select
end method
'-------------------------------------------
method startdrag( iX as long, iY as long)
drawmode = %DRAGGING
bgcolor = %DRAG_COLOR
me.SetDDO(iX, iY)
end method
'-------------------------------------------
method enddrag( iX as long, iY as long)
bgcolor = %DEFAULT_COLOR
graphic attach hGW, 0, redraw
graphic color %black, %white
me.erasebox
bgcolor = %DEFAULT_COLOR
drawmode = %IDLING
me.drawbox
graphic redraw
end method
'-------------------------------------------
method dragto( iX as long, iY as long)
graphic attach hGW, 0, redraw
graphic color %black, %white
me.erasebox
X = X + (iX - DDOX)
Y = Y + (iY - DDOY)
me.drawbox
graphic redraw
DDOX = iX
DDOY = iY
end method
'-------------------------------------------
method startdraw( iX as long, iY as long)
drawmode = %DRAWING
bgcolor = %DRAW_COLOR
me.SetDDO(iX, iY)
me.SetLoc(iX, iY)
end method
'-------------------------------------------
method startsize ( iX as long, iY as long)
drawmode = %SIZING
bgcolor = %SIZE_COLOR
me.SetDDO(iX, iY)
end method
'-------------------------------------------
method endsize ( iX as long, iY as long)
graphic attach hGW, 0, redraw
graphic color %black, %white
me.erasebox
bgcolor = %DEFAULT_COLOR
drawmode = %IDLING
me.drawbox
graphic redraw
end method
'-------------------------------------------
method enddraw ( iX as long, iY as long)
' possible that X, Y define a point other than the NW corner of the rect
X = min(X, X + W) : Y = min(Y, Y + H)
W = abs(W): H = abs(H)
graphic attach hGW, 0, redraw
graphic color %black, %white
me.erasebox
bgcolor = %DEFAULT_COLOR
drawmode = %IDLING
me.drawbox
graphic redraw
end method
'-------------------------------------------
method drawto( iX as long, iY as long)
graphic attach hGW, 0, redraw
graphic color %black, %white
me.erasebox
W = iX - DDOX
H = iY - DDOY
me.drawbox
graphic redraw
end method
'-------------------------------------------
method sizeto ( iX as long, iY as long)
graphic attach hGW, 0, redraw
graphic color %black, %white
me.erasebox
W = W + (iX - DDOX)
H = H + (iY - DDOY)
me.SetDDO(iX, iY)
me.drawbox
graphic redraw
end method
'-------------------------------------------
method EraseBox
graphic box (X - %boxlinewidth, Y - %boxlinewidth) - (X + W + %BOXLINEWIDTH, Y + H + %BOXLINEWIDTH), 0, %white, %white, 0
end method
'-------------------------------------------
method DrawBox
local s as string
select case as long drawmode
case %DRAWING
s = "DRAWING "
case %DRAGGING
s = "DRAGGING "
case %SIZING
s = "SIZING "
case %IDLING
s = "IDLING "
case %RCLICKSUBJECT
s = "RCLICK "
end select
s = s + "(" + format$(X) + "," + format$(Y) + ")-(" + format$(W) + "," + format$(H) + ")"
sendmessage hGW, %WM_SETTEXT, 0, strptr(s)
'graphic box (100, 100) - (200, 200), 0, %white, %red, 0
graphic box (X, Y) - (X + W, Y + H), 0, %black, bgcolor, 0
graphic set pos (X + 5, y + 5)
graphic print str$(lx) + " z=" + format$(z) + " " + title
end method
'-----------------------------------------------------------------
' returns zero if point not in box, 1 if point in size border, 2 if point inside size border
method pointenclosed ( iX as long, iY as long ) as long
local r as rect
setrect r, X, Y, X + W, Y + H
if ptinrect ( r, iX, iY) then
inflaterect r, - %SIZEBORDERWIDTH - 1, - %SIZEBORDERWIDTH -1
if ptinrect ( r, iX, iY) then
method = 2: exit method
end if
method = 1: exit method
end if
end method
end interface
end class
'--------------------------------------------------------------------------------
' make a list of ctlbox indexes in ascending z order and draw boxes in Z order
sub DrawInZOrder
local i, j, k, n as long
local zs() as long
graphic clear %white, 0
n = ubound(gBX)
if n >= 0 then
dim zs(0 to n) as local long
for i = 0 to n
if not isobject (gbx(i)) then
? "notobject", i
exit sub
else
j = gBX(i).GetZPos
end if
zs(i) = mak(dword, i, j)
next
array sort zs() ' NB z order is Most Significant word so this sorts in Z order
for i = 0 to n
j = lo(word,zs(i))
gBX(j).Drawbox
next
end if
graphic redraw
end sub
'--------------------------------------------------------------------------------
' move the box specified by lx up(direction = 0) or down (direction <> 0) the Z order
' by adjusting the Z orders of boxes
sub reZorder ( lx as long, direction as long )
local i, j, n as long
local zs() as long
n = ubound(gBX)
for i = 0 to n
j = gBX(i).getZpos
gBX(i).SetZPos(j*10)
next
if direction = 0 then
j = gBX(lx).GetZpos + 11
gBX(lx).SetZPos(j)
else
j = gBX(lx).GetZpos - 11
gBX(lx).SetZPos(j)
end if
n = ubound(gBX)
dim zs(0 to n) as local long
for i = 0 to n
zs(i) = mak(dword, i, gBX(i).GetZPos)
next
array sort zs() ' NB z order is Most Significant word so this sorts in Z order
for i = 0 to n
j = lo(word,zs(i))
gBX(j).SetZPos ( i )
next
DrawinZorder
end sub
'--------------------------------------------------------------------------------
' return two words in a dword.
' loword is 1 if the point is in the sizing border, 2 if elsewhere in the box, 0 if not in the box
' if loword > 0 then hiword = index of the CtlBox enclosing the cursor position given by the parameters
' or -1 if no such box is defined
' NB the boxes are inspected in Z order, if two boxes are overlapping then the one with the
' highest Z order is picked first
function inabox ( X as long, Y as long ) as dword
local i, j, k, n as long
local zs() as long
graphic clear %white, 0
n = ubound(gBX)
if n < 0 then
function = -1
exit function
end if
dim zs(0 to n) as local long
for i = 0 to n
zs(i) = mak(dword, i, gBX(i).GetZPos)
next
array sort zs(), descend ' NB z order is Most Significant word so this sorts in Z order
for i = 0 to n
k = lo(word,zs(i))
j = gBX(k).pointenclosed( X, Y )
if j then
function = mak(dword,j,k)
exit function
end if
next
function = -1
end function
'--------------------------------------------------------------------------------
' delete the control and shuffle the array down, redim to remove topmost member
sub DeleteControl (lx as long)
local i, n as long
n = ubound(gBX)
gBX(lx) = nothing
for i = lx to n -1
gBX(i) = gBX(i + 1)
next
gBX(n) = nothing
if n > 0 then
redim preserve gBX(0 to n-1) as global ICtlBox
DrawInZOrder
else
erase gBX()
graphic clear %white
graphic redraw
end if
? "done del"
end sub
'--------------------------------------------------------------------------------
' right click menu. Parameter is the CtlBox index
sub RClickMenu ( lx as long, X as long, Y as long)
local hmenu, menuchoice as long
local pt as POINTAPI
local hWnd as dword
hWnd = GetWindow(hGW, %GW_CHILD)
pt.X = X : pt.Y = Y
Clienttoscreen(hWnd, pt)
hmenu = CreatePopupMenu
InsertMenu(hMenu, 0, %MF_BYCOMMAND, 1, "move up Z order")
InsertMenu(hMenu, 0, %MF_BYCOMMAND, 2, "move down Z order")
' InsertMenu(hMenu, 0, %MF_BYCOMMAND, 3, "Edit Title")
' InsertMenu(hMenu, 0, %MF_BYCOMMAND, 4, "Edit Control Type")
InsertMenu(hMenu, 0, %MF_BYCOMMAND, 5, "Delete Control")
MenuChoice = TrackPopupMenuEx(hmenu, _
%mf_enabled or %MF_BYCOMMAND or %TPM_RETURNCMD, _
pt.X, pt.Y, _
hWnd, byval %NULL)
select case as long menuchoice
case 1 ' up z order
rezorder ( lx, 0)
case 2 ' down z order
rezorder ( lx, 1)
case 3 ' edit title
? "edit title"
case 4 ' edit type
? "edit type"
case 5 ' delete
DeleteControl(lx)
end select
end sub
'--------------------------------------------------------------------------------
function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
'local p as pointapi
static bx as long
local bxtop, i, l, lresult, n, x, y as long
local s as string
static drawmode as long ' either %DRAWING or %DRAGGING or %IDLING
static hcursor, dragcursor, drawcursor, sizecursor as dword
select case wMsg
'
case %wm_user + 400
SizeCursor = LoadCursor(%NULL,byval %IDC_SIZENWSE)
DragCursor = LoadCursor(%NULL,byval %IDC_HAND)
DrawCursor = LoadCursor(%NULL,byval %IDC_CROSS)
hcursor = getcursor
case %wm_mousemove
x = lo(word, lparam)
y = hi(word, lparam)
lresult = inabox( X, Y)
select case as long lo(word,lresult)
case 1 ' sizing
setcursor SizeCursor
case 2 ' dragging
setcursor DragCursor
case else
setcursor hCursor
end select
'
select case as long drawmode
case %DRAWING
setcursor DrawCursor
gBX(bx).drawto( X, Y)
DrawInZOrder
function = 1
exit function
case %DRAGGING
setcursor DragCursor
gBX(bx).dragto( X, Y )
DrawInZOrder
function = 1
exit function
case %SIZING
setcursor SizeCursor
gBX(bx).sizeto( X, Y )
DrawInZOrder
function = 1
exit function
case else ' idling
end select
'
case %wm_lbuttondown
x = lo(word, lparam)
y = hi(word,lparam)
lresult = inabox( X, Y)
if lresult = -1 then
bx = 0
lresult = 0
else
bx = hi(word, lresult)
lresult = lo(word, lresult)
end if
's = str$(bx)
'sendmessage getparent(hWnd), %WM_SETTEXT, 0, strptr(s)
select case as long lresult
'
case 0 ' user clicked ouside a box so start a new one
drawmode = %DRAWING
n = 0
bxtop = ubound(gBX)
for i = 0 to bxtop
n = max(n,gBX(i).GetIndex)
next
bx = bxtop + 1
redim preserve gBX(0 to bxtop + 1) as ICtlBox
let gBX(bx) = class "CtlBoxClass"
gBX(bx).SetIndex ( n + 1 ) ' the highest number in use + 1
gBX(bx).SetZPos ( bx )
gBX(bx).startdraw( X, Y)
case 1 ' user clicked on sizing border
drawmode = %sizing
gBX(bx).startsize( X, Y)
case 2 ' user clicked elsewhere inside box, prepare to drag existing box
drawmode = %DRAGGING
gBX(bx).startdrag( X, Y)
end select
function = 1
exit function
'
case %wm_lbuttonup
x = lo(word, lparam)
y = hi(word,lparam)
setcursor hcursor
select case as long drawmode
case %DRAWING
l = gBX(bx).GetSize
if (lo(word,l) < %MINVIABLEBOXSIDE) or (hi(word,l) < %MINVIABLEBOXSIDE) then
n = ubound(gBX)
if n = 0 then
erase gBX()
else
redim preserve gBX ( 0 to n - 1 ) as global ICtlBox ' get rid of last controlbox
end if
else
gBX(bx).enddraw( X, Y)
end if
drawmode = %IDLING
if ubound(gBX) > -1 then
DrawInZOrder
else
graphic attach hGW, 0, redraw
graphic clear %white
graphic redraw
s = "IDLING"
sendmessage hGW, %WM_SETTEXT, 0, strptr(s)
end if
function = 1
exit function
case %DRAGGING
gBX(bx).enddrag( X, Y)
drawmode = %IDLING
DrawInZOrder
function = 1
exit function
case %SIZING
gBX(bx).endsize( X, Y)
drawmode = %IDLING
DrawInZOrder
function = 1
exit function
end select
'
case %wm_rbuttondown
x = lo(word, lparam)
y = hi(word,lparam)
lresult = inabox( X, Y)
if lresult = -1 then
exit select
else
i = hi(word, lresult)
end if
gBX(i).SetDrawmode (%RCLICKSUBJECT)
DrawInZorder
RClickMenu ( i, X, Y )
if i <= ubound(gBX) then
if isobject(gBX(i)) then
gBX(i).SetDrawMode (%IDLING)
DrawInZOrder
end if
end if
function = 1
exit function ' Right button pressed
'
case %wm_rbuttonup
exit function ' Right button pressed
'
case %wm_ncrbuttonup
beep
'
case %wm_destroy
for i = 0 to ubound(gBX)
gBX(i) = nothing
next
end select
function = CallWindowProc(gOriginalProc, hWnd, wMsg, wParam, lParam)
end function
'-----------------------------------------------------------------------------
function pbmain () as long
local X, Y, W, H as long
local skey as string
local hWndChildofGW as dword
console get loc to x, y ' Console pos on screen
console get size to w, h ' Console size
x = x + (w - 200) / 2 ' Calculate center x pos
y = y + (h - 200) / 2 ' Calculate center y pos
graphic window "draw boxes", 100, 100, 500, 500 to hGW
hWndChildofGW = GetWindow(hGW, %GW_CHILD) ' Retrieve static handle of graphic window
gOriginalProc = SetWindowLong(hWndChildofGW, %GWL_WNDPROC, codeptr(GrProc)) ' Subclasses Graphic control
sendmessage hWndChildofGW, %wm_user + 400, 0, 0 ' initialise WndProc
graphic attach hGW, 0, redraw
graphic color %black, %white
do
sleep 2
loop until hGW = 0
SetWindowLong(hWndChildofGW, %GWL_WNDPROC, gOriginalProc) ' remove subclassing
graphic waitkey$ to sKey
end function
Comment