📄 tecanvas.pas
字号:
TTeeCanvasCalcPoints=Function( x,z:Integer; Var P0,P1:TPoint3D;
Var Color0,Color1:TColor):Boolean of object;
TTeeCanvasSurfaceStyle=(tcsSolid,tcsWire,tcsDot);
TCanvas3D=class {$IFDEF CLR}abstract{$ENDIF} (TTeeCanvas)
private
F3DOptions : TView3DOptions;
IDisabledRotation : Integer;
protected
FIsOrthogonal : Boolean; // 6.01, moved from private due to RotateTool
GradientZ : Integer; // 7.0, used at TGLCanvas
procedure CalcPieAngles(X1,Y1,X2,Y2,X3,Y3,X4,Y4:Integer; var Theta,Theta2:Extended);
Function GetPixel3D(X,Y,Z:Integer):TColor; virtual; abstract;
Function GetSupports3DText:Boolean; virtual; abstract;
procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); virtual; abstract;
public
RotationCenter : TPoint3DFloat;
{ 3d }
Function CalcRect3D(Const R:TRect; Z:Integer):TRect;
Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); virtual; abstract;
Function Calculate3DPosition(const P:TPoint3D):TPoint; overload; // 7.0
Function Calculate3DPosition(P:TPoint; z:Integer):TPoint; overload;
Function Calculate3DPosition(x,y,z:Integer):TPoint; overload; virtual; abstract;
Function FourPointsFromRect(Const R:TRect; Z:Integer):TFourPoints;
Function RectFromRectZ(Const R:TRect; Z:Integer):TRect;
Function InitWindow( DestCanvas:TCanvas; A3DOptions:TView3DOptions;
ABackColor:TColor;
Is3D:Boolean;
Const UserRect:TRect):TRect; virtual; abstract;
Procedure Assign(Source:TCanvas3D); virtual;
Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); virtual; abstract;
Procedure ShowImage( DestCanvas,DefaultCanvas:TCanvas;
Const UserRect:TRect); virtual; abstract;
Function ReDrawBitmap:Boolean; virtual; abstract;
Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
ArrowWidth,ArrowHeight,Z:Integer); virtual; abstract;
procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); virtual; abstract;
procedure Cone( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
Dark3D:Boolean; ConePercent:Integer); virtual; abstract;
Procedure Cube( Left,Right,Top,Bottom,Z0,Z1:Integer;
DarkSides:Boolean=True); overload; virtual; abstract;
Procedure Cube( const R:TRect; Z0,Z1:Integer;
DarkSides:Boolean=True); overload;
procedure Cylinder( Vertical:Boolean; Left,Top,Right,Bottom,Z0,Z1:Integer;
Dark3D:Boolean); virtual; abstract;
procedure DisableRotation; virtual;
procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); virtual; abstract;
procedure EnableRotation; virtual;
Procedure HorizLine3D(Left,Right,Y,Z:Integer); virtual; abstract;
Procedure VertLine3D(X,Top,Bottom,Z:Integer); virtual; abstract;
Procedure ZLine3D(X,Y,Z0,Z1:Integer); virtual; abstract;
procedure FrontPlaneBegin; virtual;
procedure FrontPlaneEnd; virtual;
Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer); overload; virtual; abstract;
Procedure LineWithZ(const FromPoint,ToPoint:TPoint; Z:Integer); overload;
procedure MoveTo3D(X,Y,Z:Integer); overload; virtual; abstract;
procedure MoveTo3D(const P:TPoint3D); overload; // 7.0
procedure LineTo3D(X,Y,Z:Integer); overload; virtual; abstract;
procedure LineTo3D(const P:TPoint3D); overload; // 7.0
procedure Pie3D( XCenter,YCenter,XRadius,YRadius,Z0,Z1:Integer;
Const StartAngle,EndAngle:Double;
DarkSides,DrawSides:Boolean;
DonutPercent:Integer=0;
Gradient:TCustomTeeGradient=nil); virtual; abstract;
procedure Plane3D(Const A,B:TPoint; Z0,Z1:Integer); virtual; abstract;
procedure PlaneWithZ(const P:TFourPoints; Z:Integer); overload;
procedure PlaneWithZ(P1,P2,P3,P4:TPoint; Z:Integer); overload; virtual; abstract;
procedure PlaneFour3D(Var Points:TFourPoints; Z0,Z1:Integer); virtual; abstract;
procedure PolygonWithZ(Points: Array of TPoint; Z:Integer); virtual; abstract;
procedure Polyline(const Points: Array of TPoint; Z:Integer); overload; virtual; abstract;
procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
DarkSides:Boolean); virtual; abstract;
Procedure PyramidTrunc(Const R:TRect; StartZ,EndZ:Integer;
TruncX,TruncZ:Integer); virtual; abstract;
Procedure Rectangle(Const R:TRect; Z:Integer); overload;
Procedure Rectangle(X0,Y0,X1,Y1,Z:Integer); overload;
Procedure RectangleWithZ(Const Rect:TRect; Z:Integer); virtual; abstract;
Procedure RectangleY(Left,Top,Right,Z0,Z1:Integer); virtual; abstract;
Procedure RectangleZ(Left,Top,Bottom,Z0,Z1:Integer); virtual; abstract;
procedure RotatedEllipse(Left,Top,Right,Bottom,Z:Integer; Const Angle:Double);
procedure RotateLabel3D( x,y,z:Integer; Const St:String;
RotDegree:Double); virtual; abstract; // 7.0
procedure Sphere(x,y,z:Integer; Const Radius:Double); virtual; abstract;
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic; Z:Integer); overload;
Procedure Surface3D( Style:TTeeCanvasSurfaceStyle;
SameBrush:Boolean; NumXValues,NumZValues:Integer;
CalcPoints:TTeeCanvasCalcPoints ); virtual; abstract;
Procedure TextOut3D(x,y,z:Integer; const Text:String); virtual; abstract;
procedure Triangle3D( Const Points:TTrianglePoints3D;
Const Colors:TTriangleColors3D); virtual; abstract;
procedure TriangleWithZ(Const P1,P2,P3:TPoint; Z:Integer); virtual; abstract;
property Pixels3D[X,Y,Z:Integer]:TColor read GetPixel3D write SetPixel3D;
property Supports3DText:Boolean read GetSupports3DText;
property View3DOptions:TView3DOptions read F3DOptions write F3DOptions;
end;
TTeeCanvas3D=class(TCanvas3D)
private
FXCenter : Integer;
FYCenter : Integer;
FZCenter : Integer;
FXCenterOffset : Integer;
FYCenterOffset : Integer;
s1 : Extended;
s2 : Extended;
s3 : Extended;
c1 : Extended;
c2 : Extended;
c3 : Extended;
c2s3 : Double;
c2c3 : Double;
tempXX : Double;
tempYX : Double;
tempXZ : Double;
tempYZ : Double;
FWas3D : Boolean;
FBitmap : TBitmap;
{$IFDEF TEEBITMAPSPEED}
IBitmapCanvas : TTeeCanvasHandle;
{$ENDIF}
FDirty : Boolean;
FMonochrome : Boolean;
FTextAlign : TCanvasTextAlign;
IHasPerspec : Boolean;
IHasTilt : Boolean;
IOrthoX : Double;
IOrthoY : Double;
IZoomPerspec : Double;
IZoomFactor : Double;
IZoomText : Boolean;
procedure InternalCylinder(Vertical:Boolean; Left,Top,Right,Bottom,
Z0,Z1:Integer; Dark3D:Boolean; ConePercent:Integer);
protected
FBufferedDisplay : Boolean;
FIs3D : Boolean;
IPoints : TFourPoints;
{ 2d }
function GetBackColor:TColor; override;
Function GetBackMode:TCanvasBackMode; override;
Function GetHandle:TTeeCanvasHandle; override;
Function GetMonochrome:Boolean; override;
Function GetPixel(X, Y: Integer):TColor; override;
Function GetPixel3D(X,Y,Z:Integer):TColor; override;
Function GetSupports3DText:Boolean; override;
Function GetSupportsFullRotation:Boolean; override;
Function GetTextAlign:TCanvasTextAlign; override;
Function GetUseBuffer:Boolean; override;
Procedure PolygonFour; virtual;
Procedure SetBackColor(Color:TColor); override;
Procedure SetBackMode(Mode:TCanvasBackMode); override;
Procedure SetMonochrome(Value:Boolean); override;
procedure SetPixel(X, Y: Integer; Value: TColor); override;
procedure SetTextAlign(Align:TCanvasTextAlign); override;
Procedure SetUseBuffer(Value:Boolean); override;
Procedure DeleteBitmap; virtual;
Procedure TransferBitmap(ALeft,ATop:Integer; ACanvas:TCanvas); virtual;
{ 3d private }
Procedure Calc3DTPoint(Var P:TPoint; z:Integer);
Function Calc3DTPoint3D(Const P:TPoint3D):TPoint;
Procedure Calc3DPoint(Var P:TPoint; x,y,z:Integer); overload;
Procedure Calc3DPoint(Var P:TPoint; x,y:Double; z:Integer); overload;
{ 3d }
procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;
Procedure Calc3DPos(var x,y:Integer; z:Integer); overload;
Procedure CalcPerspective(const Rect:TRect);
{$IFNDEF CLR}
Procedure CalcTrigValues;
{$ENDIF}
public
{ almost public... }
Procedure Calculate2DPosition(Var x,y:Integer; z:Integer); override;
Function Calculate3DPosition(x,y,z:Integer):TPoint; override;
{ public }
Constructor Create;
Destructor Destroy; override;
{$IFDEF CLR}
Procedure CalcTrigValues;
{$ENDIF}
Function InitWindow( DestCanvas:TCanvas;
A3DOptions:TView3DOptions;
ABackColor:TColor;
Is3D:Boolean;
Const UserRect:TRect):TRect; override;
Function ReDrawBitmap:Boolean; override;
Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;
procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
procedure Donut( XCenter,YCenter,XRadius,YRadius:Integer;
Const StartAngle,EndAngle,HolePercent:Double); override;
procedure Draw(X, Y: Integer; Graphic: TGraphic); override;
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
procedure EraseBackground(const Rect: TRect); override;
procedure FillRect(const Rect: TRect); override;
procedure LineTo(X,Y:Integer); override;
procedure MoveTo(X,Y:Integer); override;
procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
procedure Rectangle(X0,Y0,X1,Y1:Integer); override;
procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); override;
Procedure TextOut(X,Y:Integer; const Text:String); override;
{ 2d extra }
procedure ClipRectangle(Const Rect:TRect); override;
procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); override;
procedure DisableRotation; override;
Procedure DoHorizLine(X0,X1,Y:Integer); override;
Procedure DoVertLine(X,Y0,Y1:Integer); override;
procedure EnableRotation; override;
Procedure GradientFill( Const Rect:TRect;
StartColor,EndColor:TColor;
Direction:TGradientDirection;
Balance:Integer=50); override;
Procedure Invalidate; override;
Procedure Line(X0,Y0,X1,Y1:Integer); override;
{$IFDEF D5}
Procedure Polyline(const Points:Array of TPoint); override;
{$ELSE}
Procedure Polyline(const Points:TPointArray); override;
{$ENDIF}
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;
property XCenter:Integer read FXCenter write FXCenter;
property YCenter:Integer read FYCenter write FYCenter;
property ZCenter:Integer read FZCenter write FZCenter;
{ 3d }
Procedure Projection(MaxDepth:Integer; const Bounds,Rect:TRect); override;
Procedure Arrow( Filled:Boolean; Const FromPoint,ToPoint:TPoint;
ArrowWidth,ArrowHeight,Z:Integer); 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); override;
procedure EllipseWithZ(X1, Y1, X2, Y2, Z: Integer); override;
procedure GetCirclePoints(var P:TCirclePoints; 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 HorizLine3D(Left,Right,Y,Z:Integer); override;
procedure LineTo3D(X,Y,Z:Integer); override;
Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer); override;
procedure MoveTo3D(X,Y,Z:Integer); override;
procedure Pie3D( XCenter,YCenter,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 PolygonWithZ(Points: Array of TPoint; Z:Integer); override;
procedure Polyline(const Points: Array of TPoint; Z:Integer); override;
procedure Pyramid( Vertical:Boolean; Left,Top,Right,Bottom,z0,z1:Integer;
DarkSides:Boolean); 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); 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;
Procedure VertLine3D(X,Top,Bottom,Z:Integer); override;
Procedure ZLine3D(X,Y,Z0,Z1:Integer); override;
property Bitmap:TBitmap read FBitmap;
end;
Function ApplyDark(Color:TColor; HowMuch:Byte):TColor;
Function ApplyBright(Color:TColor; HowMuch:Byte):TColor;
Function Point3D(x,y,z:Integer):TPoint3D;
Procedure SwapDouble(Var a,b:Double); { exchanges a and b }
Procedure SwapInteger(Var a,b:Integer); { exchanges a and b }
Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Integer);
Procedure RectCenter(Const R:TRect; Var X,Y:Integer);
Function RectFromPolygon(Const Points:Array of TPoint; NumPoints:Integer):TRect;
Function RectFromTriangle(Const Points:TTrianglePoints):TRect;
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);
Procedure ClipRoundRectangle(ACanvas:TTeeCanvas; Const Rect:TRect; RoundSize:Integer);
Procedure ClipPolygon(ACanvas:TTeeCanvas; Var Points:Array of TPoint; NumPoints:Integer);
Const TeeCharForHeight = 'W'; { <-- this is used to calculate Text Height }
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}
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
{$ELSE}
procedure Painting(Sender: QObjectH; EventRegion: QRegionH); override;
{$ENDIF}
public
Procedure LinkProperty(AInstance:TObject; Const PropName:String);
published
{ Published declarations }
property Height default 25;
property Width default 75;
end;
TButtonColor = class(TTeeButton)
private
Function GetTeeColor : TColor;
procedure SetTeeColor(Const Value:TColor); // 7.0
protected
procedure DrawSymbol(ACanvas:TTeeCanvas); override;
public
GetColorProc : TButtonGetColorProc;
procedure Click; override;
property SymbolColor:TColor read GetTeeColor write SetTeeColor;
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;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
{$IFNDEF CLR}
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
{$ENDIF}
{$ENDIF}
public
Constructor Create(AOwner:TComponent); override;
{$IFNDEF D6}
procedure AddItem(Item: String; AObject: TObject);
{$ENDIF}
published
property Style default csDropDownList;
property Height default 21;
property ItemHeight default 13;
property ItemIndex;
end;
{$ENDIF}
{$IFNDEF D5}
procedure FreeAndNil(var Obj);
{$ENDIF}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -