tecanvas.pas

BCB第三方组件

       Procedure Polyline(const Points:{$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}); overload; override;
       Procedure Polygon(const Points: Array of TPoint); override;
       procedure RotateLabel(x,y:Integer; const St:String; RotDegree:Double); override;
       procedure RotateLabel3D( x,y,z:Integer;
                                const St:String; RotDegree:Double); override;
       procedure UnClipRectangle; override;

       { 3d }
       Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); overload; override;
       Function Calculate3DPosition(x,y,z:Integer):TPoint; override;
       Procedure Projection(MaxDepth:Integer; const ABounds,Rect:TRect); override;

       Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
                        ArrowWidth,ArrowHeight,Z:Integer;
                        const ArrowPercent:Double); override;

       procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                       Dark3D:Boolean; ConePercent:Integer); override;
       Procedure Cube(Left,Right,Top,Bottom,Z0,Z1:Integer; DarkSides:Boolean=True); override;
       procedure Cylinder( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
                           Dark3D:Boolean=True); override;
       procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); override;
       procedure GetCirclePoints(var P:{$IFDEF D5}TCirclePoints{$ELSE}TPointArray{$ENDIF}; X1, Y1, X2, Y2, Z: Integer);
       Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); override;
       Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); override;
       procedure Pie3D( AXCenter,AYCenter,XRadius,YRadius,Z0,Z1:Integer;
                        Const StartAngle,EndAngle:Double;
                        DarkSides,DrawSides:Boolean; DonutPercent:Integer=0;
                        Gradient:TCustomTeeGradient=nil); override;
       procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); override;
       procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); override;
       procedure PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); override;
       Procedure Polygon3D(const Points: Array of TPoint3D); override;
       procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
                          DarkSides:Boolean=True); override;
       Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
                              TruncX,TruncZ:Integer); override;
       Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); override;
       procedure Sphere(x,y,z:Integer; Const Radius:Double); overload; override;
       Procedure Surface3D( Style:TTeeCanvasSurfaceStyle;
                            SameBrush:Boolean;
                            NumXValues,NumZValues:Integer;
                            CalcPoints:TTeeCanvasCalcPoints ); override;
       Procedure TextOut3D(X,Y,Z:Integer; const Text:String); override;
       procedure Triangle3D( Const Points:TTrianglePoints3D;
                             Const Colors:TTriangleColors3D); override;
       procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); override;

       property Bitmap:TBitmap read FBitmap write FBitmap; // 7.02 rw
     end;

Function ApplyDark(Color:TColor; HowMuch:Byte):TColor;
Function ApplyBright(Color:TColor; HowMuch:Byte):TColor;

Function Point3D(const x,y,z:Integer):TPoint3D; {$IFDEF D9}inline;{$ENDIF}

Procedure SwapDouble(Var a,b:Double); {$IFDEF D10}inline;{$ENDIF}   { exchanges a and b }
Procedure SwapInteger(Var a,b:Integer); {$IFDEF D10}inline;{$ENDIF} { exchanges a and b }

Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Integer); {$IFDEF D9}inline;{$ENDIF}
Procedure RectCenter(Const R:TRect; Var X,Y:Integer); {$IFDEF D9}inline;{$ENDIF}
Function RectFromPolygon(Const Points:Array of TPoint; NumPoints:Integer):TRect;
Function RectFromTriangle(Const Points:TTrianglePoints):TRect; {$IFDEF D9}inline;{$ENDIF}

{ Returns True if rectangle Small is inside the rectangle Big }
function RectangleInRectangle(const Small,Big:TRect):Boolean;

Procedure ClipCanvas(ACanvas:TCanvas; Const Rect:TRect);
Procedure UnClipCanvas(ACanvas:TCanvas);

// These Clipxxx routines are now deprecated...
// Use TTeeCanvas.Clipxxx equivalent methods.

Procedure ClipEllipse(ACanvas:TTeeCanvas; Const Rect:TRect); {$IFDEF D10}inline;{$ENDIF}
                         {$IFDEF D11}deprecated 'Please use ACanvas.ClipEllipse method.';{$ENDIF} // Do not localize

Procedure ClipRoundRectangle(ACanvas:TTeeCanvas; Const Rect:TRect; RoundSize:Integer); {$IFDEF D10}inline;{$ENDIF}
                         {$IFDEF D11}deprecated 'Please use ACanvas.ClipRectangle method.';{$ENDIF} // Do not localize

Procedure ClipPolygon(ACanvas:TTeeCanvas; const Points:Array of TPoint; NumPoints:Integer);
                         {$IFDEF D11}deprecated 'Please use ACanvas.ClipPolygon method.';{$ENDIF} // Do not localize

Const
  // This is used to calculate average Text Height
  TeeCharForHeight     = 'W';  // Do not localize

  DarkerColorQuantity  : Byte=128; { <-- for dark 3D sides }
  DarkColorQuantity    : Byte=64;

