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 / BSP9.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-05  |  2KB  |  105 lines
  1. program Beispiel9;
  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.      PNewDTBgrd=^TNewDTBgrd;
  22.      TNewDTBgrd=object(TDsktpBgrd)
  23.        procedure Draw;virtual;
  24.      end;
  25.  
  26. var MyProg:TApplication;
  27.  
  28. {Implementation TApplication}
  29.  
  30. procedure TApplication.SetDesktopFrame(Titel:string);
  31. var R:TRect;
  32. begin
  33.   with Desktop^ do
  34.    begin
  35.      GetBounds(R);
  36.      Frame:=new(PFrame, Init(R,R,Titel,winDouble+winPanel+winMenu));
  37.      Frame^.Palette:=Palette1;
  38.      List^.InsertItem(Frame);
  39.    end;
  40. end;
  41.  
  42. procedure TApplication.SetDesktopBackground;
  43. var R:TRect;
  44.     NBgrd:PNewDTBgrd;
  45. begin
  46.   with Desktop^ do
  47.    begin
  48.      R:=Frame^.Area;
  49.      NBgrd:=new(PNewDTBgrd, Init(R));
  50.      NBgrd^.Palette[7]:=#14;
  51.      NBgrd^.Palette[8]:=#7;
  52.      List^.InsertItem(NBgrd);
  53.    end;
  54. end;
  55.  
  56. procedure TApplication.InitMenuBar;
  57. begin
  58.   Palette[1]:=#14;
  59.   Palette[5]:=#14;
  60.   Palette[4]:=#4;
  61.   Palette[12]:=#4;
  62.   MainMenu('~F~enster',0);
  63.    SubMenu('~S~tandard-Fenster',cmStandard,0,0,false,false);
  64.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  65. end;
  66.  
  67. procedure TApplication.HandleEvent;
  68. begin
  69.   Heap^.ShowHeapStatus(523,8,White);
  70.   TProgram.HandleEvent;
  71.   case Event.Command of
  72.    cmStandard : NewWindow;
  73.   end; {case}
  74. end;
  75.  
  76.  
  77. procedure TApplication.NewWindow;
  78. var R:TRect;
  79.     Window:PWindow;
  80. begin
  81.   R.Assign(60,80,440,280);
  82.   Window:=new(PWindow, Init(R,'Beispiel 9 : Window',winDouble+winPanel+winMenu+winKey));
  83.   InsertDesktop(Window);
  84. end;
  85.  
  86.  
  87. {Implementation TNewDTBgrd}
  88.  
  89. procedure TNewDTBgrd.Draw;
  90. begin
  91.   with Border do
  92.    begin
  93.      SetFillStyle(SolidFill,GetPalColor(7));
  94.      Bar(A.x,A.y,B.x,A.y+20);
  95.      SetFillStyle(SolidFill,GetPalColor(8));
  96.      Bar(A.x,A.y+22,B.x,B.y);
  97.    end;
  98. end;
  99.  
  100.  
  101. begin
  102.   MyProg.Init('Beispiel 9');
  103.   MyProg.Run;
  104.   MyProg.Done;
  105. end.