home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / win-os2.swg / 0048_Windows Screen Saver.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  3.4 KB  |  135 lines
  1. {
  2. From: bobs@dragons.nest.nl (Bob Swart)
  3.  
  4. { here is a very small screensaver. It compiles to less than 3Kbytes: }
  5. {$A+,B-,D-,F+,G+,I-,K-,L-,N-,P-,Q-,R-,S+,T-,V-,W+,X+,Y-}
  6. {$M 8192,0,8192}
  7. program ScrnSave;
  8. {$D SCRNSAVE: Bob Swart}
  9. uses WinTypes,
  10.      WinProcs;
  11.  
  12.   function MyYield: Boolean;
  13.   var msg: TMsg;
  14.   begin
  15.     while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
  16.     begin
  17.       if msg.message = WM_QUIT then
  18.       begin
  19.         PostQuitMessage(msg.wParam);
  20.         MyYield := TRUE;
  21.         EXIT
  22.       end
  23.       else
  24.       begin
  25.         TranslateMessage(msg);
  26.         DispatchMessage(msg)
  27.       end
  28.     end;
  29.     MyYield := FALSE
  30.   end {MyYield};
  31.  
  32.  
  33. function DefSaverProc(hwnd: HWND; msg,wp: Word; lp: LongInt): LongInt; export;
  34. Const SC_SCREENSAVE = $F140;
  35. begin
  36.   DefSaverProc := 0;
  37.   case msg of
  38.       WM_CREATE: ShowCursor(FALSE);
  39.      WM_DESTROY: begin
  40.                    ShowCursor(TRUE);
  41.                    PostQuitMessage(0);
  42.                  end;
  43.   WM_SYSCOMMAND: if wp <> SC_SCREENSAVE then { screen saver starten }
  44.                    PostMessage(hwnd, WM_CLOSE, 0, 0);
  45.  WM_ACTIVATEAPP: if wp = 0 then PostMessage(hwnd, WM_CLOSE, 0, 0);
  46.      WM_KEYDOWN,
  47.   WM_SYSKEYDOWN,
  48. {  WM_MOUSEMOVE, => I don't like my screensaver to stop on a mousemove }
  49.  WM_LBUTTONDOWN,
  50.  WM_MBUTTONDOWN,
  51.  WM_RBUTTONDOWN: PostMessage(hwnd, WM_CLOSE, 0, 0);
  52.     else
  53.       DefSaverProc := DefWindowProc(hwnd, msg, wp, lp)
  54.   end {case}
  55. end {DefSaverProc};
  56.  
  57.  
  58. function WndProc(hwnd: HWND; msg, wp: Word; lp: LongInt): LongInt; export;
  59. var ps: TPaintStruct;
  60.     X,Y: Integer;
  61.     R,G,B: Byte;
  62.     Dc: HDC;
  63. begin
  64.   WndProc := 0;
  65.   case msg of
  66.     WM_PAINT:
  67.       begin
  68.         beginPaint(hwnd, ps);
  69.         endPaint(hwnd, ps);
  70.  
  71.         Dc := GetDC(hwnd);
  72.         SetBkMode(Dc,TRANSPARENT);
  73.         X := GetSystemMetrics(SM_CXSCREEN);
  74.         Y := GetSystemMetrics(SM_CYSCREEN);
  75.         while NOT MyYield do
  76.         begin
  77.           R := Random($FF);
  78.           G := Random($FF);
  79.           B := Random($FF);
  80.           SetTextColor(Dc,RGB(R,G,B));
  81.           TextOut(Dc,Random(X),Random(Y),'Bob Swart',9);
  82.         end;
  83.         releasedc(Dc, hwnd)
  84.       end;
  85.   else
  86.     WndProc := CallWindowProc(@DefSaverProc, hwnd, msg, wp, lp)
  87.   end
  88. end {WndProc};
  89.  
  90.  
  91. function BlackBox(WndProc: TFARPROC): Integer;
  92. var msg: TMsg;
  93. Const wc: TWndClass=();
  94. begin
  95.   wc.style         := CS_OWNDC;
  96.   wc.lpfnWndProc   := WndProc;
  97.   wc.hInstance     := hInstance;
  98.   wc.hbrBackground := GetStockObject(BLACK_BRUSH);
  99.   wc.lpszClassName := 'BlackBox';
  100.   RegisterClass(wc);
  101.  
  102.   CreateWindow('BlackBox', nil, WS_POPUP+WS_MAXIMIZE+WS_VISIBLE,
  103.         0, 0, 0, 0, 0, 0, hInstance, nil);
  104.  
  105.   while GetMessage(msg, 0, 0, 0) do DispatchMessage(msg);
  106.   BlackBox := msg.wParam
  107. end {BlackBox};
  108.  
  109. function Configure: Integer;
  110. begin
  111.   Configure :=
  112.     MessageBox(HWnd(0),
  113.               'Borland Pascal Performance Optimiziation screen saver demo',
  114.               'DOS/Win Special 94/4',
  115.                mb_OK OR mb_IconInformation)
  116. end {Configure};
  117.  
  118.  
  119. begin
  120.   if hPrevInst <> 0 then Halt(1);
  121.   Randomize;
  122.   while ord(CmdLine[0]) <> 0 do
  123.   begin
  124.     if (CmdLine[0] = '-') OR (CmdLine[0] = '/') then
  125.     begin
  126.       Inc(CmdLine);
  127.       case CmdLine[0] of
  128.         's', 'S': blackbox(@WndProc) { activate };
  129.         'c', 'C': configure
  130.       end
  131.     end;
  132.     Inc(CmdLine)
  133.   end
  134. end.
  135.