Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/wgraph1/beispiel/bsp11.pas

Pascal/Delphi Source File | 1992-12-05 | 6.1 KB | 267 lines

program Beispiel11;

uses GDecl,
     GEvent,
     GDrivers,
     GViews,
     GDlg,
     GApp,
     Dos,
     Graph;


const cmMemory = 101;
      cmUhr    = 102;

      msgSetClock = 1;  {Digitaluhr neu setzen}

type TApplication=object(TApp)
       procedure SetDesktopFrame(Titel:string); virtual;
       procedure SetDesktopBackground; virtual;
       procedure InitMenuBar; virtual;
       procedure HandleEvent; virtual;
       procedure SpeicherStatus;
       procedure DigitalUhr;
     end;

     PMemoryInfo=^TMemoryInfo;
     TMemoryInfo=object(TWindow)
       procedure SetPalette; virtual;
       procedure InitBackground; virtual;
     end;

     PMemoryInfoBgrd=^TMemoryInfoBgrd;
     TMemoryInfoBgrd=object(TBackground)
       procedure Draw;virtual;
     end;

     PDigitalUhr=^TDigitalUhr;
     TDigitalUhr=object(TWindow)
       procedure SetPalette; virtual;
       procedure InitBackground; virtual;
       procedure HandleEvent; virtual;
     end;

     PUhrBgrd=^TUhrBgrd;
     TUhrBgrd=object(TBackground)
       Stunde  : word;
       Minute  : word;
       Sekunde : word;
       procedure Draw;virtual;
     end;

     PNewDTBgrd=^TNewDTBgrd;
     TNewDTBgrd=object(TDsktpBgrd)
       procedure Draw;virtual;
     end;

var MyProg:TApplication;

{Implementation TApplication}

procedure TApplication.SetDesktopFrame(Titel:string);
var R:TRect;
begin
  with Desktop^ do
   begin
     GetBounds(R);
     Frame:=new(PFrame, Init(R,R,Titel,winDouble+winPanel+winMenu));
     Frame^.Palette:=Palette1;
     List^.InsertItem(Frame);
   end;
end;

procedure TApplication.SetDesktopBackground;
var R:TRect;
    NBgrd:PNewDTBgrd;
begin
  with Desktop^ do
   begin
     R:=Frame^.Area;
     NBgrd:=new(PNewDTBgrd, Init(R));
     NBgrd^.Palette[7]:=#14;
     NBgrd^.Palette[8]:=#7;
     List^.InsertItem(NBgrd);
   end;
end;

procedure TApplication.InitMenuBar;
begin
  Palette[1]:=#14;
  Palette[5]:=#14;
  Palette[4]:=#4;
  Palette[12]:=#4;
  MainMenu('~F~enster',0);
   SubMenu('~S~peicher-Ressourcen',cmMemory,0,0,false,false);
   SubMenu('~D~igitaluhr',cmUhr,0,0,false,false);
   SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
end;

procedure TApplication.HandleEvent;
begin
  Heap^.ShowHeapStatus(523,8,White);
  TProgram.HandleEvent;
  case Event.Command of
   cmMemory : SpeicherStatus;
   cmUhr    : DigitalUhr;
  end; {case}
end;


procedure TApplication.SpeicherStatus;
var R:TRect;
    Window:PMemoryInfo;
begin
  R.Assign(60,80,450,320);
  Window:=new(PMemoryInfo, Init(R,'Speicher-Ressourcen',winDouble+winPanel+winMenu));
  Window^.SetWindowAttrib(false);
  InsertDesktop(Window);
end;

procedure TApplication.DigitalUhr;
var R:TRect;
    Window:PDigitalUhr;
begin
  R.Assign(360,80,550,185);
  Window:=new(PDigitalUhr, Init(R,'Uhr',winDouble+winPanel+winMenu));
  Window^.SetWindowAttrib(false);
  InsertDesktop(Window);
end;

{Implementation TMemoryInfo}

procedure TMemoryInfo.SetPalette;
begin
  Palette:=Pal[palGreen];
end;

procedure TMemoryInfo.InitBackground;
var R:TRect;
begin
  R:=Frame^.Area;
  Bgrd:=new(PMemoryInfoBgrd, Init(R));
  List^.InsertItem(Bgrd);
end;

{Implementation TMemoryInfoBgrd}

