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 / BSP11.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-05  |  6KB  |  267 lines
  1. program Beispiel11;
  2.  
  3. uses GDecl,
  4.      GEvent,
  5.      GDrivers,
  6.      GViews,
  7.      GDlg,
  8.      GApp,
  9.      Dos,
  10.      Graph;
  11.  
  12.  
  13. const cmMemory = 101;
  14.       cmUhr    = 102;
  15.  
  16.       msgSetClock = 1;  {Digitaluhr neu setzen}
  17.  
  18. type TApplication=object(TApp)
  19.        procedure SetDesktopFrame(Titel:string); virtual;
  20.        procedure SetDesktopBackground; virtual;
  21.        procedure InitMenuBar; virtual;
  22.        procedure HandleEvent; virtual;
  23.        procedure SpeicherStatus;
  24.        procedure DigitalUhr;
  25.      end;
  26.  
  27.      PMemoryInfo=^TMemoryInfo;
  28.      TMemoryInfo=object(TWindow)
  29.        procedure SetPalette; virtual;
  30.        procedure InitBackground; virtual;
  31.      end;
  32.  
  33.      PMemoryInfoBgrd=^TMemoryInfoBgrd;
  34.      TMemoryInfoBgrd=object(TBackground)
  35.        procedure Draw;virtual;
  36.      end;
  37.  
  38.      PDigitalUhr=^TDigitalUhr;
  39.      TDigitalUhr=object(TWindow)
  40.        procedure SetPalette; virtual;
  41.        procedure InitBackground; virtual;
  42.        procedure HandleEvent; virtual;
  43.      end;
  44.  
  45.      PUhrBgrd=^TUhrBgrd;
  46.      TUhrBgrd=object(TBackground)
  47.        Stunde  : word;
  48.        Minute  : word;
  49.        Sekunde : word;
  50.        procedure Draw;virtual;
  51.      end;
  52.  
  53.      PNewDTBgrd=^TNewDTBgrd;
  54.      TNewDTBgrd=object(TDsktpBgrd)
  55.        procedure Draw;virtual;
  56.      end;
  57.  
  58. var MyProg:TApplication;
  59.  
  60. {Implementation TApplication}
  61.  
  62. procedure TApplication.SetDesktopFrame(Titel:string);
  63. var R:TRect;
  64. begin
  65.   with Desktop^ do
  66.    begin
  67.      GetBounds(R);
  68.      Frame:=new(PFrame, Init(R,R,Titel,winDouble+winPanel+winMenu));
  69.      Frame^.Palette:=Palette1;
  70.      List^.InsertItem(Frame);
  71.    end;
  72. end;
  73.  
  74. procedure TApplication.SetDesktopBackground;
  75. var R:TRect;
  76.     NBgrd:PNewDTBgrd;
  77. begin
  78.   with Desktop^ do
  79.    begin
  80.      R:=Frame^.Area;
  81.      NBgrd:=new(PNewDTBgrd, Init(R));
  82.      NBgrd^.Palette[7]:=#14;
  83.      NBgrd^.Palette[8]:=#7;
  84.      List^.InsertItem(NBgrd);
  85.    end;
  86. end;
  87.  
  88. procedure TApplication.InitMenuBar;
  89. begin
  90.   Palette[1]:=#14;
  91.   Palette[5]:=#14;
  92.   Palette[4]:=#4;
  93.   Palette[12]:=#4;
  94.   MainMenu('~F~enster',0);
  95.    SubMenu('~S~peicher-Ressourcen',cmMemory,0,0,false,false);
  96.    SubMenu('~D~igitaluhr',cmUhr,0,0,false,false);
  97.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  98. end;
  99.  
  100. procedure TApplication.HandleEvent;
  101. begin
  102.   Heap^.ShowHeapStatus(523,8,White);
  103.   TProgram.HandleEvent;
  104.   case Event.Command of
  105.    cmMemory : SpeicherStatus;
  106.    cmUhr    : DigitalUhr;
  107.   end; {case}
  108. end;
  109.  
  110.  
  111. procedure TApplication.SpeicherStatus;
  112. var R:TRect;
  113.     Window:PMemoryInfo;
  114. begin
  115.   R.Assign(60,80,450,320);
  116.   Window:=new(PMemoryInfo, Init(R,'Speicher-Ressourcen',winDouble+winPanel+winMenu));
  117.   Window^.SetWindowAttrib(false);
  118.   InsertDesktop(Window);
  119. end;
  120.  
  121. procedure TApplication.DigitalUhr;
  122. var R:TRect;
  123.     Window:PDigitalUhr;
  124. begin
  125.   R.Assign(360,80,550,185);
  126.   Window:=new(PDigitalUhr, Init(R,'Uhr',winDouble+winPanel+winMenu));
  127.   Window^.SetWindowAttrib(false);
  128.   InsertDesktop(Window);
  129. end;
  130.  
  131. {Implementation TMemoryInfo}
  132.  
  133. procedure TMemoryInfo.SetPalette;
  134. begin
  135.   Palette:=Pal[palGreen];
  136. end;
  137.  
  138. procedure TMemoryInfo.InitBackground;
  139. var R:TRect;
  140. begin
  141.   R:=Frame^.Area;
  142.   Bgrd:=new(PMemoryInfoBgrd, Init(R));
  143.   List^.InsertItem(Bgrd);
  144. end;
  145.  
  146. {Implementation TMemoryInfoBgrd}
  147.  
  148. procedure TMemoryInfoBgrd.Draw;
  149. var z:string;
  150.     EMS:PEMS;
  151.     HD:PHardDisk;
  152. begin
  153.   with Border do
  154.    begin
  155.      SetFillStyle(SolidFill,GetPalColor(7));
  156.      Bar(A.x,A.y,B.x,B.y);
  157.      str(MemAvail:8,z);
  158.      SetColor(Red);
  159.      OutTextXY(A.x+10,A.y+25,'Hauptspeicher');
  160.      OutTextXY(A.x+10,A.y+100,'Expanded Memory');
  161.      OutTextXY(A.x+10,A.y+160,'Festplatte C');
  162.      SetColor(Blue);
  163.      OutTextXY(A.x+10,A.y+45,'Freier RAM (Heap)           : '+z+' Byte');
  164.      str(MaxAvail:8,z);
  165.      OutTextXY(A.x+10,A.y+65,'Größter zusammenhängender');
  166.      OutTextXY(A.x+10,A.y+75,'freier Speicherblock        : '+z+' Byte');
  167.      EMS:=new(PEMS, Init(Border));
  168.      str(EMS^.FreeMemory:8,z);
  169.      OutTextXY(A.x+10,A.y+120,'verfügbarer Speicher        : '+z+' Byte');
  170.      str(EMS^.FreeMemory div 16384:8,z);
  171.      OutTextXY(A.x+10,A.y+140,'verfügbare Seiten           : '+z+' Seiten');
  172.      dispose(EMS, Done);
  173.      HD:=new(PHardDisk, Init(Border));
  174.      str(HD^.FreeMemory:8,z);
  175.      OutTextXY(A.x+10,A.y+180,'verfügbare Plattenkapazität : '+z+' Byte');
  176.      dispose(HD, Done);
  177.    end;
  178. end;
  179.  
  180. {Implementation TDigitalUhr}
  181.  
  182. procedure TDigitalUhr.SetPalette;
  183. begin
  184.   Palette:=Pal[palRed];
  185. end;
  186.  
  187. procedure TDigitalUhr.InitBackground;
  188. var R:TRect;
  189. begin
  190.   R:=Frame^.Area;
  191.   Bgrd:=new(PUhrBgrd, Init(R));
  192.   List^.InsertItem(Bgrd);
  193. end;
  194.  
  195. procedure TDigitalUhr.HandleEvent;
  196. var Std,Min,Sek,HSek,
  197.     StdOld,MinOld,SekOld : word;
  198.     LfdPtr:PGroup;
  199.  
  200. procedure WriteTime(Nr,x,y:integer;Zeit1,Zeit2:word);
  201. var zz:string[2];
  202. begin
  203.   Mouse.HideMouse;
  204.   str(Zeit1:2,zz);
  205.   SetColor(Blue);
  206.   OutTextXY(x,y,zz);
  207.   str(Zeit2:2,zz);
  208.   SetColor(LightCyan);
  209.   OutTextXY(x,y,zz);
  210.   if Nr<3 then OutTextXY(x+38,y,':');
  211.   Mouse.ShowMouse;
  212. end;
  213.  
  214. begin
  215.   TWindow.HandleEvent;
  216.   SetTextStyle(TriplexFont,HorizDir,4);
  217.   GetTime(Std,Min,Sek,HSek);
  218.   LfdPtr:=List^.GetItems(3);
  219.   with PUhrBgrd(LfdPtr)^ do
  220.    begin
  221.      StdOld:=Stunde;
  222.      MinOld:=Minute;
  223.      SekOld:=Sekunde;
  224.    end;
  225.   if StdOld<>Std then WriteTime(1,Origin.x+30,Origin.y+40,StdOld,Std);
  226.   if MinOld<>Min then WriteTime(2,Origin.x+80,Origin.y+40,MinOld,Min);
  227.   if SekOld<>Sek then WriteTime(3,Origin.x+130,Origin.y+40,SekOld,Sek);
  228.   with PUhrBgrd(LfdPtr)^ do
  229.    begin
  230.      Stunde:=Std;
  231.      Minute:=Min;
  232.      Sekunde:=Sek;
  233.    end;
  234.   SetTextStyle(DefaultFont,HorizDir,0);
  235. end;
  236.  
  237. {Implementation TUhrBgrd}
  238.  
  239. procedure TUhrBgrd.Draw;
  240. begin
  241.   Stunde:=0; Minute:=0; Sekunde:=0;
  242.   with Border do
  243.    begin
  244.      SetFillStyle(SolidFill,Blue);
  245.      Bar(A.x,A.y,B.x,B.y);
  246.    end;
  247. end;
  248.  
  249. {Implementation TNewDTBgrd}
  250.  
  251. procedure TNewDTBgrd.Draw;
  252. begin
  253.   with Border do
  254.    begin
  255.      SetFillStyle(SolidFill,GetPalColor(7));
  256.      Bar(A.x,A.y,B.x,A.y+20);
  257.      SetFillStyle(SolidFill,GetPalColor(8));
  258.      Bar(A.x,A.y+22,B.x,B.y);
  259.    end;
  260. end;
  261.  
  262.  
  263. begin
  264.   MyProg.Init('Beispiel 11');
  265.   MyProg.Run;
  266.   MyProg.Done;
  267. end.