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