teeglcanvas.pas

Delphi TeeChartPro.6.01的源代码

procedure TGLCanvas.Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer; DarkCover:Boolean);
begin
  InternalCylinder(Vertical,Left,Top,Right,Bottom,Z0,Z1,DarkCover,100);
  Assert(CheckGLError,'Cylinder');
end;

procedure TGLCanvas.Cone(Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer; Dark3D:Boolean; ConePercent:Integer);
begin
  InternalCylinder(Vertical,Left,Top,Right,Bottom,Z0,Z1,Dark3D,ConePercent);
  Assert(CheckGLError,'Cone');
end;

procedure TGLCanvas.Sphere(x,y,z:Integer; Const Radius:Double);
begin
  glPushMatrix;
  glTranslatef(x,-y,-z);

  if Brush.Style<>bsClear then
  begin
    SetColor(Brush.Color);
    glEnable(GL_CULL_FACE);
    SetBrushBitmap;
    gluSphere(FQuadric,Radius,TeeSphereSlices,TeeSphereStacks);
    EndBrushBitmap;
    glDisable(GL_CULL_FACE);
  end;

  if Pen.Style<>psClear then // 6.0
  begin
    SetPen;
    gluQuadricDrawStyle(FQuadric, GLU_LINE);
    gluSphere(FQuadric,Radius,TeeSphereSlices,TeeSphereStacks);
    gluQuadricDrawStyle(FQuadric, GLU_FILL);
  end;

  glPopMatrix;
  Assert(CheckGLError,'Sphere');
end;

Procedure TGLCanvas.SetColor(AColor:TColor);
var tmp : GLMat;
begin
  ColorToGL(AColor,tmp);
  glColor4fv(@tmp);
end;

procedure TGLCanvas.SetPen;
begin
  With Pen do
  begin
    if Style=psSolid then glDisable(GL_LINE_STIPPLE)
    else
    begin
      glEnable(GL_LINE_STIPPLE);
      Case Style of
       psSolid   : glLineStipple(1,$FFFF);
       psDot     : glLineStipple(1,$5555);
       psDash    : glLineStipple(1,$00FF);
       psDashDot : glLineStipple(1,$55FF);
      else
       glLineStipple(1,$1C47);
      end;
    end;

    if not IDrawToBitmap then
       glLineWidth(Width);

    SetColor(Color);
  end;
  Assert(CheckGLError,'SetPen');
end;

procedure TGLCanvas.LineTo(X, Y: Integer);
begin
  SetPen;
  glBegin(GL_LINES);
    TeeVertex2D(FX,FY);
    TeeVertex2D(X,Y);
  glEnd;
  FX:=X;
  FY:=Y;
  Assert(CheckGLError,'LineTo');
end;

procedure TGLCanvas.ClipRectangle(Const Rect:TRect);
begin
end;

procedure TGLCanvas.ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer);
begin
//  glEnable(GL_CLIP_PLANE0);
end;

procedure TGLCanvas.UnClipRectangle;
begin
//  glDisable(GL_CLIP_PLANE0);
end;

function TGLCanvas.GetBackColor:TColor;
begin
  result:=clWhite;
end;

procedure TGLCanvas.SetBackColor(Color:TColor);
begin
  FBackColor:=Color;
end;

procedure TGLCanvas.SetBackMode(Mode:TCanvasBackMode);
begin
  FBackMode:=Mode;
end;

Function TGLCanvas.GetMonochrome:Boolean;
begin
  result:=False;
end;

Function TGLCanvas.GetPixel(x,y:Integer):TColor;
begin
  result:=clWhite; // 6.0 How to do this in OpenGL ?
end;

Procedure TGLCanvas.SetMonochrome(Value:Boolean);
begin
end;

procedure TGLCanvas.StretchDraw(const Rect: TRect; Graphic: TGraphic);
begin
end;

procedure TGLCanvas.Draw(X, Y: Integer; Graphic: TGraphic);
begin
end;

