tecanvas.pas

TeeChart Pro v7.04,Delphi图表专用控件,可以生成多种图表

  inherited;
  Color:=clGray;
  Style:=psDot;
end;

{ TDarkGrayPen }
Constructor TDarkGrayPen.Create(OnChangeEvent:TNotifyEvent);
Begin
  inherited;
  Color:=clDkGray;
end;

{ TChartBrush }
Constructor TChartBrush.Create(OnChangeEvent:TNotifyEvent);
Begin
  inherited Create;
  Color:=clDefault;
  OnChange:=OnChangeEvent;
end;

Destructor TChartBrush.Destroy;
begin
  FImage.Free;
  inherited;
end;

Procedure TChartBrush.Assign(Source:TPersistent);
begin
  if Source is TChartBrush then
     Image.Assign(TChartBrush(Source).FImage);
  inherited;
end;

Procedure TChartBrush.Clear;  // 7.0
begin
  Style:=bsClear;
  Image:=nil;
end;

procedure TChartBrush.SetImage(Value: TPicture);
begin
  if Assigned(Value) then Image.Assign(Value)
                     else FreeAndNil(FImage);
  Changed;
end;

Function TChartBrush.GetImage:TPicture;
begin
  if not Assigned(FImage) then
  begin
    FImage:=TPicture.Create;
    FImage.OnChange:=OnChange;
  end;

  result:=FImage;
end;

{ TView3DOptions }
Constructor TView3DOptions.Create({$IFDEF TEEVCL}AParent:TWinControl{$ENDIF});
begin
  inherited Create;

  {$IFDEF TEEVCL}
  FParent      :=AParent;
  {$ENDIF}

  FOrthogonal  :=True;
  FOrthoAngle  :=45;
  FFontZoom    :=100; { % } // 7.0
  FZoom        :=100; { % }
  FZoomText    :=True;
  FRotation    :=345;
  FElevation   :=345;
  FPerspective :=TeeDefaultPerspective; { % }
end;

Procedure TView3DOptions.Repaint;
begin
  {$IFDEF TEEVCL}
  FParent.Invalidate;
  {$ENDIF}
end;

Procedure TView3DOptions.SetIntegerProperty(Var Variable:Integer; Value:Integer);
begin
  if Variable<>Value then
  begin
    Variable:=Value;
    Repaint;
  end;
end;

Procedure TView3DOptions.SetBooleanProperty(Var Variable:Boolean; Value:Boolean);
begin
  if Variable<>Value then
  begin
    Variable:=Value;
    Repaint;
  end;
end;

Procedure TView3DOptions.SetElevation(Value:Integer);
begin
  SetIntegerProperty(FElevation,Value);
end;

Procedure TView3DOptions.SetFontZoom(Value:Integer);
begin
  SetIntegerProperty(FFontZoom,Value);
end;

Procedure TView3DOptions.SetPerspective(Value:Integer);
begin
  SetIntegerProperty(FPerspective,Value);
end;

Procedure TView3DOptions.SetRotation(Value:Integer);
begin
  SetIntegerProperty(FRotation,Value);
end;

Procedure TView3DOptions.SetTilt(Value:Integer);
begin
  SetIntegerProperty(FTilt,Value);
end;

Procedure TView3DOptions.SetHorizOffset(Value:Integer);
begin
  if FHorizOffset<>Value then
  begin
    FHorizOffset:=Value;
    Repaint;
    if Assigned(FOnScrolled) then FOnScrolled(True);
  end;
end;

Procedure TView3DOptions.SetVertOffset(Value:Integer);
begin
  if FVertOffset<>Value then
  begin
    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.FFontZoom    :=FFontZoom;
    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;

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

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

  {$IFNDEF TEECANVASLOCKS}
  {$IFDEF CLR}
  FPen.OwnerLock:=nil;
  FFont.OwnerLock:=nil;
  FBrush.OwnerLock:=nil;
  {$ELSE}
  {$IFNDEF CLX}
  FPen.OwnerCriticalSection:=nil;
  FFont.OwnerCriticalSection:=nil;
  FBrush.OwnerCriticalSection:=nil;
  {$ENDIF}
  {$ENDIF}
  {$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;
    Style:=[];

    {$IFNDEF CLX}
    CharSet:=DEFAULT_CHARSET;
    {$ENDIF}
    Name:=GetDefaultFontName;
    Size:=GetDefaultFontSize;
  end;

  ITransp:=0; // 6.02
  IFont:=nil; // 6.02

  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;

    {$IFDEF TEEWINDOWS}
    SetTextColor(Handle,ColorToRGB(AColor));
    {$ENDIF}

    BackMode:=cbmOpaque;
    BackColor:=ABackColor;
  end
  else
  begin
    Brush.Bitmap:=nil;

    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; {$IFDEF D9}inline;{$ENDIF}
begin
  with result do
  begin
    rgbtRed:=Byte(Color);
    rgbtGreen:=Byte(Color shr 8);
    rgbtBlue:=Byte(Color shr 16);
  end;
end;

{$IFDEF TEEWINDOWS}

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);
  LBrush.lbHatch:=0;

  result:=ExtCreatePen( PS_COSMETIC or PS_ALTERNATE,1,LBrush,0,nil );
  {$ENDIF}
end;

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

  PenModes: array[TPenMode] of Word =
    (R2_BLACK, R2_WHITE, R2_NOP, R2_NOT, R2_COPYPEN, R2_NOTCOPYPEN, R2_MERGEPENNOT,
     R2_MASKPENNOT, R2_MERGENOTPEN, R2_MASKNOTPEN, R2_MERGEPEN, R2_NOTMERGEPEN,
     R2_MASKPEN, R2_NOTMASKPEN, R2_XORPEN, R2_NOTXORPEN);
var LBrush   : TLogBrush;
{$ENDIF}
{$IFNDEF CLX}
var tmpEnd : Integer;
{$ENDIF}
begin
  if APen.SmallDots then
  begin
    // Delphi 2005 VCL .Net and Win32 bug.  
    // TPen.GetPenData uses TLogPen instead of TExtLogPen
    // Workaround for Delphi 2005: Set "psDot" style
    // Another Delphi 2005 VCL Bug: Setting Pen.Handle leaks GDI Object.

    {$IFDEF D9}
    FPen.Color:=AColor;
    F