teeglcanvas.pas

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

{******************************************}
{    TeeChart Pro OpenGL Canvas            }
{ Copyright (c) 1998-2005 by David Berneda }
{       All Rights Reserved                }
{******************************************}
unit TeeGLCanvas;
{$I TeeDefs.inc}

{$IFOPT D-}
{$C-}  // Turn off assertions if debug is not on.
{$ENDIF}

interface

uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     SysUtils,
     Classes,
     {$IFDEF CLX}
     Qt, QGraphics, QControls, Types,
     {$ELSE}
     Graphics, Controls,
     {$IFDEF D9}
     Types,
     {$ENDIF}
     {$ENDIF}

     {$IFDEF LINUX}
     OpenGLLinux,
     {$ELSE}
     OpenGL2,
     {$ENDIF}

     TeeConst, TeCanvas;

type
  GLMat=Array[0..3] of GLFloat;

  {$IFDEF LINUX}
  PGLUQuadricObj=GLUQuadricObj;
  {$ENDIF}

var
  //  TeeOpenGLFontExtrusion : Integer=0; Removed v7: Use TGLCanvas.FontExtrusion

  TeeOpenGLFontName   : {$IFDEF CLR}String{$ELSE}PChar{$ENDIF}=TeeMsg_DefaultEngFontName;

  TeeMaterialAmbient  : Double=1;
  TeeMaterialDiffuse  : Double=1;
  TeeMaterialSpecular : Double=1;

  TeeFullLightModel : GLENum= GL_FALSE;
  TeeLightLocal     : GLENum= GL_FALSE;
  TeeColorPlanes    : GLENum= GL_FRONT_AND_BACK;

  TeeTextAngleY  : Integer=0;
  TeeTextAngleZ  : Integer=0;

  TeeDefaultLightSpot:Integer=180;

  TeeSphereSlices:Integer = 32;
  TeeSphereStacks:Integer = 32;
  TeeCylinderStacks:Integer = 6;

  TeeSmooth : Boolean = False;
  TeeSmoothQuality : GLEnum = GL_FASTEST;

  TeePerspectiveQuality : GLEnum = GL_NICEST;

  TeeWrapTextures : Boolean=True;

const
  TeeFontListRange  = 256-32+1;
  TeeMaxFonts       = 10;

type
  TGLFontCache=packed record
    Offset : Integer;
    Name   : String;
    Weight : Integer;
    Style  : TFontStyles;
  end;

