teeglcanvas.pas

Delphi TeeChartPro.6.01的源代码

    Qz:= z1-z1;
    Px:= Points[0].x-Points[2].x;
    Py:= Points[0].y-Points[2].y;
    Pz:= z0-z1;
    tmpNormal[0]:= (Py*Qz - Pz*Qy);
    tmpNormal[1]:= (Pz*Qx - Px*Qz);
    tmpNormal[2]:= -(Px*Qy - Py*Qx);
  end;

  Procedure AddPoints;
  begin
    With Points[0] do TeeVertex3D(x,y,z0);
    With Points[1] do TeeVertex3D(x,y,z0);
    With Points[2] do TeeVertex3D(x,y,z1);
    With Points[3] do TeeVertex3D(x,y,z1);
  end;

begin
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    AddPoints;
    glEnd;
  end;
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_QUADS);
    CalcNormalPlaneFour;
    glNormal3fv(@tmpNormal);
    SetColor(Brush.Color);
    AddPoints;
    glEnd;
  end;
  Assert(CheckGLError,'PlaneFour3D');
end;

procedure TGLCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  Rectangle(X1,Y1,X2,Y2);
  Assert(CheckGLError,'RoundRect');
end;

Procedure TGLCanvas.Repaint;
begin
  if Assigned(View3DOptions) then View3DOptions.Repaint;
end;

Procedure TGLCanvas.Invalidate;
begin
end;

{$IFNDEF LINUX}
Procedure TGLCanvas.CreateFontOutlines;
var FontMode : Integer;
begin
  if FontOutlines then FontMode:=WGL_FONT_LINES
                  else FontMode:=WGL_FONT_POLYGONS;
  wglUseFontOutlines(GetDCHandle,32,TeeFontListRange,FontOffset,0,
                     TeeOpenGLFontExtrusion,FontMode,nil);

  Assert(CheckGLError,'InitFont');
end;
{$ENDIF}

Procedure TGLCanvas.InitOpenGLFont;
{$IFNDEF LINUX}
var Old,
    HFont    : THandle;
{$ENDIF}
begin
  {$IFNDEF LINUX}
  HFont := CreateFont(-12, 0, 0, 0, FW_BOLD,
		      0, 0, 0, {$IFDEF CLX}Cardinal{$ENDIF}(ANSI_CHARSET),
		      OUT_DEFAULT_PRECIS,
                      CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY{DRAFT_QUALITY},
		      DEFAULT_PITCH or FF_DONTCARE{FIXED_PITCH or FF_MODERN},
                      TeeOpenGLFontName);

  Old:=SelectObject(GetDCHandle, HFont);
  FontOffset:=1000;

  DeleteFont;

  CreateFontOutlines;

  DeleteObject(SelectObject(GetDCHandle,Old));
  IFontCreated:=True;

  {$ENDIF}
end;

Procedure TGLCanvas.TextOut3D(X,Y,Z:Integer; const Text:String);
var tmp       : TSize;
    tmpLength : Integer;
    tmpSize   : Double;
    tmpAlign  : Integer;
begin
  if not IFontCreated then InitOpenGLFont;
  tmpLength:=Length(Text);

  ReferenceCanvas.Font.Assign(Font);
  tmp:=ReferenceCanvas.TextExtent(Text);

  tmpAlign:=FTextAlign;
  if tmpAlign>=TA_BOTTOM then
     Dec(tmpAlign,TA_BOTTOM)
  else
     Inc(y,Round(0.7*tmp.Cy));

  if tmpAlign=TA_CENTER then
     Dec(x,Round(0.55*tmp.Cx))
  else
  if tmpAlign=TA_RIGHT then
     Dec(x,tmp.Cx+(tmpLength div 2));               {-Round(Sqr(tmp.Cx)/19.0)}

  if TeeOpenGLFontExtrusion>0 then glEnable(GL_CULL_FACE);

  glPushMatrix;

  glTranslatef(x,-y,-z+2);

{  if FTextToViewer
  With View3DOptions do
  begin
    glRotatef(360-Tilt, 0, 0, 1);
    glRotatef(360-Rotation, 0, 1, 0);
    if not Orthogonal then glRotatef(360+Elevation, 1, 0, 0);
  end; }

  if TeeTextAngleY<>0 then glRotatef(TeeTextAngleY,1,0,0);
  if TeeTextAngleZ<>0 then glRotatef(TeeTextAngleZ,0,1,0);