Procedure TGLCanvas.GradientFill( Const Rect:TRect;
                                  StartColor,EndColor:TColor;
                                  Direction:TGradientDirection;
                                  Balance:Integer=50);

  Procedure DoVertical(AStartColor,AEndColor:TColor);
  begin
    With Rect do
    begin
      SetColor(AEndColor);
      TeeVertex3D(Right,Bottom,FDepth);
      SetColor(AStartColor);
      TeeVertex3D(Right,Top,FDepth);
      TeeVertex3D(Left, Top,FDepth);
      SetColor(AEndColor);
      TeeVertex3D(Left, Bottom,FDepth);
    end;
  end;

  Procedure DoHorizontal(AStartColor,AEndColor:TColor);
  begin
    With Rect do
    begin
      SetColor(AEndColor);
      TeeVertex3D(Right,Bottom,FDepth);
      TeeVertex3D(Right,Top,FDepth);
      SetColor(AStartColor);
      TeeVertex3D(Left, Top,FDepth);
      TeeVertex3D(Left, Bottom,FDepth);
    end;
  end;

begin
  Assert(CheckGLError,'Before GradientFill');
  glBegin(GL_QUADS);
  TeeNormal(0,0,-1);
  Case Direction of
     gdTopBottom  : DoVertical(StartColor,EndColor);
     gdBottomTop  : DoVertical(EndColor,StartColor);
     gdLeftRight  : DoHorizontal(StartColor,EndColor);
     gdRightLeft  : DoHorizontal(EndColor,StartColor);
     gdFromCenter : ;
     gdFromTopLeft: ;
  else
{     gdFromBottomLeft }
  end;
  glEnd;
  Assert(CheckGLError,'GradientFill');
end;

Procedure TGLCanvas.RectangleY(Left,Top,Right,Z0,Z1:Integer);
begin
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_QUADS);
    TeeNormal(0,1,0);
    SetColor(Brush.Color);
    SetBrushBitmap;
    TeeVertex3D(Left, Top,Z1);
    TeeVertex3D(Right,Top,Z1);
    TeeVertex3D(Right,Top,Z0);
    TeeVertex3D(Left, Top,Z0);
    glEnd;
    EndBrushBitmap;
  end;
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    TeeVertex3D(Left, Top,Z0);
    TeeVertex3D(Right,Top,Z0);
    TeeVertex3D(Right,Top,Z1);
    TeeVertex3D(Left, Top,Z1);
    glEnd;
  end;
  Assert(CheckGLError,'RectangleY');
end;

Procedure TGLCanvas.RectangleWithZ(Const Rect:TRect; Z:Integer);
begin
  With Rect do
  begin
    if Pen.Style<>psClear then
    begin
      SetPen;
      glBegin(GL_LINE_LOOP);
      TeeVertex3D(Left, Top,   Z);
      TeeVertex3D(Right,Top,   Z);
      TeeVertex3D(Right,Bottom,Z);
      TeeVertex3D(Left, Bottom,Z);
      glEnd;
    end;

    if Brush.Style<>bsClear then
    begin
      SetColor(Brush.Color);
      SetBrushBitmap;
      glBegin(GL_QUADS);
      TeeNormal(0,0,-1);
      glTexCoord2f(0,1);
      TeeVertex3D(Left, Top,   Z);
      glTexCoord2f(1,1);
      TeeVertex3D(Left, Bottom,Z);
      glTexCoord2f(1,0);
      TeeVertex3D(Right,Bottom,Z);
      glTexCoord2f(0,0);
      TeeVertex3D(Right,Top,   Z);
      glEnd;
      EndBrushBitmap;
    end;
  end;

  Assert(CheckGLError,'RectangleWithZ');
end;

Procedure TGLCanvas.RectangleZ(Left,Top,Bottom,Z0,Z1:Integer);
begin
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    TeeVertex3D(Left,Top,   Z0);
    TeeVertex3D(Left,Bottom,Z0);
    TeeVertex3D(Left,Bottom,Z1);
    TeeVertex3D(Left,Top,   Z1);
    glEnd;
  end;
  if Brush.Style<>bsClear then
  begin
    SetColor(Brush.Color);
    SetBrushBitmap;
    glBegin(GL_QUADS);
    TeeNormal(1,0,0);
    glTexCoord2f(0,1);
    TeeVertex3D(Left, Top,   Z0);
    glTexCoord2f(1,1);
    TeeVertex3D(Left, Bottom,Z0);
    glTexCoord2f(1,0);
    TeeVertex3D(Left,Bottom,Z1);
    glTexCoord2f(0,0);
    TeeVertex3D(Left,Top,   Z1);
    glEnd;
    EndBrushBitmap;
  end;
  Assert(CheckGLError,'RectangleZ');
