Graph3D.pas

Top  Previous  Next

{*****************************************************************************}

{                                                                             }

{    Graph Package 1.0.1                                                      }

{    Date released : July 29, 2005                                            }

{    http://www.bk02.net/gpack                                                }

{    Copyright (c) 2004-2005 BK02 Team                                        }

{                                                                             }

{*****************************************************************************}

 

unit Graph3D;

 

interface

 

uses

   Types, Windows, Graphics, SysUtils, Classes, Controls, ExtCtrls, OpenGL, UnitTool;

 

const

   ResCircle=40;

   ResLine=10;

   ResZYX=20;

 

type

   ShapeStyle=(OrdCone,OrdCube,OrdCylinder,OrdLine,OrdPlane,OrdSphere,OrdTriangle,OrdZYX);

 

   TShape=record

       Expression : string[100];

       Style : ShapeStyle;

       Color : array[0..3]of TColor;

       A,B,C,R,VX0,VX1,VY0,VY1,X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:float;

   end;

 

   TGraph3D = class (TPanel)

   private

       Color: array[0..3]of TColor;

       dc: HDC;

       FActive: Boolean;

       FAxis: Boolean;

       FAxisLength: Integer;

       FColorAxis1: TColor;

       FColorAxis2: TColor;

       FColorBackground: TColor;

       IsMouseDown: Boolean;

       MouseDownX: Integer;

       MouseDownY: Integer;

       PVX0: float;

       PVX1: float;

       PVX2: float;

       PVXOld: float;

       PVY0: float;

       PVY1: float;

       PVY2: float;

       PVYOld: float;

       PVZ0: float;

       PVZ1: float;

       PVZ2: float;

       PVZOld: float;

       rc: HDC;

       TempColor: array[0..30]of TColor;

       TempX: array[0..LCount]of float;

       TempY: array[0..LCount]of float;

       TempZ: array[0..LCount]of float;

       TempS : TStringDynArray;

       FWireframe: Boolean;

       XInc: float;

       XMax: float;

       XMin: float;

       YInc: float;

       YMax: float;

       YMin: float;

       ZMax: float;

       ZMin: float;

       procedure SetActive(const Value: Boolean);

       procedure SetColor(Color:TColor);

       procedure OnMouseDownCustom(Sender: TObject; Button: TMouseButton;

           Shift: TShiftState; X, Y: Integer);

       procedure OnMouseMoveCustom(Sender: TObject; Shift: TShiftState; X, Y:

           Integer);

       procedure OnMouseUpCustom(Sender: TObject; Button: TMouseButton; Shift:

           TShiftState; X, Y: Integer);

       //Draw method

       procedure DrawElipZ(X0,Y0,Z0,R0,X1,Y1,Z1,R1:float;Color1,Color2:TColor);

       procedure DrawAxis;

       procedure DrawCone(X0,Y0,Z0,X1,Y1,Z1,R:float);

       procedure DrawCube(X0,Y0,Z0,X1,Y1,Z1:float);

       procedure DrawCylinder(X,Y,Z,A,B,C:float);

       procedure DrawLine(X0,Y0,Z0,X1,Y1,Z1:float);

       procedure DrawPlane(X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:float);

       procedure DrawSphere(X,Y,Z,R:float);

       procedure DrawTriangle(X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2:float);

       procedure DrawZYX(Expression:string;VX0,VY0,VX1,VY1:float);

   public

       Count: Integer;

       Items: array[0..MaxShape]of TShape;

       constructor Create(AOwner:TComponent); override;

       procedure Clear;

       procedure Add(s:string;Color0,Color1:TColor);

       procedure Remove(index:integer);

       procedure Replace(index : integer; S: string);

 

       procedure SaveBitmap(filename:string);

       procedure Render;

       procedure ZoomIn;

       procedure ZoomOut;

       procedure Rotate(dx,dy:float);

   published

       property Active: Boolean read FActive write SetActive;

       property Axis: Boolean read FAxis write FAxis;

       property AxisLength: Integer read FAxisLength write FAxisLength;

       property WireFrame: boolean read FWireFrame write FWireFrame;

       property ColorAxis1: TColor read FColorAxis1 write FColorAxis1;

       property ColorAxis2: TColor read FColorAxis2 write FColorAxis2;

       property ColorBackground: TColor read FColorBackground write

           FColorBackground;

   end;

 

implementation

 

{

*********************************** TGraph3D ***********************************

}

constructor TGraph3D.Create(AOwner:TComponent);

begin

   inherited;

   XMin:=-1;XMax:=1;YMin:=-1;YMax:=1;XInc:=0.1;YInc:=0.1;ZMin:=-1;ZMax:=1;

   Wireframe:=false; Axis:=true; Active := false;

   IsMouseDown:=false;

   ColorAxis1:=16744448;

   ColorAxis2:=clWhite;

   ColorBackGround:=ClBlack;

   AxisLength:=5;Count:=0;

   PVX0:=5; PVY0:=5; PVZ0:=5;

   PVX1:=0; PVY1:=0; PVZ1:=0;

   PVX2:=0; PVY2:=0; PVZ2:=1;

end;

 

procedure TGraph3D.Add(s:string;Color0,Color1:TColor);

begin

   inc(Count);

   Items[Count-1].Color[0]:= Color0;

   Items[Count-1].Color[1]:= Color1;

   Replace(Count-1, S);

end;

 

procedure TGraph3D.DrawAxis;

begin

   if not Axis then exit;

   glBegin(GL_LINES);

   SetColor(ColorAxis1);

   glVertex3f(-AxisLength,0,0);

   SetColor(ColorAxis2);

   glVertex3f(AxisLength,0,0);

   SetColor(ColorAxis1);

   glVertex3f(0,-AxisLength,0);

   SetColor(ColorAxis2);

   glVertex3f(0,AxisLength,0);

   SetColor(ColorAxis1);

   glVertex3f(0,0,-AxisLength);

   SetColor(ColorAxis2);

   glVertex3f(0,0,AxisLength);

   glEnd();

end;

 

procedure TGraph3D.DrawCone(X0,Y0,Z0,X1,Y1,Z1,R:float);

var

   i: Integer;

   Angle: float;

begin

   glBegin(GL_TRIANGLE_FAN);

   SetColor(Color[0]);

   glVertex3f(X0,Y0,Z0);

   SetColor(Color[1]);

   for i:=0 to ResCircle do

   begin

       Angle:=2*pi*i/ResCircle;

       glVertex3f(X1+R*cos(Angle),Y1+R*sin(Angle),Z1);

   end;

   glEnd();

end;

 

procedure TGraph3D.DrawCube(X0,Y0,Z0,X1,Y1,Z1:float);

begin

   glBegin(GL_QUADS);

   SetColor(clBlue);

   glVertex3f(X0,Y0,Z0);

   glVertex3f(X1,Y0,Z0);

   glVertex3f(X1,Y1,Z0);

   glVertex3f(X0,Y1,Z0);

   glVertex3f(X0,Y0,Z0);

   glVertex3f(X1,Y0,Z0);

   glVertex3f(X1,Y0,Z1);

   glVertex3f(X0,Y0,Z1);

   glVertex3f(X0,Y0,Z1);

   glVertex3f(X1,Y0,Z1);

   glVertex3f(X1,Y1,Z1);

   glVertex3f(X0,Y1,Z1);

   glVertex3f(X1,Y1,Z1);

   glVertex3f(X0,Y1,Z1);

   glVertex3f(X0,Y1,Z0);

   glVertex3f(X1,Y1,Z0);

   glVertex3f(X1,Y0,Z0);

   glVertex3f(X1,Y1,Z0);

   glVertex3f(X1,Y1,Z1);

   glVertex3f(X1,Y0,Z1);

   glVertex3f(X0,Y0,Z0);

   glVertex3f(X0,Y1,Z0);

   glVertex3f(X0,Y1,Z1);

   glVertex3f(X0,Y0,Z1);

   glEnd();

end;

 

procedure TGraph3D.DrawCylinder(X,Y,Z,A,B,C:float);

var

   i: Integer;

   Angle: float;

begin

   glBegin(GL_QUAD_STRIP);

   for i:=0 to ResCircle do

   begin

       Angle:=2*pi*i/ResCircle;

       SetColor(Color[0]);

       glVertex3f(X+A*cos(Angle),Y+B*sin(Angle),Z-C);

       SetColor(Color[1]);

       glVertex3f(X+A*cos(Angle),Y+B*sin(Angle),Z+C);

   end;

   glEnd();

end;

 

procedure TGraph3D.DrawElipZ(X0,Y0,Z0,R0,X1,Y1,Z1,R1:float;Color1,

   Color2:TColor);

var

   i: Integer;

   Angle: float;

begin

   for i:=0 to ResCircle do

   begin

       Angle:=2*pi*i/ResCircle;

       SetColor(Color1);

       glVertex3f(X0+R0*cos(Angle),Y0+R0*sin(Angle),Z0);

       SetColor(Color2);

       glVertex3f(X1+R1*cos(Angle),Y1+R1*sin(Angle),Z1);

   end;

end;

 

procedure TGraph3D.DrawLine(X0,Y0,Z0,X1,Y1,Z1:float);

begin

   glBegin(GL_LINE);

   SetColor(Color[0]);

   glVertex(X0,Y0,Z0);

   SetColor(Color[1]);

   glVertex(X1,Y1,Z1);

   glEnd();

end;

 

procedure TGraph3D.DrawPlane(X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:float);

begin

   glBegin(GL_QUADS);

   SetColor(Color[0]);

   glVertex3f(X0,Y0,Z0);

   glVertex3f(X1,Y1,Z1);

   SetColor(Color[1]);

   glVertex3f(X2,Y2,Z2);

   glVertex3f(X3,Y3,Z3);

   glEnd();

end;

 

procedure TGraph3D.DrawSphere(X,Y,Z,R:float);

var

   i: Integer;

   Z1, Z2, R1, R2, Angle: float;

begin

   InterpolateColor(Color[0],Color[1],2*ResLine+1,TempColor);

   glBegin(GL_TRIANGLE_STRIP);

   R2:=0;Z2:=-R;

   for i:=-ResLine+1 to ResLine do begin

       Angle:=(PI/2)*i/ResLine;

       Z1:=r*Sin(Angle);

       R1:=r*Cos(Angle);

       DrawElipZ(X,Y,Z+Z2,r2,X,Y,Z+Z1,R1,TempColor[i+ResLine-1],TempColor[i+ResLine]);

       R2:=R1;Z2:=Z1;

   end;

   glEnd();

end;

 

procedure TGraph3D.DrawTriangle(X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2:float);

begin

   glBegin(GL_TRIANGLES);

   SetColor(Color[0]);

   glVertex(0,0,0);

   SetColor(Color[1]);

   glVertex(0,1,0);

   SetColor(Color[2]);

   glVertex(0,1,1);

   glEnd();

end;

 

procedure TGraph3D.DrawZYX(Expression:string;VX0,VY0,VX1,VY1:float);

var

   i, j, k: Integer;

   Dx, Dy: float;

begin

   //Create Array

   Dx:=Vx1-Vx0;Dy:=Vy1-Vy0;

   for i:=0 to ResZYX do

       for j:=0 to ResZYX do begin

           TempX[i*(ResZYX+1)+j]:=VX0+i/ResZYX*Dx;

     TempY[i*(ResZYX+1)+j]:=VY0+j/ResZYX*Dy;

       end;

   //Calculate TempZ

   Evaluate(Expression,'X','Y',(ResZYX+1)*(ResZYX+1),TempX,TempY,TempZ);

   InterpolateColor(Color[0],Color[1],ResZYX+1,TempColor);

   glBegin(GL_QUADS);

   for i:=0 to ResZYX-1 do

       for j:=0 to ResZYX-1 do begin

           k:=i*(ResZYX+1)+j;

           SetColor(TempColor[i]);

           glVertex3f(TempX[k],TempY[k],TempZ[k]);

           glVertex3f(TempX[k+1],TempY[k+1],TempZ[k+1]);

           SetColor(TempColor[i+1]);

           glVertex3f(TempX[k+ResZYX+2],TempY[k+ResZYX+2],TempZ[k+ResZYX+2]);

           glVertex3f(TempX[k+ResZYX+1],TempY[k+ResZYX+1],TempZ[k+ResZYX+1]);

       end;

   glEnd();

end;

 

procedure TGraph3D.OnMouseDownCustom(Sender: TObject; Button: TMouseButton;

   Shift: TShiftState; X, Y: Integer);

begin

   IsMouseDown:=true;

   MouseDownX:=X;

   MouseDownY:=Y;

   PVXOld:=PVX0;

   PVYOld:=PVY0;

   PVZOld:=PVZ0;

end;

 

procedure TGraph3D.OnMouseMoveCustom(Sender: TObject; Shift: TShiftState; X, Y:

   Integer);

begin

   if(not IsMouseDown)then exit;

   PVX0:=PVXOld;

   PVY0:=PVYOld;

   PVZ0:=PVZOld;

   Rotate(2*(X-MouseDownX)/Width,0);

   Rotate(0,2*(MouseDownY-Y)/Height);

   Render();

end;

 

procedure TGraph3D.OnMouseUpCustom(Sender: TObject; Button: TMouseButton;

   Shift: TShiftState; X, Y: Integer);

begin

   IsMouseDown:=false;

end;

 

procedure TGraph3D.Remove(index:integer);

var

   i: Integer;

begin

   dec(Count);

   for i:=index to Count-1 do Items[i]:=Items[i+1];

   Render();

end;

 

procedure TGraph3D.Render;

var

   i, j: Integer;

begin

   if not Active then exit;

   //Configure Panel Size

   glViewport(0,0,Self.Width,Self.Height);

   glMatrixMode(GL_PROJECTION);

   glLoadIdentity();

   gluPerspective(45.0, Self.Width/Self.Height, 0.1, 500.0);

   glMatrixMode(GL_MODELVIEW);

   //Clear and set PointView

   glClearColor((colorBackground AND $000000FF) / 255,((colorBackground AND $0000FF00) DIV 256) / 255,((colorbackground AND $00FF0000) DIV 65536) / 255, 1);

   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

   glLoadIdentity();

   gluLookAt(PVX0,PVY0,PVZ0,PVX1,PVY1,PVZ1,PVX2,PVY2,PVZ2);

   if Wireframe then glPolygonmode(GL_FRONT_AND_BACK, GL_LINE)else glPolygonmode(GL_FRONT_AND_BACK, GL_FILL);

   //Draw

   DrawAxis();

   for i:=0 to Count-1 do begin

     //Set Color

     for j:=0 to 3 do Color[j]:=Items[i].Color[j];

     //Check Style

     with Items[i]do

         case Items[i].Style of

         OrdCone:DrawCone(X0,Y0,Z0,X1,Y1,Z1,R);

         OrdCube:DrawCube(X0,Y0,Z0,X1,Y1,Z1);

         OrdCylinder:DrawCylinder(X0,Y0,Z0,A,B,C);

         OrdLine:DrawLine(X0,Y0,Z0,X1,Y1,Z1);

         OrdPlane:DrawPlane(X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3);

         OrdSphere:DrawSphere(X0,Y0,Z0,R);

         OrdTriangle:DrawTriangle(X0,Y0,Z0,X1,Y1,Z1,X2,Y2,Z2);

         OrdZYX:DrawZYX(Expression,VX0,VY0,VX1,VY1);

         end;

   end;

   SwapBuffers(DC);

end;

 

procedure TGraph3D.Rotate(dx,dy:float);

var

   r, a, b: float;

begin

   ConvertV3ToS(PVX0,PVY0,PVZ0,r,a,b);

   a:=a+dx; b:=b+dy;

   if(b<=PI)and (b>=0) then begin

        ConvertSToV3(R,A,B,PVX0,PVY0,PVZ0);

        Render()

   end;

end;

 

procedure TGraph3D.SaveBitmap(filename:string);

var bmp: TBitmap;

begin

   DC := GetDC (Handle);

   bmp:=TBitmap.Create;

   bmp.Width :=width;

   bmp.Height := Height;

   BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width,bmp.Height,dc, 0, 0, SRCCOPY);

   bmp.height:=bmp.height-5;

   bmp.width :=bmp.width -5;

   bmp.savetofile(filename);

   bmp.Free;

