home *** CD-ROM | disk | FTP | other *** search
/ Chip 1995 March / CHIP3.mdf / utility / animator / animator.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-21  |  3.3 KB  |  138 lines
  1. (* By Scott D. Stephenson, CIS #70564,677 *)
  2. (* 10 Oct 93 *)
  3.  
  4. (* Program shell courtesy of Boilerplate (copyright L. David Baldwin) *)
  5. (* Mr Baldwin has written several Pascal tools found on the BPascal SIG (thanks!) *)
  6.  
  7. (* Animator is a rather crude "toy" program I wrote in a moment of boredom. *)
  8. (* Basically, I wanted to see if I could animate the desktop background screen. *)
  9. (* This version simply draws sun-like rays on the desktop window at one second intervals. *)
  10.  
  11. (* There sure is a lot of room for improvement in this code. *)
  12. (* If you create better animations, and I sure hope you will, *)
  13. (* please post them so we can all enjoy the fun! *)
  14.  
  15. (* The Animator source code is free to all. *)
  16.  
  17.  
  18. program animator;
  19. {$R animator.RES}
  20.  
  21. uses
  22.   Objects, OWindows, ODialogs, WinTypes, WinProcs, Strings, OStdDlgs, OStdWnds, Windos;
  23.  
  24. type
  25.   TMyApp = object(TApplication)
  26.     procedure InitInstance; virtual;
  27.     procedure InitMainWindow; virtual;
  28.   end;
  29.  
  30.   PMyWindow = ^TMyWindow;
  31.   TMyWindow = object(TDlgWindow)
  32.     P_101 : PStatic;
  33.     procedure   WMTimer (var Msg: TMessage); virtual wm_First + Wm_Timer;
  34.     constructor Init(ATitle : PChar);
  35.     procedure   SetupWindow ; virtual;
  36.     function    GetClassName : PChar; virtual;
  37.     procedure   GetWindowClass(var AWndClass : TWndClass); virtual;
  38.     destructor  Done; virtual;
  39.   end;
  40.  
  41. const
  42.   Textlen = 25;  {!!change as appropriate}
  43. var DesktopRectangle: trect;
  44.  
  45.  
  46. procedure desktoptest;
  47. var desk: hwnd;
  48.     dc: hdc;
  49.     x: integer;
  50.     r: trect;
  51. begin
  52. randomize;
  53. copyrect(r,desktoprectangle);
  54. with r do
  55.   begin
  56.   left:= random(left);
  57.   top:= random(top);
  58.   right:=  random(right);
  59.   bottom:=  random(bottom);
  60.   end;
  61. desk:= getdesktopwindow;
  62. dc:= getdc(desk);
  63. selectobject(desk,getstockobject(black_brush));
  64. moveto(dc,r.left,r.top);
  65. lineto(dc,r.right,r.bottom);
  66. releasedc(desk,dc);
  67. end;
  68.  
  69. procedure   TMyWindow.WMTimer (var Msg: TMessage);
  70. begin
  71. desktoptest;
  72. end;
  73.  
  74. {-------TMyWindow.Init}
  75. constructor TMyWindow.Init(ATitle : PChar);
  76. begin
  77. TDlgWindow.Init(Nil, 'ANIMATOR');
  78. New(P_101, InitResource(@Self, 101, Textlen));
  79. end;
  80.  
  81. {-------TMyWindow.SetupWindow;}
  82. procedure TMyWindow.SetupWindow;
  83. begin
  84. TDlgWindow.SetupWindow;
  85. P_101^.SetText('A String');
  86. setTimer(hwindow,1,1000,nil);
  87. getclientrect(getdesktopwindow,DesktopRectangle);
  88. end;
  89.  
  90. {-------TMyWindow.GetClassName}
  91. function TMyWindow.GetClassName : PChar;
  92. begin
  93. GetClassName := 'ANIMATOR';
  94. end;
  95.  
  96. {-------TMyWindow.GetWindowClass}
  97. procedure TMyWindow.GetWindowClass(var AWndClass : TWndClass);
  98. begin
  99. TDlgWindow.GetWindowClass(AWndClass);
  100. with AWndClass do
  101.   begin
  102.   hCursor := LoadCursor(0, PChar(idc_Arrow));
  103.   hIcon := LoadIcon(0, PChar(idi_Application));
  104.   Style := cs_Vredraw or cs_Hredraw;
  105.   end;
  106. end;
  107.  
  108. {------TMyWindow.Done}
  109. destructor TMyWindow.Done;
  110. var r: trect;
  111. begin
  112. TDlgWindow.Done;
  113. KillTimer(hWindow,1 );
  114. (* hey, we don't want to leave our desktop cluttered after we quit! *)
  115. InvalidateRect(getdesktopwindow,@DesktopRectangle,true);
  116. end;
  117.  
  118. {------TMyApp.InitMainWindow}
  119. procedure TMyApp.InitMainWindow;
  120. begin
  121.   MainWindow := New(PMyWindow, Init(''));
  122. end;
  123.  
  124. {------TMyApp.InitInstance}
  125. procedure TMyApp.InitInstance;
  126. begin
  127. TApplication.InitInstance;
  128. hAccTable := 0;
  129. end;
  130.  
  131. var
  132.   App : TMyApp;
  133. begin
  134.   App.Init('MyWindow');
  135.   App.Run;
  136.   App.Done;
  137. end.
  138.