teeglcanvas.pas

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

    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
    begin
      With Points[t] do
      begin
        TeeNormal(x,y,z);
        glTexCoord3i(x,y,z);
        TeeVertex3D(x,y,z);
      end;
    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 FontMode : Integer;
begin
  if FontOutlines then FontMode:=WGL_FONT_LINES
                  else FontMode:=WGL_FONT_POLYGONS;

  wglUseFontOutlines(GetDCHandle,32,TeeFontListRange,FontCache[Index].Offset,
                     0.1,
                     FontExtrusion,FontMode,nil);

  Assert(CheckGLError,'InitFont');
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-Rotation, 0, 1, 0);
    if not Orthogonal then glRotatef(360+Elevation, 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*1.41,tmpSize*1.6,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);

    SetColor(Color);

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

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

    glPopMatrix;
  end;

  SetColor(Font.Color);

  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;

Function TGLCanvas.GetSupportsFullRotation:Boolean;
begin
  result:=True;
end;

Function TGLCanvas.GetTextAlign:TCanvasTextAlign;
begin
  result:=FTextAlign;
end;

Function TGLCanvas.GetUseBuffer:Boolean;
begin
  result:=FUseBuffer;
end;

Procedure TGLCanvas.SetUseBuffer(Value:Boolean);
begin
  FUseBuffer:=Value;
  IDestCanvas:=nil;
  DeleteFont;
  DeleteTextures;
end;

Procedure TGLCanvas.DeleteFont;
var t : Integer;
begin
  for t:=0 to INumFonts-1 do
  begin
    glDeleteLists(FontCache[t].Offset,TeeFontListRange);
    Assert(CheckGLError,'DeleteFont '+IntToStr(FSavedError));
  end;

  INumFonts:=0;
end;

Function TGLCanvas.GetHandle:TTeeCanvasHandle;
begin
  result:=FDC;
end;

Procedure TGLCanvas.DoHorizLine(X0,X1,Y:Integer);
begin
  MoveTo(X0,Y);
  LineTo(X1,Y);
end;

Procedure TGLCanvas.DoVertLine(X,Y0,Y1:Integer);
begin
  MoveTo(X,Y0);
  LineTo(X,Y1);
end;

procedure TGLCanvas.RotateLabel3D(x,y,z:Integer; Const St:String; RotDegree:Double);
begin
  glPushMatrix;
  glTranslatef(x,-y,0);
  glRotatef(RotDegree,0,0,1);
  glTranslatef(-x,y,z);
  TextOut(X,Y,St);
  glPopMatrix;
  Assert(CheckGLError,'RotateLabel3D');
end;

procedure TGLCanvas.RotateLabel(x,y:Integer; Const St:String; RotDegree:Double);
begin
  RotateLabel3D(x,y,0,St,RotDegree);
end;

Procedure TGLCanvas.Line(X0,Y0,X1,Y1:Integer);
begin
  MoveTo(X0,Y0);
  LineTo(X1,Y1);
end;

// Nothing to do here. OpenGL already clears it...
procedure TGLCanvas.EraseBackground(const Rect: TRect);
begin
end;

Procedure TGLCanvas.HorizLine3D(Left,Right,Y,Z:Integer);
begin
  MoveTo3D(Left,Y,Z);
  LineTo3D(Right,Y,Z);
end;

Procedure TGLCanvas.VertLine3D(X,Top,Bottom,Z:Integer);
begin
  MoveTo3D(X,Top,Z);
  LineTo3D(X,Bottom,Z);
end;

Procedure TGLCanvas.ZLine3D(X,Y,Z0,Z1:Integer);
begin
  MoveTo3D(X,Y,Z0);
  LineTo3D(X,Y,Z1);
end;

Procedure TGLCanvas.Arrow( Filled:Boolean;
                           Const FromPoint,ToPoint:TPoint;
                           ArrowWidth,ArrowHeight,Z:Integer;
                           const ArrowPercent:Double);
Var x    : Double;
    y    : Double;
    SinA : Double;
    CosA : Double;

    Function CalcArrowPoint:TPoint;
    Begin
      result.X:=Round( x*CosA + y*SinA);
      result.Y:=Round(-x*SinA + y*CosA);
    end;

Var tmpHoriz  : Integer;
    tmpVert   : Integer;
    dx        : Integer;
    dy        : Integer;
    tmpHoriz4 : Double;
    xb        : Double;
    yb        : Double;
    l         : Double;

   { These are the Arrows points coordinates }
    To3D,pc,pd,pe,pf,pg,ph:TPoint;

    (*           pc
                   |\
    ph           pf| \
      |------------   \ ToPoint
 From |------------   /
    pg           pe| /
                   |/
                 pd
    *)
begin
  Assert(CheckGLError,'BeforeArrow');
  dx := ToPoint.x-FromPoint.x;
  dy := FromPoint.y-ToPoint.y;

  l  := TeeDistance(dx,dy);

  if l>0 then  { if at least one pixel... }
  Begin
    tmpHoriz:=ArrowWidth;
    tmpVert :=Math.Min(Round(l),ArrowHeight);
    SinA:= dy / l;
    CosA:= dx / l;
    xb:= ToPoint.x*CosA - ToPoint.y*SinA;
    yb:= ToPoint.x*SinA + ToPoint.y*CosA;
    x := xb - tmpVert;
    y := yb - tmpHoriz/2;
    pc:=CalcArrowPoint;
    y := yb + tmpHoriz/2;
    pd:=CalcArrowPoint;

    if Filled then
    Begin
      tmpHoriz4:=tmpHoriz*(ArrowPercent*0.005);
      y := yb - tmpHoriz4;
      pe:=CalcArrowPoint;
      y := yb + tmpHoriz4;
      pf:=CalcArrowPoint;
      x := FromPoint.x*cosa - FromPoint.y*sina;
      y := yb - tmpHoriz4;
      pg:=CalcArrowPoint;
      y := yb + tmpHoriz4;
      ph:=CalcArrowPoint;
      To3D:=ToPoint;

      PolygonWithZ([ph,pg,pe,pf],Z);
      PolygonWithZ([pc,To3D,pd],Z);
    end
    else
    begin
      MoveTo3D(FromPoint.x,FromPoint.y,z);
      LineTo3D(ToPoint.x,ToPoint.y,z);
      LineTo3D(pd.x,pd.y,z);
      MoveTo3D(ToPoint.x,ToPoint.y,z);
      LineTo3D(pc.x,pc.y,z);
    end;
  end;

  Assert(CheckGLError,'Arrow');
end;

Procedure TGLCanvas.LineWithZ(X0,Y0,X1,Y1,Z:Integer);
begin
  MoveTo3D(X0,Y0,Z);
  LineTo3D(X1,Y1,Z);
end;

procedure TGLCanvas.PolygonWithZ(const Points: array of TPoint; Z:Integer);

  Procedure AddPoints;
  var t : Integer;
  begin
    fo