end;

 

procedure TGraph3D.SetActive(const Value: Boolean);

var pfd: TPixelFormatDescriptor;

begin

   FActive := Value;

   if not Active then exit;

   //Initialize the Panel

   with pfd do begin

       nSize:=sizeof(pfd);

       nVersion:=1;

       dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER or 0;

       cColorBits:=16;

       iPixelType:=PFD_TYPE_RGBA;

   end;

   dc := GetDC(Self.Handle);

   SetPixelFormat(dc, ChoosePixelFormat(dc, @pfd), @pfd);

   rc :=wglCreateContext(dc);

   wglMakeCurrent(dc,rc);

   glShadeModel(GL_SMOOTH);

   glEnable(GL_DEPTH_TEST); glClearDepth(1.0); glDepthFunc(GL_LESS);

   glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);

   Self.OnMouseDown:=OnMouseDownCustom;

   Self.OnMouseMove:=OnMouseMoveCustom;

   Self.OnMouseUp:=OnMouseUpCustom;

   Render();

end;

 

procedure TGraph3D.SetColor(Color:TColor);

begin

   glColor3ub((Color and $0000FF),(Color and $00FF00)shr 8,(Color and $FF0000)shr 16);

end;

 

procedure TGraph3D.ZoomIn;

var

   R, a, b: float;

