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 / GINFO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-24  |  9KB  |  342 lines
  1. {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-}
  2. UNIT GInfo;
  3.  
  4. INTERFACE
  5.  
  6. USES GDecl,
  7.      GViews,
  8.      GDlg,
  9.      GDrivers,
  10.      GEvent,
  11.      GUtils,
  12.      crt,
  13.      Graph;
  14.  
  15.  
  16. type PMemoryInfo=^TMemoryInfo;
  17.      TMemoryInfo=object(TWindow)
  18.        procedure SetPalette; virtual;
  19.        procedure InitBackground; virtual;
  20.      end;
  21.  
  22.      PMausDemo=^TMausDemo;
  23.      TMausdemo=object(TDlgWindow)
  24.        Taste : array[1..2] of TRect;
  25.        MausImage:TRect;
  26.        constructor Init(var Bounds:TRect;ATitle:str80;AType:byte);
  27.        procedure InitBackground; virtual;
  28.        procedure HandleEvent; virtual;
  29.      end;
  30.  
  31.      PJoystickDemo=^TJoystickDemo;
  32.      TJoystickdemo=object(TDlgWindow)
  33.        OsziArea:TRect;
  34.        Winkel  :real;
  35.        ss,Ausl :word;
  36.        p       :pointer;
  37.        constructor Init(var Bounds:TRect;ATitle:str80;AType:byte);
  38.        destructor Done; virtual;
  39.        procedure InitBackground; virtual;
  40.        procedure HandleEvent; virtual;
  41.      end;
  42.  
  43.      PMemoryInfoBgrd=^TMemoryInfoBgrd;
  44.      TMemoryInfoBgrd=object(TBackground)
  45.        procedure Draw;virtual;
  46.      end;
  47.  
  48.      PMausDemoBgrd=^TMausDemoBgrd;
  49.      TMausDemoBgrd=object(TBackground)
  50.        procedure Draw;virtual;
  51.      end;
  52.  
  53.      PJoystickDemoBgrd=^TJoystickDemoBgrd;
  54.      TJoystickDemoBgrd=object(TBackground)
  55.        procedure Draw;virtual;
  56.      end;
  57.  
  58.  
  59.      tMausDemoData=record
  60.                      Schalter:string[19];
  61.                    end;
  62.  
  63. var MausData:tMausDemoData;
  64.  
  65. IMPLEMENTATION
  66.  
  67.  
  68. {Implementation TMemoryInfo}
  69.  
  70. procedure TMemoryInfo.SetPalette;
  71. begin
  72.   Palette:=Pal[palGreen];
  73. end;
  74.  
  75. procedure TMemoryInfo.InitBackground;
  76. var R:TRect;
  77. begin
  78.   R:=Frame^.Area;
  79.   Bgrd:=new(PMemoryInfoBgrd, Init(R));
  80.   List^.InsertItem(Bgrd);
  81. end;
  82.  
  83. {Implementation TMausDemo}
  84.  
  85. procedure TMausDemo.InitBackground;
  86. var RR:TRect;
  87. begin
  88.   RR:=Frame^.Area;
  89.   Bgrd:=new(PMausDemoBgrd, Init(RR));
  90.   List^.InsertItem(Bgrd);
  91. end;
  92.  
  93. constructor TMausDemo.Init(var Bounds:TRect;ATitle:str80;AType:byte);
  94. var RR:TRect;
  95. begin
  96.   TDlgWindow.Init(Bounds,ATitle,AType);
  97.   RR:=Frame^.Area;
  98.   with RR do
  99.    begin
  100.      Taste[1].Assign(B.x-140,A.y+45,B.x-91,A.y+105);
  101.      Taste[2].Assign(B.x-85,A.y+45,B.x-40,A.y+105);
  102.      MausImage.Assign(B.x-145,A.y+40,B.x-35,A.y+180);
  103.    end;
  104. end;
  105.  
  106. procedure TMausDemo.HandleEvent;
  107. var ct:byte;
  108.     RR:TRect;
  109. begin
  110.   TDlgWindow.HandleEvent;
  111.   RR:=Frame^.Area;
  112.   if MausImage.Contains(Mouse.Position) then
  113.    begin
  114.      ct:=pos('R',MausData.Schalter)-2;
  115.      if Mouse.CursorTyp<>ct then Mouse.SetCursorTyp(ct);
  116.    end
  117.    else if Mouse.CursorTyp<>1 then Mouse.SetCursorTyp(1);
  118.   with RR do
  119.    if Taste[1].Contains(Mouse.Position) and Mouse.LButtonKlick then
  120.     begin
  121.       Mouse.HideMouse;
  122.       SetFillStyle(SolidFill,LightRed);
  123.       Bar(B.x-140,A.y+45,B.x-91,A.y+105);
  124.       Mouse.ShowMouse;
  125.     end
  126.     else if Mouse.LButtonRel then
  127.     begin
  128.       Mouse.HideMouse;
  129.       SetFillStyle(SolidFill,LightGray);
  130.       Bar(B.x-140,A.y+45,B.x-91,A.y+105);
  131.       Mouse.ShowMouse;
  132.     end;
  133.   with RR do
  134.    if Taste[2].Contains(Mouse.Position) and Mouse.RButtonKlick then
  135.     begin
  136.       Mouse.HideMouse;
  137.       SetFillStyle(SolidFill,LightRed);
  138.       Bar(B.x-85,A.y+45,B.x-40,A.y+105);
  139.       Mouse.ShowMouse;
  140.     end
  141.     else if Mouse.RButtonRel then
  142.     begin
  143.       Mouse.HideMouse;
  144.       SetFillStyle(SolidFill,LightGray);
  145.       Bar(B.x-85,A.y+45,B.x-40,A.y+105);
  146.       Mouse.ShowMouse;
  147.     end;
  148.    if Event.Command>1000 then
  149.     begin
  150.       case Event.Command of
  151.        1001 : sound(262);
  152.        1002 : sound(294);
  153.        1003 : sound(330);
  154.        1004 : sound(349);
  155.        1005 : sound(392);
  156.        1006 : sound(440);
  157.        1007 : sound(494);
  158.        1008 : sound(523);
  159.        1009 : sound(587);
  160.        1010 : sound(659);
  161.        1011 : sound(698);
  162.        1012 : sound(784);
  163.        1013 : sound(880);
  164.        1014 : sound(988);
  165.       end; {case}
  166.       delay(200);
  167.       NoSound;
  168.       Event.Command:=cmNothing;
  169.     end;
  170. end;
  171.  
  172. {Implementation TJoystickDemo}
  173.  
  174. constructor TJoyStickDemo.Init(var Bounds:TRect;ATitle:str80;AType:byte);
  175. begin
  176.   TDlgWindow.Init(Bounds,ATitle,AType);
  177.   OsziArea:=Frame^.Area;
  178.   with OsziArea do ss:=ImageSize(A.x+50,A.y+150,B.x-120,B.y-50);
  179.   GetMem(p,ss);
  180.   Winkel:=0; Ausl:=0;
  181.   Mouse.HideMouse;
  182. end;
  183.  
  184. destructor TJoyStickDemo.Done;
  185. begin
  186.   Mouse.ShowMouse;
  187.   FreeMem(p,ss);
  188.   TDlgWindow.Done;
  189. end;
  190.  
  191. procedure TJoystickDemo.InitBackground;
  192. var RR:TRect;
  193. begin
  194.   RR:=Frame^.Area;
  195.   Bgrd:=new(PJoystickDemoBgrd, Init(RR));
  196.   List^.InsertItem(Bgrd);
  197. end;
  198.  
  199. procedure TJoystickDemo.HandleEvent;
  200. var ww:real;
  201.     aa:word;
  202. begin
  203.   TDlgWindow.HandleEvent;
  204.   with OsziArea do
  205.    begin
  206.      Joy.JoyStickHandle;
  207.      ww:=(Joy.Degree+90)*Pi/180;
  208.      aa:=Joy.Turn;
  209.      SetColor(White);
  210.      line(B.x-120,A.y+150,B.x-120,B.y-50);
  211.      SetWriteMode(XORPut);
  212.      SetColor(LightMagenta);
  213.      line(B.x-120,A.y+204,B.x-120,A.y+204+trunc(Joy.Y) div 3);
  214.      SetColor(Cyan);
  215.      line(B.x-120,A.y+205,B.x-120,A.y+205+trunc(Joy.X) div 3);
  216.      SetWriteMode(CopyPut);
  217.      GetImage(A.x+51,A.y+150,B.x-120,B.y-50,p^);
  218.      PutImage(A.x+50,A.y+150,p^,NormalPut);
  219.      SetLineStyle(SolidLn,0,ThickWidth);
  220.      SetColor(LightCyan);
  221.      line(A.x+320,A.y+70,A.x+320+trunc(40*sin(Winkel)),
  222.              A.y+70+trunc(40*cos((Winkel))));
  223.      SetColor(Black);
  224.      line(A.x+320,A.y+70,A.x+320+trunc(40*sin(ww)),
  225.              A.y+70+trunc(40*cos((ww))));
  226.      SetLineStyle(SolidLn,0,NormWidth);
  227.      Winkel:=ww;
  228.      if aa<>Ausl then
  229.       begin
  230.         SetFillStyle(SolidFill,Blue);
  231.         Bar(A.x+125,A.y+120,A.x+155,A.y+10);
  232.         SetFillStyle(SolidFill,Yellow); SetColor(LightGray);
  233.         Bar3D(A.x+125,A.y+120,A.x+145,A.y+120-(aa div 2),5,TopOn);
  234.       end;
  235.      Ausl:=aa;
  236.      SetFillStyle(SolidFill,Yellow);
  237.      if Joy.PushOne then
  238.       begin
  239.         FillEllipse(A.x+170,A.y+115,5,5);
  240.         Beep(440);
  241.         SetFillStyle(SolidFill,Red);
  242.         FillEllipse(A.x+170,A.y+115,5,5);
  243.       end;
  244.      if Joy.PushTwo then
  245.       begin
  246.         FillEllipse(A.x+170,A.y+85,5,5);
  247.         Beep(440);
  248.         SetFillStyle(SolidFill,Red);
  249.         FillEllipse(A.x+170,A.y+85,5,5);
  250.       end;
  251.    end;
  252. end;
  253.  
  254. {Implementation TMemoryInfoBgrd}
  255.  
  256. procedure TMemoryInfoBgrd.Draw;
  257. var z:string;
  258.     EMS:PEMS;
  259.     HD:PHardDisk;
  260. begin
  261.   with Border do
  262.    begin
  263.      SetFillStyle(SolidFill,GetPalColor(7));
  264.      Bar(A.x,A.y,B.x,B.y);
  265.      str(MemAvail:8,z);
  266.      SetColor(Red);
  267.      OutTextXY(A.x+10,A.y+25,'Hauptspeicher');
  268.      OutTextXY(A.x+10,A.y+100,'Expanded Memory');
  269.      OutTextXY(A.x+10,A.y+160,'Festplatte C');
  270.      SetColor(Blue);
  271.      OutTextXY(A.x+10,A.y+45,'Freier RAM (Heap)           : '+z+' Byte');
  272.      str(MaxAvail:8,z);
  273.      OutTextXY(A.x+10,A.y+65,'Größter zusammenhängender');
  274.      OutTextXY(A.x+10,A.y+75,'freier Speicherblock        : '+z+' Byte');
  275.      EMS:=new(PEMS, Init(Border));
  276.      str(EMS^.FreeMemory:8,z);
  277.      OutTextXY(A.x+10,A.y+120,'verfügbarer Speicher        : '+z+' Byte');
  278.      str(EMS^.FreeMemory div 16384:8,z);
  279.      OutTextXY(A.x+10,A.y+140,'verfügbare Seiten           : '+z+' Seiten');
  280.      dispose(EMS, Done);
  281.      HD:=new(PHardDisk, Init(Border));
  282.      str(HD^.FreeMemory:8,z);
  283.      OutTextXY(A.x+10,A.y+180,'verfügbare Plattenkapazität : '+z+' Byte');
  284.      dispose(HD, Done);
  285.    end;
  286. end;
  287.  
  288. {Implementation TMausDemoBgrd}
  289.  
  290. procedure TMausDemoBgrd.Draw;
  291. begin
  292.   with Border do
  293.    begin
  294.      SetFillStyle(SolidFill,Yellow);
  295.      Bar(A.x,A.y,B.x,B.y);
  296.      SetFillStyle(HatchFill,LightGray);
  297.      Bar(B.x-145,A.y+40,B.x-35,A.y+180);
  298.      SetFillStyle(SolidFill,LightGray);
  299.      Bar(B.x-140,A.y+45,B.x-91,A.y+105);
  300.      Bar(B.x-85,A.y+45,B.x-40,A.y+105);
  301.    end;
  302. end;
  303.  
  304. {Implementation TJoyStickDemoBgrd}
  305.  
  306. procedure TJoyStickDemoBgrd.Draw;
  307. var i:integer;
  308. begin
  309.   with Border do
  310.    begin
  311.      SetFillStyle(SolidFill,Blue);
  312.      Bar(A.x,A.y,B.x,B.y);
  313.      SetFillStyle(SolidFill,White);
  314.      Bar(A.x+50,A.y+150,B.x-120,B.y-50);
  315.      SetFillStyle(SolidFill,Red);
  316.      Bar