⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teeglcanvas.pas

📁 BCB第三方组件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    Assert(CheckGLError,'Perspective');
  end;
end;

Procedure TGLCanvas.Projection(MaxDepth:Integer; const Bounds,Rect:TRect);
begin
  RectSize(Bounds,FWidth,FHeight);
  RectCenter(Rect,FXCenter,FYCenter);
  FDepth:=MaxDepth;

  glViewport(0, 0, FWidth, FHeight);
  Assert(CheckGLError,'ViewPort '+IntToStr(FSavedError));

  DoProjection;
  SetDrawStyle(DrawStyle);
  InitMatrix;
end;

Function TGLCanvas.CalcZoom:Double;

  Function CalcPerspective:Double;
  begin
    if FIs3D and (not View3DOptions.Orthogonal) then
       result:=Math.Max(TeeMinPerspective,View3DOptions.Perspective)*0.01
    else
       result:=1;
  end;

begin
  result:=2.0*Math.Max(1,View3DOptions.Zoom)*CalcPerspective;
end;

Procedure TGLCanvas.InitMatrix;
const tmpInv=1/255.0;
var AColor : TColor;
begin
  AColor:=ColorToRGB(FBackColor);
  glClearColor( GetRValue(AColor)*tmpInv,
                GetGValue(AColor)*tmpInv,
                GetBValue(AColor)*tmpInv,
                1);
  Assert(CheckGLError,'ClearColor');

  glDisable(GL_DITHER);

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  Assert(CheckGLError,'Clear');

  glEnable(GL_DITHER);

  glMatrixMode(GL_MODELVIEW);
  Assert(CheckGLError,'ModelView');

  glLoadIdentity;
  Assert(CheckGLError,'ModelInit');

  With View3DOptions do
       glTranslatef(HorizOffset,-VertOffset,TeeZoomScale/CalcZoom);

  if ShadeQuality then glShadeModel(GL_SMOOTH)
                  else glShadeModel(GL_FLAT);

  Assert(CheckGLError,'ShadeModel');

  With View3DOptions do
  if FIs3D then
  begin
    glRotatef(Tilt, 0, 0, 1);
    glRotatef(-ElevationFloat, 1, 0, 0);
    glRotatef(RotationFloat, 0, 1, 0);
  end;

  glTranslatef( -FXCenter+RotationCenter.X,
                 FYCenter+RotationCenter.Y,
                 RotationCenter.Z+(0.5*FDepth));

  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;

procedure TGLCanvas.SetAntiAlias(const Value:Boolean);
begin
  IAntiAlias:=Value;

  // Enable / Disable antialias smoothing:
  if Value then
  begin
    //glEnable(GL_POLYGON_SMOOTH); // <--Warning: Fonts and polygon 3D Depth test fails
    glEnable(GL_POINT_SMOOTH);
    glEnable(GL_LINE_SMOOTH);
    glDisable(GL_DEPTH_TEST);
    glEnable(GL_BLEND);
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
//    glBlendFunc( GL_SRC_ALPHA_SATURATE, GL_ONE );
  end
  else
  begin
    glDisable(GL_POLYGON_SMOOTH);
    glDisable(GL_POINT_SMOOTH);
    glDisable(GL_LINE_SMOOTH);
    glDisable(GL_BLEND);
  end;
end;

Function TGLCanvas.Quadric:PGLUQuadricObj; {$IFDEF CLR}unsafe;{$ENDIF}
begin
  if not Assigned(FQuadric) then
     FQuadric:=gluNewQuadric;

  result:=FQuadric;
end;

Procedure TGLCanvas.TeeVertex2D(const x,y:Integer);
begin
  glVertex2i(x,-y);
end;

Procedure TGLCanvas.TeeVertex3D(const x,y,z:Integer);
begin
  glVertex3i(x,-y,-z);
end;

Procedure TGLCanvas.TeeNormal(const 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);
//var w : Integer;
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
    {
    Brush.Style:=bsSolid;
    Brush.Color:=Pen.Color;
    Pen.Style:=psClear;
    }

    SetPen;

    {
    w:=Pen.Width;
    Cylinder(True,Left-w,Top,Left+w,Bottom,z0-w,z0+w,True);
    Cylinder(True,Right-w,Top,Right+w,Bottom,z0-w,z0+w,True);
    Cylinder(True,Left-w,Top,Left+w,Bottom,z1-w,z1+w,True);
    Cylinder(True,Right-w,Top,Right+w,Bottom,z1-w,z1+w,True);
    Cylinder(False,Left,Top-w,Right,Top+w,z0-w,z0+w,True);
    Cylinder(False,Left,Top-w,Right,Top+w,z1-w,z1+w,True);
    }

    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));

//  tmp:=GLColor(TeeMaterialEmission);
//  glMaterialfv(TeeColorPlanes,GL_EMISSION,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_AUTO_NORMAL);
    Assert(CheckGLError,'AutoNormal');

    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);

//    glColorMaterial(TeeColorPlanes,GL_EMISSION);
    Assert(CheckGLError,'ColorMaterial');

    SetMaterialColor;

    {$IFNDEF LINUX}
    //glEnable(GL_POLYGON_OFFSET_LINE);
    glEnable(GL_POLYGON_OFFSET_FILL);
    glPolygonOffset(0.5,1);

    Assert(CheckGLError,'PolygonOffset');
    {$ENDIF}

    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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -