tecanvas.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 2,088 行 · 第 1/5 页

  result.TopLeft:=Calculate3DPosition(R.TopLeft,Z);
  result.BottomRight:=Calculate3DPosition(R.BottomRight,Z);
end;

Function TCanvas3D.Calculate3DPosition(P:TPoint; z:Integer):TPoint;
begin
  result:=Calculate3DPosition(P.X,P.Y,z)
end;

procedure TCanvas3D.Cube(const R: TRect; Z0, Z1: Integer;
  DarkSides: Boolean);
begin
  with R do Cube(Left,Right,Top,Bottom,Z0,Z1,DarkSides);
end;

function TCanvas3D.FourPointsFromRect(const R: TRect;
  Z: Integer): TFourPoints;
begin
  With R do
  begin
    result[0]:=Calculate3DPosition(TopLeft,Z);
    result[1]:=Calculate3DPosition(Right,Top,Z);
    result[2]:=Calculate3DPosition(BottomRight,Z);
    result[3]:=Calculate3DPosition(Left,Bottom,Z);
  end;
end;

procedure TCanvas3D.LineWithZ(const FromPoint, ToPoint: TPoint;
  Z: Integer);
begin
  LineWithZ(FromPoint.X,FromPoint.Y,ToPoint.X,ToPoint.Y,Z)
end;

procedure TCanvas3D.PlaneWithZ(const P: TFourPoints; Z: Integer);
begin
  PlaneWithZ(P[0],P[1],P[2],P[3],Z);
end;

function TCanvas3D.RectFromRectZ(const R: TRect; Z: Integer): TRect;
var P : TFourPoints;
begin
  P:=FourPointsFromRect(R,Z);
  result:=RectFromPolygon(P,4);
end;

procedure TCanvas3D.RotatedEllipse(Left, Top, Right, Bottom, Z: Integer;
  const Angle: Double);
const NumCirclePoints=64;
Var P       : Array[0..NumCirclePoints-1] of TPoint;
    Points  : TTrianglePoints;
    PiStep  : Double;
    t       : Integer;
    tmpX    : Double;
    tmpY    : Double;
    XCenter : Double;
    YCenter : Double;
    XRadius : Double;
    YRadius : Double;
    tmpSin  : Extended;
    tmpCos  : Extended;
    tmpSinAngle  : Extended;
    tmpCosAngle  : Extended;
    Old     : TPenStyle;
begin
  XCenter:=(Right+Left)*0.5;
  YCenter:=(Bottom+Top)*0.5;
  XRadius:=XCenter-Left;
  YRadius:=YCenter-Top;

  piStep:=2*pi/(NumCirclePoints-1);

  SinCos(Angle*TeePiStep,tmpSinAngle,tmpCosAngle);

  for t:=0 to NumCirclePoints-1 do
  begin
    SinCos(t*piStep,tmpSin,tmpCos);
    tmpX:=XRadius*tmpSin;
    tmpY:=YRadius*tmpCos;

    P[t].X:=Round(XCenter+(tmpX*tmpCosAngle+tmpY*tmpSinAngle));
    P[t].Y:=Round(YCenter+(-tmpX*tmpSinAngle+tmpY*tmpCosAngle));
  end;

  if Brush.Style<>bsClear then
  begin
    Old:=Pen.Style;
    Pen.Style:=psClear;

    Points[0].X:=Round(XCenter);
    Points[0].Y:=Round(YCenter);
    Points[1]:=P[0];
    Points[2]:=P[1];
    PolygonWithZ(Points,Z);

    Points[1]:=P[1];
    for t:=2 to NumCirclePoints-1 do
    begin
      Points[2]:=P[t];
      PolygonWithZ(Points,Z);
      Points[1]:=P[t];
    end;

    Pen.Style:=Old;
  end;

  if Pen.Style<>psClear then Polyline(P,Z);
end;

procedure TCanvas3D.StretchDraw(const Rect: TRect; Graphic: TGraphic;
  Z: Integer);
{$IFNDEF CLX}
Const BytesPerPixel=3;
{$ENDIF}
var x,y,
    tmpW,
    tmpH  : Integer;
    DestW,
    DestH : Double;
    R     : TRect;
    Bitmap : TBitmap;
    {$IFNDEF CLX}
    tmpScan : PByteArray;
    Line    : PByteArray;
    Dif     : Integer;
    P       : PChar;
    {$ELSE}
    tmpCanvas : TCanvas;
    {$ENDIF}
