home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / wissen / dos / wgraph / entpack.exe / WGDEMOQ!.EXE / GDIAG.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-20  |  3KB  |  143 lines
  1. {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-}
  2. UNIT GDiag;
  3.  
  4. INTERFACE
  5.  
  6. USES GDecl,
  7.      GViews,
  8.      GDlg,
  9.      GDrivers,
  10.      Dos,
  11.      Graph;
  12.  
  13.  
  14. type PDiagramm=^TDiagramm;
  15.      TDiagramm=object(TWindow)
  16.        procedure SetPalette; virtual;
  17.        procedure InitBackground; virtual;
  18.      end;
  19.  
  20.      PFarn=^TFarn;
  21.      TFarn=object(TWindow)
  22.        xs,ys,k:integer;
  23.        x,y,xn,yn,z,s:real;
  24.        procedure InitBackground; virtual;
  25.        procedure HandleEvent; virtual;
  26.      end;
  27.  
  28.      PDiaBgrd=^TDiaBgrd;
  29.      TDiaBgrd=object(TBackground)
  30.        procedure Draw;virtual;
  31.      end;
  32.  
  33.      PFarnBgrd=^TFarnBgrd;
  34.      TFarnBgrd=object(TBackground)
  35.        procedure Draw;virtual;
  36.      end;
  37.  
  38.  
  39. IMPLEMENTATION
  40.  
  41.  
  42. {Implementation TDiagramm}
  43.  
  44. procedure TDiagramm.SetPalette;
  45. begin
  46.   Palette:=Pal[palRed];
  47. end;
  48.  
  49. procedure TDiagramm.InitBackground;
  50. var R:TRect;
  51. begin
  52.   R:=Frame^.Area;
  53.   Bgrd:=new(PDiaBgrd, Init(R));
  54.   List^.InsertItem(Bgrd);
  55. end;
  56.  
  57. {Implementation TFarn}
  58.  
  59. const ax:array[1..3,1..4] of real = ((0,0.2,-0.15,0.85),
  60.                                      (0,-0.26,0.28,0.04),
  61.                                      (0,0,0,0));
  62.  
  63.       ay:array[1..3,1..4] of real = ((0,0.23,0.26,-0.04),
  64.                                      (0.16,0.22,0.24,0.85),
  65.                                      (0,1.6,0.44,1.6));
  66.  
  67.       p:array[1..4] of real = (0.01,0.07,0.07,0.85);
  68.  
  69. procedure TFarn.HandleEvent;
  70. var R:TRect;
  71. begin
  72.   TWindow.HandleEvent;
  73.   R:=Frame^.Area;
  74.   with R do
  75.    begin
  76.      z:=Random;
  77.      k:=1;
  78.      s:=p[1];
  79.      while s<z do
  80.       begin
  81.         inc(k);
  82.         s:=s+p[k];
  83.       end;
  84.      xn:=ax[1,k]*x+ax[2,k]*y+ax[3,k];
  85.      yn:=ay[1,k]*x+ay[2,k]*y+ay[3,k];
  86.      x:=xn; y:=yn;
  87.      xs:=round(A.x+(Size.x div 2)*(x+8)*0.12);
  88.      ys:=round(A.y+((Size.y-24) div 2)*(15-y)*0.1);
  89.      PutPixel(xs,ys,LightGreen);
  90.    end;
  91. end;
  92.  
  93. procedure TFarn.InitBackground;
  94. var R:TRect;
  95. begin
  96.   x:=0; y:=0; Randomize;
  97.   R:=Frame^.Area;
  98.   Bgrd:=new(PFarnBgrd, Init(R));
  99.   List^.InsertItem(Bgrd);
  100. end;
  101.  
  102.  
  103. {Implementation TDiaBgrd}
  104.  
  105. procedure TDiaBgrd.Draw;
  106. var dx,dy,xm,ym,r:integer;
  107. begin
  108.   with Border do
  109.    begin
  110.      SetFillStyle(XHatchFill,DarkGray);
  111.      Bar(A.x,A.y,B.x,B.y);
  112.      SetColor(Blue);
  113.      dx:=abs(B.x-A.x);
  114.      dy:=abs(B.y-A.y);
  115.      xm:=A.x+dx div 2;
  116.      ym:=A.y+dy div 2;
  117.      if dy>dx then r:=trunc(dx*3/8) else r:=trunc(dy*3/8);
  118.      SetFillStyle(SolidFill,LightRed);
  119.      PieSlice(xm,ym,0,45,r);
  120.      SetFillStyle(SolidFill,LightGreen);
  121.      PieSlice(xm,ym,45,140,r);
  122.      SetFillStyle(SolidFill,LightMagenta);
  123.      PieSlice(xm,ym,140,268,r);
  124.      SetFillStyle(SolidFill,LightBlue);
  125.      PieSlice(xm,ym,268,310,r);
  126.      SetFillStyle(SolidFill,Yellow);
  127.      PieSlice(xm,ym,310,360,r);
  128.    end;
  129. end;
  130.  
  131. {Implementation TFarnBgrd}
  132.  
  133. procedure TFarnBgrd.Draw;
  134. begin
  135.   with Border do
  136.    begin
  137.      SetFillStyle(XHatchFill,DarkGray);
  138.      Bar(A.x,A.y,B.x,B.y);
  139.    end;
  140. end;
  141.  
  142.  
  143. END.