teeglcanvas.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

  end;

begin
  Assert(CheckGLError,'Before GradientFill');
  glBegin(GL_QUADS);

  TeeNormal(0,0,-1);
  Case Direction of
     gdTopBottom  : DoVertical(EndColor,StartColor);
     gdBottomTop  : DoVertical(StartColor,EndColor);
     gdLeftRight  : DoHorizontal(EndColor,StartColor);
     gdRightLeft  : DoHorizontal(StartColor,EndColor);
     gdFromBottomLeft,
     gdDiagonalDown: DoDiagonal(StartColor,EndColor);
     gdFromTopLeft,
     gdDiagonalUp:   DoDiagonal(EndColor,StartColor);
  else
     // gdFromCenter : ;
  end;

  glEnd;
  Assert(CheckGLError,'GradientFill');
end;

Procedure TGLCanvas.RectangleY(Left,Top,Right,Z0,Z1:Integer);
begin
  if Brush.Style<>bsClear then
  begin
    SetColor(Brush.Color);
    SetBrushBitmap;

    glBegin(GL_QUADS);
    TeeNormal(0,1,0);
    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.InternalRectangle(const Rect: TRect);
begin
  glBegin(GL_QUADS);
  TeeNormal(0,0,-1);

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

  glEnd;
end;

procedure TGLCanvas.FillRect(const Rect: TRect);
begin
  if Brush.Style<>bsClear then
  begin
    SetColor(Brush.Color);
    SetBrushBitmap;
    InternalRectangle(Rect);
    EndBrushBitmap;
  end;

  Assert(CheckGLError,'FillRect '+IntToStr(FSavedError));
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
  Slices=90;
  PiStep=Pi/(1440.0/Slices);

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 Slices+5 do
    begin
      SinCos(t*piStep,tmpSin,tmpCos);
      glVertex3d(XC+XR*tmpSin,-(YC-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 Slices do
    begin
      SinCos(t*piStep,tmpSin,tmpCos);
      glVertex3d(XC+XR*tmpSin,-(YC-YR*tmpCos),-Z);
    end;

    glEnd;
  end;

  Assert(CheckGLError,'EllipseWithZ');
end;

Procedure TGLCanvas.EnableRotation;
begin
  glMatrixMode(GL_PROJECTION);
  glPopMatrix;

  glMatrixMode(GL_MODELVIEW);
  glPopMatrix;
  Assert(CheckGLError,'EnableRotation');

  if FIs3D then
  begin
    glEnable(GL_DEPTH_TEST);
    glEnable(GL_LIGHTING);
  end;
end;

Procedure TGLCanvas.DisableRotation;
begin
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;

  FDepth:=0;
  glOrtho(0,FWidth+1,0,FHeight+1,0.1,-400);  // 7.0
  Assert(CheckGLError,'Orthogonal');

  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;

  RectCenter(Bounds,FXCenter,FYCenter);
  glTranslatef( 0, FHeight, 0);
  Assert(CheckGLError,'DisableRotation');

  if FIs3D then
  begin
    glDisable(GL_DEPTH_TEST);
    glDisable(GL_LIGHTING);
  end;
end;

function TGLCanvas.GetPixel3D(X,Y,Z:Integer): TColor;
begin
  result:=clWhite;  // TODO
end;

procedure TGLCanvas.SetPixel3D(X,Y,Z:Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    glBegin(GL_POINTS);
    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_POINTS);
    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;
  if not TeeSmooth then
     glDisable(GL_BLEND);
end;

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

procedure TGLCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var Step, XC,YC : Double;
    Theta,Theta2  : Extended;
    tmpSin,tmpCos : Extended;
    t : Integer;
    tmpX, tmpY    : Double;
    P : Array[0..NumCirclePoints-1] of TPoint;
begin
  CalcPieAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4,Theta,Theta2);

  Step:=(Theta2-Theta)/(NumCirclePoints-1);

  XC:=(X2+X1)*0.5;
  YC:=(Y2+Y1)*0.5;

  P[0].X:=Round(XC);
  P[0].Y:=Round(YC);

  tmpX:=XC-X1;
  tmpY:=YC-Y1;

  for t:=1 to NumCirclePoints-1 do
  begin
    SinCos(((Pi*0.5)+Theta+(t*Step))*TeePiStep,tmpSin,tmpCos);
    P[t].X:=Round(XC+(tmpX*tmpCos+tmpY*tmpSin));
    P[t].Y:=Round(YC+(-tmpX*tmpSin+tmpY*tmpCos));
  end;

  Polygon(P);

  Assert(CheckGLError,'Pie');
end;

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

Const NumSliceParts=16;

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

  Procedure GetXY(t:Integer; var x,y:Integer);
  begin
    SinCos(((Pi*0.5)+StartAngle)+(t*piStep),tmpSin,tmpCos);
    X:=Trunc(tmpXRadius*tmpSin);
    Y:=Trunc(tmpYRadius*tmpCos);
  end;

  Procedure DrawPieSlice(z,ANormal:Integer);

    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_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); {$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;