Мышка FreeBasic (Получение мгновенного шага)

#Include "windows.bi"
Dim As Point pt,oldpt,deltapt
 
Do
    GetCursorPos(@pt)
    deltapt.x = pt.x - oldpt.x
    deltapt.y = pt.y - oldpt.y
   oldpt.x = pt.x
   oldpt.y = pt.y
   cls  
    ? "x=";deltapt.x,"y=";deltapt.y
    Sleep(10)   
Loop Until MultiKey(1)

   #INCLUDE ONCE "fbgfx.bi"
   #INCLUDE ONCE "windows.bi"
'  $Lang: "FBLite"
 
DECLARE SUB  Init ()
 
DECLARE SUB  LoadCur ()
DECLARE SUB  ALLInput ()
 
 
    '   Технич. переменные
 
DIM SHARED AS INTEGER Mx, My
DIM SHARED AS POINT Md, Cntr
DIM SHARED Mdx AS INTEGER, Mdy AS INTEGER
 
 
DIM SHARED CurImg(991) AS UBYTE
DIM SHARED AS UINTEGER ScreenXRez, ScreenYRez
 
ScreenXRez = 640: ScreenYRez = 480
'SCREENINFO ScreenXRez, ScreenYRez
 
 
     Init
 
COLOR  , RGB(20, 20, 20)
     DO: CLS
         ALLInput
 
             PUT (Mx, My), CurImg, ALPHA
 
         FLIP
         SLEEP 10, 1
     LOOP
 
 
CurDatL:
DATA 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 2, 2, 2, 2, 2, 1, 0, 0, 0, 0, 0
DATA 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0
DATA 1, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
 
SUB  Init ()
 
SCREENRES ScreenXRez, ScreenYRez, 32, 2, 0
SCREENSET 1, 0
 
       '   Загрузим курсор
     LoadCur
 
 
Mx = ScreenXRez SHR 1
My = ScreenYRez SHR 1
SetMouse Mx, My, 0, 1
GetCursorPos(@Cntr)
 
END SUB
 
SUB  LoadCur ()
DIM  ix AS INTEGER, iy AS INTEGER, Cv AS UINTEGER
RESTORE CurDatL
    FOR iy = 0 TO 14
          FOR ix = 0 TO 14
          READ Cv
          SELECT CASE Cv
             CASE 1: Cv = RGBA(0, 0, 0, 255)
             CASE 2: Cv = RGBA(255, 255, 255, 255)
             CASE ELSE: Cv = RGBA(0, 0, 0, 0)
          END SELECT
                PSET (ix, iy), Cv
    NEXT ix, iy
    GET (0, 0)-(14, 14), CurImg(0)
END SUB
 
SUB ALLInput ()
   '___   Клавиатура
     Kb$ = INKEY$
 
   '___   Мышь
   '   Определяем новые координаты мыши
     GetCursorPos(@Md)
 
   '   Ставим мышь в центр
     SetCursorPos(Cntr.x, Cntr.y)
 
   '   Считаем дельту
     Mdx = Md.x - Cntr.x
     Mdy = Md.y - Cntr.y
  
   '   Добавляем к координатам приращение мыши
     Mx = Mx + Mdx: My = My + Mdy
 
   '   Границы мыши
     IF Mx < 0 THEN Mx = 0
     IF Mx > ScreenXRez - 1 THEN Mx = ScreenXRez -1
     IF My < 0 THEN My = 0
     IF My > ScreenYRez - 1 THEN My = ScreenYRez -1
 
     IF Kb$ = CHR(27) THEN END
END SUB

If GetKeyboardLayout(0) = 68748313 Then ' если  Rus то на US 
            ActivateKeyboardLayout(1, 0)
        EndIf

'/*
' *  This Code Was Created By Jeff Molofee 2000
' *  A HUGE Thanks To Fredric Echols For Cleaning Up
' *  And Optimizing This Code, Making It More Flexible!
' *  If You've Found This Code Useful, Please Let Me Know.
' *  Visit My Site At nehe.gamedev.net
' */
 
