向DELPHI OPENGL高手求救

[边缘998]

Function WinMain(hInstance: HINST; hPrevInstance: HINST;
lpCmdLine: PChar; nCmdShow: Integer): Integer; stdcall;
Var
msg : TMsg;
finished : Boolean;
DemoStart, LastTime: DWord;
Begin
finished := False;

If Not glCreateWnd(800, 600, false, 32) Then
Begin
Result := 0;
Exit;
End;

DemoStart := GetTickCount();
SetCursorPos(400, 300);

While Not finished Do
Begin
If (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) Then

Begin
If (msg.message = WM_QUIT) Then
finished := True
Else
Begin
TranslateMessage(msg);
DispatchMessage(msg);
End;
End
Else
Begin
Inc(FPSCount);

FrameTime := GetTickCount() - ElapsedTime - DemoStart;
LastTime := ElapsedTime;
ElapsedTime := GetTickCount() - DemoStart;
ElapsedTime := (LastTime + ElapsedTime) Div 2;

If GetForegroundWindow = h_Wnd Then
Begin
GetCursorPos(mpos);
SetCursorPos(400, 300);
Heading := Heading + (mpos.x - 400) / 100 * MouseSpeed;
Tilt := Tilt - (300 - mpos.y) / 100 * MouseSpeed;
If Tilt > 60 Then
Tilt := 60;
If Tilt < -60 Then
Tilt := -60;
End;

glDraw();
SwapBuffers(h_DC);

If (keys[VK_ESCAPE]) Then
finished := True
Else
ProcessKeys;
End;
End;
glKillWnd(FALSE);
Result := msg.wParam;
End;



上面在红色代码在DELPHI的FORM窗体如何实现.即APPLICATION WIN32 应用程FORM下.

[边缘998]

Function glCreateWnd(Width, Height: Integer; Fullscreen: Boolean; PixelDepth:
Integer):Boolean;
Var
wndClass:TWndClass;
dwStyle :DWORD;
dwExStyle: DWORD;
dmScreenSettings :DEVMODE;
PixelFormat:GLuint;
h_Instance: HINST;
pfd :TPIXELFORMATDESCRIPTOR;
Begin
h_Instance := GetModuleHandle(Nil);
ZeroMemory(@wndClass, SizeOf(wndClass));

With wndClass Do
Begin
style := CS_HREDRAW Or
CS_VREDRAW Or
CS_OWNDC;
lpfnWndProc := @WndProc;
hInstance := h_Instance;
hCursor := LoadCursor(0, IDC_ARROW);
lpszClassName := 'OpenGL';
End;
If (RegisterClass(wndClass) = 0) Then
Begin
MessageBox(0, '注册窗体类失败!', '错误', MB_OK Or
MB_ICONERROR);
Result := False;
Exit
End;
If Fullscreen Then
Begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
With dmScreenSettings Do
Begin
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := Width;
dmPelsHeight := Height;
dmBitsPerPel := PixelDepth;
dmFields := DM_PELSWIDTH
Or DM_PELSHEIGHT
Or DM_BITSPERPEL;
End;

