Screen saver - completo

Top  Previous  Next

This TI shows how you can write a 32-bit screen saver in 32 bit Delphi. 

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 isFor 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) > 0and (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 <> 0and (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 = 0or (x = (ScrWidth-33)) then

        dx := -dx;

      if (y = 0or (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.