[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]