teeglcanvas.pas

BCB第三方组件

      begin
        tmpLine:=PByteArray(ScanLine[t]);

        for tt:=0 to Width-1 do
        begin
          tmpPos:=t*Height+tt;
          tmpPos2:=tt*BytesPerPixel;

          With ITextures[NumTextures-1] do
          begin
            bits^[tmpPos,0]:=tmpLine[tmpPos2+2];
            bits^[tmpPos,1]:=tmpLine[tmpPos2+1];
            bits^[tmpPos,2]:=tmpLine[tmpPos2+0];
            bits^[tmpPos,3]:=255;
          end;
        end;
      end;
    end;

    glPixelStorei(GL_UNPACK_ALIGNMENT, 4);

    {$IFNDEF LINUX}
    glGenTextures(1, @ITextures[NumTextures-1].GLTexture);
    Assert(CheckGLError,'GenTextures');
    glBindTexture(GL_TEXTURE_2D, ITextures[NumTextures-1].GLTexture);
    Assert(CheckGLError,'BinTexture');
    {$ENDIF}

    if TeeWrapTextures then tmpMode:=GL_REPEAT
                       else tmpMode:=GL_CLAMP;

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, tmpMode);
    Assert(CheckGLError,'TexParam1');
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, tmpMode);
    Assert(CheckGLError,'TexParam2');

    tmp:=GL_NEAREST;
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, tmp);
    Assert(CheckGLError,'TexParam3');
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, tmp);
    Assert(CheckGLError,'TexParam4');

    With ABitmap do
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0,
                   GL_RGBA, GL_UNSIGNED_BYTE, ITextures[NumTextures-1].Bits);

    Assert(CheckGLError,'TextImage2D');

    result:=ITextures[NumTextures-1].GLTexture;

  end
  else result:={$IFDEF LINUX}False{$ELSE}0{$ENDIF};

  {$ELSE}
  result:=0;

  {$ENDIF}
end;

procedure TGLCanvas.StretchDraw(const Rect: TRect; Graphic: TGraphic);
var tmp : TBitmap;
    Old : Boolean;
begin
  if Assigned(Graphic) then
  begin
    if Graphic is TBitmap then
       tmp:=TBitmap(Graphic)
    else
    begin
      tmp:=TBitmap.Create;
      tmp.Assign(Graphic);
    end;

    Old:=TeeWrapTextures;
    TeeWrapTextures:=False;

    if SetBrushBitmap(tmp) then
    begin
      glDisable(GL_TEXTURE_GEN_S);  // 7.02
      glDisable(GL_TEXTURE_GEN_T);
      glColor3f(1, 1, 1);
      InternalRectangle(Rect);
      EndBrushBitmap(tmp);
    end;

    TeeWrapTextures:=Old;

    if not (Graphic is TBitmap) then
       tmp.Free;

    Assert(CheckGLError,'StretchDraw');
  end;
end;

procedure TGLCanvas.Draw(X, Y: Integer; Graphic: TGraphic);
begin
  if Assigned(Graphic) then
     StretchDraw(TeeRect(X,Y,X+Graphic.Width,Y+Graphic.Height),Graphic);
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,GradientZ);
      SetColor(AStartColor);
      TeeVertex3D(Right,Top,GradientZ);
      TeeVertex3D(Left, Top,GradientZ);
      SetColor(AEndColor);
      TeeVertex3D(Left, Bottom,GradientZ);
    end;
  end;

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

  Procedure DoDiagonal(AStartColor,AEndColor:TColor);

    procedure SetMidColor(A,B:TColor); {$IFDEF CLR}unsafe;{$ENDIF}
    var tmpA, tmpB : GLMat;
    begin
      ColorToGL(A,tmpA);
      ColorToGL(B,tmpB);
      tmpA[0]:=(tmpA[0]+tmpB[0])*0.5;
      tmpA[1]:=(tmpA[1]+tmpB[1])*0.5;
      tmpA[2]:=(tmpA[2]+tmpB[2])*0.5;

      glColor4fv(PGLFloat(@tmpA));
    end;

  begin
    With Rect do
    begin
      SetColor(AEndColor);
      TeeVertex3D(Right,Bottom,GradientZ);
      SetMidColor(AEndColor, AStartColor);
      TeeVertex3D(Right,Top,GradientZ);
      SetColor(AStartColor);
      TeeVertex3D(Left, Top,GradientZ);
      SetMidColor(AEndColor, AStartColor);
      TeeVertex3D(Left, Bottom,GradientZ);
    end;
  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;

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

  RectCenter(Bounds,FXCenter,FYCenter);
  glTranslatef(0, FHeight, 0);
  Assert(CheckGLError,'DisableRotation');
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(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer);
begin
  Assert(CheckGLError,'Arc');
//  gluPartialDisk
end;

Function TGLCanvas.BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend;
begin
  if Transparency>0 then
  begin
    glEnable(GL_BLEND);
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
  end;

  ITransp:=(100-Transparency)*0.01;
  result:=nil;
end;

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

  if not IAntiAlias 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);