#Include "windows.bi"  '' Header File For Windows
#Include "crt/string.bi"
#Include Once "GL/gl.bi"
#Include Once "GL/glu.bi"
 
Dim Shared As HDC hDC  ' Private GDI Device Context
Dim Shared As HGLRC  hRC  ' Permanent Rendering Context
Dim Shared As HWND  hWnd  ' Holds Our Window Handle
Dim Shared As HINSTANCE    hInstance    ' Holds The Instance Of The Application
 
Dim Shared As bool    keys(256)   ' Array Used For The Keyboard Routine
Dim Shared As bool    active = TRUE  ' Window Active Flag Set To TRUE By Default
Dim Shared As bool    fullscreen = TRUE    ' Fullscreen Flag Set To Fullscreen Mode By Default
Dim Shared As ZString*32 classOGL = "OpenGL"
Declare Function WndProc(As HWND, As UINT,As WPARAM, As LPARAM) As Integer    ' Declaration For WndProc
Declare Function WinMain(    hInstance As HINSTANCE    , _   ' Instance
hPrevInstance As HINSTANCE    , _  ' Previous Instance
lpCmdLine As LPSTR , _   ' Command Line Parameters
nCmdShow As Integer)As Integer   ' Window Show State
 
WinMain( GetModuleHandle(NULL) ,NULL,GetCommandLine(), SW_SHOWNORMAL )
 
Sub ReSizeGLScene(width_ As GLsizei ,height As  GLsizei )  ' Resize And Initialize The GL Window
 
    If (height=0)    Then    height=1        ' Prevent A Divide By Zero By  Making Height Equal One
 
    glViewport(0,0,width_,height)      ' Reset The Current Viewport
 
    glMatrixMode(GL_PROJECTION)      ' Select The Projection Matrix
    glLoadIdentity()       ' Reset The Projection Matrix
 
    ' Calculate The Aspect Ratio Of The Window
    gluPerspective(45.0f,Cast(GLfloat,Width_)/Cast(GLfloat,height),0.1f,100.0f)
 
    glMatrixMode(GL_MODELVIEW)       ' Select The Modelview Matrix
    glLoadIdentity()         ' Reset The Modelview Matrix
End Sub
 
Function InitGL() As Integer                              ' All Setup For OpenGL Goes Here
    glShadeModel(GL_SMOOTH)       ' Enable Smooth Shading
    glClearColor(0.0f, 0.0f, 0.0f, 0.5f)    ' Black Background
    glClearDepth(1.0f)         ' Depth Buffer Setup
    glEnable(GL_DEPTH_TEST)       ' Enables Depth Testing
    glDepthFunc(GL_LEQUAL)       ' The Type Of Depth Testing To Do
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)    ' Really Nice Perspective Calculations
    Return TRUE                              ' Initialization Went OK
End Function
 
Function DrawGLScene()As Integer         ' Here's Where We Do All The Drawing
    glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT)    ' Clear Screen And Depth Buffer
    glLoadIdentity()        ' Reset The Current Modelview Matrix
    glTranslatef(-1.5f,0.0f,-6.0f)      ' Move Left 1.5 Units And Into The Screen 6.0
    glBegin(GL_TRIANGLES)        ' Drawing Using Triangles
    glVertex3f( 0.0f, 1.0f, 0.0f)     ' Top
    glVertex3f(-1.0f,-1.0f, 0.0f)     ' Bottom Left
    glVertex3f( 1.0f,-1.0f, 0.0f)     ' Bottom Right
    glEnd()                              ' Finished Drawing The Triangle
    glTranslatef(3.0f,0.0f,0.0f)      ' Move Right 3 Units
    glBegin(GL_QUADS)         ' Draw A Quad
    glVertex3f(-1.0f, 1.0f, 0.0f)     ' Top Left
    glVertex3f( 1.0f, 1.0f, 0.0f)     ' Top Right
    glVertex3f( 1.0f,-1.0f, 0.0f)     ' Bottom Right
    glVertex3f(-1.0f,-1.0f, 0.0f)     ' Bottom Left
    glEnd()                              ' Done Drawing The Quad
    Return TRUE                              ' Everything Went OK
