[View Borland Home Page][View Product List][Search This Web Site][View Available Downloads][Join Borland Online][Enter Discussion Area][Send Email To Webmaster]
delphi
Technical Information Document (TI3335)
Creating a 32-Bit Screen Saver in Delphi 3
  • Product: Delphi
  • Version: 3.x
  • Platform: Windows 95, Windows NT
  • This TI shows how you can write a 32-bit screen saver in Delphi 3. The screen saver contains support for preview mode (the little monitor in Display Properties | Screen Saver), as well as password protection and a configuration dialog.

    First, a brief overview of what a screen saver is. For a more complete overview, consult the MSDN (Microsoft Developers Network), books and articles on the subject. There are also web sites with screen saver information and source code.

    A screen saver is just an executable that has an extension of SCR instead of EXE. In Delphi 3, you can set this using the $E compiler directive.

    A screen saver can be launched in several ways:

    • When the screen saver timeout happens
    • By going to the Screen Saver tab in Display Properties (preview)
    • By configuring it
    • By previewing it (full screen)
    • By changing the screen saver password (Win95)
    The screen saver is launched with different parameters depending on how it's launched:
    • When the screen saver timeout happens, it's launched with ParamStr(1) containing either '/S', '-S', or just 'S'.
    • When you go to the Screen Saver tab in Display Properties the screen saver is supposed to preview itself in the little monitor. ParamStr(1) will contain '/P', '-P', or just 'P'. At the same time, ParamStr(2) will contain the window handle for the little monitor window.
    • When you configure the screen saver it's launched either with no parameters at all, or ParamStr(1) will contain '/C', '-C', or just 'C'.
    • When previewing the screen saver in full screen mode, it's launched just as if the screen saver timeout happened. ParamStr(1) will contain either '/S', '-S', or just 'S'.
    • When you change the screen saver password (Win95) ParamStr(1) will contain either '/A', '-A', or just 'A'.
    A screen saver has to make sure it's not launched several times. In this screen saver this is accomplished by way of a semaphore (see Simple.dpr below).

    A couple of things to look out for when it comes to the little preview window:

    • You have to wait until the window is visible
    • You have to kill the previewing when the window is made invisible
    You'll see how both of these things are handled in Simple.dpr below.

    As you know a screen saver has to respond to mouse events and key presses. When you don't have a password, it should simply shut down. When you have a password set, it should ask for the password. You'll see this as part of the SSave unit (see SSave.pas below).

    One final note before we create the screen saver:

    Debugging a screen saver can be very tricky, so make sure you save
    your code before you run the screen saver in any way... If it locks
    up, you will most likely have to reboot, or at least kill Delphi 3
    using the Task Manager...

    OK, now let's go ahead and create the screen saver!

    1. Create a new folder, e.g. C:\Foo. Launch Delphi 3, and start a brand new application. From the Project Manager, delete Unit1 and Form1 from the project. Do a File | Save Project As, and save the project as Simple.dpr in the newly created folder.
    2. Do a File | New | Form. Select Unit1 in the Code Editor. Do a File | Save As, and save the new form as SSetup.pas.
    3. Do a File | New | Form. Select Unit2 in the Code Editor. Do a File | Save As, and save the new form as SSave.pas.
    4. Do a File | New | Unit. Select Unit3 in the Code Editor. Do a File | Save As, and save the new unit as Globals.pas.
    5. Do a File | New | Unit. Select Unit3 in the Code Editor. Do a File | Save As, and save the new unit as CodeSpot.pas.
    6. Select the form SSetup. Right click on the form and select View As Text. Replace all the text in the editor with the code for SSetup.dfm below. Right click and select View As Form. Now go to the unit SSetup.pas in the editor and replace all the code with the code for SSetup.pas below.
    7. Select the form SSave. Right click on the form and select View As Text. Replace all the text in the editor with the code for SSave.dfm below. Right click and select View As Form. Now go to the unit SSave.pas in the editor and replace all the code with the code for SSave.pas below.
    8. Select the unit Globals.pas. Replace all the code with the code for Globals.pas below.
    9. Select the unit CodeSpot.pas. Replace all the code with the code for CodeSpot.pas below.
    10. Do a View | Project Source. Replace all the code with the code for Simple.dpr below.
    11. Do a Project | Build All.
    12. Copy the compiled screen saver Simple.Scr into your system directory (Something like C:\WinNT\System32 or C:\Win95\System). You can right click on Simple.Scr in the Explorer and select Install.
    13. Have lots of fun with your new screen saver project!
      **********
      SSetup.pas
      **********
      
      unit Ssetup;
      
      interface
      
      uses
        SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
        Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Spin, ExtDlgs;
      
      type
        TSetup = class(TForm)
          Ball1Box: TGroupBox;
          Label3: TLabel;
          xPos1: TSpinEdit;
          yPos1: TSpinEdit;
          xVel1: TSpinEdit;
          yVel1: TSpinEdit;
          Label5: TLabel;
          Size1: TSpinEdit;
          Label7: TLabel;
          Label4: TLabel;
          Label8: TLabel;
          Random1: TCheckBox;
          OKButton: TBitBtn;
          CancelButton: TBitBtn;
          TestButton: TBitBtn;
          procedure TestButtonClick(Sender: TObject);
          procedure FormCreate(Sender: TObject);
          procedure FormActivate(Sender: TObject);
          procedure OKButtonClick(Sender: TObject);
          procedure CancelButtonClick(Sender: TObject);
          procedure Random1Click(Sender: TObject);
          procedure Size1Change(Sender: TObject);
        private
          { Private declarations }
          Loading : Boolean;
        public
          { Public declarations }
        end;
      
      var
        Setup: TSetup;
      
      implementation
      
      uses
        SSave, Globals;
      
      {$R *.DFM}
      
      procedure TSetup.TestButtonClick(Sender: TObject);
      begin
        DefRandom := Random1.Checked;
        DefSize := Size1.Value;
        DefPosX := xPos1.Value;
        DefPosY := yPos1.Value;
        DefVelX := xVel1.Value;
        DefVelY := yVel1.Value;
      
        TestMode := True;
        Scrn := TScrn.Create(Application);
        Scrn.LoadingApp := True;
        Scrn.Left := -1000;
        Scrn.Top := -1000;
        Scrn.Width := 0;
        Scrn.Height := 0;
        Scrn.ShowModal;
        Scrn.Free;
        SetFocus;
        TestMode := False;
      end;
      
      procedure TSetup.FormCreate(Sender: TObject);
      begin
        Loading := True;
      end;
      
      procedure TSetup.FormActivate(Sender: TObject);
      begin
        if Loading then begin
          Loading := False;
      
          ReadIniFile;
      
          Size1.Value := DefSize;
          xPos1.Value := DefPosX;
          yPos1.Value := DefPosY;
          xVel1.Value := DefVelX;
          yVel1.Value := DefVelY;
      
          Random1.Checked := DefRandom;
      
          xPos1.MinValue := (DefSize*SpotSize div 2)+1;
          xPos1.MaxValue := Screen.Width-(DefSize*SpotSize div 2);
          yPos1.MinValue := (DefSize*SpotSize div 2)+1;
          yPos1.MaxValue := Screen.Height-(DefSize*SpotSize div 2);
        end;
      end;
      
      procedure TSetup.OKButtonClick(Sender: TObject);
      begin
        DefRandom := Random1.Checked;
        DefSize := Size1.Value;
        DefPosX := xPos1.Value;
        DefPosY := yPos1.Value;
        DefVelX := xVel1.Value;
        DefVelY := yVel1.Value;
      
        WriteIniFile;
        Close;
      end;
      
      procedure TSetup.CancelButtonClick(Sender: TObject);
      begin
        Close;
      end;
      
      procedure TSetup.Random1Click(Sender: TObject);
      var
        NewColor : TColor;
      begin
        NewColor := clWindow;
        with Random1 do begin
          if Checked then
            NewColor := clBtnFace;
      
          DefRandom := Checked;
      
          Size1.Enabled := not Checked;
          xPos1.Enabled := not Checked;
          yPos1.Enabled := not Checked;
          xVel1.Enabled := not Checked;
          yVel1.Enabled := not Checked;
        end;
      
        Size1.Color := NewColor;
        xPos1.Color := NewColor;
        yPos1.Color := NewColor;
        xVel1.Color := NewColor;
        yVel1.Color := NewColor;
      end;
      
      procedure TSetup.Size1Change(Sender: TObject);
      begin
        xPos1.MinValue := (Size1.Value*SpotSize div 2)+1;
        xPos1.MaxValue := Screen.Width-(Size1.Value*SpotSize div 2);
        yPos1.MinValue := (Size1.Value*SpotSize div 2)+1;
        yPos1.MaxValue := Screen.Height-(Size1.Value*SpotSize div 2);
      
        xPos1.Value := xPos1.Value;
        yPos1.Value := yPos1.Value;
      end;
      
      end.
      
      **********
      SSetup.dfm
      **********
      
      
      object Setup: TSetup
        Left = 260
        Top = 188
        BorderIcons = []
        BorderStyle = bsDialog
        Caption = 'Simple Saver Setup'
        ClientHeight = 145
        ClientWidth = 345
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlack
        Font.Height = -12
        Font.Name = 'Arial'
        Font.Style = []
        Position = poScreenCenter
        ShowHint = True
        OnActivate = FormActivate
        OnCreate = FormCreate
        PixelsPerInch = 96
        TextHeight = 15
        object Ball1Box: TGroupBox
          Left = 8
          Top = 8
          Width = 329
          Height = 89
          Caption = 'Settings'
          TabOrder = 0
          object Label3: TLabel
            Left = 72
            Top = 40
            Width = 30
            Height = 15
            Caption = 'x-pos'
          end
          object Label5: TLabel
            Left = 8
            Top = 40
            Width = 23
            Height = 15
            Caption = 'Size'
          end
          object Label7: TLabel
            Left = 136
            Top = 40
            Width = 30
            Height = 15
            Caption = 'y-pos'
          end
          object Label4: TLabel
            Left = 200
            Top = 40
            Width = 24
            Height = 15
            Caption = 'x-vel'
          end
          object Label8: TLabel
            Left = 264
            Top = 40
            Width = 24
            Height = 15
            Caption = 'y-vel'
          end
          object xPos1: TSpinEdit
            Left = 72
            Top = 56
            Width = 57
            Height = 24
            MaxLength = 4
            MaxValue = 9999
            MinValue = 0
            TabOrder = 2
            Value = 0
          end
          object yPos1: TSpinEdit
            Left = 136
            Top = 56
            Width = 57
            Height = 24
            MaxLength = 4
            MaxValue = 9999
            MinValue = 0
            TabOrder = 3
            Value = 0
          end
          object xVel1: TSpinEdit
            Left = 200
            Top = 56
            Width = 57
            Height = 24
            MaxLength = 4
            MaxValue = 10
            MinValue = -10
            TabOrder = 4
            Value = 0
          end
          object yVel1: TSpinEdit
            Left = 264
            Top = 56
            Width = 57
            Height = 24
            MaxLength = 4
            MaxValue = 10
            MinValue = -10
            TabOrder = 5
            Value = 0
          end
          object Size1: TSpinEdit
            Left = 8
            Top = 56
            Width = 57
            Height = 24
            MaxLength = 4
            MaxValue = 4
            MinValue = 1
            TabOrder = 1
            Value = 1
            OnChange = Size1Change
          end
          object Random1: TCheckBox
            Left = 8
            Top = 16
            Width = 97
            Height = 17
            Caption = 'Randomize'
            TabOrder = 0
            OnClick = Random1Click
          end
        end
        object OKButton: TBitBtn
          Left = 8
          Top = 104
          Width = 73
          Height = 33
          Caption = 'Ok'
          Font.Charset = DEFAULT_CHARSET
          Font.Color = clBlack
          Font.Height = -12
          Font.Name = 'Arial'
          Font.Style = []
          ParentFont = False
          TabOrder = 1
          OnClick = OKButtonClick
          Kind = bkOK
        end
        object CancelButton: TBitBtn
          Left = 136
          Top = 104
          Width = 73
          Height = 33
          Font.Charset = DEFAULT_CHARSET
          Font.Color = clBlack
          Font.Height = -12
          Font.Name = 'Arial'
          Font.Style = []
          ParentFont = False
          TabOrder = 2
          OnClick = CancelButtonClick
          Kind = bkCancel
        end
        object TestButton: TBitBtn
          Left = 264
          Top = 104
          Width = 73
          Height = 33
          Caption = 'Test'
          Font.Charset = DEFAULT_CHARSET
          Font.Color = clBlack
          Font.Height = -12
          Font.Name = 'Arial'
          Font.Style = []
          ParentFont = False
          TabOrder = 3
          OnClick = TestButtonClick
          Glyph.Data = {
            76010000424D7601000000000000760000002800000020000000100000000100
            0400000000000001000000000000000000001000000010000000000000000000
            800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
            FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000000
            033333FFFF77777773F330000077777770333777773FFFFFF733077777000000
            03337F3F3F777777733F0797A770003333007F737337773F3377077777778803
            30807F333333337FF73707888887880007707F3FFFF333777F37070000878807
            07807F777733337F7F3707888887880808807F333333337F7F37077777778800
            08807F333FFF337773F7088800088803308073FF777FFF733737300008000033
            33003777737777333377333080333333333333F7373333333333300803333333
            33333773733333333333088033333333333373F7F33333333333308033333333
            3333373733333333333333033333333333333373333333333333}
          NumGlyphs = 2
        end
      end
      
      *********
      SSave.pas
      *********
      
      unit Ssave;
      
      interface
      
      uses WinTypes, WinProcs, Graphics, Forms, Messages, Classes, Controls,
        ExtCtrls, StdCtrls, SysUtils;
      
      type
        TScrn = class(TForm)
          Image1: TImage;
          procedure FormKeyDown(Sender: TObject; var Key: Word;
            Shift: TShiftState);
          procedure FormCreate(Sender: TObject);
          procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
            Y: Integer);
          procedure FormActivate(Sender: TObject);
          procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
          procedure FormClose(Sender: TObject; var Action: TCloseAction);
        private
          { Private declarations }
          Mouse : TPoint;
          procedure StartSaver(var WinMsg : TMessage); message WM_USER+1;
          procedure StopSaver(var WinMsg : TMessage); message WM_USER+2;
          procedure GetPassword;
          procedure Trigger(Sender : TObject; var Done : Boolean);
        public
          { Public declarations }
          LoadingApp : Boolean;
        end;
      
      var
        Scrn : TScrn;
        DesktopBitmap : TBitmap;
      
      implementation
      
      uses
        CodeSpot, Globals, Registry;
      
      const
        IgnoreCount : Integer = 0;
      
      {$R *.DFM}
      
      procedure CursorOff;
      begin
        ShowCursor(False);
      end;
      
      procedure CursorOn;
      begin
        ShowCursor(True);
      end;
      
      procedure TScrn.StartSaver(var WinMsg : TMessage);
      begin
        DrawSpot;
      end;
      
      procedure TScrn.StopSaver(var WinMsg : TMessage);
      begin
        GetPassword;
      end;
      
      procedure TScrn.GetPassword;
      var
        MyMod     : THandle;
        PwdFunc   : function (Parent : THandle) : Boolean; stdcall;
        SysDir    : String;
        NewLen    : Integer;
        MyReg     : TRegistry;
        OkToClose : Boolean;
      begin
        if (SSMode <> ssRun) or TestMode then begin
          Close;
          Exit;
        end;
      
        IgnoreCount := 5;
        OkToClose := False;
        MyReg := TRegistry.Create;
        MyReg.RootKey := HKEY_CURRENT_USER;
        if MyReg.OpenKey('Control Panel\Desktop',False) then begin
          try
            try
              ShowCursor(True);
              if MyReg.ReadInteger('ScreenSaveUsePassword') <> 0 then begin
                SetLength(SysDir,MAX_PATH);
                NewLen := GetSystemDirectory(PChar(SysDir),MAX_PATH);
                SetLength(SysDir,NewLen);
                if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then
                  SysDir := SysDir+'\';
                MyMod := LoadLibrary(PChar(SysDir+'PASSWORD.CPL'));
                if MyMod = 0 then
                  OkToClose := True
                else begin
                  PwdFunc := GetProcAddress(MyMod,'VerifyScreenSavePwd');
                  if PwdFunc(Handle) then
                    OkToClose := True;
                  FreeLibrary(MyMod);
                end;
              end
              else
                OkToClose := True;
            finally
              ShowCursor(False);
            end;
          except
            OkToClose := True;
          end;
        end
        else
          OkToClose := True;
      
        MyReg.Free;
      
        if OkToClose then
          Close;
      end;
      
      procedure TScrn.Trigger(Sender : TObject; var Done : Boolean);
      begin
        PostMessage(Handle,WM_USER+1,0,0);
      end;
      
      procedure TScrn.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
      begin
        GetPassword;
      end;
      
      procedure TScrn.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
      begin
        if IgnoreCount > 0 then begin
          Dec(IgnoreCount);
          Exit;
        end;
      
        if (Mouse.X = -1) and (Mouse.Y = -1) then begin
          Mouse.X := X;
          Mouse.Y := Y;
        end
        else
          if (Abs(X-Mouse.X) > 2) and (Abs(Y-Mouse.Y) > 2) then begin
            Mouse.X := X;
            Mouse.Y := Y;
            GetPassword;
          end;
      end;
      
      procedure TScrn.FormCreate(Sender: TObject);
      begin
        LoadingApp := True;
      end;
      
      procedure TScrn.FormActivate(Sender: TObject);
      var
        Dummy : Boolean;
      begin
        if LoadingApp then begin
          LoadingApp := False;
          Scrn.Color := clBlack;
          Scrn.Top := 0;
          Scrn.Left := 0;
          Scrn.Width := Screen.Width;
          Scrn.Height := Screen.Height;
          InitSpot;
          Mouse.X := -1;
          Mouse.Y := -1;
          Application.OnIdle := Trigger;
          SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE + SWP_NOMOVE);
          SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@Dummy,0);
          CursorOff;
          Scrn.Visible := True;
          SetCapture(Scrn.Handle);
        end;
      end;
      
      procedure TScrn.FormMouseDown(Sender: TObject; Button: TMouseButton;
                                    Shift: TShiftState; X, Y: Integer);
      begin
        GetPassword;
      end;
      
      procedure TScrn.FormClose(Sender: TObject; var Action: TCloseAction);
      var
        Dummy : Boolean;
      begin
        SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@Dummy,0);
        Application.OnIdle := nil;
        ReleaseCapture;
        CursorOn;
      end;
      
      end.
      
      *********
      SSave.dfm
      *********
      
      object Scrn: TScrn
        Left = 314
        Top = 376
        HorzScrollBar.Visible = False
        BorderIcons = [biSystemMenu]
        BorderStyle = bsNone
        ClientHeight = 130
        ClientWidth = 457
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -13
        Font.Name = 'System'
        Font.Style = []
        OnActivate = FormActivate
        OnClose = FormClose
        OnCreate = FormCreate
        OnKeyDown = FormKeyDown
        OnMouseDown = FormMouseDown
        OnMouseMove = FormMouseMove
        PixelsPerInch = 96
        TextHeight = 16
        object Image1: TImage
          Left = 0
          Top = 0
          Width = 457
          Height = 130
          Align = alClient
          Visible = False
        end
      end
      
      ***********
      Globals.pas
      ***********
      
      unit Globals;
      
      interface
      
      type
        TSSMode = (ssSetPwd,ssPreview,ssConfig,ssRun);
      
      const
        SSMode      : TSSMode = ssRun;
      
        TestMode    : Boolean = False;
      
        Section     = 'Screen Saver.Simple Screen Saver';
      
        SpotSize    = 50;
      
        DefSize     : Integer = 2;
        DefPosX     : Integer = 51;
        DefPosY     : Integer = 51;
        DefVelX     : Integer = 1;
        DefVelY     : Integer = 1;
      
        DefRandom   : Boolean = True;
      
      procedure ReadIniFile;
      procedure WriteIniFile;
      
      implementation
      
      uses
        IniFiles;
      
      procedure ReadIniFile;
      var
        IniFile : TIniFile;
      begin
        IniFile := TIniFile.Create('CONTROL.INI');
      
        DefSize := IniFile.ReadInteger(Section,'Size1',DefSize);
        DefPosX := IniFile.ReadInteger(Section,'PosX1',DefPosX);
        DefPosY := IniFile.ReadInteger(Section,'PosY1',DefPosY);
        DefVelX := IniFile.ReadInteger(Section,'VelX1',DefVelX);
        DefVelY := IniFile.ReadInteger(Section,'VelY1',DefVelY);
      
        DefRandom := IniFile.ReadBool(Section,'Rand1',DefRandom);
      
        IniFile.Free;
      end;
      
      procedure WriteIniFile;
      var
        IniFile : TIniFile;
      begin
        IniFile := TIniFile.Create('CONTROL.INI');
      
        IniFile.WriteInteger(Section,'Size1',DefSize);
        IniFile.WriteInteger(Section,'PosX1',DefPosX);
        IniFile.WriteInteger(Section,'PosY1',DefPosY);
        IniFile.WriteInteger(Section,'VelX1',DefVelX);
        IniFile.WriteInteger(Section,'VelY1',DefVelY);
      
        IniFile.WriteBool(Section,'Rand1',DefRandom);
      
        IniFile.Free;
      end;
      
      end.
      
      ************
      CodeSpot.pas
      ************
      
      unit Codespot;
      
      interface
      
      uses
        WinTypes, WinProcs, Graphics, Forms, Controls, Classes, Sysutils, Dialogs;
      
      var
        zx, zy  : Integer;
        cx, cy,
        vx, vy,
        d       : Real;
        Picture : HBitmap;
      
      procedure InitSpot;
      procedure DrawSpot;
      
      implementation
      
      uses
        SSave, Globals;
      
      procedure InitSpot;
      begin
        Randomize;
      
        if not TestMode then
          ReadIniFile;
      
        zx := Screen.Width;
        zy := Screen.Height;
      
        d  := (Random(4)+1)*SpotSize;
        cx := Random((zx div 2)-Round(d)-1)+1;
        cy := Random(zy-Round(d)-1)+1;
        vx := Random(2)+1;
        vy := Random(2)+1;
        if Random(2) = 0 then
          vx := -vx;
        if Random(2) = 0 then
          vy := -vy;
      
        if not DefRandom then begin
          d := DefSize*SpotSize;
          cx := DefPosX-d/2;
          cy := DefPosY-d/2;
          vx := DefVelX;
          vy := DefVelY;
        end;
      
        Scrn.Image1.Picture.Bitmap := DesktopBitmap;
        Picture := Scrn.Image1.Picture.Bitmap.Handle;
      end;
      
      procedure DrawSpot;
      var
        WinDC, MemDC : HDC;
        Rgn1, Rgn3   : HRgn;
      begin
        WinDC := GetDC(Scrn.Handle);
        MemDC := CreateCompatibleDC(WinDC);
      
        SelectObject(MemDC,Picture);
      
        if ((cx+vx <= 0) or (cx+d+vx >= zx)) then
          vx := -vx;
      
        if ((cy+vy <= 0) or (cy+d+vy >= zy)) then
          vy := -vy;
      
        cx := cx+vx;
        cy := cy+vy;
      
        Rgn3 := CreateRectRgn(0,0,zx,zy);
        Rgn1 := CreateEllipticRgn(Round(cx),Round(cy),
                                  Round(cx+d),Round(cy+d));
      
        CombineRgn(Rgn3,Rgn3,Rgn1,RGN_DIFF);
        FillRgn(WinDC,Rgn3,GetStockObject(BLACK_BRUSH));
      
        SelectObject(WinDC,Rgn1);
        BitBlt(WinDC,0,0,zx,zy,MemDC,0,0,SRCCOPY);
      
        DeleteObject(Rgn3);
        DeleteObject(Rgn1);
      
        DeleteDC(MemDC);
        ReleaseDC(Scrn.Handle,WinDC);
      end;
      
      end.
      
      **********
      Simple.dpr
      **********
      
      program Simple;
      
      uses
        Forms,
        SysUtils,
        Windows,
        Graphics,
        Classes,
        Ssave in 'SSave.pas' {Scrn},
        Codespot in 'CodeSpot.pas',
        Ssetup in 'SSetup.pas' {Setup},
        Globals in 'Globals.pas';
      
      {$E SCR}
      {$R *.RES}
      
      var
        MySem       : THandle;
        Arg1,
        Arg2        : String;
        DemoWnd     : HWnd;
        MyRect      : TRect;
        MyCanvas    : TCanvas;
        x, y,
        dx, dy      : Integer;
        MyBkgBitmap,
        InMemBitmap : TBitmap;
        ScrWidth,
        ScrHeight   : Integer;
        SysDir      : String;
        NewLen      : Integer;
        MyMod       : THandle;
        PwdFunc     : function (a : PChar; ParentHandle : THandle; b, c : Integer) : 
                          Integer; stdcall;
      
      begin
        Arg1 := UpperCase(ParamStr(1));
        Arg2 := UpperCase(ParamStr(2));
      
        if (Copy(Arg1,1,2) = '/A') or (Copy(Arg1,1,2) = '-A') or
           (Copy(Arg1,1,1) = 'A') then
          SSMode := ssSetPwd;
      
        if (Copy(Arg1,1,2) = '/P') or (Copy(Arg1,1,2) = '-P') or
           (Copy(Arg1,1,1) = 'P') then
          SSMode := ssPreview;
      
        if (Copy(Arg1,1,2) = '/C') or (Copy(Arg1,1,2) = '-C') or
           (Copy(Arg1,1,1) = 'C') or (Arg1 = '') then
          SSMode := ssConfig;
      
        if SSMode = ssSetPwd then begin
          SetLength(SysDir,MAX_PATH);
          NewLen := GetSystemDirectory(PChar(SysDir),MAX_PATH);
          SetLength(SysDir,NewLen);
          if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then
            SysDir := SysDir+'\';
          MyMod := LoadLibrary(PChar(SysDir+'MPR.DLL'));
          if MyMod <> 0 then begin
            PwdFunc := GetProcAddress(MyMod,'PwdChangePasswordA');
            if Assigned(PwdFunc) then
              PwdFunc('SCRSAVE',StrToInt(Arg2),0,0);
            FreeLibrary(MyMod);
          end;
          Halt;
        end;
      
        MySem := CreateSemaphore(nil,0,1,'SimpleSaverSemaphore');
        if ((MySem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then begin
          CloseHandle(MySem);
          Halt;
        end;
      
        Application.Initialize;
      
        if SSMode = ssPreview then begin
          DemoWnd := StrToInt(Arg2);
          while not IsWindowVisible(DemoWnd) do
            Application.ProcessMessages;
          GetWindowRect(DemoWnd,MyRect);
          ScrWidth := MyRect.Right-MyRect.Left+1;
          ScrHeight := MyRect.Bottom-MyRect.Top+1;
          MyRect := Rect(0,0,ScrWidth-1,ScrHeight-1);
          MyCanvas := TCanvas.Create;
          MyCanvas.Handle := GetDC(DemoWnd);
          MyCanvas.Pen.Color := clWhite;
          x := (ScrWidth div 2)-16;
          y := (ScrHeight div 2)-16;
          dx := 1;
          dy := 1;
          MyBkgBitmap := TBitmap.Create;
          with MyBkgBitmap do begin
            Width := ScrWidth;
            Height := ScrHeight;
          end;
          MyBkgBitmap.Canvas.FillRect(Rect(0,0,ScrWidth-1,ScrHeight-1));
          InMemBitmap := TBitmap.Create;
          with InMemBitmap do begin
            Width := ScrWidth;
            Height := ScrHeight;
          end;
          while IsWindowVisible(DemoWnd) do begin
            InMemBitmap.Canvas.CopyRect(MyRect,MyBkgBitmap.Canvas,MyRect);
            InMemBitmap.Canvas.Draw(x,y,Application.Icon);
            MyCanvas.CopyRect(MyRect,InMemBitmap.Canvas,MyRect);
            Sleep(10);
            Application.ProcessMessages;
            if (x = 0) or (x = (ScrWidth-33)) then
              dx := -dx;
            if (y = 0) or (y = (ScrHeight-33)) then
              dy := -dy;
            x := x+dx;
            y := y+dy;
          end;
          MyBkgBitmap.Free;
          InMemBitmap.Free;
          MyCanvas.Free;
          CloseHandle(MySem);
          Halt;
        end;
      
        DesktopBitmap := TBitmap.Create;
        with DesktopBitmap do begin
          Width := Screen.Width;
          Height := Screen.Height;
        end;
        BitBlt(DesktopBitmap.Canvas.Handle,0,0,Screen.Width,Screen.Height,
                GetDC(GetDesktopWindow),0,0,SrcCopy);
      
        if SSMode = ssConfig then begin
          Application.CreateForm(TSetup, Setup);
        end else
          Application.CreateForm(TScrn,Scrn);
      
        Application.Run;
      
        DesktopBitmap.Free;
        CloseHandle(MySem);
      end.

    DISCLAIMER: You have the right to use this technical information subject to the terms of the No-Nonsense License Statement that you received with the Borland product to which this information pertains.
    Trademarks & Copyright © 1998 Borland International, Inc.