home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol12n18.zip / METER.ZIP / TESTMETR.PAS < prev   
Pascal/Delphi Source File  |  1993-06-12  |  3KB  |  114 lines
  1. {$X+,V-}
  2. PROGRAM TestMetr;
  3. USES App, Crt, Dialogs, Drivers, Menus, Objects, Views,
  4.      Meter;
  5. CONST
  6.   cmMeterDemo   = 100;
  7. TYPE
  8.   TMyApp = OBJECT(TApplication)
  9.    (* overriden methods *)
  10.     PROCEDURE HandleEvent(VAR Event: TEvent);  VIRTUAL;
  11.     PROCEDURE InitMenuBar;                     VIRTUAL;
  12.     PROCEDURE InitStatusLine;                  VIRTUAL;
  13.    (* new methods *)
  14.     PROCEDURE ShowMeter;
  15.   END;
  16.  
  17. PROCEDURE TMyApp.HandleEvent(VAR Event: TEvent);
  18. BEGIN
  19.   TApplication.HandleEvent(Event);
  20.   IF Event.What = evCommand THEN
  21.     BEGIN
  22.       CASE Event.Command OF
  23.         cmMeterDemo : ShowMeter;
  24.         ELSE EXIT
  25.       END;
  26.       ClearEvent(Event);
  27.     END;
  28. END;
  29.  
  30. PROCEDURE TMyApp.InitMenuBar;
  31. VAR R: TRect;
  32. BEGIN
  33.   GetExtent(R);
  34.   R.B.Y := R.A.Y + 1;
  35.   MenuBar :=
  36.     New(PMenuBar, Init(R, NewMenu(
  37.       NewSubMenu('~F~ile', hcNoContext, NewMenu(
  38.         NewItem('~M~eter control demo', 'F2', kbF2,
  39.                    cmMeterDemo, hcNoContext,
  40.         NewLine(
  41.         NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  42.         NIL)))),
  43.       NIL)
  44.     )));
  45. END;
  46.  
  47. PROCEDURE TMyApp.InitStatusLine;
  48. VAR R: TRect;
  49. BEGIN
  50.   GetExtent(R);
  51.   R.A.Y := R.B.Y - 1;
  52.   StatusLine :=
  53.     New(PStatusLine, Init(R,
  54.       NewStatusDef(0, $FFFF,
  55.         NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  56.         NewStatusKey('~F2~ Demo for meter control',
  57.                        kbF2, cmMeterDemo,
  58.         NIL)),
  59.       NIL)
  60.     ));
  61. END;
  62.  
  63. PROCEDURE TMyApp.ShowMeter;
  64. (* demo procedure showing three different meter controls *)
  65. VAR
  66.   PM, PM2, PM3 : PMeter;
  67.   PD : PDialog;
  68.   i  : WORD;
  69.   R  : TRect;
  70. BEGIN
  71.   R.Assign(25, 4, 55, 16);
  72.   PD := New(PDialog, Init(R, 'Meter Demo Dialog'));
  73.   Desktop^.Insert(PD);
  74.  (* first meter, pretending some copying operation *)
  75.   R.Assign(2, 2, 25, 4);
  76.   PM := New(PMeter, Init(R, 'Copying...', 0, 250));
  77.   PD^.Insert(PM);
  78.  (* second meter, indicating some verification process *)
  79.   R.Move(0, 3);
  80.   PM2 := New(PMeter, Init(R, 'Verifying...', 100, 200));
  81.   PM2^.SetColor($74, $2E);
  82.   PD^.Insert(PM2);
  83.  (* last meter shows some kind of conversion action *)
  84.   R.Move(0, 3);
  85.   PM3 := New(PMeter, Init(R, 'Converting...', 0, 300));
  86.   PM3^.SetColor($71, $1A);
  87.   PD^.Insert(PM3);
  88.   FOR i := 1 TO 250 DO
  89.     BEGIN
  90.       PM^.SetValue(i);
  91.       Delay(25);
  92.     END;
  93.   FOR i := 100 TO 200 DO
  94.     BEGIN
  95.       PM2^.SetValue(i);
  96.       Delay(10);
  97.     END;
  98.   FOR i := 1 TO 300 DO
  99.     BEGIN
  100.       PM3^.SetValue(i);
  101.       Delay(25);
  102.     END;
  103.   Delay(1000);
  104.   Desktop^.Delete(PD);
  105.   Dispose(PD, Done);
  106. END;
  107.  
  108. VAR  MyApp : TMyApp;
  109. BEGIN
  110.   MyApp.Init;
  111.   MyApp.Run;
  112.   MyApp.Done;
  113. END.
  114.