tecanvas.pas

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

PAS
2,088
字号
    FVertOffset:=Value;
    Repaint;
    if Assigned(FOnScrolled) then FOnScrolled(False);
  end;
end;

Procedure TView3DOptions.SetOrthoAngle(Value:Integer);
begin
  SetIntegerProperty(FOrthoAngle,Value);
end;

Procedure TView3DOptions.SetOrthogonal(Value:Boolean);
begin
  SetBooleanProperty(FOrthogonal,Value);
end;

Procedure TView3DOptions.SetZoom(Value:Integer);
begin
  if FZoom<>Value then
  begin
    if Assigned(FOnChangedZoom) then FOnChangedZoom(Value);
    FZoom:=Value;
    Repaint;
  end;
end;

Procedure TView3DOptions.SetZoomText(Value:Boolean);
begin
  SetBooleanProperty(FZoomText,Value);
end;

Procedure TView3DOptions.Assign(Source:TPersistent);
begin
  if Source is TView3DOptions then
  With TView3DOptions(Source) do
  begin
    Self.FElevation   :=FElevation;
    Self.FHorizOffset :=FHorizOffset;
    Self.FOrthoAngle  :=FOrthoAngle;
    Self.FOrthogonal  :=FOrthogonal;
    Self.FPerspective :=FPerspective;
    Self.FRotation    :=FRotation;
    Self.FTilt        :=FTilt;
    Self.FVertOffset  :=FVertOffset;
    Self.FZoom        :=FZoom;
    Self.FZoomText    :=FZoomText;
  end;
end;

function TView3DOptions.CalcOrthoRatio: Double;
var tmpSin   : Extended;
    tmpCos   : Extended;
    tmpAngle : Extended;
begin
  if Orthogonal then
  begin
    tmpAngle:=OrthoAngle;
    if tmpAngle>90 then tmpAngle:=180-tmpAngle;
    SinCos(tmpAngle*TeePiStep,tmpSin,tmpCos);
    result:=tmpSin/tmpCos;
  end
  else result:=1;
end;

{ TTeeCanvas }
Procedure TTeeCanvas.InternalDark(Const AColor:TColor; Quantity:Byte);
var tmpColor : TColor;
begin
  tmpColor:=ApplyDark(AColor,Quantity);
  if FBrush.Style=bsSolid then FBrush.Color:=tmpColor
                          else BackColor:=tmpColor;
end;

Procedure TTeeCanvas.SetCanvas(ACanvas:TCanvas);
begin
  FCanvas:=ACanvas;
  FPen   :=FCanvas.Pen;
  FFont  :=FCanvas.Font;
  FBrush :=FCanvas.Brush;
end;

Function TTeeCanvas.GetBackMode:TCanvasBackMode;
begin
  {$IFDEF CLX}
  if QPainter_BackgroundMode(Handle)=BGMode_TransparentMode then
     result:=cbmTransparent
  else
     result:=cbmOpaque;
  {$ELSE}
  result:=TCanvasBackMode(GetBkMode(FCanvas.Handle));
  {$ENDIF}
end;

Procedure TTeeCanvas.SetBackMode(Mode:TCanvasBackMode); { Opaque, Transparent }
begin
  {$IFDEF CLX}
  if Mode<>GetBackMode then
  begin
    FCanvas.Start;
    if Mode=cbmTransparent then QPainter_setBackgroundMode(Handle,BGMode_TransparentMode)
    else
    if Mode=cbmOpaque then QPainter_setBackGroundMode(Handle,BGMode_OpaqueMode);
    FCanvas.Stop;
  end;
  {$ELSE}
  SetBkMode(FCanvas.Handle,Ord(Mode));
  {$ENDIF}
end;

Procedure TTeeCanvas.SetBackColor(Color:TColor);
{$IFDEF CLX}
Var QC : QColorH;
{$ENDIF}
begin
  {$IFDEF CLX}
  if Color<>GetBackColor then
  begin
    QC:=QColor(Color);
    FCanvas.Start;
    QPainter_setBackgroundColor(Handle,QC);
    FCanvas.Stop;
    QColor_destroy(QC);
  end;
  {$ELSE}
  SetBkColor(FCanvas.Handle,TColorRef(ColorToRGB(Color)));
  {$ENDIF}
end;

function TTeeCanvas.GetBackColor:TColor;
begin
  {$IFDEF CLX}
  result:=QColorColor(QPainter_backgroundColor(Handle));
  {$ELSE}
  result:=TColor(GetBkColor(FCanvas.Handle));
  {$ENDIF}
end;

