⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tecanvas.pas

📁 TeeChart7Source 控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:

{$IFNDEF TEEVCL}
procedure FreeAndNil(var Obj);
function StrToInt(const S: string): Integer;
function ColorToRGB(Color: TColor): Longint;
{$ENDIF}

var IsWindowsNT:Boolean=False;
    GetDefaultFontSize:Integer=0;
    GetDefaultFontName:String='';

{$IFDEF LINUX}
Function GetRValue(Color:Integer):Byte;
Function GetGValue(Color:Integer):Byte;
Function GetBValue(Color:Integer):Byte;
Function RGB(r,g,b:Integer):TColor;
{$ENDIF}

{$IFDEF CLX}
Function TeeCreatePenSmallDots(AColor:TColor):QPenH;
{$ELSE}
Function TeeCreatePenSmallDots(AColor:TColor):HPen;
{$ENDIF}

Procedure TeeSetTeePen(FPen:TPen; APen:TChartPen; AColor:TColor; Handle:TTeeCanvasHandle);

// Converts ABitmap pixels into Gray Scale (levels of gray)
Procedure TeeGrayScale(ABitmap:TBitmap; Inverted:Boolean; AMethod:Integer); { 5.02 }

Function TeePoint(aX,aY:Integer):TPoint; { compatibility with D6 CLX }
function PointInRect(Const Rect:TRect; x,y:Integer):Boolean; { compatibility with D6 CLX }
function TeeRect(Left,Top,Right,Bottom:Integer):TRect; { compatibility with D6 CLX }
Function OrientRectangle(Const R:TRect):TRect;
Function PolygonBounds(Const P:TPointArray):TRect;  // 7.0

// Default color depth 
Const TeePixelFormat={$IFDEF CLX}pf32Bit{$ELSE}pf24Bit{$ENDIF};

{$IFDEF CLX}
type
  TRGBTriple=packed record
    rgbtBlue   : Byte;
    rgbtGreen  : Byte;
    rgbtRed    : Byte;
    rgbtAlpha  : Byte;  // Linux ?
  end;
{$ENDIF}

Function RGBValue(Color:TColor):TRGBTriple;

{$IFDEF TEEVCL}
{ Show the TColorDialog, return new color if changed }
Function EditColor(AOwner:TComponent; AColor:TColor):TColor;

{ Show the TColorDialog, return True if color changed }
Function EditColorDialog(AOwner:TComponent; var AColor:TColor):Boolean;
{$ENDIF}

// Returns point "ATo" minus ADist pixels from AFrom point.
Function PointAtDistance(AFrom,ATo:TPoint; ADist:Integer):TPoint;

// Returns True when 3 first points in P are "face-viewing".
Function TeeCull(const P:TFourPoints):Boolean; overload;
Function TeeCull(const P0,P1,P2:TPoint):Boolean; overload;

// Draws SRC bitmap with smooth stretch to Dst bitmap
type TSmoothStretchOption = (ssBestQuality, ssBestPerformance);

procedure SmoothStretch(Src, Dst: TBitmap); overload;
procedure SmoothStretch(Src, Dst: TBitmap; Option: TSmoothStretchOption); overload;

// Returns Sqrt( Sqr(x)+Sqr(y) )
Function TeeDistance(const x,y:Double):Double;  // 7.0 changed to "double"

{ Used at EditColor function, for the Color Editor dialog }
var TeeCustomEditColors:TStrings=nil;

    {$IFNDEF LINUX}
    TeeFontAntiAlias:Integer=ANTIALIASED_QUALITY;
    {$ENDIF}

    {$IFNDEF CLX}
    TeeSetDCBrushColor:function(DC: HDC; Color: COLORREF): COLORREF; stdcall;
    TeeSetDCPenColor:function(DC: HDC; Color: COLORREF): COLORREF; stdcall;
    {$ENDIF}

// Load a DLL, compatible with Delphi 4 and up.
{$IFNDEF LINUX}
Function TeeLoadLibrary(Const FileName:String):HInst;

// Free Library, but do not free library in Windows 95 (lock bug)
Procedure TeeFreeLibrary(hLibModule: HMODULE);
{$ENDIF}

var
  TeeNumCylinderSides:Integer=16;

implementation

Uses {$IFDEF CLR}
     System.Runtime.InteropServices,
     System.Drawing,
     System.Drawing.Drawing2D,
     {$ENDIF}

     {$IFDEF TEEVCL}
     {$IFDEF CLX}
     QForms, QDialogs,
     {$ELSE}
     Forms, Dialogs,
     {$ENDIF}
     {$ENDIF}

     Math,
     {$IFNDEF CLX}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     {$ENDIF}
     TeeConst;

type PPoints = ^TPoints;
     TPoints = Array[0..0] of TPoint;

{$IFNDEF CLX}
var WasOldRegion : Boolean=False;
    OldRegion    : HRgn=0;
{$ENDIF}

{$IFNDEF TEEWINDOWS}
procedure InflateRect(var R:TRect; x,y:Integer);
begin
  Inc(R.Left,-x);
  Inc(R.Right,x);
  Inc(R.Top,-y);
  Inc(R.Bottom,y);