If (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) =
DISP_CHANGE_FAILED) Then
Begin
MessageBox(0, '不能转换为全屏模式!', '错误', MB_OK
Or
MB_ICONERROR);
Fullscreen := False;
End;
End;
If (Fullscreen) Then
Begin
dwStyle := WS_POPUP Or
WS_CLIPCHILDREN
Or WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW;
ShowCursor(False);
End
Else
Begin
dwStyle := WS_OVERLAPPEDWINDOW Or
WS_CLIPCHILDREN Or
WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW Or
WS_EX_WINDOWEDGE;
ShowCursor(false);
End;
h_Wnd := CreateWindowEx(dwExStyle,
'OpenGL',
WND_TITLE,
dwStyle,
0, 0,
Width, Height,
0,
0,
h_Instance,
Nil);
If h_Wnd = 0 Then
Begin
glKillWnd(Fullscreen);
MessageBox(0, '不能创建窗体！', '错误', MB_OK Or
MB_ICONERROR);
Result := False;
Exit;
End;
With pfd Do
Begin
nSize := SizeOf(TPIXELFORMATDESCRIPTOR);
nVersion := 1;
dwFlags := PFD_DRAW_TO_WINDOW
Or PFD_SUPPORT_OPENGL
Or PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := PixelDepth;
cRedBits := 0;
cRedShift := 0;
cGreenBits := 0;
cGreenShift := 0;
cBlueBits := 0;
cBlueShift := 0;
cAlphaBits := 0;
cAlphaShift := 0;
cAccumBits := 0;
cAccumRedBits := 0;
cAccumGreenBits := 0;
cAccumBlueBits := 0;
cAccumAlphaBits := 0;
cDepthBits := 16;
cStencilBits := 0;
cAuxBuffers := 0;
iLayerType := PFD_MAIN_PLANE;
bReserved := 0;
dwLayerMask := 0;
dwVisibleMask := 0;
dwDamageMask := 0;
End;
h_DC := GetDC(h_Wnd);
If (h_DC = 0) Then
Begin
glKillWnd(Fullscreen);
MessageBox(0, '不能得到设备场景!', '错误', MB_OK Or
MB_ICONERROR);
Result := False;
Exit;
End;
PixelFormat := ChoosePixelFormat(h_DC, @pfd);
If (PixelFormat = 0) Then
Begin
glKillWnd(Fullscreen);
MessageBox(0, '找不到合适的格式', '错误', MB_OK
Or MB_ICONERROR);
Result := False;
Exit;
End;
If (Not SetPixelFormat(h_DC, PixelFormat, @pfd)) Then
Begin
glKillWnd(Fullscreen);
MessageBox(0, '无法创建渲染格式', '错误', MB_OK Or
MB_ICONERROR);
Result := False;
Exit;
End;
h_RC:=wglCreateContext(h_DC);
If (h_RC = 0) Then
Begin
glKillWnd(Fullscreen);
MessageBox(0, '无法创建OpenGL 绘制描述表', '错误',
MB_OK Or MB_ICONERROR);
Result := False;
Exit;
End;
If (Not wglMakeCurrent(h_DC, h_RC)) Then
Begin
glKillWnd(Fullscreen);
MessageBox(0,'Unable to activate OpenGL rendering context','Error',
MB_OK Or MB_ICONERROR);
Result:=False;
Exit;
End;
SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, Nil);
ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);

glResizeWnd(Width, Height);
glInit();

Result := True;
End;

[边缘998]

Function WinMain(hInstance: HINST; hPrevInstance: HINST;
lpCmdLine: PChar; nCmdShow: Integer): Integer; stdcall;
Var
msg :TMsg;
finished:Boolean;
DemoStart,LastTime:DWord;
Begin
finished:=False;

If Not glCreateWnd(800,600,false,32) Then
Begin
Result := 0;
Exit;
End;

DemoStart := GetTickCount();
SetCursorPos(400, 300);

While Not finished Do
Begin
If (PeekMessage(msg,0,0,0,PM_REMOVE)) Then
Begin
If (msg.message=WM_QUIT) Then
finished:=True
Else
Begin
TranslateMessage(msg);
DispatchMessage(msg);
End;
End
Else
Begin
Inc(FPSCount);

FrameTime:=GetTickCount()-ElapsedTime -DemoStart;
LastTime := ElapsedTime;
ElapsedTime := GetTickCount() - DemoStart;
ElapsedTime := (LastTime + ElapsedTime) Div 2;

If GetForegroundWindow =h_Wnd Then
Begin
GetCursorPos(mpos);
SetCursorPos(400,300);
Heading:=Heading+(mpos.x-400)/100*MouseSpeed;
Tilt:=Tilt-(300-mpos.y)/100*MouseSpeed;
If Tilt > 60 Then
Tilt := 60;
If Tilt < -60 Then
Tilt := -60;
End;

glDraw();
SwapBuffers(h_DC);

If (keys[VK_ESCAPE]) Then
finished := True
Else
ProcessKeys;
End;
End;
glKillWnd(FALSE);
Result := msg.wParam;
End;
Begin
WinMain(hInstance, hPrevInst, CmdLine, CmdShow);
End.


问题就是我把上面的代码移值到VCL窗口上用CANVAS去画.其它都搬过去了,也显示了,但就是红色代码在VCL工程哪不知道如何写了,在这里他是在消息循环里面去处理.高手指点下.如果写.

[边缘998]

1-2楼的代码贴得比较齐了,可供详细看.
问题就是能把红色部分的代码移值到VCL工程中来.

我把图象之类的都可以画到FORM上了,但就是红色代码不知道怎么去实现了.闷闷闷.
我试过用APPLICATION.ONMESSAGE去处理红色代码,但太卡了.

如何能像控制台下哪样在消息循环中去处理...

[qkhhxkj102]

牛人呀,只能帮顶下

[彖爻之辞]

顶,学习

[lake_cx]

放到Application.OnIdle事件中

[边缘998]

顶上去先,明天回公司写下看看6楼的是否可以.

[边缘998]

我已搞掂了，结贴结贴。在OnMessage和OnIdle中稍有少少差别，但都还没有符合，原因是这两个事件处理相当快。我的第秒贞变化时间太小了，以致效果不明显，后来我加了一句给他睡眠50MM秒，哈哈，效果出来了。好爽。还是谢谢大家。。