INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

How To

How do I write a screen saver? by Glenn9999
Posted: 12 Apr 08 (Edited 21 Jun 11)

How do I write a screen saver?
This FAQ is intended to discuss the mechanics involved in making a screen saver.  It is not intended to be a guide regarding screen saver effects or coming up with them (to be honest the ones in the example are pretty bad - I'm not the one to come to if you want help on those).  There are no guarantees placed upon the code you see here.  It's been tested in Turbo Delphi 2006, and to the best of my knowledge works.

Much of the code is based on Inprise TID #4534, though much has been changed from what is presented there for various reasons.

So what is a screen saver?
From a technical standpoint, a screen saver is nothing more than a program which satisfies certain requirements.  Those are:

1) Be compiled with an *.SCR extension.
2) Have defined a resource string which describes the screen saver.
3) Provide a means to determine whether the program is running, and exit if it is.
4) Accept a set of set command-line parameters.
5) Act accordingly on those parameters.

SCR & Resource String
To handle the SCR extension and resource string is reasonably straight forward.

In the main file:

CODE

{$R sid.RES}
{$E scr}

The first includes a resource file named sid.RES, the second defines the compiled extension to be scr.  To make the resource file, call BRCC32.  The file will have one string defined - for a screen saver, the description string is the resource string found in the first position.
 
Is a copy running?
A semaphore is used in that event.  One is checked for on run time and then created by a name upon run if it doesn't exist.  If it already exists the program exits.

Command-line parms
Command-line parms are accepted by the screen saver to determine what it should do.  Of primary interest is the first parm.  When it is received it should be checked for any combination ("C", "-C", or "/C" should all suffice, as well as nothing).

Valid command-line parms:
/C - Bring up configuration screen.
/P - Run screen saver in window-box mode.  This is the little box that comes up and shows you the screen saver when you select it.
/S - Shows the screen saver in full-screen mode.
/A - Password Change call (Win9X only)

Configuration
This is the screen you see when you click Settings.  This can be straight-forward VCL.  Create a form with the values you want to change/save.  Have a cancel and save button (even an about button if you want it!).  When you load the form, load the read-in values to the form.  When you save the form, write them to registry.  Nothing explicitly special.

Preview
This is the window-box mode.  It will involve receiving a window handle to draw your screen-saver action on.  You will need to associate a canvas to the window handle and then do your drawing there.  It will need to respond reasonably quickly to input to exit (~10ms).

Show
This is the screen saver show mode.  It will involve a VCL form that you make full screen, and then draw on.  A number of events will be defined so the screen saver may respond to inputs.

Password
Believe it or not, the responsibility of handling the limited password facility in Windows 9X fell upon each screen saver.  This call is pretty standard, however.

Sample Project Source Files
Due to length I won't be copying any specific source here and will provide it in the zip file below.  Descriptions of source files you will find are below:

ssdemo.dpr
This is the main source file.  Bring it up, for you will notice many changes in it, primarily to handle the command parms.

CODE

program ssdemo;
  { main application for screen saver demo, written by Glenn9999 at tek-tips.com
    based off of the Inprise Delphi TID #4534 - several bits changed
    for various reasons }
uses
  Forms,
  configunit in 'configunit.pas' {ConfigForm},
  drawunit in 'drawunit.pas' {Drawform},
  scrnsave in 'scrnsave.pas',
  windows,
  ssaction in 'ssaction.pas';

{$R *.RES}

{ sid.res is compiled from sid.rc by BRCC32.  sid.rc holds the screen saver id
  string for this screen saver.  This is the string you see in the screen saver
  configuration of windows 2000/XP if you select a screen saver. }

{$R sid.RES}
{$E scr}

var
  WinHandle: THandle;
  MySem: THandle;
  program_state: ps_type;
  start_time: DWord;

begin
  SS_Initialize(program_state, Winhandle, MySem);
 { get configuration data from registry }
  read_values(config_rec);
  Application.Initialize;
  Application.Title := 'Demo Screen Saver';
  { preview option }
  if program_state = Preview then
    begin
      { spindle off messages until window is visible }
      while not IsWindowVisible(WinHandle) do
        Application.ProcessMessages;
      { initialize and do screen saver draw }
      start_time := WinMSSinceStart;
      SS_Init(WinHandle);
      while IsWindowVisible(Winhandle) do
        begin
          if (WinMSSinceStart - Start_Time) >= config_rec.Delay then
            begin
               SS_Start(WinHandle);
               start_time := WinMSSinceStart;
            end;
          Application.ProcessMessages;
          sleep(10);
        end;
      SS_End(Winhandle);
    end;
  { show the screen saver full-screen }
  if program_state = Show then
    begin
      Application.CreateForm(TDrawform, Drawform);
      Application.Run;
    end;
  { show the configuration option screen }
  if program_state = Config then
    begin
      Application.CreateForm(TConfigForm, ConfigForm);
      Application.Run;
    end;
  { a semaphore is opened/checked in SS_Initialize, this closes it }
  CloseHandle(MySem);
end.

configunit.pas
The pas file associated with the configuration menu.  Nothing that is particularly remarkable - load values into form on startup, give option to save them on exit.

CODE

unit configunit;
  { configuration code by Glenn9999 }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, ExtCtrls, scrnsave;

type
  TConfigForm = class(TForm)
    BtnCancel: TButton;
    SaveBtn: TButton;
    Label1: TLabel;
    TextString: TEdit;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    procedure BtnCancelClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ConfigForm: TConfigForm;

implementation

{$R *.DFM}

procedure TConfigForm.BtnCancelClick(Sender: TObject);
{ cancel button code }
begin
  Application.Terminate;
end;

procedure TConfigForm.SaveBtnClick(Sender: TObject);
{ save button code, saves form values to registry and writes them }
  begin
    config_rec.TextString := TextString.Text;
    config_rec.Delay := SpinEdit1.Value;
    write_values(config_rec);
    Application.Terminate;
  end;

procedure TConfigForm.FormCreate(Sender: TObject);
  { load values from the registry in here and put them to the form }
begin
  TextString.Text := Config_rec.TextString;
  SpinEdit1.Value := Config_rec.Delay;
end;

end.

drawunit.pas
The form for Show mode.  FormKeydown, FormMouseMove, and FormMouseDown are defined to handle events and detect standard user input.  FormCreate is used to handle initializations, show the form in full screen, and perform any initial actions for the screen saver action.  FormClose performs any deinitializations necessary.

To draw the effects: OnIdle is set to a trigger procedure which draws one step of the effects - PostMessage is used to place it within queue.

Upon termination, CheckMyTerminate is called.  The primary reason for this call is to handle the Windows 9X password security requirement.

CODE

unit drawunit;
   { form code for drawing the screen saver full-screen }
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, scrnsave, ssaction;

type
  TDrawform = class(TForm)
    procedure CheckMyTerminate;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    mouse: TPoint;
  protected
    procedure StartSaver(var WinMsg : TMessage); message WM_USER+1;
    procedure Trigger(Sender : TObject; var Done : Boolean);
  public
    { Public declarations }
  end;

var
  Drawform: TDrawform;
  start_time: DWord;

implementation

{$R *.DFM}


procedure TDrawForm.StartSaver(var WinMsg : TMessage);
{ draw one step of the screen saver here }
begin
  if (WinMSSinceStart - start_Time) >= config_rec.Delay then
    begin
      SS_Start(DrawForm.Handle);
      start_time := WinMSSinceStart;
    end;
  sleep(10);
end;

procedure TDrawform.Trigger(Sender : TObject; var Done : Boolean);
{ executed by the screen saver on idle }
begin
  PostMessage(DrawForm.Handle,WM_USER+1,0,0);
end;

procedure TDrawform.CheckMyTerminate;
{ handles termination functions - in 9X we must check for password so that is
  here }
begin
  if CheckSSPassWord(Handle) then
    begin
      SS_End(DrawForm.Handle);
      Application.Terminate;
    end;
end;

procedure TDrawform.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
{ key down event action }
begin
  CheckMyTerminate;
end;

procedure TDrawform.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
{ mouse move event action - if the mouse is moved more than 5 units in
  any direction, terminate code is run }