//  other font rotations: glRotatef(270,1,0,0);
  tmpSize:=Font.Size*1.5;
  glScalef(tmpSize,tmpSize,1);
  TeeNormal(0,0,1);
  SetColor(Font.Color);

  glListBase(FontOffset-32);
  glCallLists(tmpLength, GL_UNSIGNED_BYTE, PChar(Text));
  glPopMatrix;
  Assert(CheckGLError,'TextOut3D');

  if TeeOpenGLFontExtrusion>0 then
  begin
    glDisable(GL_CULL_FACE);
    glFrontFace(GL_CCW);
    Assert(CheckGLError,'FrontFace');
  end;
end;

Procedure TGLCanvas.TextOut(X,Y:Integer; const Text:String);
begin
  TextOut3D(x,y,0,Text);
end;

procedure TGLCanvas.MoveTo3D(X,Y,Z:Integer);
begin
  FX:=X;
  FY:=Y;
  FZ:=Z;
end;

procedure TGLCanvas.LineTo3D(X,Y,Z:Integer);
begin
  SetPen;
  glBegin(GL_LINES);
  TeeVertex3D(FX,FY,FZ);
  TeeVertex3D(x,y,z);
  glEnd;
  FX:=X;
  FY:=Y;
  FZ:=Z;
  Assert(CheckGLError,'LineTo3D');
end;

procedure TGLCanvas.PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer);
begin
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    TeeVertex3D(P1.X,P1.Y,Z);
    TeeVertex3D(P2.X,P2.Y,Z);
    TeeVertex3D(P3.X,P3.Y,Z);
    TeeVertex3D(P4.X,P4.Y,Z);
    glEnd;
  end;
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_QUADS);
    SetColor(Brush.Color);
    TeeNormal(0,0,-1);
    TeeVertex3D(P1.X,P1.Y,Z);
    TeeVertex3D(P2.X,P2.Y,Z);
    TeeVertex3D(P3.X,P3.Y,Z);
    TeeVertex3D(P4.X,P4.Y,Z);
    glEnd;
  end;
  Assert(CheckGLError,'PlaneWithZ');
end;

procedure TGLCanvas.Plane3D(Const A,B:TPoint; Z0,Z1:Integer);
begin
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_QUADS);
    TeeNormal(0,1,0);  { <-- CalcNormal }
    SetColor(Brush.Color);
    TeeVertex3D(A.X,A.Y,Z0);
    TeeVertex3D(B.X,B.Y,Z0);
    TeeVertex3D(B.X,B.Y,Z1);
    TeeVertex3D(A.X,A.Y,Z1);
    glEnd;
  end;
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    TeeVertex3D(A.X,A.Y,Z0);
    TeeVertex3D(B.X,B.Y,Z0);
    TeeVertex3D(B.X,B.Y,Z1);
    TeeVertex3D(A.X,A.Y,Z1);
    glEnd;
  end;
  Assert(CheckGLError,'Plane3D');
end;

procedure TGLCanvas.SetDrawStyle(Value:TTeeCanvasSurfaceStyle);
begin
  if Value=tcsWire then
     glPolygonMode(GL_FRONT_AND_BACK,GL_LINE)
  else
  if Value=tcsDot then
     glPolygonMode(GL_FRONT_AND_BACK,GL_POINT)
  else
     glPolygonMode(GL_FRONT_AND_BACK,GL_FILL);
end;

Function TGLCanvas.GetSupports3DText:Boolean;
begin
  result:=True;
end;

Function TGLCanvas.GetSupportsFullRotation:Boolean;
begin
  result:=True;
end;

Function TGLCanvas.GetTextAlign:TCanvasTextAlign;
begin
  result:=FTextAlign;
end;

Function TGLCanvas.GetUseBuffer:Boolean;
begin
  result:=FUseBuffer;
end;

Procedure TGLCanvas.SetUseBuffer(Value:Boolean);
begin
  FUseBuffer:=Value;
  IDestCanvas:=nil;
  DeleteFont;
end;

Procedure TGLCanvas.DeleteFont;
begin
  if IFontCreated then
  begin
    glDeleteLists(FontOffset,TeeFontListRange);
    IFontCreated:=False;
  end;
//  Assert(CheckGLError,'DeleteFont '+IntToStr(FSavedError));
end;

Function TGLCanvas.GetHandle:TTeeCanvasHandle;
begin
  result:=FDC;
end;

Procedure TGLCanvas.DoHorizLine(X0,X1,Y:Integer);
begin
  MoveTo(X0,Y);
  LineTo(X1,Y);
