 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
 Verfasst am: 12.03.2013, 01:37 Titel: multikey bei mehreren Fenstern? |
 |
|
Wollte eigentlich meine 'opengl durch zweites fenster routine' überarbeiten und hatte etwas langeweile wo ich mal mit zwei fenstern mit opengl render context rumgespielt habe...
Klappt eigentlich ganz gut, nur funktioniert nun plötzlich die abfrage von Multikey so nicht mehr, inkey dagegen funktioniert problemlos wie es scheint... liegt es an meinem code, vielleicht das abfangen der messages vom anderen fenstern, das hin und her springen des rendercontextes oder an irgendwas anderes?
nebenbei reagieren beide fenster teilweise sehr träge...
hier langer bastelcode: (fehlt natürlich noch einiges)
| Code: |
#Include once "windows.bi"
#Include once "GL/gl.bi"
'#Include once "GL/glext.bi"
#Include once "GL/glu.bi"
#Define cmdmsg(msg) Open cons for output as #99 : print #99,msg : close #99 :
#Define VSYNC &b000010000
Namespace Win32_Window
#IfnDef PFNWGLSWAPINTERVALEXTPROC
Type PFNWGLSWAPINTERVALEXTPROC as Function (interval as integer) as BOOL '(WINAPI *PFNWGLSWAPINTERVALEXTPROC)(int interval);
#EndIf
Dim h_Instance as hInstance 'Program Instance Handle
Dim h_DC as HDC 'Device Context Handle
Dim h_RC as HGLRC 'OpenGL Rendering Context Handle
Dim h_Wnd as HWND 'Window Handle
Dim Win_width as UInteger
Dim Win_height as UInteger
Dim Win_bits as UInteger
Dim Win_bpp as UInteger
Dim Win_title as STRING
Dim Win_driver as STRING
Declare Function WndProc_win32 (byval h_Wnd as HWND, byval u_Msg as UINT, byval w_Param as WPARAM, byval l_Param as LPARAM) as LRESULT
Declare Function KillWindow_win32() as BOOL
Function InitWindow_win32() as BOOL
Screeninfo Win_width,Win_height,Win_bits,Win_bpp,,,Win_driver
If (screenptr = 0) Then
'' Error:
cmdmsg("ERROR: No Mainscreen initialised.")
Return FALSE
End If
If (lcase(Win_driver)="opengl") Then
'' Error:
cmdmsg("ERROR: OpenGL is initialised on Mainscreen.")
'Return FALSE
End If
Win_title = "Win32GL"
Return TRUE
End Function
Function CreateGLWindow_win32(byval flags as UInteger = 0, byval DepthBits as UInteger = 16) as BOOL
h_Instance = GetModuleHandle(NULL)
'' ----
Dim wc as WNDCLASSEX
Dim wcname as STRING * 8 = "Win32GL"+chr(0)
With wc
.cbSize = sizeof(WNDCLASSEX)
.style = CS_HREDRAW OR CS_VREDRAW OR CS_OWNDC
.lpfnWndProc = @WndProc_win32
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = h_Instance
.hIcon = LoadIcon(NULL, IDI_WINLOGO)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = NULL
.lpszMenuName = NULL
.lpszClassName = strptr(wcname)
End With
If (RegisterClassEx(@wc) = 0) Then
'' Error: could not register Window Class
cmdmsg("ERROR: could not register Window Class")
Return FALSE
End If
'' ----
'' ----
Dim dwExStyle as DWORD
Dim dwStyle as DWORD
dwExStyle = WS_EX_APPWINDOW OR WS_EX_WINDOWEDGE
dwStyle = WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU OR WS_MINIMIZEBOX
'dwStyle = WS_OVERLAPPEDWINDOW 'RESIZABLE flag
'dwStyle = WS_POPUP
Dim WindowRect as RECT
With WindowRect
.left = 0
.top = 0
.right = Win_width
.bottom = Win_height
End With
AdjustWindowRectEx(@WindowRect, dwStyle, FALSE, dwExStyle)
h_Wnd = CreateWindowEx(dwExStyle, strptr(wcname), Win_title, dwStyle, 0, 0, WindowRect.right-WindowRect.left, WindowRect.bottom-WindowRect.top, NULL, NULL, h_Instance, NULL)
If (h_Wnd = 0) Then
'' Error: couldn't create Window
KillWindow_win32()
Return FALSE
End If
h_DC = GetDC(h_Wnd)
If (h_DC = 0) Then
'' Error: couldn't get DC
KillWindow_win32()
Return FALSE
End If
'' ----
'' set up pixelformat
Dim pfd as PIXELFORMATDESCRIPTOR
Dim alphabits as UInteger
If (Win_bits = 32) Then
alphabits = 8
Else
alphabits = 0
End If
'' Note: '*' not realy sure what it is doing right now (get information)
With pfd
.nSize = sizeof(PIXELFORMATDESCRIPTOR)
.nVersion = 1 '*
.dwFlags = PFD_DRAW_TO_WINDOW OR PFD_SUPPORT_OPENGL OR PFD_DOUBLEBUFFER '*
.iPixelType = PFD_TYPE_RGBA 'or PFD_TYPE_COLORINDEX
.cColorBits = Win_bits 'Zero or grater
.cRedBits = 0 'Not used
.cRedShift = 0 'Not used
.cGreenBits = 0 'Not used
.cGreenShift = 0 'Not used
.cBlueBits = 0 'Not used
.cBlueShift = 0 'Not used
.cAlphaBits = alphabits
.cAlphaShift = 0 'Not Used
.cAccumBits = 0 '*
.cAccumRedBits = 0 'Not used
.cAccumGreenBits = 0 'Not used
.cAccumBlueBits = 0 'Not used
.cAccumAlphaBits = 0 'Not used
.cDepthBits = DepthBits '*
.cStencilBits = 0 '*
.cAuxBuffers = 0 '*
.iLayerType = PFD_MAIN_PLANE
.bReserved = 0 'Not used
.dwLayerMask = 0 'Not used
.dwVisibleMask = 0 'Not used
.dwDamageMask = 0 'Not used
End With
cmdmsg(pfd.cColorBits)
'' choose pixelformat
Dim PixelFormat as GLuint
PixelFormat = ChoosePixelFormat(h_DC, @pfd)
If (PixelFormat = 0) Then
'' Error: couldn't find any pixelformat
KillWindow_win32()
Return FALSE
End If
'' set pixelformat
If (SetPixelFormat(h_DC, PixelFormat, @pfd) = 0) Then
'' Error: couldn't set pixelformat
KillWindow_win32()
Return FALSE
End If
'' get rendering context
h_RC = wglCreateContext(h_DC)
If (h_RC = 0) Then
'' Error: couldn't get Rendering Context
KillWindow_win32()
Return FALSE
End If
'' activate rendering context
If (wglMakeCurrent(h_DC, h_RC) = 0) Then
'' Error: couldn't activate rendering context
KillWindow_win32()
Return FALSE
End If
ShowWindow(h_Wnd, SW_SHOW)
SetForegroundWindow(h_Wnd)
SetFocus(h_Wnd)
''V-Sync
Dim wglSwapIntervalEXT as PFNWGLSWAPINTERVALEXTPROC
wglSwapIntervalEXT = cast(PFNWGLSWAPINTERVALEXTPROC,wglGetProcAddress("wglSwapIntervalEXT"))
If (wglSwapIntervalEXT = 0) Then
'' WARNING: no V-Sync
cmdmsg("WARNING: V-Sync not available")
Else
If (flags AND VSync) Then
cmdmsg("INFO: V-Sync activated")
wglSwapIntervalEXT(1)
Else
wglSwapIntervalEXT(0)
End If
End If
Return TRUE
End Function ''CreateWindow_win32
Function KillWindow_win32() as BOOL
return TRUE
End Function ''KillWindow_win32
Function WndProc_win32 (byval h_Wnd as HWND, byval u_Msg as UINT, byval w_Param as WPARAM, byval l_Param as LPARAM) as LRESULT
Select Case (u_Msg)
Case WM_SYSCOMMAND
Select Case (w_Param)
Case SC_SCREENSAVE
Return 0
Case SC_MONITORPOWER
Return 0
End Select
Case WM_CLOSE
PostQuitMessage(0)
Return 0
End Select
Return DefWindowProc(h_Wnd,u_Msg,w_Param,l_Param)
End Function ''WndProc_win32
'UnregisterClass("Wnd32GL", GetModuleHandle(NULL))
End Namespace 'Win32_Window
Screenres 640,480,32,,&h02
Dim h_Wnd as HWND
Dim h_DC as HDC 'Device Context Handle
Dim h_RC as HGLRC 'OpenGL Rendering Context Handle
ScreenControl 2, cast(Integer, h_Wnd )
h_DC = wglGetCurrentDC()'GetDC(h_Wnd)
h_RC = wglGetCurrentContext()
If (Win32_Window.InitWindow_win32()) Then
Win32_Window.CreateGLWindow_win32(VSYNC)
End If
cmdmsg(h_Wnd)
cmdmsg(h_DC)
cmdmsg(h_RC)
wglMakeCurrent(h_DC, h_RC)
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
gluPerspective(45.0f,640/480,0.1f,100.0f)
glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
glShadeModel(GL_SMOOTH)
glClearColor(0.0f, 0.0f, 0.0f, 0.0f)
glClearDepth(1.0f)
glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
wglMakeCurrent(Win32_Window.h_DC, Win32_Window.h_RC)
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
gluPerspective(45.0f,640/480,0.1f,100.0f)
glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
glShadeModel(GL_SMOOTH)
glClearColor(0.0f, 0.0f, 0.0f, 0.0f)
glClearDepth(1.0f)
glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
Dim wm_msg as MSG
dim ikey as string
do
If (PeekMessage(@wm_msg,NULL,0,0,PM_REMOVE)) Then
TranslateMessage(@wm_msg)
DispatchMessage(@wm_msg)
End If
wglMakeCurrent(h_DC, h_RC)
glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)
glLoadIdentity()
gltranslatef 0.0,0.0,-6.0
glBegin(GL_TRIANGLES)
glColor3f 0.3,0.0,0.0
glVertex3f 0.0, 0.5,0.0
glColor3f 0.2,1.0,0.0
glVertex3f 1.0,-0.5,0.0
glColor3f 0.0,0.0,1.0
glVertex3f -1.0,-0.5,0.0
glEnd()
SwapBuffers(h_DC)
wglMakeCurrent(Win32_Window.h_DC, Win32_Window.h_RC)
glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)
glLoadIdentity()
gltranslatef 0.0,0.0,-5.0
glBegin(GL_TRIANGLES)
glColor3f 1.0,0.0,0.0
glVertex3f 0.0, 0.5,0.0
glColor3f 0.0,1.0,1.0
glVertex3f 1.0,-0.5,0.0
glColor3f 0.0,0.0,1.0
glVertex3f -1.0,-0.5,0.0
glEnd()
SwapBuffers(Win32_Window.h_DC)
ikey=inkey
if ikey<>"" then cmdmsg(asc(ikey))
if ikey=chr(27) THEN EXIT DO
loop until multikey(&h01)'ESC
|
_________________
 |
