📄 tecanvas.pas
字号:
{$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 + -