end;

Procedure TGLCanvas.DoVertLine(X,Y0,Y1:Integer);
begin
  MoveTo(X,Y0);
  LineTo(X,Y1);
end;

procedure TGLCanvas.RotateLabel3D(x,y,z:Integer; Const St:String; RotDegree:Integer);
begin
  glPushMatrix;
  glTranslatef(x,-y,0);
  glRotatef(RotDegree,0,0,1);
  glTranslatef(-x,y,z);
  TextOut(X,Y,St);
  glPopMatrix;
  Assert(CheckGLError,'RotateLabel3D');
end;

procedure TGLCanvas.RotateLabel(x,y:Integer; Const St:String; RotDegree:Integer);
begin
  RotateLabel3D(x,y,0,St,RotDegree);
end;

Procedure TGLCanvas.Line(X0,Y0,X1,Y1:Integer);
begin
  MoveTo(X0,Y0);
  LineTo(X1,Y1);
end;

procedure TGLCanvas.EraseBackground(const Rect: TRect);
begin { nothing ! OpenGL already clears... }
end;

Procedure TGLCanvas.HorizLine3D(Left,Right,Y,Z:Integer);
begin
  MoveTo3D(Left,Y,Z);
  LineTo3D(Right,Y,Z);
end;

Procedure TGLCanvas.VertLine3D(X,Top,Bottom,Z:Integer);
begin
  MoveTo3D(X,Top,Z);
  LineTo3D(X,Bottom,Z);
end;

Procedure TGLCanvas.ZLine3D(X,Y,Z0,Z1:Integer);
begin
  MoveTo3D(X,Y,Z0);
  LineTo3D(X,Y,Z1);
end;

Procedure TGLCanvas.Arrow( Filled:Boolean;
                           Const FromPoint,ToPoint:TPoint;
                           ArrowWidth,ArrowHeight,Z:Integer);
Var x    : Double;
    y    : Double;
    SinA : Double;
    CosA : Double;

    Function CalcArrowPoint:TPoint;
    Begin
      result.X:=Round( x*CosA + y*SinA);
      result.Y:=Round(-x*SinA + y*CosA);
    end;

Var tmpHoriz  : Integer;
    tmpVert   : Integer;
    dx        : Integer;
    dy        : Integer;
    tmpHoriz4 : Double;
    xb        : Double;
    yb        : Double;
    l         : Double;

   { These are the Arrows points coordinates }
    To3D,pc,pd,pe,pf,pg,ph:TPoint;

    (*           pc
                   |\
    ph           pf| \
      |------------   \ ToPoint
 From |------------   /
    pg           pe| /
                   |/
                 pd
    *)
begin
  Assert(CheckGLError,'BeforeArrow');
  dx := ToPoint.x-FromPoint.x;
  dy := FromPoint.y-ToPoint.y;

  l  := TeeDistance(dx,dy);

  if l>0 then  { if at least one pixel... }
  Begin
    tmpHoriz:=ArrowWidth;
    tmpVert :=Math.Min(Round(l),ArrowHeight);
    SinA:= dy / l;
    CosA:= dx / l;
    xb:= ToPoint.x*CosA - ToPoint.y*SinA;
    yb:= ToPoint.x*SinA + ToPoint.y*CosA;
    x := xb - tmpVert;
    y := yb - tmpHoriz/2;
    pc:=CalcArrowPoint;
    y := yb + tmpHoriz/2;
    pd:=CalcArrowPoint;
    if Filled then
    Begin
      tmpHoriz4:=tmpHoriz/4;
      y := yb - tmpHoriz4;
      pe:=CalcArrowPoint;
      y := yb + tmpHoriz4;
      pf:=CalcArrowPoint;
      x := FromPoint.x*cosa - FromPoint.y*sina;
      y := yb - tmpHoriz4;
      pg:=CalcArrowPoint;
      y := yb + tmpHoriz4;
      ph:=CalcArrowPoint;
      To3D:=ToPoint;
      PolygonWithZ([ph,pg,pe,pf],Z);
      PolygonWithZ([pc,To3D,pd],Z);
    end
    else
    begin
      MoveTo3D(FromPoint.x,FromPoint.y,z);
      LineTo3D(ToPoint.x,ToPoint.y,z);
      LineTo3D(pd.x,pd.y,z);
      MoveTo3D(ToPoint.x,ToPoint.y,z);
      LineTo3D(pc.x,pc.y,z);
    end;
  end;
  Assert(CheckGLError,'Arrow');
