home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l048 / 1.ddi / HISTOGRM.HGH < prev    next >
Encoding:
Text File  |  1986-05-12  |  3.8 KB  |  120 lines
  1. (***********************************************************)
  2. (*                                                         *)
  3. (*                TURBO GRAPHIX version 1.06A              *)
  4. (*                                                         *)
  5. (*                     Bar chart module                    *)
  6. (*                   Module version 1.06A                  *)
  7. (*                                                         *)
  8. (*                  Copyright (C) 1985 by                  *)
  9. (*                  BORLAND International                  *)
  10. (*                                                         *)
  11. (***********************************************************)
  12.  
  13. procedure DrawHistogram(A :PlotArray; NPoints : integer;
  14.                         Hatching : boolean; HatchStyle : integer);
  15.  
  16. var
  17.   X1, X2, Y2, NPixels, Delta, NDiff, YRef, LineStyleLoc, I : integer;
  18.   Fract, S, Y, YAxis : real;
  19.   DirectModeLoc, Negative : boolean;
  20.   Wtemp : WindowType;
  21.   X1Loc, Y1Loc, X2Loc, Y2Loc : integer;
  22.  
  23. function Balance : integer;
  24. begin
  25.   Balance := 0;
  26.   S := S + Fract;
  27.   if S >= 0.0 then
  28.   begin
  29.     S := S - 1.0;
  30.     Balance := 1;
  31.   end;
  32. end; { Balance }
  33.  
  34. begin { DrawHistogram }
  35.   if abs(NPoints) >= 2 then
  36.     begin
  37.       X1Loc := X1Glb;
  38.       Y1Loc := Y1Glb;
  39.       X2Loc := X2Glb;
  40.       Y2Loc := Y2Glb;
  41.       LineStyleLoc := LinestyleGlb;
  42.       SetLineStyle(0);
  43.       if AxisGlb then
  44.       begin
  45.         Wtemp := Window[WindowNdxGlb];
  46.         ReDefineWindow(WindowNdxGlb, X1RefGlb + 4 + X1Glb, Y1RefGlb + 6 + Y1Glb,
  47.                        X2RefGlb - 2 - X2Glb, Y2RefGlb - 14 - Y2Glb);
  48.         SelectWindow(WindowNdxGlb);
  49.         AxisGlb := true;
  50.       end;
  51.       DirectModeLoc := DirectModeGlb;
  52.       DirectModeGlb := true;
  53.       Negative := NPoints < 0;
  54.       NPoints := abs(NPoints);
  55.       NPixels := (X2RefGlb - X1RefGlb) shl 3 + 7;
  56.       Delta := NPixels div NPoints;
  57.       NDiff := NPixels - Delta * NPoints;
  58.       Fract := NDiff / NPoints;
  59.       S := -Fract;
  60.       X1 := X1RefGlb shl 3;
  61.       YRef := trunc(Y2RefGlb + Y1RefGlb - AyGlb);
  62.       if Negative then
  63.         DrawStraight(X1, X2RefGlb shl 3 + 7, YRef);
  64.       YAxis := Y1RefGlb;
  65.       if BYGlb > 0 then
  66.         YAxis := Y2RefGlb;
  67.       for I := 1 to NPoints do
  68.       begin
  69.         X2 := X1 + Delta + Balance;
  70.         Y := A[I, 2];
  71.         if not Negative then
  72.           Y := abs(Y);
  73.         Y2 := Y2RefGlb + Y1RefGlb - (trunc(AyGlb + ByGlb * Y));
  74.         if not Negative then
  75.           begin
  76.             DrawLine(X1, YAxis, X1, Y2);
  77.             DrawStraight(X1, X2, Y2);
  78.             DrawLine(X2, Y2, X2, YAxis);
  79.             if Hatching then
  80.               if Odd(I) then
  81.                 Hatch(X1, Y2, X2, YAxis, HatchStyle)
  82.               else
  83.                 Hatch(X1, Y2, X2, YAxis, -HatchStyle);
  84.           end
  85.         else
  86.           begin
  87.             DrawLine(X1, YRef, X1, Y2);
  88.             DrawStraight(X1, X2, Y2);
  89.             DrawLine(X2, Y2, X2, YRef);
  90.             if Hatching then
  91.               if YRef - Y2 < 0 then
  92.                 if Odd(I) then
  93.                   Hatch(X1, YRef, X2, Y2, HatchStyle)
  94.                 else
  95.                   Hatch(X1, YRef, X2, Y2, -HatchStyle)
  96.               else
  97.                 if Odd(I) then
  98.                   Hatch(X1, Y2, X2,YRef, HatchStyle)
  99.                 else
  100.                   Hatch(X1, Y2, X2, YRef, -HatchStyle);
  101.           end;
  102.         X1 := X2;
  103.       end;
  104.       if AxisGlb then
  105.       begin
  106.         Window[WindowNdxGlb] := Wtemp;
  107.         SelectWindow(WindowNdxGlb);
  108.         X1Glb := X1Loc;
  109.         Y1Glb := Y1Loc;
  110.         X2Glb := X2Loc;
  111.         Y2Glb := Y2Loc;
  112.         AxisGlb := false;
  113.       end;
  114.       DirectModeGlb := DirectModeLoc;
  115.       SetLineStyle(LineStyleLoc);
  116.     end
  117.   else
  118.     Error(19, 4);
  119. end; { DrawHistogram }
  120.