begin
  if (Mouse.X = -1) and (Mouse.Y = -1) then
    begin
      Mouse.X := X;
      Mouse.Y := Y;
    end
  else
  if (Abs(X-Mouse.X) > 5) or (Abs(Y-Mouse.Y) > 5) then
    CheckMyTerminate;
  Mouse.X := X;
  Mouse.Y := Y;
end;

procedure TDrawform.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CheckMyTerminate;
end;

procedure TDrawform.FormClose(Sender: TObject; var Action: TCloseAction);
{ ending default code for the screen saver, signals screen saver off,
  releases screen capture, and shows cursor }
var
  Dummy: Boolean;
begin
  SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@Dummy,0);
  ReleaseCapture;
  ShowCursor(true);
  Application.OnIdle := nil;
end;

procedure TDrawform.FormCreate(Sender: TObject);
var
  Dummy: Boolean;
begin
 { set form size to screen size }
  drawform.Width := Screen.Width;
  drawform.Height := Screen.Height;
  { initialize Mouse coords}
  Mouse.X := -1;
  Mouse.Y := -1;
  start_time := WinMSSinceStart;
  { screen saver on, capture on, Idle func set, cursor off }
  SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@Dummy,0);
  SetCapture(drawform.Handle);
  Application.OnIdle := Trigger;
  ShowCursor(false);
 { bring window to foreground }
  SetForegroundWindow(Handle);
  SetActiveWindow(Handle);
  { initialize the Screen saver action here }
  SS_Init(Handle);
end;

end.


scrnsave.pas
Some generic utility functions related to screen savers.  You shouldn't have to touch these (mostly) to do what you need.  Initialization code exists here to handle a few preliminaries for these functions.

read_values: Read values out of the registry into a global record - substitutes defaults if they are not found.
write_values: Writes values to the registry.   
checkSSpassword: Called to check for a password (Win9X).
Get_SSaverName: Not used in this project.  Will read a file and return the 1st resource string in it.  Useful if you want to find out screen saver names.
SSPwdChangeCall: Called to change the screen saver password (Win9X).
SS_Initialize: Most of this code is the same so I placed it here.  Returns data from the command-line parms, as well as the semaphore address (look at the address and change it if you reuse this code).
WinMSSinceStart: Timing code which is useful for screen drawing effects if a delay is required, since sleep() is generally not a good idea in long periods.

CODE

unit scrnsave;
  { * screen saver utility functions, mostly default for all screen savers
    * registry read/write values

     by Glenn9999 }
interface
  uses windows;
  type
    sshut_record = record
      TextString: string; { text string on screen }
      delay: DWord;  { delay between instances }
    end;
    ps_type = (Preview, Config, Show); {enum. type for ssinit code }
  var
    config_rec: sshut_record;
    { variables for initialization code }
    sysdir: string;
    osvinfo: TOsVersionInfo;
    os_is_NT: boolean;

  procedure read_values(var ssr: sshut_record);
  procedure write_values(ssr: sshut_record);
   function checkSSpassword(inhandle: THandle): boolean;
   function Get_SSaverName(infile: string): string;
  procedure SSPwdChangeCall(PWWindow: THandle);
  procedure SS_Initialize(var program_state: ps_type; var parm2, mysem: THandle);
  function WinMSSinceStart: DWord; stdcall;


implementation
   uses sysutils, registry, dialogs;
  var
    newlen: integer;

  function WinMSSinceStart: DWord;
         stdcall; external 'winmm.dll' name 'timeGetTime';

  procedure read_values(var ssr: sshut_record);
    { read registry values from HKCU/Software/SSDemo, substitute defaults if
      registry values not found  }
    var
      myreg: TRegistry;
    begin
      myReg := TRegistry.Create;
      try
        myreg.rootkey := HKEY_CURRENT_USER;
        if myreg.OpenKey('\Software\SSDemo', false) then
          begin
            ssr.TextString := myReg.ReadString('TextString');
            ssr.Delay := myReg.ReadInteger('Delay');
          end
        else
          begin
            ssr.TextString := 'Test String';
            ssr.Delay := 1000;
          end;
      finally
        myreg.CloseKey;
        myreg.Free;
      end;
    end;

  procedure write_values(ssr: sshut_record);
    { write registry values from HKCU/Software/SSDemo  }
    var
      myreg: TRegistry;
    begin
      myReg := TRegistry.Create;
      myreg.rootkey := HKEY_CURRENT_USER;
      try
        if myreg.OpenKey('\Software\SSDemo', true) then
          begin
            myReg.WriteString('TextString', ssr.TextString);
            myReg.WriteInteger('Delay', ssr.Delay);
          end;
      finally
        myreg.Closekey;
        myreg.free;
      end;
    end;

function checkSSpassword(inhandle: THandle): boolean;
  { password verification code for Windows 9X - returns true if the
    screen saver is to terminate, false if not }

  var
    MyMod     : THandle;
    PwdFunc   : function (Parent : THandle) : Boolean; stdcall;
    MyReg     : TRegistry;

  begin
    result := false;
    { all of this is irrelevant for NT, check for that first }
    if os_is_nt then
      begin
        Result := true;
        exit;
      end;

    { check whether we are to ask for a password }
    MyReg := TRegistry.Create;
    MyReg.RootKey := HKEY_CURRENT_USER;
    try
      if MyReg.OpenKey('Control Panel\Desktop',False) then
        if MyReg.ReadInteger('ScreenSaveUsePassword') = 0 then
          begin
            result := true;
            exit;
          end;
    finally
      MyReg.Free;
    end;

    { now ask for it }
    MyMod := LoadLibrary(PChar(SysDir+'PASSWORD.CPL'));
    try
      if MyMod <> 0 then
        begin
          ShowCursor(true);
          PwdFunc := GetProcAddress(MyMod,'VerifyScreenSavePwd');
          if PwdFunc(InHandle) then
            begin
              result := true;
              exit;
            end;
          ShowCursor(false);
        end
    finally
      FreeLibrary(MyMod);
    end;
  end;

function Get_SSaverName(infile: string): string;
  { takes a filename in infile and returns the 1st resource string in the
    file.  For getting the display name of a screen saver under NT standards. }
  var
    ExecInt: Thandle;
    res_string: string;
    res_len: integer;
  begin
    ExecInt := LoadLibrary(PChar(infile));
    if ExecInt <> 0 then
      begin
        res_len := 256;
        SetLength(res_string, res_len);
        res_len := LoadString(ExecInt, 1, PChar(res_string), res_len);
        SetLength(res_string, res_len);
        FreeLibrary(ExecInt);
      end;
    Result := res_string;
  end;

procedure SSPwdChangeCall(PWWindow: THandle);
  { calls the password change dialog for non-NT systems }
  var
    PwdFunc: function (a : PChar; ParentHandle : THandle; b, c : Integer) :
                    Integer; stdcall;
    IntHandle: THandle;
  begin
    { this is not relevant to NT based OSes }
    if os_is_nt then exit;
    { now call the PW change routine }
    IntHandle := LoadLibrary(PChar(SysDir+'MPR.DLL'));
    if IntHandle <> 0 then
      try
        PwdFunc := GetProcAddress(IntHandle,'PwdChangePasswordA');
        if Assigned(PwdFunc) then
          PwdFunc('SCRSAVE', PWWindow,0,0);
      finally
        FreeLibrary(IntHandle);
      end;
  end;