end;
{$ENDIF}

Function TeeCull(const P:TFourPoints):Boolean;
begin
  result:=TeeCull(P[0],P[1],P[2]);
end;

Function TeeCull(const P0,P1,P2:TPoint):Boolean;
begin
  result:=( ((P0.x-P1.x) * (P2.y-P1.y)) -
            ((P2.x-P1.x) * (P0.y-P1.y))
          ) < 0;
end;

Function TeePoint(aX,aY:Integer):TPoint;
begin
  with result do
  begin
    X:=aX;
    Y:=aY;
  end;
end;

function PointInRect(Const Rect:TRect; x,y:Integer):Boolean;
begin
  result:=(x>=Rect.Left) and (y>=Rect.Top) and
          (x<=Rect.Right) and (y<=Rect.Bottom);  // 7.0
end;

function TeeRect(Left,Top,Right,Bottom:Integer):TRect;
begin
  result.Left  :=Left;
  result.Top   :=Top;
  result.Bottom:=Bottom;
  result.Right :=Right;
end;

// Makes sure the R rectangle Left is smaller than Right and
// Top is smaller than Bottom. Returns corrected rectangle.
Function OrientRectangle(Const R:TRect):TRect;
{$IFDEF CLR}
var tmp : Integer;
{$ENDIF}
begin
  result:=R;
  with result do
  begin
    if Left>Right then
    {$IFDEF CLR}
    begin
      tmp:=Left; Left:=Right; Right:=tmp;
    end;
    {$ELSE}
    SwapInteger(Left,Right);
    {$ENDIF}

    if Top>Bottom then
    {$IFDEF CLR}
    begin
      tmp:=Top; Top:=Bottom; Bottom:=tmp;
    end;
    {$ELSE}
    SwapInteger(Top,Bottom);
    {$ENDIF}
  end;
end;

Function Point3D(x,y,z:Integer):TPoint3D;
begin
  result.x:=x;
  result.y:=y;
  result.z:=z;
end;

Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Integer);
begin
  With R do
  begin
    RectWidth :=Right-Left;
    RectHeight:=Bottom-Top;
  end;
end;

Procedure RectCenter(Const R:TRect; Var X,Y:Integer);
begin
  With R do
  begin
    X:=(Left+Right) div 2;
    Y:=(Top+Bottom) div 2;
  end;
end;

// Returns the minimum left / top and the
// maximum right / bottom for all the points in "P" polygon
Function PolygonBounds(Const P:TPointArray):TRect;
var t : Integer;
begin
  result:=TeeRect(0,0,0,0);

  if Length(P)>0 then
  With result do
  begin
    TopLeft:=P[0];
    BottomRight:=TopLeft;

    for t:=0 to Length(P)-1 do
    begin
      if P[t].X<Left then Left:=P[t].X
      else
      if P[t].X>Right then Right:=P[t].X;
      if P[t].Y<Top then Top:=P[t].Y
      else
      if P[t].Y>Bottom then Bottom:=P[t].Y;
    end;
  end;
end;

{ TChartPen }
Constructor TChartPen.Create(OnChangeEvent:TNotifyEvent);
begin
  inherited Create;
  FVisible:=True;
  DefaultVisible:=True;

  DefaultEnd:=esRound;
  OnChange:=OnChangeEvent;

  {$IFDEF CLX}
  ReleaseHandle;
  Width:=1;
  {$ENDIF}
end;

Procedure TChartPen.Assign(Source:TPersistent);
begin
  if Source is TChartPen then
  begin
    FVisible  :=TChartPen(Source).Visible;
    FSmallDots:=TChartPen(Source).SmallDots;
    FEndStyle :=TChartPen(Source).EndStyle;  { 5.01 }
  end;

  {$IFDEF CLX}
  if not Assigned(Handle) then ReleaseHandle;
  {$ENDIF}

  inherited;
end;

procedure TChartPen.Hide;
begin
  Visible:=False;
end;

procedure TChartPen.Show;
begin
  Visible:=True;
end;

Function TChartPen.IsEndStored:Boolean;
begin
  result:=FEndStyle<>DefaultEnd;
end;

Function TChartPen.IsVisibleStored:Boolean;
begin
  result:=FVisible<>DefaultVisible;
end;

procedure TChartPen.SetEndStyle(const Value: TPenEndStyle);
begin
  if FEndStyle<>Value then
  begin
    FEndStyle:=Value;
    Changed;
  end;
end;

Procedure TChartPen.SetSmallDots(Value:Boolean);
begin
  if FSmallDots<>Value then
  begin
    FSmallDots:=Value;
    Changed;
  end;
end;

Procedure TChartPen.SetVisible(Value:Boolean);
Begin
  if FVisible<>Value then
  begin
    FVisible:=Value;
    Changed;
  end;
end;

{ TChartHiddenPen }
Constructor TChartHiddenPen.Create(OnChangeEvent:TNotifyEvent);
Begin
  inherited;
  FVisible:=False;
  DefaultVisible:=False;
end;

{ TDottedGrayPen }
Constructor TDottedGrayPen.Create(OnChangeEvent:TNotifyEvent);
Begin
  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;

⌨️ 快捷键说明

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