📄 teeglcanvas.pas
字号:
Assert(CheckGLError,'Rotations');
if ShadeQuality then gluQuadricNormals(Quadric,GL_SMOOTH)
else gluQuadricNormals(Quadric,GL_FLAT);
Assert(CheckGLError,'QuadricNormals');
if Assigned(FOnInit) then FOnInit(Self);
Assert(CheckGLError,'Init');
end;
Function TGLCanvas.Quadric:PGLUQuadricObj; {$IFDEF CLR}unsafe;{$ENDIF}
begin
if not Assigned(FQuadric) then
FQuadric:=gluNewQuadric;
result:=FQuadric;
end;
Procedure TGLCanvas.TeeVertex2D(x,y:Integer);
begin
glVertex2i(x,-y);
end;
Procedure TGLCanvas.TeeVertex3D(x,y,z:Integer);
begin
glVertex3i(x,-y,-z);
end;
Procedure TGLCanvas.TeeNormal(x,y,z:Integer);
begin
glNormal3i(x,y,-z);
end;
Procedure TGLCanvas.SetBrushBitmap;
begin
SetBrushBitmap(Brush.Bitmap);
end;
Function TGLCanvas.SetBrushBitmap(Bitmap:TBitmap):Boolean;
var tmp : Cardinal;
begin
if Bitmap<>nil then
begin
tmp:=FindTexture(Bitmap);
result:=tmp<>0;
if result then
begin
glEnable(GL_TEXTURE_2D);
{$IFNDEF LINUX}
glBindTexture(GL_TEXTURE_2D, tmp);
Assert(CheckGLError,'BindTexture');
{$ENDIF}
gluQuadricTexture(Quadric,{$IFDEF LINUX}True{$ELSE}GL_TRUE{$ENDIF});
Assert(CheckGLError,'gluQuadricTexture');
IQuadricTexture:=True;
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
end;
end
else result:=True;
end;
Procedure TGLCanvas.EndBrushBitmap;
begin
EndBrushBitmap(Brush.Bitmap);
end;
Procedure TGLCanvas.EndBrushBitmap(Bitmap:TBitmap);
begin
if Bitmap<>nil then
begin
if IQuadricTexture then
begin
gluQuadricTexture(Quadric,{$IFDEF LINUX}False{$ELSE}GL_FALSE{$ENDIF});
Assert(CheckGLError,'gluQuadricTexture');
IQuadricTexture:=False;
end;
glDisable(GL_TEXTURE_2D);
end;
end;
Procedure TGLCanvas.Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean);
begin
glEnable(GL_CULL_FACE);
if Left>Right then SwapInteger(Left,Right);
if Top>Bottom then SwapInteger(Top,Bottom);
if z0>z1 then SwapInteger(z0,z1);
if Brush.Style<>bsClear then
begin
SetColor(Brush.Color);
SetBrushBitmap;
glBegin(GL_QUADS);
TeeNormal( 0, 0, -1);
glTexCoord2f(1,0);
TeeVertex3D( Left, Bottom, z0);
glTexCoord2f(1,1);
TeeVertex3D( Right, Bottom, z0);
glTexCoord2f(0,1);
TeeVertex3D( Right, Top, z0);
glTexCoord2f(0,0);
TeeVertex3D( Left, Top, z0);
TeeNormal(-1, 0, 0);
glTexCoord2f(0,0);
TeeVertex3D( Left, Top, z1);
glTexCoord2f(0,1);
TeeVertex3D( Left, Bottom, z1);
glTexCoord2f(1,1);
TeeVertex3D( Left, Bottom, z0);
glTexCoord2f(1,0);
TeeVertex3D( Left, Top, z0);
TeeNormal( 0, 0, 1);
glTexCoord2f(0,0);
TeeVertex3D( Right, Top, z1);
glTexCoord2f(0,1);
TeeVertex3D( Right, Bottom, z1);
glTexCoord2f(1,1);
TeeVertex3D( Left, Bottom, z1);
glTexCoord2f(1,0);
TeeVertex3D( Left, Top, z1);
TeeNormal( 1, 0, 0);
glTexCoord2f(0,0);
TeeVertex3D( Right, Bottom, z0);
glTexCoord2f(0,1);
TeeVertex3D( Right, Bottom, z1);
glTexCoord2f(1,1);
TeeVertex3D( Right, Top, z1);
glTexCoord2f(1,0);
TeeVertex3D( Right, Top, z0);
TeeNormal( 0, 1, 0);
glTexCoord2f(0,0);
TeeVertex3D( Left, Top, z1);
glTexCoord2f(0,1);
TeeVertex3D( Left, Top, z0);
glTexCoord2f(1,1);
TeeVertex3D( Right, Top, z0);
glTexCoord2f(1,0);
TeeVertex3D( Right, Top, z1);
TeeNormal( 0, -1, 0);
glTexCoord2f(0,0);
TeeVertex3D( Right, Bottom, z0);
glTexCoord2f(0,1);
TeeVertex3D( Left, Bottom, z0);
glTexCoord2f(1,1);
TeeVertex3D( Left, Bottom, z1);
glTexCoord2f(1,0);
TeeVertex3D( Right, Bottom, z1);
glEnd;
EndBrushBitmap;
end;
if Pen.Style<>psClear then
begin
SetPen;
glBegin(GL_LINE_LOOP);
TeeVertex3D( Left, Bottom, z0);
TeeVertex3D( Right, Bottom, z0);
TeeVertex3D( Right, Top, z0);
TeeVertex3D( Left, Top, z0);
glEnd;
glBegin(GL_LINE_LOOP);
TeeVertex3D( Left, Top, z1);
TeeVertex3D( Left, Bottom, z1);
TeeVertex3D( Right, Bottom, z1);
TeeVertex3D( Right, Top, z1);
glEnd;
glBegin(GL_LINE_LOOP);
TeeVertex3D( Right, Top, z0);
TeeVertex3D( Right, Top, z1);
TeeVertex3D( Right, Bottom, z1);
TeeVertex3D( Right, Bottom, z0);
glEnd;
glBegin(GL_LINE_LOOP);
TeeVertex3D( Left, Top, z0);
TeeVertex3D( Left, Bottom, z0);
TeeVertex3D( Left, Bottom, z1);
TeeVertex3D( Left, Top, z1);
glEnd;
glBegin(GL_LINE_LOOP);
TeeVertex3D( Right, Top, z1);
TeeVertex3D( Right, Top, z0);
TeeVertex3D( Left, Top, z0);
TeeVertex3D( Left, Top, z1);
glEnd;
end;
glDisable(GL_CULL_FACE);
Assert(CheckGLError,'Cube');
end;
Procedure TGLCanvas.SetMaterialColor; {$IFDEF CLR}unsafe;{$ENDIF}
Function GLColor(Const Value:Double):GLMat;
begin
result[0]:=Value;
result[1]:=Value;
result[2]:=Value;
result[3]:=1;
end;
var tmp : GLMat;
begin
tmp:=GLColor(TeeMaterialDiffuse);
glMaterialfv(TeeColorPlanes,GL_DIFFUSE,PGLFloat(@tmp));
tmp:=GLColor(TeeMaterialSpecular);
glMaterialfv(TeeColorPlanes,GL_SPECULAR,PGLFloat(@tmp));
tmp:=GLColor(TeeMaterialAmbient);
glMaterialfv(TeeColorPlanes,GL_AMBIENT,PGLFloat(@tmp));
Assert(CheckGLError,'Material '+IntToStr(FSavedError));
end;
{$IFNDEF LINUX}
Function TGLCanvas.GetDCHandle:HDC;
begin
{$IFDEF CLX}
result:=GetDC(GetActiveWindow);
{$ELSE}
result:=FDC;
{$ENDIF}
end;
{$ENDIF}
Function TGLCanvas.InitWindow( DestCanvas:TCanvas;
A3DOptions:TView3DOptions;
ABackColor:TColor;
Is3D:Boolean;
Const UserRect:TRect):TRect;
begin
FBounds:=UserRect;
RectSize(Bounds,FWidth,FHeight);
if Assigned(A3DOptions) then
FontZoom:=A3DOptions.FontZoom;
if (IDestCanvas<>DestCanvas) or (View3DOptions<>A3DOptions) then
begin
IDestCanvas:=DestCanvas;
View3DOptions:=A3DOptions;
InitOpenGL;
DestroyGLContext;
FDC:=DestCanvas.Handle;
{$IFNDEF LINUX}
{$IFDEF CLX}
IDrawToBitmap:=False;
{$ELSE}
IDrawToBitmap:=GetObjectType(FDC) = OBJ_MEMDC;
if IDrawToBitmap then // 7.02
DeleteTextures;
{$ENDIF}
if UseBuffer then
HRC:=CreateRenderingContext(GetDCHandle,[opDoubleBuffered],24,1) // 7.0
else
HRC:=CreateRenderingContext(GetDCHandle,[],24,1); // 7.0
if HRC=0 then Exit;
ActivateRenderingContext(GetDCHandle,HRC);
Assert(CheckGLError,'ActivateContext');
{$ENDIF}
glEnable(GL_NORMALIZE);
Assert(CheckGLError,'EnableNormalize');
glEnable(GL_DEPTH_TEST);
Assert(CheckGLError,'EnableDepth');
glDepthFunc(GL_LESS);
Assert(CheckGLError,'DepthFunc');
glEnable(GL_LINE_STIPPLE);
Assert(CheckGLError,'EnableLineStipple');
glEnable(GL_COLOR_MATERIAL);
Assert(CheckGLError,'EnableColorMaterial');
glColorMaterial(TeeColorPlanes,GL_AMBIENT_AND_DIFFUSE);
Assert(CheckGLError,'ColorMaterial');
SetMaterialColor;
{$IFNDEF LINUX}
//glEnable(GL_POLYGON_OFFSET_LINE);
glEnable(GL_POLYGON_OFFSET_FILL);
glPolygonOffset(0.5,1);
Assert(CheckGLError,'PolygonOffset');
{$ENDIF}
// Enable / Disable antialias smoothing:
if TeeSmooth then
begin
glEnable(GL_POLYGON_SMOOTH);
glEnable(GL_POINT_SMOOTH);
glEnable(GL_LINE_SMOOTH);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
end
else
begin
glDisable(GL_POLYGON_SMOOTH);
glDisable(GL_POINT_SMOOTH);
glDisable(GL_LINE_SMOOTH);
glDisable(GL_BLEND);
end;
glDisable(GL_CULL_FACE);
glEnable(GL_DITHER);
Assert(CheckGLError,'Dither');
glHint(GL_PERSPECTIVE_CORRECTION_HINT, TeePerspectiveQuality);
glHint(GL_LINE_SMOOTH_HINT, TeeSmoothQuality);
glHint(GL_POINT_SMOOTH_HINT, TeeSmoothQuality);
glHint(GL_POLYGON_SMOOTH_HINT, TeeSmoothQuality);
glLightModelf(GL_LIGHT_MODEL_TWO_SIDE,TeeFullLightModel);
glLightModelf(GL_LIGHT_MODEL_LOCAL_VIEWER,TeeLightLocal);
Assert(CheckGLError,'LightModel');
end;
FX:=0;
FY:=0;
FIs3D:=Is3D;
{$IFNDEF LINUX}
if GetObjectType(GetDCHandle) <> OBJ_MEMDC then
begin
FDC:=DestCanvas.Handle;
ActivateRenderingContext(GetDCHandle,HRC);
end;
{$ENDIF}
SetCanvas(DestCanvas);
FBackColor:=ABackColor;
result:=UserRect;
end;
Procedure TGLCanvas.InitAmbientLight(AmbientLight:Integer); {$IFDEF CLR}unsafe;{$ENDIF}
var tmp:GLMat;
tmpNum:Double;
begin
glDisable(GL_LIGHTING);
glDisable(GL_LIGHT0);
glDisable(GL_LIGHT1);
glDisable(GL_LIGHT2);
Assert(CheckGLError,'DisableLight');
if AmbientLight>0 then
begin
glEnable(GL_LIGHTING);
Assert(CheckGLError,'EnableLight');
tmpNum:=AmbientLight*0.01;
tmp[0]:=tmpNum;
tmp[1]:=tmpNum;
tmp[2]:=tmpNum;
tmp[3]:=1;
glLightModelfv(GL_LIGHT_MODEL_AMBIENT, PGLFloat(@tmp));
Assert(CheckGLError,'LightModel');
end
else
begin
tmp[0]:=0;
tmp[1]:=0;
tmp[2]:=0;
tmp[3]:=1;
glEnable(GL_LIGHTING);
glLightModelfv(GL_LIGHT_MODEL_AMBIENT, PGLFloat(@tmp));
Assert(CheckGLError,'LightModel');
glDisable(GL_LIGHTING);
Assert(CheckGLError,'DisableLightModel');
end;
end;
Procedure TGLCanvas.SetShininess(Const Value:Double);
begin
glMateriali(TeeColorPlanes, GL_SHININESS, Round(128.0*Value));
Assert(CheckGLError,'Shininess');
end;
Procedure TGLCanvas.InitLight(Num:Integer; Const AColor:GLMat;
const Position,Direction:TPoint3DFloat;
UseDirection:Boolean;
const SpotDegrees:Double); {$IFDEF CLR}unsafe;{$ENDIF}
procedure AssertLight(const Text:String);
begin
Assert(CheckGLError,Text+' '+IntToStr(Num));
end;
Const tmpSpec=0.99;
tmpDif =0.99;
tmpAmb =0.1;
var tmp : GLMat;
begin
glEnable(GL_LIGHTING);
glEnable(Num);
AssertLight('EnableLight');
tmp[0]:=tmpAmb;
tmp[1]:=tmpAmb;
tmp[2]:=tmpAmb;
tmp[3]:=1;
tmp:=AColor;
glLightfv(Num,GL_AMBIENT, PGLFloat(@tmp));
AssertLight('LightAmbient');
tmp[0]:=tmpDif;
tmp[1]:=tmpDif;
tmp[2]:=tmpDif;
tmp[3]:=1;
glLightfv(Num,GL_DIFFUSE, PGLFloat(@tmp));
AssertLight('LightDiffuse');
tmp[0]:=tmpSpec;
tmp[1]:=tmpSpec;
tmp[2]:=tmpSpec;
tmp[3]:=1;
glLightfv(Num,GL_SPECULAR, PGLFloat(@tmp));
AssertLight('LightSpecular');
tmp[0]:= Position.X;
tmp[1]:= -Position.Y;
tmp[2]:= -Position.Z;
tmp[3]:=1;
glLightfv(Num,GL_POSITION, PGLFloat(@tmp));
AssertLight('LightPosition');
if UseDirection then
begin
tmp[0]:= Direction.X;
tmp[1]:= -Direction.Y;
tmp[2]:= -Direction.Z;
end
else
begin
tmp[0]:=0;
tmp[1]:=0;
tmp[2]:=1;
end;
tmp[3]:=0;
glLightfv(Num,GL_SPOT_DIRECTION, PGLFloat(@tmp));
AssertLight('LightDirection');
if SpotDegrees=180 then
glLightf(Num,GL_SPOT_CUTOFF,TeeDefaultLightSpot)
else
glLightf(Num,GL_SPOT_CUTOFF,SpotDegrees);
AssertLight('LightSpot');
end;
Procedure TGLCanvas.ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect);
begin
glFlush;
Assert(CheckGLError,'Flush');
{$IFNDEF LINUX}
SwapBuffers(GetDCHandle);
{$ENDIF}
SetCanvas(DefaultCanvas);
Assert(CheckGLError,'ShowImage');
if IDrawToBitmap then // 7.02
DeleteTextures;
end;
Function TGLCanvas.ReDrawBitmap:Boolean;
begin
result:=False;
end;
procedure TGLCanvas.Rectangle(X0,Y0,X1,Y1:Integer);
begin
if Brush.Style<>bsClear then
FillRect(TeeRect(X0,Y0,X1,Y1));
if Pen.Style<>psClear then
begin
SetPen;
glBegin(GL_LINE_LOOP);
TeeVertex2D(X0,Y0);
TeeVertex2D(X1,Y0);
TeeVertex2D(X1,Y1);
TeeVertex2D(X0,Y1);
glEnd;
end;
Assert(CheckGLError,'Rectangle');
end;
procedure TGLCanvas.SetTextAlign(Align:Integer);
begin
FTextAlign:=Align;
end;
procedure TGLCanvas.MoveTo(X, Y: Integer);
begin
FX:=X;
FY:=Y;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -