[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]

{
From: bobs@dragons.nest.nl (Bob Swart)

{ here is a very small screensaver. It compiles to less than 3Kbytes: }
{$A+,B-,D-,F+,G+,I-,K-,L-,N-,P-,Q-,R-,S+,T-,V-,W+,X+,Y-}
{$M 8192,0,8192}
program ScrnSave;
{$D SCRNSAVE: Bob Swart}
uses WinTypes,
     WinProcs;

  function MyYield: Boolean;
  var msg: TMsg;
  begin
    while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
    begin
      if msg.message = WM_QUIT then
      begin
        PostQuitMessage(msg.wParam);
        MyYield := TRUE;
        EXIT
      end
      else
      begin
        TranslateMessage(msg);
        DispatchMessage(msg)
      end
    end;
    MyYield := FALSE
  end {MyYield};


function DefSaverProc(hwnd: HWND; msg,wp: Word; lp: LongInt): LongInt; export;
Const SC_SCREENSAVE = $F140;
begin
  DefSaverProc := 0;
  case msg of
      WM_CREATE: ShowCursor(FALSE);
     WM_DESTROY: begin
                   ShowCursor(TRUE);
                   PostQuitMessage(0);
                 end;
  WM_SYSCOMMAND: if wp <> SC_SCREENSAVE then { screen saver starten }
                   PostMessage(hwnd, WM_CLOSE, 0, 0);
 WM_ACTIVATEAPP: if wp = 0 then PostMessage(hwnd, WM_CLOSE, 0, 0);
     WM_KEYDOWN,
  WM_SYSKEYDOWN,
{  WM_MOUSEMOVE, => I don't like my screensaver to stop on a mousemove }
 WM_LBUTTONDOWN,
 WM_MBUTTONDOWN,
 WM_RBUTTONDOWN: PostMessage(hwnd, WM_CLOSE, 0, 0);
    else
      DefSaverProc := DefWindowProc(hwnd, msg, wp, lp)
  end {case}
end {DefSaverProc};


function WndProc(hwnd: HWND; msg, wp: Word; lp: LongInt): LongInt; export;
var ps: TPaintStruct;
    X,Y: Integer;
    R,G,B: Byte;
    Dc: HDC;
begin
  WndProc := 0;
  case msg of
    WM_PAINT:
      begin
        beginPaint(hwnd, ps);
        endPaint(hwnd, ps);

        Dc := GetDC(hwnd);
        SetBkMode(Dc,TRANSPARENT);
        X := GetSystemMetrics(SM_CXSCREEN);
        Y := GetSystemMetrics(SM_CYSCREEN);
        while NOT MyYield do
        begin
          R := Random($FF);
          G := Random($FF);
          B := Random($FF);
          SetTextColor(Dc,RGB(R,G,B));
          TextOut(Dc,Random(X),Random(Y),'Bob Swart',9);
        end;
        releasedc(Dc, hwnd)
      end;
  else
    WndProc := CallWindowProc(@DefSaverProc, hwnd, msg, wp, lp)
  end
end {WndProc};


function BlackBox(WndProc: TFARPROC): Integer;
var msg: TMsg;
Const wc: TWndClass=();
begin
  wc.style         := CS_OWNDC;
  wc.lpfnWndProc   := WndProc;
  wc.hInstance     := hInstance;
  wc.hbrBackground := GetStockObject(BLACK_BRUSH);
  wc.lpszClassName := 'BlackBox';
  RegisterClass(wc);

  CreateWindow('BlackBox', nil, WS_POPUP+WS_MAXIMIZE+WS_VISIBLE,
        0, 0, 0, 0, 0, 0, hInstance, nil);

  while GetMessage(msg, 0, 0, 0) do DispatchMessage(msg);
  BlackBox := msg.wParam
end {BlackBox};

function Configure: Integer;
begin
  Configure :=
    MessageBox(HWnd(0),
              'Borland Pascal Performance Optimiziation screen saver demo',
              'DOS/Win Special 94/4',
               mb_OK OR mb_IconInformation)
end {Configure};


begin
  if hPrevInst <> 0 then Halt(1);
  Randomize;
  while ord(CmdLine[0]) <> 0 do
  begin
    if (CmdLine[0] = '-') OR (CmdLine[0] = '/') then
    begin
      Inc(CmdLine);
      case CmdLine[0] of
        's', 'S': blackbox(@WndProc) { activate };
        'c', 'C': configure
      end
    end;
    Inc(CmdLine)
  end
end.

[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]