'14:53 23/09/2017 '22:50 10/03/2018 uses corewin ' #ifdef FileDialogs uses FileDialog #endif ' ' 'SHARED STATE SERVER SIDE '------------------------ ' sys bu[0x400] 'STATIC BUFFER TO HOLD STATE VARIABLES 'function guistate() as sys export = @bu sys guistate() export {#noinit : return @bu} ' '-------------------------------------- 'INCLUDE ON BOTH SERVER AND CLIENT SIDE '-------------------------------------- sys b b = guistate() bind b { sys hWndMain,inst,hDC,hRC sys minCreate, RebuildWindow sys pixelform sys mposx,mposy,sposx,sposy,eposx,eposy,iposx,iposy sys mmove,bleft,bmid,bright,bwheel sys pause sys bkey,keyd,lastkey,lastchar sys key[256] } '-------------------------------------- #undef b 'MAKE INVISIBLE #undef bu 'MAKE INVISIBLE RECT crect string cr=chr(13)+chr(10), tab=chr(9), qu=chr(34) macro CreateMainWindow ====================== hwnd = CreateWindowEx( 0, 'extended styles "wins", 'class name "Main Window", 'window name style, ' CW_USEDEFAULT, 'default horizontal position CW_USEDEFAULT, 'default vertical position width, 'defined width height, 'defined height null, 'no parent or owner window null, 'class menu used inst, 'instance handle null); 'no window creation data if not hWnd then MessageBox 0,"Unable to create window","problem",MB_ICONERROR exit function end if end macro ' #ifdef OpenGL uses glWinUtil #endif 'Opengl ' ' macro LogMousePos ================= mposx=LoWord[lparam] : mposy=HiWord[lparam] sPosX=mPosX : sPosY=mPosy iPosX=mPosX : iPosY=mPosy GetCursorPos @mp sp=mp act=1 end macro macro MouseMessages =================== case WM_MOUSEMOVE mposx=LoWord[lparam] : mposy=HiWord[lparam] : mmove=1 static POINT sp,mp if act=0 then act=1 if bleft 'adjust window position scope POINT q 'MOUSE POSITION ON SCREEN RECT r 'WINDOW RECT ON SCREEN int w,h GetWindowRect hwnd,@r GetCursorPos @mp w=r.right-r.left h=r.bottom-r.top if mposy<32 'MOUSE POSITION IN CLIENT AREA if mposx>w*.75 'stretch right w=w+mp.x-sp.x h=h-mp.y+sp.y q.y=q.y+mp.y-sp.y elseif mposx<32 'menu? else 'move q.x=mp.x-sp.x q.y=mp.y-sp.y end if moveWindow hwnd,r.left+q.x,r.top+q.y,w,h,1 sp=mp end if end scope end if case WM_LBUTTONDOWN : bleft=1 : LogMousePos case WM_LBUTTONUP : bleft=0 : eposx=mposx case WM_RBUTTONDOWN : bright=1 : LogMousePos case WM_RBUTTONUP : bright=0 : eposx=mposx case WM_MBUTTONDOWN : bMid=1 : LogMousePos case WM_MBUTTONUP : bMid=0 : eposx=mposx case WM_MOUSEWHEEL : bWheel=wParam : sar bWheel,16 end macro macro KeyboardMessages ====================== case WM_CHAR : lastchar=wparam case WM_KEYUP : key[wparam]=0 : keyd=0 : if wparam>30 then bkey=0 case WM_KEYDOWN wparam and= 255 select case wparam keydown 'macro intercept 'DEFAULT CASES case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 case 32 : if key[32]=0 then pause=1-pause 'toggle end select key[wparam]=1 lastkey=wparam bkey=lastkey keyd=lastkey #ifdef opengl act=1 #endif end macro 'MICROSECOND TIMER ================== ' macro TimeMark(c) ================= QueryPerformanceCounter @c end macro ' function TimeDiff(quad *te,*ts) as double ========================================= static quad freq QueryPerformanceFrequency @freq return (te-ts)/freq 'SECONDS end function ' function AppExePath(optional sys n) as char* ============================== static byte b[512] sys i=GetModuleFileName(GetModuleHandle(0), @b, 512) while b[i] != 0x5c '92 '\' i-- wend if not n then i++ 'include the '\' by default b[i]=0 = @b 'low level return end function function GetClientWHXY(sys hWnd, *w,*h,*x,*y) ============================================= RECT rc POINT pt GetClientRect(hwnd, @rc) GetCursorPos @pt w=rc.right*.25 h=rc.bottom ScreenToClient hWnd,@pt x=pt.x y=pt.y end function function GetDropFiles(sys hDropParam) As string =============================================== string sDropFiles, sFiles sys i,e,le e=DragQueryFile(hDropParam, -1, null, 0)-1 ' for i = 0 To e le=DragQueryFile(hDropParam, i, null, 1) sfile=space le DragQueryFile(hDropParam, i, StrPtr sFile, le+1) If Ucase(mid(sFile, -4)) = ".LNK" else sDropFiles+= sFile + chr(13,10) end if next i return sDropFiles end function /* ===== NOTES ===== STANDARD CHILD WINDOWS STYLES ' Button The class for a button. ComboBox The class for a combo box. Edit The class for an edit control. ListBox The class for a list box. MDIClient The class for an MDI client window. ScrollBar The class for a scroll bar. Static The class for a static control. BOOL WINAPI CreateProcess( 1 __in_opt LPCTSTR lpApplicationName, 2 __inout_opt LPTSTR lpCommandLine, 3 __in_opt LPSECURITY_ATTRIBUTES lpProcessAttributes, 4 __in_opt LPSECURITY_ATTRIBUTES lpThreadAttributes, 5 __in BOOL bInheritHandles, 6 __in DWORD dwCreationFlags, 7 __in_opt LPVOID lpEnvironment, 8 __in_opt LPCTSTR lpCurrentDirectory, 9 __in LPSTARTUPINFO lpStartupInfo, 10 __out LPPROCESS_INFORMATION lpProcessInformation ); */ ' ' Function MainWindow(sys width,height,style) =========================================== ' indexbase 0 sys a,b,c,hWnd WNDCLASSEX wc MSG wm 'globals hDC, hRC, inst, minCreate ' inst=GetModuleHandle 0 'cname="wins" ' ' with wc .cbSize = sizeof WNDCLASSEX ' .style=CS_HREDRAW or CS_VREDRAW .lpfnWndProc = @wndproc .cbClsExtra = 0 .cbWndExtra = 0 .hInstance = inst .hIcon = LoadIcon 0, IDI_APPLICATION .hCursor = LoadCursor 0,IDC_ARROW .hbrBackground = GetStockObject WHITE_BRUSH .lpszMenuName = 0 .lpszClassName = strptr "wins" .hIconSm = null end with ' if not RegisterClassEx @wc MessageBox 0,"Registration failed","Problem",MB_ICONERROR exit function end if ' ' ' CreateMainWindow 'MACRO WITH OPENGL OVERRIDE ' DragAcceptFiles(hwnd, true) ' #ifdef WindowOpacity 'Set WS_EX_LAYERED on this window SetWindowLong(hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) | WS_EX_LAYERED) SetLayeredWindowAttributes(hwnd, 0, WindowOpacity, LWA_ALPHA); #endif ' ShowWindow hWnd,SW_NORMAL UpdateWindow hWnd hWndMain=hwnd ' 'MESSAGE LOOP '============ ' sys bRet ' #ifdef opengl while running 'frame processing loop while PeekMessage @wm, 0, 0, 0, PM_REMOVE #else while bRet := GetMessage @wm, 0, 0, 0 #endif ' 'if bRet == -1 then ' 'show an error message? 'else #ifdef EscapeKeyEnd if wm.message=WM_KEYDOWN if wm.wparam=27 SendMessage hwnd,WM_CLOSE,0,0 end if end if #endif ' #ifdef InMessageLoop InMessageLoop ''CUMSTOMISED MESSAGE PROCESSING #else #ifdef MessageLoopProcesses MessageLoopProcesses #endif TranslateMessage @wm DispatchMessage @wm #endif wend 'GetMessage / PeekMessage ' #ifdef Opengl #ifdef ActOpengl if not closing then ActOpengl 'frame processing end if #endif wend 'running #endif ' end function ; end of WinMain '