unit ads_Canvas;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_Canvas.pas This unit contains the following routines.
Circle_1 Circle_2 Circle_3 DistanceFromAxis DistanceTweenPoints Ellipse EllipseDrawHalf G0DistanceOnLine_1 G0DistanceOnLine_2 GetEllipseHalfChord GetEllipsePoint Heart MarkPoint
*) interface Uses Graphics, Dialogs, SysUtils,Windows, Math; procedure Heart( Canvas : TCanvas; Top : Integer; Left : Integer; Height : Integer; Width : Integer ); Function Ellipse( Canvas : TCanvas; Apogeex : Integer; Apogeey : Integer; Perigeex : Integer; Perigeey : Integer; Width : Integer; Fill : Boolean; FillColor : TColor; BorderColor : TColor): Boolean; Procedure Circle( Canvas : TCanvas; DiameterPt1 : TPoint; DiameterPt2 : TPoint; Fill : Boolean; FillColor : TColor; BorderColor : TColor); OverLoad; Procedure Circle( Canvas : TCanvas; Center : TPoint; Width : Extended; Fill : Boolean; FillColor : TColor; BorderColor : TColor); OverLoad; Procedure Circle( Canvas : TCanvas; DiameterPt1x: Integer; DiameterPt1y: Integer; DiameterPt2x: Integer; DiameterPt2y: Integer; Fill : Boolean; FillColor : TColor; BorderColor : TColor); OverLoad; Function EllipseDrawHalf( Canvas : TCanvas; Apogee : TPoint; Perigee : TPoint; Width : Extended; LeftHalf : Boolean): TPoint; Function G0DistanceOnLine(StartPoint : TPoint; Slope: Extended;Distance: Extended;Plusx:Boolean): TPoint;Overload; Function G0DistanceOnLine( StartPoint : TPoint; Distance : Extended; Angle : Extended): TPoint; OverLoad; Function DistanceFromAxis(CurrentPoint,FocusPoint: TPoint; Slope,a: Extended;Plusx:Boolean): TPoint; Function DistanceTweenPoints(Point1,Point2: TPoint): Extended; Procedure MarkPoint(Canvas : TCanvas;Point : TPoint); Function GetEllipseHalfChord( Length : Extended; Width : Extended; Section: Extended): Extended; Function GetEllipsePoint( AxisPt : TPoint; Length : Extended; Width : Extended; Section: Extended; Slope : Extended; ToLeft : Boolean): TPoint; implementation //Unit Description UnitIndex Master Index
Function G0DistanceOnLine(StartPoint : TPoint; Slope: Extended;Distance: Extended;Plusx:Boolean): TPoint;
Var
inCounter : Integer;
Dist : Extended;
NewPoint : TPoint;
NewPointx : Extended;
NewPointy : Extended;
Intercept : Extended;
Lowx : Extended;
Highx : Extended;
Curx : Extended;
Quality : Extended;
Begin
NewPoint.x := StartPoint.x;
NewPoint.y := StartPoint.y;
If Distance = 0.0 Then Exit;
If Plusx Then
Begin
Lowx := StartPoint.x;
Highx := StartPoint.x+Distance;
End
Else
Begin
Lowx := StartPoint.x-Distance;
Highx := StartPoint.x;
End;
Curx := Lowx+((Highx-Lowx)/2);
Intercept := StartPoint.y-(Slope*StartPoint.x);
If Slope <> 0 Then
Begin
For inCounter := 1 To 1000 Do
Begin
NewPointx := Curx;
NewPointy := (Slope*NewPointx)+ Intercept;
Dist :=
Sqrt(
((StartPoint.x-NewPointx)*(StartPoint.x-NewPointx))+
((StartPoint.y-NewPointy)*(StartPoint.y-NewPointy)));
Quality := (Abs(Distance-Dist)/Distance);
If Quality < 0.00001 Then
Begin
NewPoint.x := StrToInt(FloatToStr(Int(NewPointx)));
NewPoint.y := StrToInt(FloatToStr(Int(NewPointy)));
Break;
End;
If Dist > Distance Then
Begin
If Plusx Then
Highx := Curx
Else
Lowx := Curx;
End
Else
Begin
If Plusx Then
Lowx := Curx
Else
Highx := Curx;
End;
Curx := Lowx+((Highx-Lowx)/2);
End;
End
Else
Begin
If Plusx Then
Begin
Lowx := StartPoint.y;
Highx := StartPoint.y+Distance;
End
Else
Begin
Lowx := StartPoint.y-Distance;
Highx := StartPoint.y;
End;
Curx := Lowx+((Highx-Lowx)/2);
For inCounter := 1 To 1000 Do
Begin
NewPointx := StartPoint.x;
NewPointy := Curx;
Dist :=
Sqrt(
((StartPoint.x-NewPointx)*(StartPoint.x-NewPointx))+
((StartPoint.y-NewPointy)*(StartPoint.y-NewPointy)));
Quality := (Abs(Distance-Dist)/Distance);
If Quality < 0.00001 Then
Begin
NewPoint.x := StrToInt(FloatToStr(Int(NewPointx)));
NewPoint.y := StrToInt(FloatToStr(Int(NewPointy)));
Break;
End;
If Dist > Distance Then
Begin
If Plusx Then
Highx := Curx
Else
Lowx := Curx;
End
Else
Begin
If Plusx Then
Lowx := Curx
Else
Highx := Curx;
End;
Curx := Lowx+((Highx-Lowx)/2);
End;
End;
Result := NewPoint;
End;
//Unit Description UnitIndex Master Index
Function Ellipse(
Canvas : TCanvas;
Apogeex : Integer;
Apogeey : Integer;
Perigeex : Integer;
Perigeey : Integer;
Width : Integer;
Fill : Boolean;
FillColor : TColor;
BorderColor : TColor): Boolean;
Var
Apogee : TPoint;
Perigee : TPoint;
Temp1 : TPoint;
Temp2 : TPoint;
Center : TPoint;
End1 : TPoint;
End2 : TPoint;
Begin
Result := True;
Try
Apogee.x := Apogeex;
Apogee.y := Apogeey;
Perigee.x := Perigeex;
Perigee.y := Perigeey;
If Apogee.x > Perigee.x Then
Begin
Temp1 := Apogee;
Temp2 := Perigee;
Apogee := Temp2;
Perigee:= Temp1;
End;
If Apogee.x > Perigee.x Then
Center.x := ((Apogee.x - Perigee.x) div 2) + Perigee.x
Else
Center.x := ((Perigee.x - Apogee.x) div 2) + Apogee.x;
If Apogee.y > Perigee.y Then
Center.y := ((Apogee.y - Perigee.y) div 2) + Perigee.y
Else
Center.y := ((Perigee.y - Apogee.y) div 2) + Apogee.y;
Canvas.Pen.Color := BorderColor;
End1 :=
EllipseDrawHalf(
Canvas , //Canvas : TCanvas;
Apogee , //Apogee : TPoint;
Perigee, //Perigee : TPoint;
Width , //Width : Extended;
True );//LeftHalf : Boolean);
End2 :=
EllipseDrawHalf(
Canvas , //Canvas : TCanvas;
Apogee , //Apogee : TPoint;
Perigee, //Perigee : TPoint;
Width , //Width : Extended;
False );//LeftHalf : Boolean);
With Canvas Do
Begin
MoveTo(End1.x,End1.y);
LineTo(Perigee.x,Perigee.y);
LineTo(End2.x,End2.y);
If Fill Then
Begin
Brush.Color := FillColor;
FloodFill(
center.x,
center.y,
BorderColor,
fsBorder);
End;
Refresh;
End;
Except
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function DistanceFromAxis(CurrentPoint,FocusPoint: TPoint; Slope,a: Extended;Plusx:Boolean): TPoint;
Var
AxisX : Extended;
HalfChord : Extended;
HafChord : Integer;
rlSlope : Extended;
Begin
AxisX := DistanceTweenPoints(CurrentPoint,FocusPoint);
HalfChord :=
sqrt(
((((2*a)+(AxisX*AxisX))*((2*a)+(AxisX*AxisX)))-(AxisX*AxisX))
);
HafChord := StrToInt(FloatToStr(Int(HalfChord)));
If Slope = 0 Then
Begin
rlSlope := 1;
End
Else
Begin
rlSlope := -1/Slope;
End;
Result :=
G0DistanceOnLine(
CurrentPoint, //StartPoint : TPoint;
rlSlope , //Slope: Extended;
HafChord , //Distance: Integer;
PlusX );//Plusx:Boolean): TPoint;
End;
//Unit Description UnitIndex Master Index
Function DistanceTweenPoints(Point1,Point2: TPoint): Extended;
Begin
Try
Result :=
sqrt(
((Point1.x-Point2.x)*(Point1.x-Point2.x))
+
((Point1.y-Point2.y)*(Point1.y-Point2.y)));
Except
Result := 0.00;
End;
End;
//Unit Description UnitIndex Master Index
Procedure MarkPoint(Canvas : TCanvas;Point : TPoint);
Begin
With Canvas Do
Begin
MoveTo(Point.x,Point.y);
LineTo(Point.x-5,Point.y);
MoveTo(Point.x,Point.y);
LineTo(Point.x+5,Point.y);
MoveTo(Point.x,Point.y);
LineTo(Point.x,Point.y-5);
MoveTo(Point.x,Point.y);
LineTo(Point.x,Point.y+5);
End;
End;
//Unit Description UnitIndex Master Index
Function GetEllipseHalfChord(
Length : Extended;
Width : Extended;
Section: Extended): Extended;
Var
a : Extended;
b : Extended;
x : Extended;
xx : Extended;
aa : Extended;
bb : Extended;
Begin
Result := 0.0;
a := Length/2;
b := Width/2;
If Section > Length Then Section := Length;
If Section < 0.0 Then Section := 0.0;
x := Section-a;
xx := (x*x);
aa := (a*a);
bb := (b*b);
If a = 0.0 Then Exit;
Result :=
sqrt(
(1-((xx)/(aa)))*(bb)
);
End;
//Unit Description UnitIndex Master Index
Function GetEllipsePoint(
AxisPt : TPoint;
Length : Extended;
Width : Extended;
Section: Extended;
Slope : Extended;
ToLeft : Boolean): TPoint;
Var
Dist : Extended;
inDist : Integer;
rlSlope: Extended;
Begin
Dist :=
GetEllipseHalfChord(
Length , //Length : Extended;
Width , //Width : Extended;
Section);//Section: Extended): Extended;
inDist := StrToInt(FloatToStr(Int(Dist)));
If Slope = 0 Then
Begin
rlSlope := 1;
End
Else
Begin
rlSlope := -1/Slope;
End;
Result :=
G0DistanceOnLine(
AxisPt , //StartPoint : TPoint;
rlSlope , //Slope: Extended;
inDist , //Distance: Integer;
ToLeft );//Plusx:Boolean): TPoint;
End;
//Unit Description UnitIndex Master Index
Function EllipseDrawHalf(
Canvas : TCanvas;
Apogee : TPoint;
Perigee : TPoint;
Width : Extended;
LeftHalf : Boolean): TPoint;
Var
Slope : Extended;
LastAxis : TPoint;
LastPoint : TPoint;
CurAxis : TPoint;
AxisDelta : Integer;
AxisCum : Integer;
NewPoint : TPoint;
a : Extended;
Length : Extended;
Begin
Result := Apogee;
Length := DistanceTweenPoints(Apogee,Perigee);
If Length = 0 Then Exit;
If Width = 0 Then Exit;
If (Apogee.x-Perigee.x) = 0.00 Then
Slope := 999999.0
Else
slope := (Apogee.y-Perigee.y)/(Apogee.x-Perigee.x);
a := Length / 2;
With Canvas Do
Begin
MoveTo(Apogee.x,Apogee.y);
LastAxis := Apogee;
LastPoint := Apogee;
AxisDelta := 1;
AxisCum := 0;
While True Do
Begin
AxisCum := AxisCum + AxisDelta;
If AxisCum > 2*a Then
Begin
CurAxis := Perigee;
End
Else
Begin
If (Abs(Slope) > 0) And (Abs(Slope) < 999999.0) Then
Begin
CurAxis := G0DistanceOnLine(Apogee,Slope,AxisCum,True);
If LeftHalf Then
NewPoint :=
GetEllipsePoint(
CurAxis, //AxisPt : TPoint;
2*a , //Length : Extended;
Width , //Width : Extended;
AxisCum, //Section: Extended;
Slope , //Slope : Extended;
True )//ToLeft : Boolean): TPoint;
Else
NewPoint :=
GetEllipsePoint(
CurAxis, //AxisPt : TPoint;
2*a , //Length : Extended;
Width , //Width : Extended;
AxisCum, //Section: Extended;
Slope , //Slope : Extended;
False );//ToLeft : Boolean): TPoint;
End
Else
Begin
If Slope = 0 Then
Begin
CurAxis := Apogee;
CurAxis.x := Apogee.x+AxisCum;
NewPoint := CurAxis;
If LeftHalf Then
NewPoint.y :=
NewPoint.y +
StrToInt(FloatToStr(Int(
GetEllipseHalfChord(
2*a,
Width,
AxisCum)
)))
Else
NewPoint.y :=
NewPoint.y -
StrToInt(FloatToStr(Int(
GetEllipseHalfChord(
2*a,
Width,
AxisCum)
)));
End
Else
Begin
CurAxis := Apogee;
CurAxis.y := Apogee.y+AxisCum;
NewPoint := CurAxis;
If LeftHalf Then
NewPoint.x :=
NewPoint.x +
StrToInt(FloatToStr(Int(
GetEllipseHalfChord(
2*a,
Width,
AxisCum)
)))
Else
NewPoint.x :=
NewPoint.x -
StrToInt(FloatToStr(Int(
GetEllipseHalfChord(
2*a,
Width,
AxisCum)
)));
End;
End;
End;
MoveTo(LastPoint.x,LastPoint.y);
Result := LastPoint;
LineTo(NewPoint.x,NewPoint.y);
LastPoint := NewPoint;
LastAxis := CurAxis;
If AxisCum > 2*a Then
Begin
MoveTo(NewPoint.x,NewPoint.y);
LineTo(Perigee.x,Perigee.y);
If Slope = 0 Then
Begin
LineTo(Perigee.x,Perigee.y+3);
LineTo(Perigee.x,Perigee.y-6);
End
Else
Begin
If Abs(Slope) > 9999 Then
Begin
LineTo(Perigee.x+3,Perigee.y);
LineTo(Perigee.x-6,Perigee.y);
End;
End;
Break;
End;
End;
End;
End;
//Unit Description UnitIndex Master Index
procedure Heart(
Canvas : TCanvas;
Top : Integer;
Left : Integer;
Height : Integer;
Width : Integer
);
Var
BoxLeftx : integer;
BoxLefty : integer;
BoxRightx : integer;
BoxRighty : integer;
ArcStartx : integer;
ArcStarty : integer;
ArcEndx : integer;
ArcEndy : integer;
begin
Top := 100;
Left := 100;
Height := 300;
Width := 100;
With Canvas Do
Begin
BoxLeftx := Left+(width div 2);
BoxLefty := Top;
BoxRightx := Left+Width;
BoxRighty := Top+Height;
ArcStartx := BoxRightx;
ArcStarty := Top+(Height div 2);
ArcEndx := BoxLeftx;
ArcEndy := ArcStarty;
MoveTo(ArcStartx,ArcStarty);
Arc(
BoxLeftx,
BoxLefty,
BoxRightx,
BoxRighty,
ArcStartx,
ArcStarty,
ArcEndx,
ArcEndy);
BoxLeftx := Left;
BoxLefty := Top;
BoxRightx := Left+(Width div 2);
BoxRighty := Top+Height;
ArcStartx := BoxRightx;
ArcStarty := Top+(Height div 2);
ArcEndx := BoxLeftx;
ArcEndy := ArcStarty;
MoveTo(ArcStartx,ArcStarty);
Arc(
BoxLeftx,
BoxLefty,
BoxRightx,
BoxRighty,
ArcStartx,
ArcStarty,
ArcEndx,
ArcEndy);
BoxLeftx := Left-(17*Width);
BoxLefty := Top-Height;
BoxRightx := Left+Width;
BoxRighty := Top+(Height*2);
ArcStartx := Left+(Width div 2);
ArcStarty := Top+Height-2;
ArcEndx := Left+Width;
ArcEndy := Top+(Height div 2);
Arc(
BoxLeftx,
BoxLefty,
BoxRightx,
BoxRighty,
ArcStartx,
ArcStarty,
ArcEndx,
ArcEndy);
BoxLeftx := Left;
BoxLefty := Top-Height;
BoxRightx := Left+Width+(17*Width);
BoxRighty := Top+(Height*2);
ArcStartx := Left;
ArcStarty := Top+(Height div 2);
ArcEndx := Left+(Width div 2);
ArcEndy := Top+Height-2;
Arc(
BoxLeftx,
BoxLefty,
BoxRightx,
BoxRighty,
ArcStartx,
ArcStarty,
ArcEndx,
ArcEndy);
Brush.Color := clRed;
FloodFill(
Left+(width div 2),
Top+height-(height div 4),
clBlack,
fsBorder);
End;
end;
//Unit Description UnitIndex Master Index
Procedure Circle(
Canvas : TCanvas;
DiameterPt1 : TPoint;
DiameterPt2 : TPoint;
Fill : Boolean;
FillColor : TColor;
BorderColor : TColor);
Var
Width : Integer;
Apogeex : Integer;
Apogeey : Integer;
Perigeex : Integer;
Perigeey : Integer;
Begin
Width := StrToInt(FloatToStr(Int(DistanceTweenPoints(DiameterPt1,DiameterPt2))));
Apogeex := DiameterPt1.x;
Apogeey := DiameterPt1.y;
Perigeex := DiameterPt2.x;
Perigeey := DiameterPt2.y;
Ellipse(
Canvas , //Canvas : TCanvas;
Apogeex , //Apogeex : Integer;
Apogeey , //Apogeey : Integer;
Perigeex , //Perigeex : Integer;
Perigeey , //Perigeey : Integer;
Width , //Width : Integer;
Fill , //Fill : Boolean;
FillColor , //FillColor : TColor;
BorderColor );//BorderColor : TColor): Boolean;
End;
//Unit Description UnitIndex Master Index
Procedure Circle(
Canvas : TCanvas;
DiameterPt1x: Integer;
DiameterPt1y: Integer;
DiameterPt2x: Integer;
DiameterPt2y: Integer;
Fill : Boolean;
FillColor : TColor;
BorderColor : TColor); OverLoad;
Var
DiameterPt1 : TPoint;
DiameterPt2 : TPoint;
Begin
DiameterPt1.x := DiameterPt1x;
DiameterPt1.y := DiameterPt1y;
DiameterPt2.x := DiameterPt2x;
DiameterPt2.y := DiameterPt2y;
Circle(
Canvas , //Canvas : TCanvas;
DiameterPt1 , //DiameterPt1 : TPoint;
DiameterPt2 , //DiameterPt2 : TPoint;
Fill , //Fill : Boolean;
FillColor , //FillColor : TColor;
BorderColor );//BorderColor : TColor);
End;
//Unit Description UnitIndex Master Index
Procedure Circle(
Canvas : TCanvas;
Center : TPoint;
Width : Extended;
Fill : Boolean;
FillColor : TColor;
BorderColor : TColor); OverLoad;
Var
DiameterPt1 : TPoint;
DiameterPt2 : TPoint;
Radius : Extended;
Begin
Radius := Width/2;
DiameterPt1 :=
G0DistanceOnLine(
Center, //StartPoint : TPoint;
0 , //Slope : Extended;
Radius, //Distance : Extended;
False );//Plusx:Boolean): TPoint;
DiameterPt2 :=
G0DistanceOnLine(
Center, //StartPoint : TPoint;
0 , //Slope : Extended;
Radius, //Distance : Extended;
True );//Plusx:Boolean): TPoint;
Circle(
Canvas , //Canvas : TCanvas;
DiameterPt1 , //DiameterPt1 : TPoint;
DiameterPt2 , //DiameterPt2 : TPoint;
Fill , //Fill : Boolean;
FillColor , //FillColor : TColor;
BorderColor );//BorderColor : TColor);
End;
//Unit Description UnitIndex Master Index
Function G0DistanceOnLine(
StartPoint : TPoint;
Distance : Extended;
Angle : Extended): TPoint; OverLoad;
Var
Slope : Extended;
Plusx : Boolean;
Begin
If (Angle >= (90-2)) And (Angle <= (90+2)) Then
Begin
Slope := 999;
End
Else
Begin
If (Angle >= (270-2)) And (Angle <= (270+2)) Then
Begin
Slope := 999;
End
Else
Begin
If Angle = 0.0 Then
Begin
Slope := 0.00001;
End
Else
Begin
Slope := Tan(Angle*(pi/180))*-1;
End;
End;
End;
Plusx := (((Angle >= 0 ) And (Angle < 90)) Or ((Angle > 270 ) And (Angle <= 360)));
If (Angle >= (90-2)) And (Angle <= (90+2)) Then Plusx := False;
If (Angle >= (270-2)) And (Angle <= (270+2)) Then Plusx := True;
Result :=
G0DistanceOnLine(
StartPoint, //StartPoint : TPoint;
Slope , //Slope: Extended;
Distance , //Distance: Extended;
Plusx );//Plusx:Boolean): TPoint;Overload;
End;
end.
//