Bu unit program Canvas işleminde kullanılır.
Kod: Tümünü seç
unit ads_Canvas;
interface
Uses Graphics, Dialogs, SysUtils,Windows;
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;
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
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
end.