begin

   ConvertV3ToS(PVX0,PVY0,PVZ0,R,a,b);

   R:=R-1;

   ConvertSToV3(R,A,B,PVX0,PVY0,PVZ0);

   Render();

end;

 

procedure TGraph3D.ZoomOut;

var

   R, a, b: float;

begin

   ConvertV3ToS(PVX0,PVY0,PVZ0,R,a,b);

   R:=R+1;

   ConvertSToV3(R,A,B,PVX0,PVY0,PVZ0);

   Render();

end;

 

procedure TGraph3D.Replace(index: integer; S: string);

var

   i, L  : integer;

begin

   //Format S

   for i:=1 to length(S)do

       if s[i]='('then break;

   s[i]:=',';

   for i:=length(s)downto 1 do

       if s[i]=')'then break;

   delete(s,i,1);

   s:=StrDelSpc(s);

   TempS := StrSplit(s,',');

   L := length(TempS);

   //Create TempX to hold Array

   for i:=1 to L-1 do

       trystrtofloat(TempS[i],TempX[i]);

   with Items[Index]do

   if(TempS[0]='CONE')then

       begin

           Style:=OrdCone;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];

           X1:=TempX[4];Y1:=TempX[5];Z1:=TempX[6];

           R := TempX[7];

       end

   else if(TempS[0]='CUBE')then

       begin

           Style:=OrdCube;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];

           X1:=TempX[4];Y1:=TempX[5];Z1:=TempX[6];

       end

   else if(TempS[0]='CYLINDER')then

       begin

           Style:=OrdCylinder;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];

           A:=TempX[4];B:=TempX[5];C:=TempX[6];

       end

   else if(TempS[0]='LINE')then

       begin

           Style:=OrdLine;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];

           X1:=TempX[4];Y1:=TempX[5];Z1:=TempX[6];

       end

   else if(TempS[0]='PLANE')then

       begin

           Style:=OrdPlane;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];

           X1:=TempX[4];Y1:=TempX[5];Z1:=TempX[6];

           X2:=TempX[7];Y2:=TempX[8];Z2:=TempX[9];

           X3:=TempX[10];Y3:=TempX[11];Z3:=TempX[12];

       end

   else if(TempS[0]='SPHERE')then

       begin

           Style:=OrdSphere;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];R:=TempX[4];

       end

   else if(TempS[0]='TRIANGLE')then

       begin

           Style:=OrdTriangle;

           X0:=TempX[1];Y0:=TempX[2];Z0:=TempX[3];

           X1:=TempX[4];Y1:=TempX[5];Z1:=TempX[6];

           X2:=TempX[7];Y2:=TempX[8];Z2:=TempX[9];

       end

   else if(TempS[0]='ZYX')then

       begin

           Style:=OrdZYX;

           Expression:=TempS[1];

           VX0:=TempX[2];VY0:=TempX[3];

           VX1:=TempX[4];VY1:=TempX[5];

       end;

   Render();

end;

 

procedure TGraph3D.Clear;

begin

   Count := 0;

   Render();

end;

 

end.