teeglcanvas.pas

BCB第三方组件

    Procedure DrawSlice;
    var t : Integer;

      Procedure DrawSliceStep;
      var X,Y : Integer;
      begin
        GetXY(t,X,Y);
        TeeVertex3D(X,z,Y);
      end;

    begin
      TeeVertex3D(0,z,0);
      if z=z1 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);
      SetBrushBitmap;
      TeeNormal(0,ANormal,0);
      DrawSlice;
      glEnd;
      EndBrushBitmap;
    end;
  end;

  Procedure DrawCover;
  var t,x,y : Integer;
  begin
    glBegin(GL_QUAD_STRIP);
    SetColor(Brush.Color);
    SetBrushBitmap;
    TeeNormal(0,1,0);
    for t:=0 to NumSliceParts do
    begin
      GetXY(t,X,Y);
      TeeVertex3D(X,Z1,Y);
      TeeVertex3D(X,Z0,Y);
    end;
    glEnd;
    EndBrushBitmap;

    if Pen.Style<>psClear then
    begin
      GetXY(0,X,Y);
      MoveTo3D(X,Z0,Y);
      LineTo3D(X,Z1,Y);
    end;
  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); //z1-z0);
  glRotatef(180,1,0,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(z1,-1);
  DrawPieSlice(z0,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_LINE_STRIP);  // 7.07

    for t:=0 to Count-1 do
        TeeVertex2D(Points[t].X,Points[t].Y);

    glEnd;

    Assert(CheckGLError,'Polyline');

    FX:=Points[0].X;
    FY:=Points[0].Y;
  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); {$IFDEF CLR}unsafe;{$ENDIF}
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;
    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(PGLFloat(@tmpNormal));
    SetColor(Brush.Color);
    SetBrushBitmap;
    AddPoints;
    glEnd;
    EndBrushBitmap;
  end;

  Assert(CheckGLError,'PlaneFour3D');
end;

procedure TGLCanvas.Polygon3D(const Points: array of TPoint3D);

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

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

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

  Assert(CheckGLError,'Polygon3D');
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(Index:Integer);
var tmp : Integer;

  procedure VectorFont(FontMode:Integer);
  begin
    if not wglUseFontOutlines(GetDCHandle,32,TeeFontListRange,FontCache[Index].Offset,
                       0,FontExtrusion,FontMode,nil) then
    begin
      tmp:=GetLastError;
      Assert(tmp=0,'UseFontOutlines: '+IntToStr(tmp));
    end;
  end;

begin
  case FontStyle of
    fsBitmap: begin
                // Dont know why, only accepts 224 (TeeFontListRange-1)
                if not wglUseFontBitmaps(GetDCHandle,32,TeeFontListRange-1,FontCache[Index].Offset) then
                begin
                  tmp:=GetLastError;
                  Assert(tmp=0,'UseFontBitmaps: '+IntToStr(tmp));
                end;
              end;
   fsOutline: VectorFont(WGL_FONT_LINES);
  else
    VectorFont(WGL_FONT_POLYGONS);
  end;
end;
{$ENDIF}

Function TGLCanvas.FontWeight:Integer;
begin
  if fsBold in Font.Style then
     result:=FW_BOLD
  else
     result:=FW_NORMAL;
end;

Procedure TGLCanvas.InitOpenGLFont;

  Function FontPitch:Cardinal;
  begin
    case Font.Pitch of
      fpVariable: result:=VARIABLE_PITCH;
      fpFixed: result:=FIXED_PITCH;
    else
      result:=DEFAULT_PITCH;
    end;
  end;

{$IFNDEF LINUX}
var Old,
    HFont    : THandle;
    tmpItalic,
    tmpUnderline,
    tmpStrike : Boolean;
{$ENDIF}
begin
  {$IFNDEF LINUX}
  tmpItalic:=fsItalic in Font.Style;
  tmpUnderline:=fsUnderline in Font.Style;
  tmpStrike:=fsStrikeOut in Font.Style;

  HFont := CreateFont(-12, 0, 0, 0, FontWeight,
		      Cardinal(tmpItalic), Byte(tmpUnderline),
                      Cardinal(tmpStrike),
                      {$IFDEF CLX}Cardinal{$ENDIF}(Font.Charset),
		      OUT_DEFAULT_PRECIS,
                      CLIP_DEFAULT_PRECIS,
                      TeeFontAntiAlias, // DEFAULT_QUALITY {DRAFT_QUALITY},
		      FontPitch or FF_DONTCARE {FIXED_PITCH or FF_MODERN},
                      {$IFNDEF CLR}PAnsiChar{$ENDIF}(Font.Name));

  Old:=SelectObject(GetDCHandle, HFont);
  FontCache[INumFonts].Offset:=(INumFonts+1)*1000;
  CreateFontOutlines(INumFonts);
  DeleteObject(SelectObject(GetDCHandle,Old));

  FontCache[INumFonts].Name:=Font.Name;
  FontCache[INumFonts].Weight:=FontWeight;
  FontCache[INumFonts].Style:=Font.Style;
  {$ENDIF}
end;

Procedure TGLCanvas.TextOut3D(X,Y,Z:Integer; const Text:String);

  Function FindFont:Integer;
  var t : Integer;
  begin
    for t:=0 to INumFonts-1 do
    with FontCache[t] do
    if (Name=Font.Name) and
       (Weight=FontWeight) and
       (Style=Font.Style) then
    begin
      result:=t;
      exit;
    end;

    if INumFonts<TeeMaxFonts then
    begin
      InitOpenGLFont;
      result:=INumFonts;
      Inc(INumFonts);
    end
    else result:=0;
  end;

var tmp       : TSize;
    tmpLength : Integer;
    tmpSize   : Double;
    tmpAlign  : Integer;
    tmpFont   : Integer;
begin
  tmpFont:=FindFont;

  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 FontExtrusion>0 then
     glEnable(GL_CULL_FACE);

  glPushMatrix;

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

(*
  if FTextToViewer
  With View3DOptions do
  begin
    glRotatef(360-Tilt, 0, 0, 1);
    glRotatef(360-RotationFloat, 0, 1, 0);
    if not Orthogonal then glRotatef(360+ElevationFloat, 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;
  glScalef(tmpSize*TeeTextWidthFactor,tmpSize*TeeTextHeightFactor,1);

  TeeNormal(0,0,1);

  glListBase(FontCache[tmpFont].Offset-32);

  if Assigned(IFont) then
  With IFont.Shadow do
  if (HorizSize<>0) or (VertSize<>0) then
  begin
    //if Transparency>0 then
    //   tmpBlend:=BeginBlending(RectText(tmpX,tmpY),Transparency)
    //else
    //   tmpBlend:=nil;

    glPushMatrix;
    glTranslatef(0.03*HorizSize,-0.03*VertSize,-0.1);

    SetColor(Color);

    if FontStyle=fsBitmap then
       glRasterPos3f(x+1+0.03*HorizSize,-y-2-0.03*VertSize,-z+2);

    glCallLists(tmpLength, GL_UNSIGNED_BYTE,
      {$IFNDEF CLR}PChar{$ENDIF}(Text));

    //if Transparency>0 then EndBlending(tmpBlend);

    glPopMatrix;
  end;

  SetColor(Font.Color);

  if FontStyle=fsBitmap then
     glRasterPos2i(0,0);

  glCallLists(tmpLength, GL_UNSIGNED_BYTE, {$IFNDEF CLR}PChar{$ENDIF}(Text));

  glPopMatrix;
  Assert(CheckGLError,'TextOut3D');

  if FontExtrusion>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;