begin
  Pen.Style:=psClear;

  if Graphic is TBitmap then
  begin
    Bitmap:=TBitmap(Graphic);
    Bitmap.PixelFormat:=TeePixelFormat;
  end
  else
  begin
    Bitmap:=TBitmap.Create;
    Bitmap.PixelFormat:=TeePixelFormat;
    {$IFNDEF CLX}
    Bitmap.IgnorePalette:=True;
    {$ENDIF}
    Bitmap.Assign(Graphic);
  end;

  tmpW:=Bitmap.Width;
  tmpH:=Bitmap.Height;
  DestH:=(Rect.Bottom-Rect.Top)/tmpH;
  DestW:=(Rect.Right-Rect.Left)/tmpW;

  {$IFNDEF CLX}
  Line:=Bitmap.ScanLine[0];
  Dif:=Integer(Bitmap.ScanLine[1])-Integer(Line);
  {$ELSE}
  tmpCanvas:=Bitmap.Canvas;
  {$ENDIF}

  R.Top:=Rect.Top;

  for y:=0 to tmpH-1 do
  begin
    {$IFNDEF CLX}
    tmpScan:=PByteArray(Integer(Line)+Dif*y);
    {$ENDIF}

    R.Bottom:=Rect.Top+Round(DestH*(y+1));

    R.Left:=Rect.Left;
    for x:=0 to tmpW-1 do
    begin
      R.Right:=Rect.Left+Round(DestW*(x+1));

      {$IFDEF CLX}
       {$IFDEF D7}
       Brush.Color:=tmpCanvas.Pixels[x,y];
       {$ELSE}
        {$IFDEF MSWINDOWS}
        Brush.Color:=Windows.GetPixel(QPainter_handle(tmpCanvas.Handle), X, Y);
        {$ELSE}
        Brush.Color:=0; // Not implemented.
        {$ENDIF}
       {$ENDIF}
      {$ELSE}
      p:=@tmpScan[X*BytesPerPixel];
      Brush.Color:= Byte((p+2)^) or (Byte((p+1)^) shl 8) or (Byte((p)^) shl 16);
      {$ENDIF}

      RectangleWithZ(R,Z);
      R.Left:=R.Right;
    end;

    R.Top:=R.Bottom;
  end;

  if not (Graphic is TBitmap) then Bitmap.Free;
end;

{ TTeeCanvas3D }
Constructor TTeeCanvas3D.Create;
begin
  inherited;
  FontZoom:=100;
  IZoomText:=True;
  FBufferedDisplay:=True;
  FDirty:=True;
  FTextAlign:=TA_LEFT;
end;

Procedure TTeeCanvas3D.DeleteBitmap;
begin
  {$IFDEF CLX}
  if Assigned(FBitmap) and QPainter_isActive(FBitmap.Canvas.Handle) then
     QPainter_end(FBitmap.Canvas.Handle);
  {$ENDIF}
  FreeAndNil(FBitmap);
end;

Destructor TTeeCanvas3D.Destroy;
begin
  DeleteBitmap;
  inherited;
end;

Procedure TTeeCanvas3D.TextOut(X,Y:Integer; const Text:String);
{$IFNDEF CLX}
var tmpDC  : TTeeCanvasHandle;
{$ENDIF}

  {$IFDEF CLX}
  Procedure InternalTextOut(AX,AY:Integer);
  var tmp : Integer;
  begin
    tmp:=TextAlign;
    if tmp>=TA_BOTTOM then
    begin
      Dec(AY,TextHeight(Text));
      Dec(tmp,TA_BOTTOM);
    end;

    if tmp=TA_RIGHT then
       Dec(AX,TextWidth(Text))
    else
    if tmp=TA_CENTER then
       Dec(AX,TextWidth(Text) div 2);

    FCanvas.TextOut(AX,AY,Text);
  end;

  {$ELSE}

  Function IsTrueTypeFont:Boolean;
  var tmpMet : TTextMetric;
  begin
    GetTextMetrics(tmpDC,tmpMet);
    result:=(tmpMet.tmPitchAndFamily and TMPF_TRUETYPE)=TMPF_TRUETYPE;
  end;
  {$ENDIF}

  Function RectText(tmpX,tmpY:Integer):TRect;
  var tmpW : Integer;
      tmpH : Integer;
      tmp  : Integer;
  begin
    tmpW:=TextWidth(Text);
    tmpH:=TextHeight(Text);

    tmp:=TextAlign;
    if tmp>=TA_BOTTOM then Dec(tmp,TA_BOTTOM);

    if tmp=TA_RIGHT then
       result:=TeeRect(tmpX-tmpW,tmpY,tmpX,tmpY+tmpH)
    else
    if tmp=TA_CENTER then
       result:=TeeRect(tmpX-(tmpW div 2),tmpY,tmpX+(tmpW div 2),tmpY+tmpH)
    else
       result:=TeeRect(tmpX,tmpY,tmpX+tmpW,tmpY+tmpH);
  end;

  {$IFNDEF CLX}
  Procedure CreateFontPath;
  begin
    BeginPath(tmpDC);
    Windows.TextOut(tmpDC,X, Y, PChar(Text),Length(Text));
    EndPath(tmpDC);
  end;
  {$ENDIF}