end;

Procedure TGLCanvas.LineWithZ(X0,Y0,X1,Y1,Z:Integer);
begin
  MoveTo3D(X0,Y0,Z);
  LineTo3D(X1,Y1,Z);
end;

procedure TGLCanvas.PolygonWithZ(Points: array of TPoint; Z:Integer);

  Procedure AddPoints;
  var t : Integer;
  begin
    for t:=Low(Points) to High(Points) do
        With Points[t] do TeeVertex3D(x,y,z);
  end;

begin
  if Brush.Style<>bsClear then
  begin
    SetColor(Brush.Color);
    SetBrushBitmap;
    glBegin(GL_POLYGON);
    TeeNormal(0,0,-1);
    AddPoints;
    glEnd;
    EndBrushBitmap;
  end;

  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    AddPoints;
    glEnd;
  end;

  Assert(CheckGLError,'PolygonWithZ');
end;

procedure TGLCanvas.Triangle3D( Const Points:TTrianglePoints3D;
                                Const Colors:TTriangleColors3D);
var t:Integer;
begin
  if Brush.Style<>bsClear then
  begin
    glBegin(GL_POLYGON);
    TeeNormal(0,0,-1);  { <-- calc Normal }
    SetColor(Colors[0]);
    With Points[0] do TeeVertex3D(x,y,z);
    SetColor(Colors[1]);
    With Points[1] do TeeVertex3D(x,y,z);
    SetColor(Colors[2]);
    With Points[2] do TeeVertex3D(x,y,z);
    glEnd;
  end;
  if Pen.Style<>psClear then
  begin
    SetPen;
    glBegin(GL_LINE_LOOP);
    for t:=0 to 2 do With Points[t] do TeeVertex3D(x,y,z);
    glEnd;
  end;
  Assert(CheckGLError,'Triangle3D');
end;

procedure TGLCanvas.TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer);
begin
  PolygonWithZ([P1,P2,P3],Z);
end;

Function TGLCanvas.GetBackMode:TCanvasBackMode;
begin
  result:=FBackMode;
end;

Procedure TGLCanvas.Surface3D( Style:TTeeCanvasSurfaceStyle;
                               SameBrush:Boolean;
                               NumXValues,NumZValues:Integer;
                               CalcPoints:TTeeCanvasCalcPoints);

  Procedure DrawCells;
  var tmpX,
      tmpZ : Integer;

    Procedure AddVertexs;
    Var tmpColor0,
        tmpColor1 : TColor;
        P0        : TPoint3D;
        P1        : TPoint3D;
    begin 
      if CalcPoints(tmpX,tmpZ+1,P0,P1,tmpColor0,tmpColor1) then
      begin
        if SameBrush then
        begin
          With P0 do TeeVertex3D(x,y,z);
          With P1 do TeeVertex3D(x,y,z);
        end
        else
        begin
          if tmpColor0<>clNone then SetColor(tmpColor0);
          With P0 do TeeVertex3D(x,y,z);
          if tmpColor1<>clNone then SetColor(tmpColor1);
          With P1 do TeeVertex3D(x,y,z);
        end;
      end
      else
      begin
        glEnd;
        glBegin(GL_QUAD_STRIP);
        TeeNormal(0,-1,0);
      end;
    end;

  begin
    for tmpX:=2 to NumXValues do
    begin
      glBegin(GL_QUAD_STRIP);
      TeeNormal(0,1,0);
      for tmpZ:=NumZValues-1 downto 0 do AddVertexs;
      glEnd;
    end;
  end;

begin
  SetPen;
  if (Style=tcsSolid) or (not SameBrush) then SetColor(Brush.Color);

  if DrawStyle=tcsSolid then SetDrawStyle(Style);

  DrawCells;

  if (Pen.Style<>psClear) and (Style=tcsSolid) then
  begin
    glPolygonMode(GL_FRONT_AND_BACK,GL_LINE);
    SetColor(Pen.Color);
    SameBrush:=True;
    DrawCells;
  end;

  SetDrawStyle(DrawStyle);
  Assert(CheckGLError,'Surface3D');
end;

procedure TGLCanvas.PyramidTrunc(Const R: TRect; StartZ, EndZ: Integer;
                                 TruncX,TruncZ:Integer);
begin
  Pyramid(True,R.Left,R.Top,R.Right,R.Bottom,StartZ,EndZ,True);
end;

end.