procedure SS_Initialize(var program_state: ps_type; var parm2, mysem: THandle);
  { generic initialization code applicable to all screen savers }
  var
    parm1: string;
  begin
    { process first parm - allow for /C -C or C }
    if paramcount in [1..2] then
      begin
        if length(paramstr(1)) = 1 then
          parm1 := '/' + paramstr(1)
        else
          begin
            parm1 := copy(paramstr(1), 1, 2);
            if parm1[1] = '-' then
              parm1[1] := '/';
          end;
        parm1[2] := upcase(parm1[2]);
      end
    else
      parm1 := '/S'; { no parms, assume default of show as Win screen savers do }

    if parm1 = '/C' then
      program_state := Config;
    if parm1 = '/P' then
      program_state := Preview;
    if parm1 = '/S' then
      program_state := Show;
    if paramcount = 2 then
      parm2 := StrToInt(paramstr(2));
   { check for password change call and handle - this is not relevant for NT }
    if (parm1 = '/A') then
      begin
        SSPwdChangeCall(parm2);
        halt(0);
      end;
    { Create semaphore, check for previous program existence, end if there }
    MySem := CreateSemaphore(nil,0,1,'SSaverSemaphore');
    if ((MySem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
      begin
        CloseHandle(MySem);
        Halt;
      end;
  end;

initialization
 { get Windows System Directory }
  SetLength(SysDir, MAX_PATH);
  NewLen := GetSystemDirectory(PChar(SysDir),MAX_PATH);
  SetLength(SysDir,NewLen);
  if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then
    SysDir := SysDir + '\';
 { get windows type }
  osvinfo.dwOSVersionInfoSize := Sizeof(osvinfo);
  GetVersionEx(osvinfo);
  os_is_nt := (osvinfo.dwPlatformId = VER_PLATFORM_WIN32_NT);
end.

sid.rc
The resource file containing the resource id string for the project.  Change and compile this to change the string that shows up in the screen saver config.

CODE

STRINGTABLE
BEGIN
1, "Demo Screensaver"
END

ssaction.pas
Screen saver action code - this takes the string in config and shows it in a random spot on the screen in a random color with the configured delay between showing it.  I set up SS_Init, SS_Start, and SS_End procedures which all take window handles.  This is so the code can be used both for Window box mode (Preview) and screen saver mode (Show).  The graphics could probably be drawn to a TBitmap and then StretchDrawed to the windows canvas handle to give a better effect, though I didn't do that.  WinRect holds the screen dimensions of whatever window was passed.

CODE

unit ssaction;
  { screen saver actions by Glenn9999 - they are written to accept a windows
    handle so they can be done in either window-box mode or screen saver mode.
    No duplicate code required, therefore no duplicate testing is required

    This puts a configured text string up on the screen in a random location
    in a random color.  Rinse and repeat, delays are handled in main code. }
interface
  uses windows, graphics, classes;

  var
    MyCanvas: TCanvas;
    WinRect: TRect;
    posx, posy: integer;
    tw, th: integer;

  procedure SS_Init(WinHandle: Integer);
  procedure SS_Start(WinHandle: Integer);
  procedure SS_End(WinHandle: Integer);

implementation
  uses scrnsave;

  procedure SS_Init(WinHandle: Integer);
    { initializes screen saver action }
    begin
      { get window dimensions and set up TCanvas }
      GetClientRect(WinHandle, WinRect);
      MyCanvas := TCanvas.Create;
      MyCanvas.Handle := GetDC(Winhandle);
      { initialize variables here }
      randomize;
      { now initialize draw structures -
        draw black background and draw first text position }
      MyCanvas.Brush.Color := clBlack;
      MyCanvas.FillRect(WinRect);
      MyCanvas.Font.Color := Random($7FFFFF) + $7FFFFF;
      tw := MyCanvas.TextWidth(config_rec.textstring);
      th := MyCanvas.TextHeight(config_rec.textstring);
      posx := Random(WinRect.Right-tw) + 1;
      posy := Random(WinRect.Bottom-th) + 1;
      MyCanvas.TextOut(posx, posy, config_rec.TextString);
    end;

  procedure SS_Start(WinHandle: Integer);
    { one step of the screen saver action - we do not want delay  }
    begin
    { fill old string area with black }
      MyCanvas.Brush.Color := clBlack;
      MyCanvas.FillRect(Rect(posx, posy, posx + tw, posy + th));
    { now draw new text string }
      MyCanvas.Pen.Color := clBlack;
      MyCanvas.Font.Color := Random($7FFFFF) + $7FFFFF;
      tw := MyCanvas.TextWidth(config_rec.textstring);
      th := MyCanvas.TextHeight(config_rec.textstring);
      posx := Random(WinRect.Right-tw) + 1;
      posy := Random(WinRect.Bottom-th) + 1;
      MyCanvas.TextOut(posx, posy, config_rec.textstring);
    end;

  procedure SS_End(WinHandle: Integer);
    { termination requirements - free canvas and free device context }
    begin
      ReleaseDC(WinHandle, MyCanvas.Handle);
      MyCanvas.Free;
    end;

end.

Relevant questions may be asked in the thread announcing this.

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close