home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1143 / gepackt.exe / BSPQTSW.EXE / FTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-28  |  1.8 KB  |  89 lines
  1. (***************************************
  2. * WG-VISION 1.0   BEISPIELPROGRAMM     *
  3. ****************************************
  4. *                                      *
  5. * Aufblenden eines verschieb- und      *
  6. * skalierbaren Windows (nichtmodal)    *
  7. *                                      *
  8. ****************************************
  9. * (c) 1993 Dipl.Phys. Mathias Scholz   *
  10. ***************************************)
  11.  
  12. {$I COMPILER.INC}
  13.  
  14. program FTest;
  15.  
  16. uses WDecl,
  17.      WEvent,
  18.      WApp,
  19.      WDlg;
  20.  
  21. const cmNewWindow=101;
  22.  
  23. type TApplication=object(TApp)
  24.       procedure InitMenuBar; virtual;
  25.       procedure HandleEvent; virtual;
  26.       procedure NewWindow;
  27.      end;
  28.  
  29.      PNewWindow=^TNewWindow;
  30.      TNewWindow=object(TWindow)
  31.       constructor Init;
  32.       procedure SetPalette; virtual;
  33.      end;
  34.  
  35. var MyApp:TApplication;
  36.  
  37.  
  38. {Implementation TApplication}
  39.  
  40. procedure TApplication.InitMenuBar;
  41. begin
  42.   MainMenu('~F~enster',0);
  43.    SubMenu('~T~estfenster',cmNewWindow,0,0,false,false);
  44.    SubMenu('E~x~it  Alt-X',cmCloseApplication,0,altX,false,false);
  45.  end;
  46.  
  47. procedure TApplication.HandleEvent;
  48. begin
  49.   TProgram.HandleEvent;
  50.   case Event.Command of
  51.    cmNewWindow:NewWindow;
  52.   end; {case}
  53. end;
  54.  
  55. procedure TApplication.NewWindow;
  56. var Window:PNewWindow;
  57. begin
  58.   Window:=New(PNewWindow, Init);
  59.   InsertDesktop(Window);
  60. end;
  61.  
  62. {Implementation TNewWindow}
  63.  
  64. constructor TNewWindow.Init;
  65. var R:TRect;
  66. begin
  67.   R.Assign(60,80,400,280);
  68.   TWindow.Init(R,'Testfenster',winDouble+winPanel+winMenu+winKey);
  69.   SetWindowAttrib(false);
  70. end;
  71.  
  72. procedure TNewWindow.SetPalette;
  73. var I:integer;
  74. begin
  75.   TWindow.SetPalette;
  76.   for I:=2 to 5 do Palette[I]:=#14;
  77.   Palette[3]:=#7;
  78.   Palette[6]:=#1;
  79.   Palette[7]:=#8;
  80. end;
  81.  
  82. {Hauptprogramm}
  83.  
  84. begin
  85.   MyApp.Init('Fenster-Test');
  86.   MyApp.Run;
  87.   MyApp.Done;
  88. end.
  89.