procedure TMemoryInfoBgrd.Draw;
var z:string;
    EMS:PEMS;
    HD:PHardDisk;
begin
  with Border do
   begin
     SetFillStyle(SolidFill,GetPalColor(7));
     Bar(A.x,A.y,B.x,B.y);
     str(MemAvail:8,z);
     SetColor(Red);
     OutTextXY(A.x+10,A.y+25,'Hauptspeicher');
     OutTextXY(A.x+10,A.y+100,'Expanded Memory');
     OutTextXY(A.x+10,A.y+160,'Festplatte C');
     SetColor(Blue);
     OutTextXY(A.x+10,A.y+45,'Freier RAM (Heap)           : '+z+' Byte');
     str(MaxAvail:8,z);
     OutTextXY(A.x+10,A.y+65,'Größter zusammenhängender');
     OutTextXY(A.x+10,A.y+75,'freier Speicherblock        : '+z+' Byte');
     EMS:=new(PEMS, Init(Border));
     str(EMS^.FreeMemory:8,z);
     OutTextXY(A.x+10,A.y+120,'verfügbarer Speicher        : '+z+' Byte');
     str(EMS^.FreeMemory div 16384:8,z);
     OutTextXY(A.x+10,A.y+140,'verfügbare Seiten           : '+z+' Seiten');
     dispose(EMS, Done);
     HD:=new(PHardDisk, Init(Border));
     str(HD^.FreeMemory:8,z);
     OutTextXY(A.x+10,A.y+180,'verfügbare Plattenkapazität : '+z+' Byte');
     dispose(HD, Done);
   end;
end;

{Implementation TDigitalUhr}

procedure TDigitalUhr.SetPalette;
begin
  Palette:=Pal[palRed];
end;

procedure TDigitalUhr.InitBackground;
var R:TRect;
begin
  R:=Frame^.Area;
  Bgrd:=new(PUhrBgrd, Init(R));
  List^.InsertItem(Bgrd);
end;

procedure TDigitalUhr.HandleEvent;
var Std,Min,Sek,HSek,
    StdOld,MinOld,SekOld : word;
    LfdPtr:PGroup;

procedure WriteTime(Nr,x,y:integer;Zeit1,Zeit2:word);
var zz:string[2];
begin
  Mouse.HideMouse;
  str(Zeit1:2,zz);
  SetColor(Blue);
  OutTextXY(x,y,zz);
  str(Zeit2:2,zz);
  SetColor(LightCyan);
  OutTextXY(x,y,zz);
  if Nr<3 then OutTextXY(x+38,y,':');
  Mouse.ShowMouse;
end;

begin
  TWindow.HandleEvent;
  SetTextStyle(TriplexFont,HorizDir,4);
  GetTime(Std,Min,Sek,HSek);
  LfdPtr:=List^.GetItems(3);
  with PUhrBgrd(LfdPtr)^ do
   begin
     StdOld:=Stunde;
     MinOld:=Minute;
     SekOld:=Sekunde;
   end;
  if StdOld<>Std then WriteTime(1,Origin.x+30,Origin.y+40,StdOld,Std);
  if MinOld<>Min then WriteTime(2,Origin.x+80,Origin.y+40,MinOld,Min);
  if SekOld<>Sek then WriteTime(3,Origin.x+130,Origin.y+40,SekOld,Sek);
  with PUhrBgrd(LfdPtr)^ do
   begin
     Stunde:=Std;
     Minute:=Min;
     Sekunde:=Sek;
   end;
  SetTextStyle(DefaultFont,HorizDir,0);
end;

{Implementation TUhrBgrd}

procedure TUhrBgrd.Draw;
begin
  Stunde:=0; Minute:=0; Sekunde:=0;
  with Border do
   begin
     SetFillStyle(SolidFill,Blue);
     Bar(A.x,A.y,B.x,B.y);
   end;
end;

{Implementation TNewDTBgrd}

procedure TNewDTBgrd.Draw;
begin
  with Border do
   begin
     SetFillStyle(SolidFill,GetPalColor(7));
     Bar(A.x,A.y,B.x,A.y+20);
     SetFillStyle(SolidFill,GetPalColor(8));
     Bar(A.x,A.y+22,B.x,B.y);
   end;
end;


begin
  MyProg.Init('Beispiel 11');
  MyProg.Run;
  MyProg.Done;
end.