{$IFDEF CLR}
{$UNSAFECODE ON}
{$ENDIF}

  TGLCanvas = class({$IFDEF CLR}TTeeCanvas3D{$ELSE}TCanvas3D{$ENDIF})
  private
    { Private declarations }
    FBackColor     : TColor;
    FBackMode      : TCanvasBackMode;

    FDepth         : Integer;
    FTextAlign     : Integer;

    FWidth         : Integer;
    FHeight        : Integer;

    FOnInit        : TNotifyEvent;

    { internal }
    FDC            : TTeeCanvasHandle;

    HRC            : HGLRC;
    FX             : Integer;
    FY             : Integer;
    FZ             : Integer;
    FIs3D          : Boolean;

    { fonts }
    FontCache      : Array[0..TeeMaxFonts] of TGLFontCache;
    INumFonts      : Integer;

    FUseBuffer     : Boolean;
    IDestCanvas    : TCanvas;
    IDrawToBitmap  : Boolean;
    FSavedError    : GLEnum;

    FQuadric       : PGLUQuadricObj;
    IQuadricTexture: Boolean;

    Function CalcZoom:Double;
    Procedure DeleteTextures;
    Procedure DestroyGLContext;
    Procedure DoProjection;
    Procedure EndBrushBitmap; overload;
    Procedure EndBrushBitmap(Bitmap:TBitmap); overload;
    Function FindTexture(ABitmap:TBitmap):{$IFDEF LINUX}GLBoolean{$ELSE}GLUInt{$ENDIF};
    Function FontWeight:Integer;

    {$IFNDEF LINUX}
    Function GetDCHandle:HDC;
    {$ENDIF}

    Procedure InitMatrix;
    procedure InternalRectangle(const Rect: TRect);

    Function Quadric:PGLUQuadricObj; {$IFDEF CLR}unsafe;{$ENDIF}
    Procedure SetBrushBitmap; overload;
    Function SetBrushBitmap(Bitmap:TBitmap):Boolean; overload;
    Procedure SetColor(AColor:TColor);
    Procedure SetPen;
    Procedure TeeVertex2D(x,y:Integer); {$IFDEF D9}inline;{$ENDIF}
    Procedure TeeVertex3D(x,y,z:Integer); {$IFDEF D9}inline;{$ENDIF}
    Procedure TeeNormal(x,y,z:Integer); {$IFDEF D9}inline;{$ENDIF}
    procedure InternalCylinder(Vertical:Boolean; Left,Top,Right,Bottom,
                        Z0,Z1:Integer; Dark3D:Boolean; ConePercent:Integer);
  protected
    { Protected declarations }
    {$IFNDEF LINUX}
    Procedure CreateFontOutlines(Index:Integer);
    {$ENDIF}

    Procedure InitOpenGLFont;
    Procedure InitAmbientLight(AmbientLight:Integer);
    Procedure InitLight(Num:Integer; Const AColor:GLMat;
                        const Position,Direction:TPoint3DFloat;
                        UseDirection:Boolean;
                        const SpotDegrees:Double);
    Procedure SetShininess(Const Value:Double);
    procedure SetDrawStyle(Value:TTeeCanvasSurfaceStyle);

    { 2d }
    Function GetBackMode:TCanvasBackMode; override;
    Function GetBackColor:TColor; override;
    Function GetHandle:TTeeCanvasHandle; override;
    Function GetMonochrome:Boolean; override;
    Function GetPixel(x,y:Integer):TColor; override;
    function GetPixel3D(X,Y,Z:Integer): TColor; override;
    Function GetSupports3DText:Boolean; override;
    Function GetSupportsFullRotation:Boolean; override;
    Function GetTextAlign:TCanvasTextAlign; override;
    Function GetUseBuffer:Boolean; override;

    Procedure SetBackColor(Color:TColor); override;
    Procedure SetBackMode(Mode:TCanvasBackMode); override;
    Procedure SetMonochrome(Value:Boolean); override;
    procedure SetPixel(X, Y: Integer; Value: TColor); override;
    procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;
    Procedure SetTextAlign(Align:TCanvasTextAlign); override;
    Procedure SetUseBuffer(Value:Boolean); override;
  public
    DrawStyle      : TTeeCanvasSurfaceStyle;
    FontExtrusion  : Integer;
    FontOutlines   : Boolean;
    ShadeQuality   : Boolean;

    { Public declarations }
    Constructor Create;
    Destructor Destroy; override;

    Function CheckGLError:Boolean;

    Procedure DeleteFont;
    Procedure Repaint;

    { 3d }
    Procedure DisableRotation; override;
    Procedure EnableRotation; override;
    Procedure SetMaterialColor;

    Function BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend; override;
    procedure EndBlending(Blend:TTeeBlend); override;

    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
                     Const StartAngle,EndAngle,HolePercent:Double); override;
    procedure Draw(X, Y: Integer; Graphic: TGraphic); override;
    procedure EraseBackground(const Rect: TRect); override;
    procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
    procedure FillRect(const Rect: TRect); override;
    procedure LineTo(X,Y:Integer); override;
    procedure MoveTo(X,Y:Integer); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Rectangle(X0,Y0,X1,Y1:Integer); override;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
    procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); override;
    Procedure TextOut(X,Y:Integer; const Text:String); override;
    Procedure DoHorizLine(X0,X1,Y:Integer); override;
    Procedure DoVertLine(X,Y0,Y1:Integer); override;

    procedure ClipRectangle(Const Rect:TRect); override;
    procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); override;

    Procedure GradientFill( Const Rect:TRect;
                            StartColor,EndColor:TColor;
                            Direction:TGradientDirection;
                            Balance:Integer=50); override;
    Procedure Invalidate; override;
    Procedure Line(X0,Y0,X1,Y1:Integer); override;
    procedure Polyline(const Points:{$IFDEF D5}array of TPoint{$ELSE}TPointArray{$ENDIF}); override; // 6.0
    Procedure Polygon(const Points: array of TPoint); override;
    procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Double); override;
    procedure UnClipRectangle; override;

    { 3d }
    Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); override;
    Function Calculate3DPosition(x,y,z:Integer):TPoint; override;
    Function InitWindow( DestCanvas:TCanvas;
                         A3DOptions:TView3DOptions;
                         ABackColor:TColor;
                         Is3D:Boolean;
                         Const UserRect:TRect):TRect; override;
    Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); override;
    Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;
    Function ReDrawBitmap:Boolean; override;

    Procedure Arrow( Filled:Boolean;
                     Const FromPoint,ToPoint:TPoint;
                     ArrowWidth,ArrowHeight,Z:Integer;
                     const ArrowPercent:Double); override;

    procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                    Dark3D:Boolean; ConePercent:Integer); override;
    Procedure Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean); override;

    procedure Cylinder(Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer; DarkCover:Boolean); override;
    procedure EllipseWithZ(X1, Y1, X2, Y2, Z:Integer); override;
    Procedure HorizLine3D(Left,Right,Y,Z:Integer); override;
    procedure LineTo3D(X,Y,Z:Integer); override;
    Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer); override;
    procedure MoveTo3D(X,Y,Z:Integer); override;
    procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
                     Const StartAngle,EndAngle:Double;
                     DarkSides,DrawSides:Boolean;
                     DonutPercent:Integer=0;
                     Gradient:TCustomTeeGradient=nil); override;
    procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); override;
    procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); override;
    procedure PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); override;
    procedure Polygon3D(const Points: array of TPoint3D);
    procedure PolygonWithZ(const Points: array of TPoint; Z:Integer); override;
    procedure Pyramid(Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer; DarkSides:Boolean); override;
    Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
                           TruncX,TruncZ:Integer); override;
    Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); override;
    Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); override;
    Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); override;
    procedure RotateLabel3D(x,y,z:Integer;
                            Const St:String; RotDegree:Double); override;
    procedure Sphere(x,y,z:Integer; Const Radius:Double); override;
    Procedure Surface3D( Style:TTeeCanvasSurfaceStyle;
                         SameBrush:Boolean;
                         NumXValues,NumZValues:Integer;
                         CalcPoints:TTeeCanvasCalcPoints ); override;
    Procedure TextOut3D(X,Y,Z:Integer; const Text:String); override;
    procedure Triangle3D(Const Points:TTrianglePoints3D; Const Colors:TTriangleColors3D); override;
    procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); override;
    Procedure VertLine3D(X,Top,Bottom,Z:Integer); override;
    Procedure ZLine3D(X,Y,Z0,Z1:Integer); override;

    { events }
    property OnInit:TNotifyEvent read FOnInit write FOnInit;
  published
  end;

  TGLShape=class(TPersistent)
  private
    FBrush : TChartBrush;
    FPen   : TChartPen;
    procedure SetBrush(const Value:TChartBrush);
    procedure SetPen(const Value:TChartPen);
  protected
    procedure PushMatrix;
    procedure PopMatrix;
  public
    Canvas    : TGLCanvas;
    Rotation  : Double;
    Elevation : Double;
    Tilt      : Double;

    Constructor Create(ACanvas: TGLCanvas); virtual;
    Destructor Destroy; override;
    procedure Draw(X,Y:Integer); virtual;

    property Brush:TChartBrush read FBrush write SetBrush;
    property Pen:TChartPen read FPen write SetPen;
  end;

  TGLTorus=class(TGLShape)
  public
    Inner : Double;
    Outer : Double;
    Rings : Integer;
    Sides : Integer;

    Constructor Create(ACanvas: TGLCanvas); override;
    procedure Draw(X,Y:Integer); override;
  end;

