home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1143 / gepackt.exe / BSPQTSW.EXE / DEMOGR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-09  |  8.7 KB  |  348 lines
  1. (***************************************
  2. * WG-VISION 1.0      DEMONSTRATION     *
  3. ****************************************
  4. *                                      *
  5. * Unit für das Demonstrationsprogramm  *
  6. *                                      *
  7. *--------------------------------------*
  8. * Achtung: Nur VGA !                   *
  9. ****************************************
  10. * (c) 1993 Dipl.Phys. Mathias Scholz   *
  11. ***************************************)
  12.  
  13. {$I COMPILER.INC}
  14. {$F+,O+}
  15.  
  16. UNIT DemoGr;
  17.  
  18. INTERFACE
  19.  
  20. USES WDecl,
  21.      WViews,
  22.      WDlg,
  23.      WDriver,
  24.      WEvent,
  25.      WUtils,
  26.      crt,
  27.      dos,
  28.      graph;
  29.  
  30.  
  31. type PDiagramm=^TDiagramm;
  32.      TDiagramm=object(TWindow)
  33.        constructor Init(x,y:integer);
  34.        procedure SetPalette; virtual;
  35.        procedure InitBackground; virtual;
  36.      end;
  37.  
  38.      PFarn=^TFarn;
  39.      TFarn=object(TWindow)
  40.        xs,ys,k:integer;
  41.        x,y,xn,yn,z,s:real;
  42.        constructor Init(a,b:integer);
  43.        procedure InitBackground; virtual;
  44.        procedure HandleEvent; virtual;
  45.      end;
  46.  
  47.      PMausDemo=^TMausDemo;
  48.      TMausdemo=object(TDlgWindow)
  49.        Taste : array[1..2] of TRect;
  50.        MausImage:TRect;
  51.        constructor Init(x,y:integer);
  52.        procedure InitBackground; virtual;
  53.        procedure HandleEvent; virtual;
  54.      end;
  55.  
  56.      PDiaBgrd=^TDiaBgrd;
  57.      TDiaBgrd=object(TBackground)
  58.        procedure Draw;virtual;
  59.      end;
  60.  
  61.      PFarnBgrd=^TFarnBgrd;
  62.      TFarnBgrd=object(TBackground)
  63.        procedure Draw;virtual;
  64.      end;
  65.  
  66.      PMausDemoBgrd=^TMausDemoBgrd;
  67.      TMausDemoBgrd=object(TBackground)
  68.        procedure Draw;virtual;
  69.      end;
  70.  
  71.  
  72. IMPLEMENTATION
  73.  
  74. type tMausDemoData=record
  75.                      Schalter:string[19];
  76.                    end;
  77.  
  78. var MausData:tMausDemoData;
  79.  
  80. {Implementation TDiagramm}
  81.  
  82. constructor TDiagramm.Init(x,y:integer);
  83. var R:TRect;
  84. begin
  85.   R.Assign(x,y,x+210,y+200);
  86.   TWindow.Init(R,'Demo Geschäftsgrafik',winDouble+winPanel+winMenu+winKey);
  87. end;
  88.  
  89. procedure TDiagramm.SetPalette;
  90. begin
  91.   Palette:=Pal[palRed];
  92. end;
  93.  
  94. procedure TDiagramm.InitBackground;
  95. var R:TRect;
  96. begin
  97.   R:=Frame^.Area;
  98.   Bgrd:=new(PDiaBgrd, Init(R));
  99.   List^.InsertItem(Bgrd);
  100. end;
  101.  
  102. {Implementation TFarn}
  103.  
  104. const ax:array[1..3,1..4] of real = ((0,0.2,-0.15,0.85),
  105.                                      (0,-0.26,0.28,0.04),
  106.                                      (0,0,0,0));
  107.  
  108.       ay:array[1..3,1..4] of real = ((0,0.23,0.26,-0.04),
  109.                                      (0.16,0.22,0.24,0.85),
  110.                                      (0,1.6,0.44,1.6));
  111.  
  112.       p:array[1..4] of real = (0.01,0.07,0.07,0.85);
  113.  
  114.  
  115. constructor TFarn.Init(a,b:integer);
  116. var R:TRect;
  117. begin
  118.   R.Assign(a,b,a+210,b+200);
  119.   TWindow.Init(R,'Demo fraktales Farnblatt',winDouble+winPanel+winMenu+winKey);
  120. end;
  121.  
  122. procedure TFarn.HandleEvent;
  123. var R:TRect;
  124. begin
  125.   TWindow.HandleEvent;
  126.   R:=Frame^.Area;
  127.   with R do
  128.    begin
  129.      z:=Random;
  130.      k:=1;
  131.      s:=p[1];
  132.      while s<z do
  133.       begin
  134.         inc(k);
  135.         s:=s+p[k];
  136.       end;
  137.      xn:=ax[1,k]*x+ax[2,k]*y+ax[3,k];
  138.      yn:=ay[1,k]*x+ay[2,k]*y+ay[3,k];
  139.      x:=xn; y:=yn;
  140.      xs:=round(A.x+(Size.x div 2)*(x+8)*0.12);
  141.      ys:=round(A.y+((Size.y-24) div 2)*(15-y)*0.1);
  142.      PutPixel(xs,ys,LightGreen);
  143.    end;
  144. end;
  145.  
  146. procedure TFarn.InitBackground;
  147. var R:TRect;
  148. begin
  149.   x:=0; y:=0; Randomize;
  150.   R:=Frame^.Area;
  151.   Bgrd:=new(PFarnBgrd, Init(R));
  152.   List^.InsertItem(Bgrd);
  153. end;
  154.  
  155. {Implementation TMausDemo}
  156.  
  157. procedure TMausDemo.InitBackground;
  158. var RR:TRect;
  159. begin
  160.   RR:=Frame^.Area;
  161.   Bgrd:=new(PMausDemoBgrd, Init(RR));
  162.   List^.InsertItem(Bgrd);
  163. end;
  164.  
  165. constructor TMausDemo.Init(x,y:integer);
  166. var RR:TRect;
  167.     i:integer;
  168. begin
  169.   RR.Assign(x,y,x+400,y+320);
  170.   TDlgWindow.Init(RR,'Maus-Demo',winSingle);
  171.   SetPushButton(268,197,80,22,'OK',cmCloseWindow);
  172.    ChangePalColor(8,LightGray);
  173.   SetGroupFrame(20,40,195,230,'Mauszeiger',ThickWidth);
  174.    ChangePalColor(2,LightCyan);
  175.    ChangePalColor(1,Red);
  176.   SetRadioButton(40,70,' ~1~  Standard',1);
  177.    ChangePalColor(2,LightCyan);
  178.    ChangePalColor(3,Magenta);
  179.   SetRadioButton(40,90,' ~2~  Fadenkreuz',1);
  180.    ChangePalColor(2,LightCyan);
  181.    ChangePalColor(3,Magenta);
  182.   SetRadioButton(40,110,' ~3~  Sanduhr',1);
  183.    ChangePalColor(2,LightCyan);
  184.    ChangePalColor(3,Magenta);
  185.   SetRadioButton(40,130,' ~4~  Vierfach-Pfeil',1);
  186.    ChangePalColor(2,LightCyan);
  187.    ChangePalColor(3,Magenta);
  188.   SetRadioButton(40,150,' ~5~  Doppelpfeil',1);
  189.    ChangePalColor(2,LightCyan);
  190.    ChangePalColor(3,Magenta);
  191.   SetRadioButton(40,170,' ~6~  DPfeil/schräg',1);
  192.    ChangePalColor(2,LightCyan);
  193.    ChangePalColor(3,Magenta);
  194.   SetRadioButton(40,190,' ~7~  DPfeil/gerade',1);
  195.    ChangePalColor(2,LightCyan);
  196.    ChangePalColor(3,Magenta);
  197.   SetRadioButton(40,210,' ~8~  DPfeil/schräg',1);
  198.    ChangePalColor(2,LightCyan);
  199.    ChangePalColor(3,Magenta);
  200.   SetRadioButton(40,230,' ~9~  Kursorstrich',1);
  201.    ChangePalColor(2,LightCyan);
  202.    ChangePalColor(3,Magenta);
  203.   SetRadioButton(40,250,'1~0~  Hand',1);
  204.    ChangePalColor(2,LightCyan);
  205.    ChangePalColor(3,Magenta);
  206.   for i:=1 to 7 do
  207.    begin
  208.      SetPushButton(212+i*22,235,16,(8-i)*8,'',1000+i);
  209.       ChangePalColor(7,LightGray);
  210.       ChangePalColor(8,LightGray);
  211.      SetPushButton(212+i*22,238+(8-i)*8,16,i*8,'',1007+i);
  212.       ChangePalColor(7,LightGray);
  213.       ChangePalColor(8,LightGray);
  214.    end;
  215.   with MausData do Schalter:='TGRrrrrrrrrrTTTTTTT';
  216.   SetData(MausData);
  217.   RR:=Frame^.Area;
  218.   with RR do
  219.    begin
  220.      Taste[1].Assign(B.x-140,A.y+45,B.x-91,A.y+105);
  221.      Taste[2].Assign(B.x-85,A.y+45,B.x-40,A.y+105);
  222.      MausImage.Assign(B.x-145,A.y+40,B.x-35,A.y+180);
  223.    end;
  224. end;
  225.  
  226. procedure TMausDemo.HandleEvent;
  227. var ct:byte;
  228.     RR:TRect;
  229. begin
  230.   TDlgWindow.HandleEvent;
  231.   RR:=Frame^.Area;
  232.   if MausImage.Contains(Mouse.Position) then
  233.    begin
  234.      ct:=pos('R',MausData.Schalter)-2;
  235.      if Mouse.CursorTyp<>ct then Mouse.SetCursorTyp(ct);
  236.    end
  237.    else if Mouse.CursorTyp<>1 then Mouse.SetCursorTyp(1);
  238.   with RR do
  239.    if Taste[1].Contains(Mouse.Position) and Mouse.LButtonKlick then
  240.     begin
  241.       Mouse.HideMouse;
  242.       SetFillStyle(SolidFill,LightRed);
  243.       Bar(B.x-140,A.y+45,B.x-91,A.y+105);
  244.       Mouse.ShowMouse;
  245.     end
  246.     else if Mouse.LButtonRel then
  247.     begin
  248.       Mouse.HideMouse;
  249.       SetFillStyle(SolidFill,LightGray);
  250.       Bar(B.x-140,A.y+45,B.x-91,A.y+105);
  251.       Mouse.ShowMouse;
  252.     end;
  253.   with RR do
  254.    if Taste[2].Contains(Mouse.Position) and Mouse.RButtonKlick then
  255.     begin
  256.       Mouse.HideMouse;
  257.       SetFillStyle(SolidFill,LightRed);
  258.       Bar(B.x-85,A.y+45,B.x-40,A.y+105);
  259.       Mouse.ShowMouse;
  260.     end
  261.     else if Mouse.RButtonRel then
  262.     begin
  263.       Mouse.HideMouse;
  264.       SetFillStyle(SolidFill,LightGray);
  265.       Bar(B.x-85,A.y+45,B.x-40,A.y+105);
  266.       Mouse.ShowMouse;
  267.     end;
  268.    if Event.Command>1000 then
  269.     begin
  270.       case Event.Command of
  271.        1001 : sound(262);
  272.        1002 : sound(294);
  273.        1003 : sound(330);
  274.        1004 : sound(349);
  275.        1005 : sound(392);
  276.        1006 : sound(440);
  277.        1007 : sound(494);
  278.        1008 : sound(523);
  279.        1009 : sound(587);
  280.        1010 : sound(659);
  281.        1011 : sound(698);
  282.        1012 : sound(784);
  283.        1013 : sound(880);
  284.        1014 : sound(988);
  285.       end; {case}
  286.       delay(200);
  287.       NoSound;
  288.       Event.Command:=cmNothing;
  289.     end;
  290. end;
  291.  
  292. {Implementation TDiaBgrd}
  293.  
  294. procedure TDiaBgrd.Draw;
  295. var dx,dy,xm,ym,r:integer;
  296. begin
  297.   with Border do
  298.    begin
  299.      SetFillStyle(XHatchFill,DarkGray);
  300.      Bar(A.x,A.y,B.x,B.y);
  301.      SetColor(Blue);
  302.      dx:=abs(B.x-A.x);
  303.      dy:=abs(B.y-A.y);
  304.      xm:=A.x+dx div 2;
  305.      ym:=A.y+dy div 2;
  306.      if dy>dx then r:=trunc(dx*3/8) else r:=trunc(dy*3/8);
  307.      SetFillStyle(SolidFill,LightRed);
  308.      PieSlice(xm,ym,0,45,r);
  309.      SetFillStyle(SolidFill,LightGreen);
  310.      PieSlice(xm,ym,45,140,r);
  311.      SetFillStyle(SolidFill,LightMagenta);
  312.      PieSlice(xm,ym,140,268,r);
  313.      SetFillStyle(SolidFill,LightBlue);
  314.      PieSlice(xm,ym,268,310,r);
  315.      SetFillStyle(SolidFill,Yellow);
  316.      PieSlice(xm,ym,310,360,r);
  317.    end;
  318. end;
  319.  
  320. {Implementation TFarnBgrd}
  321.  
  322. procedure TFarnBgrd.Draw;
  323. begin
  324.   with Border do
  325.    begin
  326.      SetFillStyle(XHatchFill,DarkGray);
  327.      Bar(A.x,A.y,B.x,B.y);
  328.    end;
  329. end;
  330.  
  331. {Implementation TMausDemoBgrd}
  332.  
  333. procedure TMausDemoBgrd.Draw;
  334. begin
  335.   with Border do
  336.    begin
  337.      FBar(A.x,A.y,B.x,B.y,LightGray);
  338.      SetFillStyle(HatchFill,LightGreen);
  339.      Bar(B.x-145,A.y+40,B.x-35,A.y+180);
  340.      RectAngle(B.x-145,A.y+40,B.x-35,A.y+180);
  341.      D3Frame(B.x-150,a.y+35,B.x-30,A.y+185,Black,White);
  342.      FBar(B.x-140,A.y+45,B.x-91,A.y+105,LightGray);
  343.      FBar(B.x-85,A.y+45,B.x-40,A.y+105,LightGray);
  344.    end;
  345. end;
  346.  
  347.  
  348. END.