home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / wissen / dos / wgraph / entpack.exe / WGBSP!.EXE / BSP10.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-05  |  4KB  |  166 lines
  1. program Beispiel10;
  2.  
  3. uses GDecl,
  4.      GEvent,
  5.      GViews,
  6.      GDlg,
  7.      GApp,
  8.      Graph;
  9.  
  10.  
  11. const cmStandard = 101;
  12.  
  13. type TApplication=object(TApp)
  14.        procedure SetDesktopFrame(Titel:string); virtual;
  15.        procedure SetDesktopBackground; virtual;
  16.        procedure InitMenuBar; virtual;
  17.        procedure HandleEvent; virtual;
  18.        procedure NewWindow;
  19.      end;
  20.  
  21.      PMemoryInfo=^TMemoryInfo;
  22.      TMemoryInfo=object(TWindow)
  23.        procedure SetPalette; virtual;
  24.        procedure InitBackground; virtual;
  25.      end;
  26.  
  27.      PMemoryInfoBgrd=^TMemoryInfoBgrd;
  28.      TMemoryInfoBgrd=object(TBackground)
  29.        procedure Draw;virtual;
  30.      end;
  31.  
  32.      PNewDTBgrd=^TNewDTBgrd;
  33.      TNewDTBgrd=object(TDsktpBgrd)
  34.        procedure Draw;virtual;
  35.      end;
  36.  
  37. var MyProg:TApplication;
  38.  
  39. {Implementation TApplication}
  40.  
  41. procedure TApplication.SetDesktopFrame(Titel:string);
  42. var R:TRect;
  43. begin
  44.   with Desktop^ do
  45.    begin
  46.      GetBounds(R);
  47.      Frame:=new(PFrame, Init(R,R,Titel,winDouble+winPanel+winMenu));
  48.      Frame^.Palette:=Palette1;
  49.      List^.InsertItem(Frame);
  50.    end;
  51. end;
  52.  
  53. procedure TApplication.SetDesktopBackground;
  54. var R:TRect;
  55.     NBgrd:PNewDTBgrd;
  56. begin
  57.   with Desktop^ do
  58.    begin
  59.      R:=Frame^.Area;
  60.      NBgrd:=new(PNewDTBgrd, Init(R));
  61.      NBgrd^.Palette[7]:=#14;
  62.      NBgrd^.Palette[8]:=#7;
  63.      List^.InsertItem(NBgrd);
  64.    end;
  65. end;
  66.  
  67. procedure TApplication.InitMenuBar;
  68. begin
  69.   Palette[1]:=#14;
  70.   Palette[5]:=#14;
  71.   Palette[4]:=#4;
  72.   Palette[12]:=#4;
  73.   MainMenu('~F~enster',0);
  74.    SubMenu('~S~peicher-Ressourcen',cmStandard,0,0,false,false);
  75.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  76. end;
  77.  
  78. procedure TApplication.HandleEvent;
  79. begin
  80.   Heap^.ShowHeapStatus(523,8,White);
  81.   TProgram.HandleEvent;
  82.   case Event.Command of
  83.    cmStandard : NewWindow;
  84.   end; {case}
  85. end;
  86.  
  87.  
  88. procedure TApplication.NewWindow;
  89. var R:TRect;
  90.     Window:PMemoryInfo;
  91. begin
  92.   R.Assign(60,80,450,320);
  93.   Window:=new(PMemoryInfo, Init(R,'Speicher-Ressourcen',winDouble+winPanel+winMenu));
  94.   Window^.SetWindowAttrib(false);
  95.   InsertDesktop(Window);
  96. end;
  97.  
  98. {Implementation TMemoryInfo}
  99.  
  100. procedure TMemoryInfo.SetPalette;
  101. begin
  102.   Palette:=Pal[palGreen];
  103. end;
  104.  
  105. procedure TMemoryInfo.InitBackground;
  106. var R:TRect;
  107. begin
  108.   R:=Frame^.Area;
  109.   Bgrd:=new(PMemoryInfoBgrd, Init(R));
  110.   List^.InsertItem(Bgrd);
  111. end;
  112.  
  113. {Implementation TMemoryInfoBgrd}
  114.  
  115. procedure TMemoryInfoBgrd.Draw;
  116. var z:string;
  117.     EMS:PEMS;
  118.     HD:PHardDisk;
  119. begin
  120.   with Border do
  121.    begin
  122.      SetFillStyle(SolidFill,GetPalColor(7));
  123.      Bar(A.x,A.y,B.x,B.y);
  124.      str(MemAvail:8,z);
  125.      SetColor(Red);
  126.      OutTextXY(A.x+10,A.y+25,'Hauptspeicher');
  127.      OutTextXY(A.x+10,A.y+100,'Expanded Memory');
  128.      OutTextXY(A.x+10,A.y+160,'Festplatte C');
  129.      SetColor(Blue);
  130.      OutTextXY(A.x+10,A.y+45,'Freier RAM (Heap)           : '+z+' Byte');
  131.      str(MaxAvail:8,z);
  132.      OutTextXY(A.x+10,A.y+65,'Größter zusammenhängender');
  133.      OutTextXY(A.x+10,A.y+75,'freier Speicherblock        : '+z+' Byte');
  134.      EMS:=new(PEMS, Init(Border));
  135.      str(EMS^.FreeMemory:8,z);
  136.      OutTextXY(A.x+10,A.y+120,'verfügbarer Speicher        : '+z+' Byte');
  137.      str(EMS^.FreeMemory div 16384:8,z);
  138.      OutTextXY(A.x+10,A.y+140,'verfügbare Seiten           : '+z+' Seiten');
  139.      dispose(EMS, Done);
  140.      HD:=new(PHardDisk, Init(Border));
  141.      str(HD^.FreeMemory:8,z);
  142.      OutTextXY(A.x+10,A.y+180,'verfügbare Plattenkapazität : '+z+' Byte');
  143.      dispose(HD, Done);
  144.    end;
  145. end;
  146.  
  147.  
  148. {Implementation TNewDTBgrd}
  149.  
  150. procedure TNewDTBgrd.Draw;
  151. begin
  152.   with Border do
  153.    begin
  154.      SetFillStyle(SolidFill,GetPalColor(7));
  155.      Bar(A.x,A.y,B.x,A.y+20);
  156.      SetFillStyle(SolidFill,GetPalColor(8));
  157.      Bar(A.x,A.y+22,B.x,B.y);
  158.    end;
  159. end;
  160.  
  161.  
  162. begin
  163.   MyProg.Init('Beispiel 10');
  164.   MyProg.Run;
  165.   MyProg.Done;
  166. end.