paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 16:56:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

openglcontrol: fixed windows xp, bug #15730

Browse Source 
git-svn-id: trunk@24132 -
This commit is contained in:
mattias 2010-03-21 09:05:04 +00:00
parent 451b009b38
commit 0765eb1ccc
1 changed files with 29 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
components/opengl/glwin32wglcontext.pas
View File

@ -20,8 +20,8 @@ unit GLWin32WGLContext;
interface interface
uses uses
Classes, SysUtils, Windows, LCLProc, LCLType, gl, Forms, Controls, Classes, SysUtils, LMessages, Windows, LCLProc, LCLType, gl, Forms, Controls,
Win32Int, WSLCLClasses, WSControls, Win32WSControls; Win32Int, WSLCLClasses, WSControls, Win32WSControls, Win32Proc, LCLMessageGlue;
procedure LOpenGLViewport(Left, Top, Width, Height: integer); procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND); procedure LOpenGLSwapBuffers(Handle: HWND);
@ -252,6 +252,32 @@ begin
Result:=wglMakeCurrent(Info^.DC,Info^.WGLContext); Result:=wglMakeCurrent(Info^.DC,Info^.WGLContext);
end; end;
function GlWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
var
PaintMsg : TLMPaint;
winctrl : TWinControl;
begin
case Msg of
WM_ERASEBKGND: begin
Result:=0;
end;
WM_PAINT: begin
winctrl := GetWin32WindowInfo(Window)^.WinControl;
if Assigned(winctrl) then begin
FillChar(PaintMsg, SizeOf(PaintMsg), 0);
PaintMsg.Msg := LM_PAINT;
PaintMsg.DC := WParam;
DeliverMessage(winctrl, PaintMsg);
Result:=PaintMsg.Result;
end else
Result:=WindowProc(Window, Msg, WParam, LParam);
end;
else
Result:=WindowProc(Window, Msg, WParam, LParam);
end;
end;
function LOpenGLCreateContext(AWinControl: TWinControl; function LOpenGLCreateContext(AWinControl: TWinControl;
WSPrivate: TWSPrivateClass; SharedControl: TWinControl; WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
DoubleBuffered, RGBA: boolean; const AParams: TCreateParams): HWND; DoubleBuffered, RGBA: boolean; const AParams: TCreateParams): HWND;
@ -269,7 +295,7 @@ begin
with Params do begin with Params do begin
pClassName := @ClsName; pClassName := @ClsName;
WindowTitle := StrCaption; WindowTitle := StrCaption;
SubClassWndProc := nil; SubClassWndProc := @GlWindowProc;
end; end;
// create window // create window
FinishCreateWindow(AWinControl, Params, false); FinishCreateWindow(AWinControl, Params, false);