home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / SPOOLAQ.ZIP / SPOOL1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-11  |  10KB  |  383 lines
  1. {************************************************}
  2. {                                                }
  3. {   program SPOOL1                               }
  4. {   demo program based on TVGUID15.PAS           }
  5. {   (Copyright (c) 1990 by Borland International)}
  6. {                                                }
  7. {   this program shows the use of the Idle-method}
  8. {                                                }
  9. {   this is part of SPOOL.EXE                    }
  10. {                                                }
  11. {************************************************}
  12. {$V-}
  13.  
  14. program Sppol1;
  15.  
  16. uses Objects, Drivers, Views, Menus, Dialogs, App, Dos;
  17.  
  18. const
  19.   FileToRead        = 'SPOOL1.PAS';
  20.   MaxLines          = 100;
  21.   WinCount: Integer =   0;
  22.   cmFileOpen        = 100;
  23.   cmNewWin          = 101;
  24.   cmNewDialog       = 102;
  25.  
  26. var
  27.   LineCount: Integer;
  28.   Lines: array[0..MaxLines - 1] of PString;
  29.  
  30. type
  31.   DialogData = record
  32.     CheckBoxData: Word;
  33.     RadioButtonData: Word;
  34.     InputLineData: string[128];
  35.   end;
  36.  
  37.    PIdleObject = ^TIdleObject;
  38.    TIdleObject = object ( TView )
  39.          lastTimerTicks : longint;
  40.          AnzahlAufrufe : word;
  41.          lastUhrzeit: longint;
  42.          momentaneUhrzeit : longint;
  43.  
  44.          constructor Init( Rect : TRect );
  45.          procedure   Draw;    virtual;
  46.          procedure   Update;  virtual;
  47.    end;
  48.  
  49.   TMyApp = object(TApplication)
  50.     DisplayIdleCalls : PIdleObject;
  51.     constructor Init;
  52.     destructor  Done;                         virtual;
  53.     procedure HandleEvent(var Event: TEvent); virtual;
  54.     procedure InitMenuBar;                    virtual;
  55.     procedure InitStatusLine;                 virtual;
  56.     procedure Idle;                           virtual;
  57.     procedure NewDialog;
  58.     procedure NewWindow;
  59.   end;
  60.  
  61.   PInterior = ^TInterior;
  62.   TInterior = object(TScroller)
  63.     constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  64.     procedure Draw; virtual;
  65.   end;
  66.  
  67.   PDemoWindow = ^TDemoWindow;
  68.   TDemoWindow = object(TWindow)
  69.     RInterior, LInterior: PInterior;
  70.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  71.     function MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
  72.     procedure SizeLimits(var Min, Max: TPoint); virtual;
  73.   end;
  74.  
  75.   PDemoDialog = ^TDemoDialog;
  76.   TDemoDialog = object(TDialog)
  77.   end;
  78.  
  79. procedure ReadFile;
  80. var
  81.   F: Text;
  82.   S: String;
  83. begin
  84.   LineCount := 0;
  85.   Assign(F, FileToRead);
  86.   {$I-}
  87.   Reset(F);
  88.   {$I+}
  89.   if IOResult <> 0 then
  90.   begin
  91.     Writeln('Cannot open ', FileToRead);
  92.     Halt(1);
  93.   end;
  94.   while not Eof(F) and (LineCount < MaxLines) do
  95.   begin
  96.     Readln(F, S);
  97.     Lines[LineCount] := NewStr(S);
  98.     Inc(LineCount);
  99.   end;
  100.   Close(F);
  101. end;
  102.  
  103. procedure DoneFile;
  104. var
  105.   I: Integer;
  106. begin
  107.   for I := 0 to LineCount - 1 do
  108.     if Lines[I] <> nil then DisposeStr(Lines[i]);
  109. end;
  110.  
  111. { TInterior }
  112. constructor TInterior.Init(var Bounds: TRect; AHScrollBar,
  113.   AVScrollBar: PScrollBar);
  114. begin
  115.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  116.   Options := Options or ofFramed;
  117.   SetLimit(128, LineCount);
  118. end;
  119.  
  120. procedure TInterior.Draw;
  121. var
  122.   Color: Byte;
  123.   I, Y: Integer;
  124.   B: TDrawBuffer;
  125. begin
  126.   Color := GetColor(1);
  127.   for Y := 0 to Size.Y - 1 do
  128.   begin
  129.     MoveChar(B, ' ', Color, Size.X);
  130.     i := Delta.Y + Y;
  131.     if (I < LineCount) and (Lines[I] <> nil) then
  132.       MoveStr(B, Copy(Lines[I]^, Delta.X + 1, Size.X), Color);
  133.     WriteLine(0, Y, Size.X, 1, B);
  134.   end;
  135. end;
  136.  
  137. { TDemoWindow }
  138. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  139. var
  140.   S: string[3];
  141.   R: TRect;
  142. begin
  143.   Str(WindowNo, S);
  144.   TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  145.   GetExtent(Bounds);
  146.   R.Assign(Bounds.A.X, Bounds.A.Y, Bounds.B.X div 2 + 1, Bounds.B.Y);
  147.   LInterior := MakeInterior(R, True);
  148.   LInterior^.GrowMode := gfGrowHiY;
  149.   Insert(Linterior);
  150.   R.Assign(Bounds.B.X div 2, Bounds.A.Y, Bounds.B.X, Bounds.B.Y);
  151.   RInterior := MakeInterior(R,False);
  152.   RInterior^.GrowMode := gfGrowHiX + gfGrowHiY;
  153.   Insert(RInterior);
  154. end;
  155.  
  156. function TDemoWindow.MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
  157. var
  158.   HScrollBar, VScrollBar: PScrollBar;
  159.   R: TRect;
  160. begin
  161.   R.Assign(Bounds.B.X-1, Bounds.A.Y+1, Bounds.B.X, Bounds.B.Y-1);
  162.   VScrollBar := New(PScrollBar, Init(R));
  163.   VScrollBar^.Options := VScrollBar^.Options or ofPostProcess;
  164.   if Left then VScrollBar^.GrowMode := gfGrowHiY;
  165.   Insert(VScrollBar);
  166.   R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y);
  167.   HScrollBar := New(PScrollBar, Init(R));
  168.   HScrollBar^.Options := HScrollBar^.Options or ofPostProcess;
  169.   if Left then HScrollBar^.GrowMode := gfGrowHiY + gfGrowLoY;
  170.   Insert(HScrollBar);
  171.   Bounds.Grow(-1,-1);
  172.   MakeInterior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar));
  173. end;
  174.  
  175. procedure TDemoWindow.SizeLimits(var Min, Max: TPoint);
  176. var R: TRect;
  177. begin
  178.   TWindow.SizeLimits(Min, Max);
  179.   Min.X := LInterior^.Size.X + 9;
  180. end;
  181.  
  182.  
  183. constructor TIdleObject.Init(  Rect : TRect );
  184. begin
  185.     TView.Init( Rect );
  186.     lastTimerTicks   := 0;
  187.     AnzahlAufrufe       := 0;
  188.     lastUhrzeit      := 0;
  189.     momentaneUhrzeit := 0;
  190. end;
  191.  
  192.  
  193. procedure TIdleObject.Draw;
  194. var
  195.     buf   : TDrawBuffer;
  196.     value : string[6];
  197.     Params : array [0..0] of longint;
  198. begin
  199.     Params[0] := AnzahlAufrufe;
  200.     FormatStr( Value, '%6d', Params);
  201.     MoveStr( Buf, Value, GetColor(2));
  202.     WriteLine(0, 0, 6, 1, Buf);
  203. end;
  204.  
  205.  
  206. procedure TIdleObject.Update;
  207.   function GetSekunden : longint;
  208.   var   Std,Min,Sek,Sek100 : word;
  209.   begin
  210.       GetTime(Std,Min,Sek,Sek100);
  211.       GetSekunden     := ( longint(Std) * longint(60) + longint(Min) )
  212.                             * longint(60) + longint(Sek);
  213.   end; (* ------------------------------------------- GetSekunden *)
  214. var   BIOSTimerTicks : longint absolute $40:$6c;
  215. begin
  216.     inc(AnzahlAufrufe);
  217.  
  218.     if BIOSTimerTicks<>lastTimerTicks then
  219.     begin
  220. (*       OK, hole Uhrzeit                                             *)
  221. (*       setzt Var. momentaneUhrzeit + momentaneUhrzeit100            *)
  222.         lastTimerTicks := BIOSTimerTicks;
  223.         momentaneUhrzeit := GetSekunden;
  224.         if momentaneUhrzeit<>lastUhrzeit then
  225.         begin
  226.             DrawView;
  227.             LastUhrzeit   := momentaneUhrzeit;
  228.             AnzahlAufrufe := 0;
  229.         end;
  230.     end;
  231. end;
  232.  
  233. { TMyApp }
  234. constructor TMyApp.Init;
  235. var
  236.     Rectangle : TRect;
  237. begin
  238.     TApplication.Init;
  239.  
  240.     GetExtent( Rectangle );
  241.     with Rectangle do
  242.     begin
  243.         a.x := b.x - 9;
  244.         b.x := b.x - 3;
  245.         b.y := a.y + 1;
  246.     end;
  247.     DisplayIdleCalls := new( PIdleObject, Init(Rectangle) );
  248.     insert( DisplayIdleCalls );
  249. end;
  250.  
  251. destructor TMyApp.Done;
  252. begin
  253.     TApplication.Done;
  254.     Dispose( DisplayIdleCalls, Done);
  255. end;
  256.  
  257. procedure TMyApp.HandleEvent(var Event: TEvent);
  258. begin
  259.   TApplication.HandleEvent(Event);
  260.   if Event.What = evCommand then
  261.   begin
  262.     case Event.Command of
  263.       cmNewWin: NewWindow;
  264.       cmNewDialog: NewDialog;
  265.     else
  266.       Exit;
  267.     end;
  268.     ClearEvent(Event);
  269.   end;
  270. end;
  271.  
  272. procedure TMyApp.InitMenuBar;
  273. var R: TRect;
  274. begin
  275.   GetExtent(R);
  276.   R.B.Y := R.A.Y + 1;
  277.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  278.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  279.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  280.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  281.       NewLine(
  282.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  283.       nil))))),
  284.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  285.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  286.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  287.       NewItem('~D~ialog', 'F2', kbF2, cmNewDialog, hcNoContext,
  288.       nil)))),
  289.     nil))
  290.   )));
  291. end;
  292.  
  293. procedure TMyApp.InitStatusLine;
  294. var R: TRect;
  295. begin
  296.   GetExtent(R);
  297.   R.A.Y := R.B.Y - 1;
  298.   StatusLine := New(PStatusLine, Init(R,
  299.     NewStatusDef(0, $FFFF,
  300.       NewStatusKey('', kbF10, cmMenu,
  301.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  302.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  303.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  304.       nil)))),
  305.     nil)
  306.   ));
  307. end;
  308.  
  309. procedure TMyApp.Idle;
  310. begin
  311.     TApplication.Idle;
  312.     DisplayIdleCalls^.Update;
  313. end; (* ------------------------------------------- HoleUhrzeit *)
  314.  
  315. procedure TMyApp.NewDialog;
  316. var
  317.   Bruce: PView;
  318.   Dialog: PDemoDialog;
  319.   R: TRect;
  320.   C: Word;
  321. begin
  322.   R.Assign(20, 6, 60, 19);
  323.   Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
  324.   with Dialog^ do
  325.   begin
  326.     R.Assign(3, 3, 18, 6);
  327.     Bruce := New(PCheckBoxes, Init(R,
  328.       NewSItem('~H~varti',
  329.       NewSItem('~T~ilset',
  330.       NewSItem('~J~arlsberg',
  331.       nil)))
  332.     ));
  333.     Insert(Bruce);
  334.     R.Assign(2, 2, 10, 3);
  335.     Insert(New(PLabel, Init(R, 'Cheeses', Bruce)));
  336.     R.Assign(22, 3, 34, 6);
  337.     Bruce := New(PRadioButtons, Init(R,
  338.       NewSItem('~S~olid',
  339.       NewSItem('~R~unny',
  340.       NewSItem('~M~elted',
  341.       nil)))
  342.     ));
  343.     Insert(Bruce);
  344.     R.Assign(21, 2, 33, 3);
  345.     Insert(New(PLabel, Init(R, 'Consistency', Bruce)));
  346.     R.Assign(3, 8, 37, 9);
  347.     Bruce := New(PInputLine, Init(R, 128));
  348.     Insert(Bruce);
  349.     R.Assign(2, 7, 24, 8);
  350.     Insert(New(PLabel, Init(R, 'Delivery instructions', Bruce)));
  351.     R.Assign(15, 10, 25, 12);
  352.     Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  353.     R.Assign(28, 10, 38, 12);
  354.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  355.     SelectNext(False);
  356.   end;
  357.   C := DeskTop^.ExecView(Dialog);
  358.   Dispose(Dialog, Done);
  359. end;
  360.  
  361. procedure TMyApp.NewWindow;
  362. var
  363.   Window: PDemoWindow;
  364.   R: TRect;
  365. begin
  366.   Inc(WinCount);
  367.   R.Assign(0, 0, 45, 13);
  368.   R.Move(Random(34), Random(11));
  369.   Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
  370.   DeskTop^.Insert(Window);
  371. end;
  372.  
  373. var
  374.   MyApp: TMyApp;
  375.  
  376. begin
  377.   ReadFile;
  378.   MyApp.Init;
  379.   MyApp.Run;
  380.   MyApp.Done;
  381.   DoneFile;
  382. end.
  383.