End Function
 
Sub KillGLWindow()        ' Properly Kill The Window
    If (fullscreen) Then                              ' Are We In Fullscreen Mode?
        ChangeDisplaySettings(NULL,0)     ' If So Switch Back To The Desktop
        ShowCursor(TRUE)        ' Show Mouse Pointer
    EndIf
 
    If (hRC)    Then                              ' Do We Have A Rendering Context?
        If (wglMakeCurrent(NULL,NULL) = FALSE)Then     ' Are We Able To Release The DC And RC Contexts?
            MessageBox(NULL,"Release Of DC And RC Failed.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
        EndIf
 
        If (wglDeleteContext(hRC) = FALSE) Then     ' Are We Able To Delete The RC?
            MessageBox(NULL,"Release Rendering Context Failed.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
        EndIf
        hRC=NULL                              ' Set RC To NULL
    EndIf
 
    If (hDC=TRUE And (ReleaseDC(hWnd,hDC) = FALSE))    Then    ' Are We Able To Release The DC
        MessageBox(NULL,"Release Device Context Failed.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
        hDC=NULL                              ' Set DC To NULL
    EndIf
 
    If (hWnd=TRUE And (DestroyWindow(hWnd) = FALSE))    Then    ' Are We Able To Destroy The Window?
        MessageBox(NULL,"Could Not Release hWnd.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
        hWnd=NULL                              ' Set hWnd To NULL
    EndIf
 
    If (UnregisterClass("OpenGL",hInstance) = FALSE)    Then  ' Are We Able To Unregister Class
        MessageBox(NULL,"Could Not Unregister Class.","SHUTDOWN ERROR",MB_OK Or MB_ICONINFORMATION)
        hInstance=NULL         ' Set hInstance To NULL
    EndIf
End Sub
 
'/*    This Code Creates Our OpenGL Window.  Parameters Are:     *
' *    title   - Title To Appear At The Top Of The Window    *
' *    width   - Width Of The GL Window Or Fullscreen Mode    *
' *    height   - Height Of The GL Window Or Fullscreen Mode   *
' *    bits   - Number Of Bits To Use For Color (8/16/24/32)   *
' *    fullscreenflag    - Use Fullscreen Mode (TRUE) Or Windowed Mode (FALSE)    */
 
Function CreateGLWindow(title As ZString Ptr , Width_ As Integer ,height As Integer ,bits As Integer ,fullscreenflag As bool ) As BOOL
    Dim As GLuint PixelFormat   ' Holds The Results After Searching For A Match
    Dim As WNDCLASS    wc      ' Windows Class Structure
    Dim As DWORD  dwExStyle    ' Window Extended Style
    Dim As DWORD  dwStyle    ' Window Style
    Dim As RECT  WindowRect    ' Grabs Rectangle Upper Left / Lower Right Values
    WindowRect.left = 0   ' Set Left Value To 0
    WindowRect.right = Width_  ' Set Right Value To Requested Width
    WindowRect.top = 0   ' Set Top Value To 0
    WindowRect.bottom = height  ' Set Bottom Value To Requested Height
 
    fullscreen=fullscreenflag   ' Set The Global Fullscreen Flag
 
    hInstance   = GetModuleHandle(NULL)    ' Grab An Instance For Our Window
    wc.style   = CS_HREDRAW Or CS_VREDRAW Or CS_OWNDC    ' Redraw On Size, And Own DC For Window.
    wc.lpfnWndProc  = Cast(WndProc, @WndProc)     ' WndProc Handles Messages
    wc.hInstance  = hInstance       ' Set The Instance
    wc.hIcon   = LoadIcon(NULL, IDI_WINLOGO)   ' Load The Default Icon
    wc.hCursor   = LoadCursor(NULL, IDC_ARROW)   ' Load The Arrow Pointer
    wc.hbrBackground    = NULL         ' No Background Required For GL
    wc.lpszMenuName  = NULL         ' We Don't Want A Menu
    wc.lpszClassName    = StrPtr(classOGL)       ' Set The Class Name
 
    If (RegisterClass(@wc)=FALSE) Then    ' Attempt To Register The Window Class
        MessageBox(NULL,"Failed To Register The Window Class.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE                              ' Return FALSE
    EndIf
 
    If (fullscreen) Then                              ' Attempt Fullscreen Mode?
        Dim As DEVMODE dmScreenSettings        ' Device Mode
        memset(@dmScreenSettings,0,SizeOf(dmScreenSettings))    ' Makes Sure Memory's Cleared
        dmScreenSettings.dmSize=SizeOf(dmScreenSettings)  ' Size Of The Devmode Structure
        dmScreenSettings.dmPelsWidth    = width_    ' Selected Screen Width
        dmScreenSettings.dmPelsHeight    = height    ' Selected Screen Height
        dmScreenSettings.dmBitsPerPel    = bits     ' Selected Bits Per Pixel
        dmScreenSettings.dmFields=DM_BITSPERPEL+DM_PELSWIDTH+DM_PELSHEIGHT
 
        ' Try To Set Selected Mode And Get Results.  NOTE: CDS_FULLSCREEN Gets Rid Of Start Bar.
        If (ChangeDisplaySettings(@dmScreenSettings,CDS_FULLSCREEN)<>DISP_CHANGE_SUCCESSFUL) Then
            ' If The Mode Fails, Offer Two Options.  Quit Or Use Windowed Mode.
            If (MessageBox(NULL,!"The Requested Fullscreen Mode Is Not Supported By\nYour Video Card. Use Windowed Mode Instead?","NeHe GL",MB_YESNO+MB_ICONEXCLAMATION)=IDYES) Then
                fullscreen=FALSE  ' Windowed Mode Selected.  Fullscreen = FALSE
            Else
                ' Pop Up A Message Box Letting User Know The Program Is Closing.
                MessageBox(NULL,"Program Will Now Close.","ERROR",MB_OK+MB_ICONSTOP)
                Return FALSE         ' Return FALSE
            EndIf
        EndIf
    EndIf
 
    If (fullscreen) Then                              ' Are We Still In Fullscreen Mode?
        dwExStyle=WS_EX_APPWINDOW        ' Window Extended Style
        dwStyle=WS_POPUP                              ' Windows Style
        ShowCursor(FALSE)                              ' Hide Mouse Pointer
    Else
        dwExStyle=WS_EX_APPWINDOW + WS_EX_WINDOWEDGE   ' Window Extended Style
        dwStyle=WS_OVERLAPPEDWINDOW       ' Windows Style
    EndIf
 
    AdjustWindowRectEx(@WindowRect, dwStyle, FALSE, dwExStyle)  ' Adjust Window To True Requested Size
 
    ' Create The Window
    hWnd=CreateWindowEx(    dwExStyle, _       ' Extended Style For The Window
    "OpenGL", _       ' Class Name
    title, _        ' Window Title
    dwStyle + _       ' Defined Window Style
    WS_CLIPSIBLINGS + _     ' Required Window Style
    WS_CLIPCHILDREN, _     ' Required Window Style
    0, 0,    _       ' Window Position
    WindowRect.right-WindowRect.left, _    ' Calculate Window Width
    WindowRect.bottom-WindowRect.top, _    ' Calculate Window Height
    NULL,    _       ' No Parent Window
    NULL,    _       ' No Menu
    hInstance, _       ' Instance
    NULL)
    If hwnd = FALSE Then       ' Dont Pass Anything To WM_CREATE
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Window Creation Error.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    Static As PIXELFORMATDESCRIPTOR pfd   ' pfd Tells Windows How We Want Things To Be
    With pfd
        .nSize        = SizeOf(PIXELFORMATDESCRIPTOR)' Size Of This Pixel Format Descriptor
        .nVersion     = 1  ' Version Number
        .dwFlags      = PFD_DRAW_TO_WINDOW _  ' Format Must Support Window
        Or PFD_SUPPORT_OPENGL _ ' Format Must Support OpenGL
        Or PFD_DOUBLEBUFFER  ' Must Support Double Buffering
        .iPixelType   = PFD_TYPE_RGBA  ' Request An RGBA Format
        .iLayerType   = PFD_MAIN_PLANE ' Main Drawing Layer
        .cColorBits   = bits ' Select Our Color Depth
        .cDepthBits   = 16 ' 16Bit Z-Buffer (Depth Buffer)
    End With
 
    hDC=GetDC(hWnd)
    If (hDC=FALSE)    Then      ' Did We Get A Device Context?
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Can't Create A GL Device Context.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    PixelFormat=ChoosePixelFormat(hDC,@pfd)
    If (PixelFormat=FALSE)    Then' Did Windows Find A Matching Pixel Format?
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Can't Find A Suitable PixelFormat.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    If(SetPixelFormat(hDC,PixelFormat,@pfd) = FALSE)    Then    ' Are We Able To Set The Pixel Format?
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Can't Set The PixelFormat.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    hRC=wglCreateContext(hDC)
    If (hRC = FALSE) Then    ' Are We Able To Get A Rendering Context?
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Can't Create A GL Rendering Context.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    If(wglMakeCurrent(hDC,hRC) = FALSE) Then     ' Try To Activate The Rendering Context
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Can't Activate The GL Rendering Context.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    ShowWindow(hWnd,SW_SHOW)      ' Show The Window
    SetForegroundWindow(hWnd)      ' Slightly Higher Priority
    SetFocus(hWnd)         ' Sets Keyboard Focus To The Window
    ReSizeGLScene(width_, height)     ' Set Up Our Perspective GL Screen
 
    If (InitGL() = FALSE)    Then        ' Initialize Our Newly Created GL Window
        KillGLWindow()        ' Reset The Display
        MessageBox(NULL,"Initialization Failed.","ERROR",MB_OK+MB_ICONEXCLAMATION)
        Return FALSE        ' Return FALSE
    EndIf
 
    Return TRUE         ' Success
End Function
 
Function WndProc(hWnd As HWND    ,    _  ' Handle For This Window
    uMsg As UINT, _   ' Message For This Window
    wParam As WPARAM, _   ' Additional Message Information
    lParam As LPARAM) As Integer   ' Additional Message Information
 
    Select Case uMsg        ' Check For Windows Messages
        Case WM_ACTIVATE       ' Watch For Window Activate Message
            If (HiWord(wParam) = FALSE)    Then    ' Check Minimization State
                active=TRUE      ' Program Is Active
            Else
                active=FALSE      ' Program Is No Longer Active
            EndIf
            Return 0        ' Return To The Message Loop
        Case WM_SYSCOMMAND       ' Intercept System Commands
            Select Case wParam       ' Check System Calls
                Case SC_SCREENSAVE     ' Screensaver Trying To Start?
                Case SC_MONITORPOWER    ' Monitor Trying To Enter Powersave?
                    Return 0       ' Prevent From Happening
            End Select
        Case WM_CLOSE        ' Did We Receive A Close Message?
            PostQuitMessage(0)      ' Send A Quit Message
            Return 0        ' Jump Back
        Case WM_KEYDOWN       ' Is A Key Being Held Down?
            keys(wParam) = TRUE     ' If So, Mark It As TRUE
            ActivateKeyboardLayout(HKL_NEXT ,KLF_REORDER)
            Return 0        ' Jump Back
        Case WM_KEYUP        ' Has A Key Been Released?
            keys(wParam) = FALSE     ' If So, Mark It As FALSE
            Return 0       ' Jump Back
        Case WM_SIZE        ' Resize The OpenGL Window
            ReSizeGLScene(LoWord(lParam),HiWord(lParam))  ' LoWord=Width, HiWord=Height
            Return 0        ' Jump Back
    End Select
    ' Pass All Unhandled Messages To DefWindowProc
    Return DefWindowProc(hWnd,uMsg,wParam,lParam)
End Function
 
Function WinMain(    hInstance As HINSTANCE    , _   ' Instance
    hPrevInstance As HINSTANCE    , _  ' Previous Instance
    lpCmdLine As LPSTR , _   ' Command Line Parameters
    nCmdShow As Integer)As Integer   ' Window Show State
 
    Dim As MSG  msg         ' Windows Message Structure
    Dim As BOOL    done = FALSE       ' Bool Variable To Exit Loop
 
    ' Ask The User Which Screen Mode They Prefer
    If (MessageBox(NULL,"Would You Like To Run In Fullscreen Mode?", "Start FullScreen?",MB_YESNO+MB_ICONQUESTION)=IDNO) Then
        fullscreen = FALSE       ' Windowed Mode
    EndIf
 
    ' Create Our OpenGL Window
    If (CreateGLWindow("NeHe's OpenGL Framework",640,480,16,fullscreen) = FALSE) Then
        Return 0         ' Quit If Window Was Not Created
    EndIf
 
    While(done = FALSE)         ' Loop That Runs While done=FALSE
        If (PeekMessage(@msg,NULL,0,0,PM_REMOVE))Then    ' Is There A Message Waiting?
            If (msg.message=WM_QUIT)    Then   ' Have We Received A Quit Message?
                done=TRUE       ' If So done=TRUE
            Else         ' If Not, Deal With Window Messages
                TranslateMessage(@msg)    ' Translate The Message
                DispatchMessage(@msg)    ' Dispatch The Message
            EndIf
        Else                              ' If There Are No Messages
            ' Draw The Scene.  Watch For ESC Key And Quit Messages From DrawGLScene()
            If (active) Then        ' Program Active?
                If (keys(VK_ESCAPE))    Then   ' Was ESC Pressed?
                    done=TRUE      ' ESC Signalled A Quit
                Else        ' Not Time To Quit, Update Screen
                    DrawGLScene()     ' Draw The Scene
                    SwapBuffers(hDC)    ' Swap Buffers (Double Buffering)
                EndIf
            EndIf
 
            If (keys(VK_F1))    Then     ' Is F1 Being Pressed?
                keys(VK_F1) = FALSE     ' If So Make Key FALSE
                KillGLWindow()      ' Kill Our Current Window
                fullscreen= (fullscreen Xor 1)    ' Toggle Fullscreen / Windowed Mode
                ' Recreate Our OpenGL Window
                If (CreateGLWindow("NeHe's OpenGL Framework",640,480,16,fullscreen) = FALSE) Then
                    Return 0      ' Quit If Window Was Not Created
                EndIf
            EndIf
        EndIf
    Wend
 
    ' Shutdown
    KillGLWindow()         ' Kill The Window
    Return (msg.wParam)      ' Exit The Program
End Function

HWin = GetForegroundWindow_()          ; Получаем активное окно.
Thread = GetWindowThreadProcessId_(HWin, 0); Получаем поток активного окна.
Define Lay = GetKeyboardLayout_(Thread)      ; Клавиатурная раскладка активного окна.

#Include "windows.bi"
 
Dim As HWND HWin = GetForegroundWindow()      
Dim As Integer Thread = GetWindowThreadProcessId(HWin, 0)
Dim As HKL hkl= GetKeyboardLayout(Thread)

#Include "windows.bi"
 
Screen 1
ActivateKeyboardLayout(HKL_NEXT ,KLF_SETFORPROCESS) 'but does not change
Do
    ? Chr(GetKey)
Loop