Procedure TTeeCanvas.ResetState;
begin
  With FPen do
  begin
    Color:=clBlack;
    Width:=1;
    Style:=psSolid;
  end;

  With FBrush do
  begin
    Color:=clWhite;
    Style:=bsSolid;
  end;

  With FFont do
  begin
    Color:=clBlack;
    Size:=10;
  end;

  BackColor:=clWhite;
  BackMode:=cbmTransparent;
  TextAlign:=TA_LEFT; { 5.01 }
end;

Procedure TTeeCanvas.AssignBrush(ABrush:TChartBrush; ABackColor:TColor);
begin
  AssignBrushColor(ABrush,ABackColor,ABrush.Color);
end;

{$IFDEF CLX}
Procedure SetTextColor(Handle:QPainterH; Color:Integer);
var QC : QColorH;
begin
  QC:=QColor(Color);
  try
    QPen_setColor(QPainter_pen(Handle), QC);
  finally
    QColor_destroy(QC);
  end;
end;
{$ENDIF}

Procedure TTeeCanvas.AssignBrushColor(ABrush:TChartBrush; AColor,ABackColor:TColor);
begin
  if Monochrome then AColor:=clWhite;
  if Assigned(ABrush.FImage) and Assigned(ABrush.FImage.Graphic) then
  begin
    Brush.Style:=bsClear;
    Brush.Bitmap:=ABrush.Image.Bitmap;
    SetTextColor(Handle,ColorToRGB(AColor));
    BackMode:=cbmOpaque;
    BackColor:=ABackColor;
  end
  else
  begin
    {$IFDEF CLX}
    Brush.Bitmap:=nil;
    {$ENDIF}

    if AColor<>Brush.Color then { 5.02 }
       Brush.Color:=AColor;

    if ABrush.Style<>Brush.Style then { 5.02 }
       Brush.Style:=ABrush.Style;

    if ABackColor=clNone then BackMode:=cbmTransparent { 5.02 }
    else
    begin
      BackMode:=cbmOpaque;
      BackColor:=ABackColor;
    end;
  end;
end;

procedure TTeeCanvas.AssignVisiblePen(APen:TPen);
begin
  AssignVisiblePenColor(APen,APen.Color);
end;

Procedure TTeeCanvas.Rectangle(Const R:TRect);
begin
  With R do Rectangle(Left,Top,Right,Bottom);
end;

Procedure TTeeCanvas.DoRectangle(Const Rect:TRect); // obsolete
begin
  Rectangle(Rect);
end;

Function RGBValue(Color:TColor):TRGBTriple;
begin
  with result do
  begin
    rgbtRed:=Byte(Color);
    rgbtGreen:=Byte(Color shr 8);
    rgbtBlue:=Byte(Color shr 16);
  end;
end;

Function TeeCreatePenSmallDots(AColor:TColor):{$IFDEF CLX}QPenH{$ELSE}HPen{$ENDIF};
{$IFNDEF CLX}
Var LBrush   : TLogBrush;
{$ENDIF}
begin
  {$IFDEF CLX}
  result:=QPen_create(QColor(AColor),1,PenStyle_DotLine);
  {$ELSE}
  LBrush.lbStyle:=bs_Solid;
  LBrush.lbColor:=ColorToRGB(AColor);
  result:=ExtCreatePen( PS_COSMETIC or PS_ALTERNATE,1,LBrush,0,nil );
  {$ENDIF}
end;

Procedure TeeSetTeePen(FPen:TPen; APen:TChartPen; AColor:TColor);
{$IFNDEF CLX}
const
  PenStyles: array[TPenStyle] of Word =
    (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL,
     PS_INSIDEFRAME);

Var LBrush   : TLogBrush;
{$ENDIF}
{$IFNDEF CLX}
Var tmpEnd : Integer;
{$ENDIF}
begin
  if APen.SmallDots then
     FPen.Handle:=TeeCreatePenSmallDots(AColor)
  else
  {$IFNDEF CLX}
  if APen.Width>1 then
  begin
    LBrush.lbStyle:=bs_Solid;
    LBrush.lbColor:=ColorToRGB(AColor);
    Case APen.EndStyle of  { 5.01 }
      esRound : tmpEnd:=PS_ENDCAP_ROUND or PS_JOIN_ROUND;
      esSquare: tmpEnd:=PS_ENDCAP_SQUARE or PS_JOIN_BEVEL;
    else tmpEnd:=PS_ENDCAP_FLAT or PS_JOIN_MITER;
    end;

    FPen.Handle:=ExtCreatePen( PS_GEOMETRIC or
            PenStyles[APen.Style] or tmpEnd,APen.Width,LBrush,0,nil);
    FPen.Mode:=APen.Mode;
  end
  else
  {$ENDIF}
  begin
    FPen.Assign(APen);

    //if APen.Style<>FPen.Style then FPen.Style:=APen.Style;
    //if APen.Width<>FPen.Width then FPen.Width:=APen.Width;
    //if APen.Mode<>FPen.Mode then FPen.Mode:=APen.Mode;

    if FPen.Color<>AColor then FPen.Color:=AColor;
  end;