end;

procedure TGLCanvas.FillRect(const Rect: TRect);
begin
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_QUADS);
    TeeNormal(0,0,-1);
    SetColor(Brush.Color);

    With Rect do
    begin
      TeeVertex2D(Left, Top);
      TeeVertex2D(Left, Bottom);
      TeeVertex2D(Right,Bottom);
      TeeVertex2D(Right,Top);
    end;

    glEnd;
  end;
  Assert(CheckGLError,'FillRect '+IntToStr(FSavedError));
end;

procedure TGLCanvas.Frame3D( var Rect: TRect; TopColor, BottomColor: TColor;
                                 Width: Integer);
begin
//  Brush.Style:=bsClear;
//  Rectangle(Rect);
//  FillRect(Rect);
end;

procedure TGLCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
  EllipseWithZ(X1,Y1,X2,Y2,0);
  Assert(CheckGLError,'Ellipse');
end;

procedure TGLCanvas.EllipseWithZ(X1, Y1, X2, Y2, Z: Integer);
Const PiStep=Pi/10.0;
var t,XC,YC,XR,YR:Integer;
    tmpSin,tmpCos:Extended;
begin
  XR:=(X2-X1) div 2;
  YR:=(Y2-Y1) div 2;
  XC:=(X1+X2) div 2;
  YC:=(Y1+Y2) div 2;
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    for t:=0 to 18 do
    begin
      SinCos(t*piStep,tmpSin,tmpCos);
      TeeVertex3D(XC+Trunc(XR*tmpSin),YC-Trunc(YR*tmpCos),Z);
    end;
    glEnd;
  end;
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_TRIANGLE_FAN);
    SetColor(Brush.Color);
    TeeNormal(0,0,-1);
    TeeVertex3D(XC,YC,Z);
    for t:=0 to 20 do
    begin
      SinCos(t*piStep,tmpSin,tmpCos);
      TeeVertex3D(XC+Trunc(XR*tmpSin),YC-Trunc(YR*tmpCos),Z);
    end;
    glEnd;
  end;
  Assert(CheckGLError,'EllipseWithZ');
end;

procedure TGLCanvas.FrontPlaneBegin;  { for titles and legend only... }
begin
  DisableRotation;
  With View3DOptions do
    glTranslatef(-FXCenter+HorizOffset,FYCenter-VertOffset,TeeZoomScale/CalcPerspective);
end;

procedure TGLCanvas.FrontPlaneEnd;
begin
  EnableRotation;
end;

Procedure TGLCanvas.EnableRotation;
begin
  glPopMatrix;
  Assert(CheckGLError,'FrontPlaneEnd');
end;

Procedure TGLCanvas.DisableRotation;
begin
  glPushMatrix;
  glLoadIdentity;
  Assert(CheckGLError,'FrontPlaneBegin');
end;

procedure TGLCanvas.SetPixel3D(X,Y,Z:Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    glBegin(GL_POINT);
    SetColor(Value);
    TeeVertex3D(X,Y,Z);
    glEnd;
    Assert(CheckGLError,'Pixel3D');
  end;
end;

procedure TGLCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    glBegin(GL_POINT);
    SetColor(Value);
    TeeVertex2D(X,Y);
    glEnd;
    Assert(CheckGLError,'Pixel');
  end;
end;

procedure TGLCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  Assert(CheckGLError,'Arc');
//  gluPartialDisk
end;

Function TGLCanvas.BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend;
begin
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
  ITransp:=(100-Transparency)*0.01;
  result:=nil;
end;

procedure TGLCanvas.EndBlending(Blend:TTeeBlend);
begin
  ITransp:=1;
  glDisable(GL_BLEND);
end;

procedure TGLCanvas.Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                           Const StartAngle,EndAngle,HolePercent:Double);
begin
  Assert(CheckGLError,'Donut');
end;

procedure TGLCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  Assert(CheckGLError,'Pie');
//  gluPartialDisk
end;