Procedure ColorToGL(AColor:TColor; Var C:GLMat);

implementation

uses Math;

const
  TeeZoomScale     = -80000;
  TeeMinPerspective = 6; // %
  TeeSolidCubeList =   8888;
  TeeWireCubeList  = TeeSolidCubeList+1;

  {$IFDEF CLX}
  BytesPerPixel    = 4;
  {$ELSE}
  BytesPerPixel    = 3;
  {$ENDIF}

var
  ITransp:Single=1;

Function MinInteger(a,b:Integer):Integer; {$IFDEF D9}inline;{$ENDIF}
begin
  if a>b then result:=b else result:=a;
end;

Procedure ColorToGL(AColor:TColor; Var C:GLMat);
begin
  AColor:=ColorToRGB(AColor);
  C[0]:=Byte(AColor)/255;
  C[1]:=Byte(AColor shr 8)/255;
  C[2]:=Byte(AColor shr 16)/255;
  C[3]:=ITransp;
end;

{ TGLCanvas }
Constructor TGLCanvas.Create;
begin
  inherited Create;
  FUseBuffer:=True;
  FSavedError:=GL_NO_ERROR;
  FTextAlign:=TA_LEFT;
end;

Procedure TGLCanvas.DestroyGLContext;
begin
  DeleteFont;

  if HRC<>0 then
  begin

    {$IFNDEF LINUX}
    DeactivateRenderingContext;
    DestroyRenderingContext(HRC);
    {$ENDIF}

    HRC:=0;
  end;
