Tweet
I call the little draggable box a winlet because it's not a window - well not a Windows window, anyway. But it can have attributes of a window, like containing a menu, textbox, listbox, closeme button, etc.
Anyway this just shows my first attempt at dragging a winlet - draggable because it contains a dragicon - around a GRAPHIC WINDOW, as ever, if you can see a way of improving it, do tell!
Anyway this just shows my first attempt at dragging a winlet - draggable because it contains a dragicon - around a GRAPHIC WINDOW, as ever, if you can see a way of improving it, do tell!
Code:
' to show dragging a winlet on a GRAPHIC WINDOW
' Chris Holbrook October 2008
'
' Also uses Edwin Knoppert's BINBAS to load an icon
' which is embedded in the executable
'
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
'#include "COMMCTRL.INC"
GLOBAL GrDialogProc AS LONG
GLOBAL GrStaticProc AS LONG
GLOBAL gMouseX AS LONG,gMouseY AS LONG ' Mouse x and y
GLOBAL gLbDOWN AS LONG,gRBDOWN AS LONG ' Left and right mouse button
GLOBAL gMouseMoved AS LONG ' Detect mouse movements
'
' Icon stuff - or you could load it from a resource file
'---------------------------------------------------------------
'//////////////////////////////////////////////////////////////////////////
'// Icon loading
'//////////////////////////////////////////////////////////////////////////
TYPE TAGICONDIR
idReserved AS WORD '// Reserved (must be 0)
idType AS WORD '// Resource Type (1 For icons)
idCount AS WORD '// How many images?
END TYPE
TYPE TAGICONDIRENTRY
bWidth AS BYTE '// Width, In Pixels, of the Image
bHeight AS BYTE '// Height, In Pixels, of the Image
bColorCount AS BYTE '// Number of colors In Image (0 If >=8bpp)
bReserved AS BYTE '// Reserved ( must be 0)
wPlanes AS WORD '// Color Planes
wBitCount AS WORD '// Bits per pixel
dwBytesInRes AS DWORD '// How many bytes In this resource?
dwImageOffset AS DWORD '// Where In the file is this image?
END TYPE
'// Creates an icon using plain filedata, like the 766 Bytes .ICO files.
'// Returns a iconhandle.
FUNCTION SetIconFileBits( BYVAL lpMem AS LONG ) AS LONG
DIM pIconDir AS TAGICONDIR PTR
DIM IconDirEntry AS TAGICONDIRENTRY PTR
pIconDir = lpMem
IF @pIconDir.idCount < 1 THEN EXIT FUNCTION
IconDirEntry = pIconDir + LEN( @pIconDir )
FUNCTION = CreateIconFromResource( _
BYVAL pIconDir + @IconDirEntry.dwImageOffset _
, @IconDirEntry.dwBytesInRes _
, @pIconDir.idType _
, &H30000& _
)
END FUNCTION
'//////////////////////////////////////////////////////////////////////////
MACRO mBinDataStuff
LOCAL a AS LONG
LOCAL t, t2 AS STRING
FOR a = 1 TO DATACOUNT: T = T & READ$( a ): NEXT a
FOR a = 1 TO LEN( T ) STEP 2
T2 = T2 & CHR$( VAL( "&H" & MID$( T, a , 2 ) ) )
NEXT a
FUNCTION = STRPTR(T2)
END MACRO
'-------------------------------------------------------------------------------
FUNCTION BinBasDRAGGRIP AS DWORD
mBinDataStuff
DATA 0000010001001010100001000400280100001600000028000000100000002000000001
DATA 00040000000000000000000000000000000000000000000000000000FFFF0000000000
DATA 0000000000000000000000000000000000000000000000000000000000000000000000
DATA 0000000000000000000000000000000000000000000000000000000000011111111111
DATA 1110011111111111111001111111111111100111111111111110011111111111111001
DATA 1111111111111001111111111111100111111111111110011111111111111001111111
DATA 1111111001111111111111100111111111111110011111111111111001111111111111
DATA 100000000000000000000000007EFE00007C7E00007ABE00007EFE00006EF600005EFA
DATA 0000000000005EFA00006EF600007EFE00007EFE00007ABE00007C7E00007EFE000000
DATA 000000
END FUNCTION
'--------------------------------------------------------------------------------
FUNCTION GrDlgProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
FUNCTION = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
END FUNCTION
'--------------------------------------------------------------------------------
FUNCTION GrProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL p AS pointapi
SELECT CASE wMsg
CASE %WM_MOUSEMOVE
gMouseMoved = %TRUE
gMouseX = LO(WORD,lParam)
gMouseY = HI(WORD,lParam) ' Current Mouse X and Y Position in the graphic window
CASE %WM_LBUTTONDOWN
gLBDOWN = 1
EXIT FUNCTION ' Left button pressed
CASE %WM_LBUTTONUP
gLBDOWN = 0
EXIT FUNCTION
CASE %WM_RBUTTONDOWN
gRBDOWN = 1
EXIT FUNCTION ' Right button pressed
CASE %WM_RBUTTONUP
gRBDOWN = 0
EXIT FUNCTION ' Right button pressed
END SELECT
FUNCTION = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
END FUNCTION
'----------------------------------------------------------
SUB doboxstuff ( X AS LONG, Y AS LONG, W AS LONG, H AS LONG, OPT hicon AS LONG)
LOCAL r, rlastbox, DragGripIconRect AS rect
LOCAL skey AS STRING
LOCAL movemode AS LONG
LOCAL hDC AS LONG
LOCAL DragSizeOriginX, DragSizeOriginY AS LONG
LOCAL lresult AS LONG
setrect BYVAL VARPTR(r), X, Y, W, H
GOSUB drawbox
DO
SLEEP 0
GRAPHIC INKEY$ TO skey
IF skey = $ESC THEN EXIT SUB
IF skey = "" THEN
IF glbdown THEN
IF ptinrect ( DragGripIconRect, DragSizeOriginX, DragSizeOriginY) THEN
DragSizeOriginX = gMouseX
DragSizeOriginY = gMouseY
END IF
IF gmousemoved THEN
DO
SLEEP 50
' the left mouse button has been held down
' the action depends upon where cursor was when
' the initial button press was made
offsetRect BYVAL VARPTR( r), gMouseX - DragSizeOriginX, gMouseY - DragSizeOriginY
GOSUB drawbox
DragSizeOriginX = gMouseX
DragSizeOriginY = gMouseY
LOOP UNTIL glbdown = 0
gmousemoved = %FALSE
ITERATE
END IF
END IF
END IF
LOOP
EXIT SUB ' never gets here
drawbox:
GRAPHIC BOX ( rlastbox.nleft,rlastbox.ntop) - (rlastbox.nright, rlastbox.nbottom), 0, %WHITE, %WHITE, 0
GRAPHIC BOX ( r.nleft,r.ntop) - (r.nright, r.nbottom), 0, %BLACK, %WHITE, 0
' calculate average corner size
IF hicon THEN
GRAPHIC GET DC TO hdc
DragGripIconRect.nleft = r.nleft + 10 ' position icon at offset 10, 10 inside box
DragGripIconRect.ntop = r.ntop + 10
DragGripIconRect.nright = r.nleft + 10 + 16
DragGripIconRect.nbottom = r.ntop + 10 + 16
lresult = drawiconex (hdc, r.nleft + 10, r.ntop + 10, hicon, 16, 16, 0, BYVAL 0, %di_normal)
END IF
GRAPHIC REDRAW
copyrect BYVAL VARPTR(rlastbox), BYVAL VARPTR(r)
RETURN
END SUB ' never gets here either
'--------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL hGW AS DWORD
LOCAL hstatic AS DWORD
LOCAL x, y, w, h, ICON_draggrip AS LONG
icon_DRAGGRIP = SetIconFileBits(BinBasDragGrip)
' Center graphic window within console window
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 "Winlet with dragicon Chris Holbrook", x, y, 600, 600 TO hGW
hStatic = GetWindow(hGW, %GW_CHILD) ' Retrieve static handle of graphic window
GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, CODEPTR(GrProc)) ' Subclasses Graphic control
GRAPHIC ATTACH hGW, 0
GRAPHIC COLOR %BLACK, %WHITE
GRAPHIC CLEAR
doboxstuff(20, 20, 200, 200, icon_draggrip)
SetWindowLong(hStatic, %GWL_WNDPROC, GrStaticProc) ' remove subclassing
IF icon_DRAGGRIP THEN destroyicon(icon_DRAGGRIP)
GRAPHIC WINDOW END
END FUNCTION
Comment