Liren Large Software Subsidy 9/09.iso/l/l048/1.ddi/CIRCSEGM.HGH

Text File | 1986-03-20 | 5.2 KB | 168 lines

(***********************************************************)
(*                                                         *)
(*                TURBO GRAPHIX version 1.06A              *)
(*                                                         *)
(*              Circle segment drawing module              *)
(*                  Module version  1.06A                  *)
(*                                                         *)
(*                  Copyright (C) 1985 by                  *)
(*                  BORLAND International                  *)
(*                                                         *)
(***********************************************************)

procedure DrawCircleSegment(Xr0, Yr0 : real; var Xr1, Yr1 : real;
                            Inner, Outer, Phi, Area : real;
                            Txt : WrkString; Option, Scale : byte);

var
  FaktC, FaktS, CDummy, C, S, Radius : real;
  Phi1, DeltaPhi, CosPhi, SinPhi, CosDphi, SinDphi : real;
  DeltaX, DeltaY, Xr2, Yr2, RadiusLoc, X0Loc, Y0Loc, X1Loc, Y1Loc : real;
  I, AsciiCode, TextLen, N, X0, Y0, X1, Y1, X2, Y2 : integer;
  DirectModeLoc : boolean;
  TempText : WrkString;

procedure ClippedLine(X1, Y1, X2, Y2 : integer);
begin
  if Clip(X1, Y1, X2, Y2) then
    DrawLine(X1, Y1, X2, Y2);
end; { ClippedLine }

procedure ClippedPoint(X, Y : integer);
begin
  if ClippingGlb then
    begin
      if (X >= X1RefGlb shl 3) and (X < X2RefGlb shl 3 + 7) then
        if (Y >= Y1RefGlb) and (Y <= Y2RefGlb) then
          DP(X, Y);
    end
  else
    DP(X, Y);
end; { ClippedPoint }

begin { DrawCircleSegment }
  X0Loc := Xr0;
  Y0Loc := Yr0;
  X1Loc := Xr1;
  Y1Loc := Yr1;
  RadiusLoc := Sqrt(Sqr(X1Loc - X0Loc) + Sqr(Y1Loc - Y0Loc));
  if RadiusLoc > 0.0 then
  begin
    Option := abs(Option);
    Inner := abs(Inner);
    Outer := abs(Outer);
    Scale := abs(Scale);
    DirectModeLoc := DirectModeGlb;
    DirectModeGlb := True;
    Phi := Phi * Pi / 180.0;
    if abs(Phi) / (2.0 * Pi) > 1.0 then
      Phi := 2.0 * Pi;
    N := trunc(RadiusLoc * abs(Phi) / 9.0);
    if N < 2 then
      N := 2;
    if (abs(Xr1 - Xr0) > 0) and (abs(Yr1 - Yr0) > 0) then
      Phi1 := ArcTan((Yr1 - Yr0) / (Xr1 - Xr0))
    else
      if Xr1 - Xr0 = 0 then
        if Yr1 - Yr0 > 0 then
          Phi1 := Pi / 2.0
        else
          Phi1 := 1.5 * Pi
        else
          if Xr1 > Xr0 then
            Phi1:=0.0
          else
            Phi1 := Pi;
    DeltaPhi := Phi / (N - 1);
    C := 1.0;
    S := 0.0;
    CosPhi := Cos(Phi1);
    SinPhi := Sin(Phi1);
    CosDphi := Cos(DeltaPhi);
    SinDphi := Sin(DeltaPhi);
    if Xr1 < Xr0 then
      begin
        FaktS := -1;
        FaktC := -1;
      end
    else
      begin
        FaktS := 1;
        FaktC := 1;
      end;
    if (Yr1 = Yr0) and (Xr1 < Xr0) then
    begin
      FaktC := -FaktC;
      FaktS := -FaktS;
    end;
    if Area < 0 then
    begin
      Area := abs(Area);
      DeltaX := FaktC * 0.3 * RadiusLoc * Cos(Phi / 2 + Phi1);
      DeltaY := trunc(FaktS * 0.3 * AspectGlb * RadiusLoc *
                      Sin(Phi / 2 + Phi1) + 0.5);
      Xr0 := Xr0 + DeltaX;
      Yr0 := Yr0 + DeltaY;
    end;
    X0 := WindowX(Xr0);
    Y0 := WindowY(Yr0);
    if not DirectModeLoc then
      ClippedPoint(X0, Y0)
    else
      DP(X0, Y0);
    X1 := X0;
    Y1 := Y0;
    for I := 1 to N do
    begin
      Xr2 := Xr0 + FaktC * RadiusLoc * (CosPhi * C - SinPhi * S);
      X2 := WindowX(Xr2);
      Yr2 := Yr0 + AspectGlb * RadiusLoc * FaktS * (SinPhi * C + CosPhi * S);
      Y2 := WindowY(Yr2);
      if not DirectModeLoc then
        ClippedLine(X1, Y1, X2, Y2)
      else
        DrawLine(X1, Y1, X2, Y2);
      X1 := X2;
      Y1 := Y2;
      CDummy := C * CosDphi - S * SinDphi;
      S := S * CosDphi + C * SinDphi;
      C := CDummy;
    end;
    if not PieGlb then
      if not DirectModeLoc then
        ClippedLine(X1, Y1, X0, Y0)
      else
        DrawLine(X1, Y1, X0, Y0);
      if (Option > 0) and (Phi < 2.0 * Pi) then
      begin
        Xr1 := Xr0 + FaktC * RadiusLoc * Inner * Cos(Phi / 2.0 + Phi1);
        Yr1 := Yr0 + FaktS * AspectGlb * RadiusLoc * Inner * Sin(Phi / 2.0 + Phi1);
        Xr2 := Xr0 + FaktC * RadiusLoc * Outer * Cos(Phi / 2.0 + Phi1);
        Yr2 := Yr0 + FaktS * AspectGlb * RadiusLoc * Outer * Sin(Phi / 2.0 + Phi1);
        X1 := WindowX(Xr1);
        Y1 := WindowY(Yr1);
        X2 := WindowX(Xr2);
        Y2 := WindowY(Yr2);
        if not DirectModeLoc then
          ClippedLine(X1, Y1, X2, Y2)
        else
          DrawLine(X1, Y1, X2, Y2);
        Str(Area:1:2, TempText);
        case Option of
          1 : TempText := Txt;
          2 : TempText := Txt + TempText;
        { 3 : TempText := TempText; }
        end;
        TextLen := Length(TempText);
        if X2 >= X0 then
          X2 := X2 + Scale * 6
        else
          X2 := X2 - TextLen * 6 * Scale;
        DrawText(X2, Y2, Scale, TempText);
      end;
      Xr1 := X0Loc + FaktC * RadiusLoc * Cos(Phi + Phi1);
      Yr1 := Y0Loc + FaktS * RadiusLoc * Sin(Phi + Phi1);
      DirectModeGlb := DirectModeLoc;
  end;
end; { DrawCircleSegment }