end;

procedure TTeeCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
  if MonoChrome then AColor:=clBlack;
  if not (APen is TChartPen) then
  begin
    FPen.Assign(APen);
    FPen.Color:=AColor;
  end
  else
  if TChartPen(APen).Visible then
  begin
    {$IFNDEF CLX}
    if IsWindowsNT then TeeSetTeePen(FPen,TChartPen(APen),AColor) { only valid in Windows-NT }
    else
    {$ENDIF}
    begin
      FPen.Assign(APen);

      //if APen.Style<>FPen.Style then FPen.Style:=APen.Style;
      //if APen.Width<>FPen.Width then FPen.Width:=APen.Width;
      //if APen.Mode<>FPen.Mode then FPen.Mode:=APen.Mode;

      FPen.Color:=AColor;

      {$IFDEF CLX}
      if FPen.Style<>psSolid then BackMode:=cbmTransparent;
      {$ENDIF}
    end;
  end
  else FPen.Style:=psClear;
end;

Procedure TTeeCanvas.AssignFont(AFont:TTeeFont);
{$IFNDEF CLX}
var tmp : TTeeCanvasHandle;
{$ENDIF}
Begin
  With FFont do
  begin
    AFont.PixelsPerInch:=PixelsPerInch;
    Assign(AFont);
    if FontZoom<>100 then  // 6.01
       Size:=Round(Size*FontZoom*0.01);
  end;

  if MonoChrome then FFont.Color:=clBlack;

  {$IFNDEF CLX}
  tmp:=Handle;
  if GetTextCharacterExtra(tmp)<>AFont.InterCharSize then
     SetTextCharacterExtra(tmp,AFont.InterCharSize);
  {$ENDIF}

  IFont:=AFont;
  AFont.ICanvas:=Self;
End;

Function TTeeCanvas.TextWidth(Const St:String):Integer;
begin
  {$IFNDEF CLX}
//  ReferenceCanvas.Font.Assign(FFont);  6.01
  result:=FCanvas.TextExtent(St).cx;
  {$ELSE}
  result:=FCanvas.TextWidth(St);
  {$ENDIF}
  if Assigned(IFont) and Assigned(IFont.FShadow) then
     Inc(result,Abs(IFont.FShadow.HorizSize));
end;

Function TTeeCanvas.TextHeight(Const St:String):Integer;
Begin
  {$IFNDEF CLX}
//  ReferenceCanvas.Font.Assign(FFont);  6.01
  result:=FCanvas.TextExtent(St).cy;
  {$ELSE}
  result:=FCanvas.TextHeight(St);
  {$ENDIF}
  if Assigned(IFont) and Assigned(IFont.FShadow) then
     Inc(result,Abs(IFont.FShadow.VertSize));
end;

Function TTeeCanvas.FontHeight:Integer;
begin
  result:=TextHeight(TeeCharForHeight);
end;

procedure TTeeCanvas.Ellipse(const R:TRect);
begin
  with R do Ellipse(Left,Top,Right,Bottom);
end;

procedure TTeeCanvas.RoundRect(const R: TRect; X,Y:Integer);
begin
  with R do RoundRect(Left,Top,Right,Bottom,X,Y);
end;

procedure TTeeCanvas.Line(const FromPoint, ToPoint: TPoint);
begin
  Line(FromPoint.X,FromPoint.Y,ToPoint.X,ToPoint.Y)
end;

Function TTeeCanvas.BeginBlending(const R: TRect;
  Transparency: TTeeTransparency):TTeeBlend;
begin
  ITransp:=Transparency;
  result:=TTeeBlend.Create(Self,R);
end;

procedure TTeeCanvas.EndBlending(Blend:TTeeBlend);
begin
  Blend.DoBlend(ITransp);
  Blend.Free;
end;

{ TCanvas3D }
Procedure TCanvas3D.Assign(Source:TCanvas3D);
begin
  Monochrome:=Source.Monochrome;
end;

function TCanvas3D.CalcRect3D(const R: TRect; Z: Integer): TRect;
begin

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?