home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / eepub05 / circsegm.hgh < prev    next >
Text File  |  1986-03-19  |  5KB  |  168 lines

  1. (***********************************************************)
  2. (*                                                         *)
  3. (*                TURBO GRAPHIX version 1.06A              *)
  4. (*                                                         *)
  5. (*              Circle segment drawing module              *)
  6. (*                  Module version  1.06A                  *)
  7. (*                                                         *)
  8. (*                  Copyright (C) 1985 by                  *)
  9. (*                  BORLAND International                  *)
  10. (*                                                         *)
  11. (***********************************************************)
  12.  
  13. procedure DrawCircleSegment(Xr0, Yr0 : real; var Xr1, Yr1 : real;
  14.                             Inner, Outer, Phi, Area : real;
  15.                             Txt : WrkString; Option, Scale : byte);
  16.  
  17. var
  18.   FaktC, FaktS, CDummy, C, S, Radius : real;
  19.   Phi1, DeltaPhi, CosPhi, SinPhi, CosDphi, SinDphi : real;
  20.   DeltaX, DeltaY, Xr2, Yr2, RadiusLoc, X0Loc, Y0Loc, X1Loc, Y1Loc : real;
  21.   I, AsciiCode, TextLen, N, X0, Y0, X1, Y1, X2, Y2 : integer;
  22.   DirectModeLoc : boolean;
  23.   TempText : WrkString;
  24.  
  25. procedure ClippedLine(X1, Y1, X2, Y2 : integer);
  26. begin
  27.   if Clip(X1, Y1, X2, Y2) then
  28.     DrawLine(X1, Y1, X2, Y2);
  29. end; { ClippedLine }
  30.  
  31. procedure ClippedPoint(X, Y : integer);
  32. begin
  33.   if ClippingGlb then
  34.     begin
  35.       if (X >= X1RefGlb shl 3) and (X < X2RefGlb shl 3 + 7) then
  36.         if (Y >= Y1RefGlb) and (Y <= Y2RefGlb) then
  37.           DP(X, Y);
  38.     end
  39.   else
  40.     DP(X, Y);
  41. end; { ClippedPoint }
  42.  
  43. begin { DrawCircleSegment }
  44.   X0Loc := Xr0;
  45.   Y0Loc := Yr0;
  46.   X1Loc := Xr1;
  47.   Y1Loc := Yr1;
  48.   RadiusLoc := Sqrt(Sqr(X1Loc - X0Loc) + Sqr(Y1Loc - Y0Loc));
  49.   if RadiusLoc > 0.0 then
  50.   begin
  51.     Option := abs(Option);
  52.     Inner := abs(Inner);
  53.     Outer := abs(Outer);
  54.     Scale := abs(Scale);
  55.     DirectModeLoc := DirectModeGlb;
  56.     DirectModeGlb := True;
  57.     Phi := Phi * Pi / 180.0;
  58.     if abs(Phi) / (2.0 * Pi) > 1.0 then
  59.       Phi := 2.0 * Pi;
  60.     N := trunc(RadiusLoc * abs(Phi) / 9.0);
  61.     if N < 2 then
  62.       N := 2;
  63.     if (abs(Xr1 - Xr0) > 0) and (abs(Yr1 - Yr0) > 0) then
  64.       Phi1 := ArcTan((Yr1 - Yr0) / (Xr1 - Xr0))
  65.     else
  66.       if Xr1 - Xr0 = 0 then
  67.         if Yr1 - Yr0 > 0 then
  68.           Phi1 := Pi / 2.0
  69.         else
  70.           Phi1 := 1.5 * Pi
  71.         else
  72.           if Xr1 > Xr0 then
  73.             Phi1:=0.0
  74.           else
  75.             Phi1 := Pi;
  76.     DeltaPhi := Phi / (N - 1);
  77.     C := 1.0;
  78.     S := 0.0;
  79.     CosPhi := Cos(Phi1);
  80.     SinPhi := Sin(Phi1);
  81.     CosDphi := Cos(DeltaPhi);
  82.     SinDphi := Sin(DeltaPhi);
  83.     if Xr1 < Xr0 then
  84.       begin
  85.         FaktS := -1;
  86.         FaktC := -1;
  87.       end
  88.     else
  89.       begin
  90.         FaktS := 1;
  91.         FaktC := 1;
  92.       end;
  93.     if (Yr1 = Yr0) and (Xr1 < Xr0) then
  94.     begin
  95.       FaktC := -FaktC;
  96.       FaktS := -FaktS;
  97.     end;
  98.     if Area < 0 then
  99.     begin
  100.       Area := abs(Area);
  101.       DeltaX := FaktC * 0.3 * RadiusLoc * Cos(Phi / 2 + Phi1);
  102.       DeltaY := trunc(FaktS * 0.3 * AspectGlb * RadiusLoc *
  103.                       Sin(Phi / 2 + Phi1) + 0.5);
  104.       Xr0 := Xr0 + DeltaX;
  105.       Yr0 := Yr0 + DeltaY;
  106.     end;
  107.     X0 := WindowX(Xr0);
  108.     Y0 := WindowY(Yr0);
  109.     if not DirectModeLoc then
  110.       ClippedPoint(X0, Y0)
  111.     else
  112.       DP(X0, Y0);
  113.     X1 := X0;
  114.     Y1 := Y0;
  115.     for I := 1 to N do
  116.     begin
  117.       Xr2 := Xr0 + FaktC * RadiusLoc * (CosPhi * C - SinPhi * S);
  118.       X2 := WindowX(Xr2);
  119.       Yr2 := Yr0 + AspectGlb * RadiusLoc * FaktS * (SinPhi * C + CosPhi * S);
  120.       Y2 := WindowY(Yr2);
  121.       if not DirectModeLoc then
  122.         ClippedLine(X1, Y1, X2, Y2)
  123.       else
  124.         DrawLine(X1, Y1, X2, Y2);
  125.       X1 := X2;
  126.       Y1 := Y2;
  127.       CDummy := C * CosDphi - S * SinDphi;
  128.       S := S * CosDphi + C * SinDphi;
  129.       C := CDummy;
  130.     end;
  131.     if not PieGlb then
  132.       if not DirectModeLoc then
  133.         ClippedLine(X1, Y1, X0, Y0)
  134.       else
  135.         DrawLine(X1, Y1, X0, Y0);
  136.       if (Option > 0) and (Phi < 2.0 * Pi) then
  137.       begin
  138.         Xr1 := Xr0 + FaktC * RadiusLoc * Inner * Cos(Phi / 2.0 + Phi1);
  139.         Yr1 := Yr0 + FaktS * AspectGlb * RadiusLoc * Inner * Sin(Phi / 2.0 + Phi1);
  140.         Xr2 := Xr0 + FaktC * RadiusLoc * Outer * Cos(Phi / 2.0 + Phi1);
  141.         Yr2 := Yr0 + FaktS * AspectGlb * RadiusLoc * Outer * Sin(Phi / 2.0 + Phi1);
  142.         X1 := WindowX(Xr1);
  143.         Y1 := WindowY(Yr1);
  144.         X2 := WindowX(Xr2);
  145.         Y2 := WindowY(Yr2);
  146.         if not DirectModeLoc then
  147.           ClippedLine(X1, Y1, X2, Y2)
  148.         else
  149.           DrawLine(X1, Y1, X2, Y2);
  150.         Str(Area:1:2, TempText);
  151.         case Option of
  152.           1 : TempText := Txt;
  153.           2 : TempText := Txt + TempText;
  154.         { 3 : TempText := TempText; }
  155.         end;
  156.         TextLen := Length(TempText);
  157.         if X2 >= X0 then
  158.           X2 := X2 + Scale * 6
  159.         else
  160.           X2 := X2 - TextLen * 6 * Scale;
  161.         DrawText(X2, Y2, Scale, TempText);
  162.       end;
  163.       Xr1 := X0Loc + FaktC * RadiusLoc * Cos(Phi + Phi1);
  164.       Yr1 := Y0Loc + FaktS * RadiusLoc * Sin(Phi + Phi1);
  165.       DirectModeGlb := DirectModeLoc;
  166.   end;
  167. end; { DrawCircleSegment }
  168.