end;

Destructor TGLCanvas.Destroy;
begin
  if Assigned(FQuadric) then
     gluDeleteQuadric(FQuadric);

  DestroyGLContext;
  DeleteTextures;
  inherited;
end;

Function TGLCanvas.CheckGLError:Boolean;
begin
  FSavedError:=glGetError;
  result:=FSavedError=GL_NO_ERROR;
//  if not result then
//     FSavedError:=FSavedError+1-1;
end;

Procedure TGLCanvas.Calculate2DPosition(Var x,y:Integer; z:Integer);
begin { nothing yet }
end;

Function TGLCanvas.Calculate3DPosition(x,y,z:Integer):TPoint;
begin
  result:=TeePoint(x,y);
end;

Procedure TGLCanvas.DoProjection;
Var tmp  : Double;
    FarZ : Integer;
    tmpW,
    tmpH : Double;
    tmpFoV : Double;
begin
  glMatrixMode(GL_PROJECTION);
  Assert(CheckGLError,'Projection');

  glLoadIdentity;
  Assert(CheckGLError,'ProjectionInit');

  FarZ:=Round(400.0*(FDepth+1));

  if (not FIs3D) or View3DOptions.Orthogonal then
  begin
    tmpW:=FWidth*0.5;
    tmpH:=FHeight*0.5;
    tmp:=100.0/CalcZoom;

    glOrtho(-tmpW*tmp,tmpW*tmp,-tmpH*tmp,tmpH*tmp,-0.1,tmp*2*FarZ);  // 7.0

    Assert(CheckGLError,'Orthogonal');

    glDisable(GL_DEPTH_TEST);
  end
  else
  begin
    glEnable(GL_DEPTH_TEST);

    tmp:=100.0/CalcZoom;
    if tmp<1 then tmp:=1;

    tmpFoV:=0.5*Math.Max(TeeMinPerspective,View3DOptions.Perspective);

    gluPerspective(tmpFoV,          // Field-of-view angle
                   FWidth/FHeight,  // Aspect ratio of viewing volume
                   1.1,             // Distance to near clipping plane
                   0.5*tmp*FarZ);       // Distance to far clipping plane

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

Procedure TGLCanvas.Projection(MaxDepth:Integer; const Bounds,Rect:TRect);
begin
  RectSize(Bounds,FWidth,FHeight);
  RectCenter(Rect,FXCenter,FYCenter);
  FDepth:=MaxDepth;

  glViewport(0, 0, FWidth, FHeight);
  Assert(CheckGLError,'ViewPort '+IntToStr(FSavedError));

  DoProjection;
  SetDrawStyle(DrawStyle);
  InitMatrix;
end;

Function TGLCanvas.CalcZoom:Double;

  Function CalcPerspective:Double;
  begin
    if FIs3D and (not View3DOptions.Orthogonal) then
       result:=Math.Max(TeeMinPerspective,View3DOptions.Perspective)*0.01
    else
       result:=1;
  end;

begin
  result:=2.0*Math.Max(1,View3DOptions.Zoom)*CalcPerspective;
end;

Procedure TGLCanvas.InitMatrix;
const tmpInv=1/255.0;
var AColor : TColor;
begin
  AColor:=ColorToRGB(FBackColor);
  glClearColor( GetRValue(AColor)*tmpInv,
                GetGValue(AColor)*tmpInv,
                GetBValue(AColor)*tmpInv,
                1);
  Assert(CheckGLError,'ClearColor');

  glDisable(GL_DITHER);

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  Assert(CheckGLError,'Clear');

  glEnable(GL_DITHER);

  glMatrixMode(GL_MODELVIEW);
  Assert(CheckGLError,'ModelView');

  glLoadIdentity;
  Assert(CheckGLError,'ModelInit');

  With View3DOptions do
       glTranslatef(HorizOffset,-VertOffset,TeeZoomScale/CalcZoom);

  if ShadeQuality then glShadeModel(GL_SMOOTH)
                  else glShadeModel(GL_FLAT);

  Assert(CheckGLError,'ShadeModel');

  With View3DOptions do
  if FIs3D then
  begin
    glRotatef(Tilt, 0, 0, 1);
    glRotatef(-Elevation, 1, 0, 0);
    glRotatef(Rotation, 0, 1, 0);
  end;

  glTranslatef( -FXCenter+RotationCenter.X,
                 FYCenter+RotationCenter.Y,
                 RotationCenter.Z+(0.5*FDepth));