Var tmpX     : Integer;
    tmpY     : Integer;
    {$IFDEF CLX}
    tmpColor : TColor;
    {$ELSE}
    tmpFontGradient : Boolean;
    tmpFontOutLine  : Boolean;
    {$ENDIF}
    tmpBlend : TTeeBlend;
begin
  {$IFNDEF CLX}
  tmpDC:=FCanvas.Handle;
  {$ENDIF}

  if Assigned(IFont) and Assigned(IFont.FShadow) then
  With IFont.FShadow do
  if (HorizSize<>0) or (VertSize<>0) then
  begin
    if HorizSize<0 then
    begin
      tmpX:=X;
      Dec(X,HorizSize);
    end
    else tmpX:=X+HorizSize;

    if VertSize<0 then
    begin
      tmpY:=Y;
      Dec(Y,VertSize);
    end
    else tmpY:=Y+VertSize;

    if Transparency>0 then
       tmpBlend:=BeginBlending(RectText(tmpX,tmpY),Transparency)
    else
       tmpBlend:=nil;

    {$IFNDEF CLX}
    SetTextColor(tmpDC, ColorToRGB(IFont.Shadow.Color));
    Windows.TextOut(tmpDC,tmpX, tmpY, PChar(Text),Length(Text));
    {$ELSE}
    tmpColor:=FCanvas.Font.Color;
    FCanvas.Font.Color:=ColorToRGB(IFont.Shadow.Color);
    InternalTextOut(tmpX,tmpY);
    FCanvas.Font.Color:=tmpColor;
    {$ENDIF}

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

  {$IFDEF CLX}
  FCanvas.Font.Color:=ColorToRGB(FFont.Color);
  {$ELSE}
  SetTextColor(tmpDC, ColorToRGB(FFont.Color));
  {$ENDIF}

  {$IFNDEF CLX}
  if Assigned(IFont) then // and IsTrueTypeFont then 5.03 (slow)
  begin
    with IFont do
    begin
      tmpFontOutLine:=Assigned(FOutline) and (FOutLine.Visible);
      tmpFontGradient:=Assigned(FGradient) and (FGradient.Visible);
    end;

    if tmpFontOutLine or tmpFontGradient then
    begin
      if tmpFontOutLine then AssignVisiblePen(IFont.FOutLine)
                        else Pen.Style:=psClear;

      Brush.Color:=FFont.Color;
      Brush.Style:=bsSolid;

      tmpDC:=FCanvas.Handle;
      BackMode:=cbmTransparent;

      CreateFontPath;

      if tmpFontGradient then
      begin
        if IFont.FGradient.Outline then WidenPath(tmpDC);

        SelectClipPath(tmpDC,RGN_AND);

        IFont.FGradient.Draw(Self,RectText(x,y));
        UnClipRectangle;

        if IFont.FGradient.Outline then exit;

        // Create path again...
        if tmpFontOutLine then
        begin
          CreateFontPath;
          Brush.Style:=bsClear;
        end;
      end;

      if tmpFontOutLine then
         if IFont.Color=clNone then StrokePath(tmpDC)
                               else StrokeAndFillPath(tmpDC);
    end
    else Windows.TextOut(tmpDC,X, Y, PChar(Text),Length(Text));
  end
  else Windows.TextOut(tmpDC,X, Y, PChar(Text),Length(Text));
  {$ELSE}
  InternalTextOut(x,y);
  {$ENDIF}
end;

procedure TTeeCanvas3D.Rectangle(X0,Y0,X1,Y1:Integer);
begin
  {$IFNDEF CLX}
  Windows.Rectangle(FCanvas.Handle,X0,Y0,X1,Y1);
  {$ELSE}
  FCanvas.Rectangle(X0,Y0,X1,Y1);
  {$ENDIF}
end;

procedure TTeeCanvas3D.RoundRect(X1,Y1,X2,Y2,X3,Y3:Integer);
begin
  {$IFNDEF CLX}
  Windows.RoundRect(FCanvas.Handle,X1,Y1,X2,Y2,X3,Y3);
  {$ELSE}
  FCanvas.RoundRect(X1,Y1,X2,Y2,X3,Y3);
  {$ENDIF}
end;

procedure TTeeCanvas3D.SetTextAlign(Align:TCanvasTextAlign);