|
| Nach oben |
|
 |
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 12.03.2013, 02:09 Titel: |
|
|
OT: Musst du diese ellenlangen Codes immer pasten? Dafür gibt es doch das NoPaste im FB-Portal oder von mir aus auch Pastebin! Grade wenn dann erst mal eine Diskussion am Laufen ist, stören so seitenlange Codes einfach nur noch.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
St_W
Anmeldungsdatum: 22.07.2007
Beiträge: 956
Wohnort: Austria
|
| Verfasst am: 12.03.2013, 15:07 Titel: |
|
|
OT: Auch wenn hier lange Codes den Lesefluss beeinträchtigen, finde ich es (insbesondere für Archivzwecke) sinnvoller, wenn Code direkt im Forum gepostet wird, als irgendwo extern (wobei FBP nicht unbedingt zu den "externen" gehört). Ansonsten ist nach einiger Zeit oft der Code verloren, weil die externe Seite nicht mehr erreichbar ist.
Viel sinnvoller würde ich es betrachten, wenn man die Foren-Software um eine Code-Collapse Funktion, so wie im internationalen Forum bereits vorhanden, erweitern würde. Das wäre wahrscheinlich nahezu kein Aufwand und würd beide Probleme lösen.
_________________
Aktuelle FreeBasic Builds, Projekte, Code-Snippets unter http://users.freebasic-portal.de/stw/
http://www.mv-lacken.at Musikverein Lacken (MV Lacken) |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4702
Wohnort: ~/
|
| Verfasst am: 13.03.2013, 15:05 Titel: |
|
|
Code-Collapse ist glaube ich sowieso geplant. Aber wie du schon sagtest: FBP ist nichts externes, sondern wurde extra für diesen Zweck bereitgestellt; und da geht auch ganz bestimmt kein Code verloren. 
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