procedure TGLCanvas.Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
                           Const StartAngle,EndAngle:Double;
                           DarkSides,DrawSides:Boolean;
                           DonutPercent:Integer=0);

Const NumSliceParts=16;

Var piStep:Double;
    tmpSin,
    tmpCos     : Extended;
    tmpXRadius : Double;
    tmpYRadius : Double;

  Function ToDegree(Const Value:Double):Double;
  begin
    result:=Value*180.0/Pi;
  end;

  Procedure DrawPieSlice(z,ANormal:Integer);

    Procedure DrawSlice;
    var t:Integer;

      Procedure DrawSliceStep;
      begin
        SinCos(StartAngle+(t*piStep),tmpSin,tmpCos);
        TeeVertex3D(Trunc(XRadius*tmpSin),Trunc(YRadius*tmpCos),z);
      end;

    begin
      TeeVertex3D(0,0,z);
      if z=z0 then for t:=0 to NumSliceParts do DrawSliceStep
              else for t:=NumSliceParts downto 0 do DrawSliceStep;
    end;

  begin
    if Pen.Style<>psClear then
    begin
      SetPen;
      glBegin(GL_LINE_LOOP);
      DrawSlice;
      glEnd;
    end;
    if Brush.Style<>bsClear then
    begin
      glBegin(GL_TRIANGLE_FAN);
      SetColor(Brush.Color);
      TeeNormal(0,0,ANormal);
      DrawSlice;
      glEnd;
    end;
  end;

  Procedure DrawCover;
  var t,x,y:Integer;
  begin
    glBegin(GL_QUAD_STRIP);
    SetColor(Brush.Color);
    TeeNormal(0,1,0);
    for t:=0 to NumSliceParts do
    begin
      SinCos(StartAngle+(t*piStep),tmpSin,tmpCos);
      X:=Trunc(XRadius*tmpSin);
      Y:=Trunc(YRadius*tmpCos);
      TeeVertex2D(X,Y);
      TeeVertex3D(X,Y,z1-z0);
    end;
    glEnd;
  end;

  Procedure DrawSide(Const AAngle:Double);
  begin
    SinCos(AAngle,tmpSin,tmpCos);
    Plane3D(TeePoint(0,0),TeePoint(Round(tmpXRadius*tmpSin),Round(tmpYRadius*tmpCos)),Z0,Z1);
  end;

begin
  glPushMatrix;
  glTranslatef(XCenter,-YCenter,0);
  piStep:=(EndAngle-StartAngle)/NumSliceParts;

  if DonutPercent>0 then
  begin
    tmpXRadius:=DonutPercent*XRadius*0.01;
    tmpYRadius:=DonutPercent*YRadius*0.01;
  end
  else
  begin
    tmpXRadius:=XRadius;
    tmpYRadius:=YRadius;
  end;

  if DrawSides then
  begin
    DrawSide(StartAngle);
    DrawSide(EndAngle);
  end;

  glEnable(GL_CULL_FACE);
  DrawCover;
  DrawPieSlice(z0,-1);
  DrawPieSlice(z1,1);
  glDisable(GL_CULL_FACE);
  glPopMatrix;
  Assert(CheckGLError,'Pie3D');
end;

procedure TGLCanvas.Polyline(const Points:{$IFDEF D5}array of TPoint{$ELSE}TPointArray{$ENDIF}); // 6.0
var Count : Integer;
    t     : Integer;
begin
  Count:=Length(Points);
  if Count>0 then
  begin
    SetPen;
    glBegin(GL_LINES);
    for t:=0 to Count-1 do TeeVertex2D(Points[t].X,Points[t].Y);
    glEnd;
    FX:=Points[0].X;
    FY:=Points[0].Y;
    Assert(CheckGLError,'Polyline');
  end;
end;

procedure TGLCanvas.Polygon(const Points: array of TPoint);
begin
  PolygonWithZ(Points,0);
  Assert(CheckGLError,'Polygon');
end;

procedure TGLCanvas.PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer);
var tmpNormal:GLMat;

  Procedure CalcNormalPlaneFour;
  var Qx,Qy,Qz,Px,Py,Pz:Double;
  begin
    Qx:= Points[3].x-Points[2].x;
    Qy:= Points[3].y-Points[2].y;