{$IFDEF TEEVCL}
type
  TButtonGetColorProc=function:TColor of object;

  TTeeButton = class(TButton)
  private
    {$IFNDEF CLX}
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    {$ENDIF}
  protected
    Instance : TObject;
    Info     : {$IFDEF CLR}TPropInfo{$ELSE}PPropInfo{$ENDIF};

    Procedure DrawSymbol(ACanvas:TTeeCanvas); virtual; // abstract;

    {$IFNDEF CLX}
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    {$IFDEF TEEWINDOWS}
    procedure PaintWindow(DC: HDC); override;
    {$ENDIF}

    {$IFNDEF LCL}
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    {$ENDIF}

    {$ELSE}
    procedure Painting(Sender: QObjectH; EventRegion: QRegionH); override;
    {$ENDIF}

    function SymbolRectangle:TRect;
  public
    Procedure LinkProperty(AInstance:TObject; Const PropName:String);
  published
    { Published declarations }
    property Height default 25;
    property Width default 75;
  end;

  TButtonColor = class(TTeeButton)
  private
    FSymbolColor : TColor;
    Function GetSymbolColor : TColor;
    procedure SetSymbolColor(Const Value:TColor); // 7.0
  protected
    procedure DrawSymbol(ACanvas:TTeeCanvas); override;
  public
    GetColorProc : TButtonGetColorProc;
    procedure Click; override;
    property SymbolColor:TColor read GetSymbolColor write SetSymbolColor;
  end;

  TComboFlat=class(TComboBox)
  private
    {$IFNDEF CLX}
    Inside: Boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

    {$IFNDEF LCL}
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    {$ENDIF}

    {$IFNDEF CLR}
    {$IFNDEF LCL}
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}

    function GetDropWidth:Integer;
    function IsDropWidthStored:Boolean;
    procedure SetDropWidth(const Value:Integer);
  public
    Constructor Create(AOwner:TComponent); override;

    procedure Add(const Item:String);

    {$IFDEF CLX}
    procedure AddItem(Item: String; AObject: TObject);
    {$ELSE}
    {$IFNDEF D6}
    procedure AddItem(Item: String; AObject: TObject);
    {$ENDIF}
    {$ENDIF}

    function CurrentItem:String;
    function SelectedObject:TObject;
  published
    property DropDownWidth:Integer read GetDropWidth write SetDropWidth  // 7.05
                                   stored IsDropWidthStored;
    property Height default 21;
    property ItemHeight default 13;
    property ItemIndex;
    property Style default csDropDownList;
  end;
{$ENDIF}

{$IFNDEF D5}
procedure FreeAndNil(var Obj);
{$ENDIF}

{$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}

Function TeeCreatePenSmallDots(const AColor:TColor;
                    const Space:Integer=0):{$IFDEF CLX}QPenH{$ELSE}HPen{$ENDIF};

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

Function TeePoint(const aX,aY:Integer):TPoint; {$IFDEF D9}inline;{$ENDIF} { compatibility with D6 CLX }
function PointInRect(Const Rect:TRect; const P:TPoint):Boolean; overload; {$IFDEF D9}inline;{$ENDIF}
function PointInRect(Const Rect:TRect; x,y:Integer):Boolean; overload; {$IFDEF D9}inline;{$ENDIF}{ compatibility with D6 CLX }
function TeeRect(Left,Top,Right,Bottom:Integer):TRect; {$IFDEF D9}inline;{$ENDIF} { compatibility with D6 CLX }
Function OrientRectangle(Const R:TRect):TRect;

procedure TeeSetBitmapSize(Bitmap:TBitmap; Width,Height:Integer);

// Returns bounding rectangle containing all points in polygon P
Function PolygonBounds(Const P:Array of TPoint):TRect;  // 7.0

// Returns True when all points in polygon A are inside polygon B
function PolygonInPolygon(const A,B:Array of TPoint):Boolean;  // 8.0

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

Function RGBValue(const Color:TColor):TRGB;

{$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:Byte=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;

procedure TeeBlendBitmaps(Const Percent: Double; ABitmap,BBitmap:TBitmap; BOrigin:TPoint);

type
  TGradientRotate=procedure(Gradient:TCustomTeeGradient; Bitmap:TBitmap);

var
  TeeGradientRotate:TGradientRotate=nil;

// Returns "Lines" array with pointers to all Bitmap row scanlines.
procedure TeeCalcLines(var Lines:TRGBArray; Bitmap:TBitmap);

// Smoothes Bitmap contents, blends with (optional) Back bitmap.
procedure TeeShadowSmooth(Bitmap,Back:TBitmap;
          Left, Top, Width, Height, horz, vert:Integer;
          Smoothness:Double; FullDraw:Boolean;
          ACanvas:TCanvas3D;
          Clip:Boolean);

type
  ICanvasHyperlinks=interface
    ['{84DBB276-CBD2-4BBB-AC31-AACBF8B6F34C}']
    procedure AddLink(x,y:Integer; const Text,URL,Hint:String);
  end;

  ICanvasToolTips=interface
    ['{03EBCB55-D01F-4CA8-8A2F-48EB3BEBC5E3}']
    procedure AddToolTip(const Entity,ToolTip:String);
  end;

{$IFNDEF D6}
function Supports(const Instance: IInterface; const IID: TGUID): Boolean;
{$ENDIF}

implementation

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

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

     Math, TeeHtml, 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); {$IFDEF D9}inline;{$ENDIF}
begin
  Inc(R.Left,-x);
  Inc(R.Right,x);
  Inc(R.Top,-y);
  Inc(R.Bottom,y);
end;
{$ENDIF}

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