Technical Information Database

TI4534D.txt - Creating a 32-Bit Screen Saver in 32-bit Delphi


Category   :Miscellaneous
Platform   :All-32Bit
Product    :All32Bit,   

Description:
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 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.

Reference:
None

4/22/99 4:08:08 PM