How do I write a screen saver?

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

program ssdemo;
  { main application for screen saver demo, written by Glenn9999
    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},
  windows, sysutils, runonce,
  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}

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: THandle);
  { generic initialization code applicable to all screen savers }
  // mod 04/22/2016.  Default is /C not /S.
  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 := '/C'; { no parms, assume default of configure 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;
  end;

var
  WinHandle: THandle;
  program_state: ps_type;

begin
  RunOnlyOnce('SSaverSemaphore');
  SS_Initialize(program_state, Winhandle);
 { 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 }
      SS_Init(WinHandle);
      while IsWindowVisible(Winhandle) do
        begin
          SS_Draw(WinHandle);
          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;
end.

unit configunit;
  { configuration code by Glenn9999 }

interface

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

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.

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

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

type
  ps_type = (Preview, Config, Show); {enum. type for ssinit code }
  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);
    function checkSSpassword(inhandle: THandle): boolean;
  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;
  sysdir: string;
  osvinfo: TOsVersionInfo;
  os_is_NT: boolean;

implementation

{$R *.DFM}

procedure TDrawForm.StartSaver(var WinMsg : TMessage);
{ draw one step of the screen saver here }
begin
  SS_Draw(Handle);
  sleep(10);
end;

procedure TDrawform.Trigger(Sender : TObject; var Done : Boolean);
{ executed by the screen saver on idle }
begin
  PostMessage(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(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 }
  Width := GetSystemMetrics(SM_CXSCREEN);
  Height := GetSystemMetrics(SM_CYSCREEN);
  { initialize Mouse coords}
  Mouse.X := -1;
  Mouse.Y := -1;
  start_time := timeGetTime;
  { screen saver on, capture on, Idle func set, cursor off }
  SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@Dummy,0);
  SetCapture(Handle);
  Application.OnIdle := Trigger;
  ShowCursor(false);
 { bring window to foreground }
  SetForegroundWindow(Handle);
  SetActiveWindow(Handle);
  { initialize the Screen saver action here }
  SS_Init(Handle);
end;

function TDrawForm.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;

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.

STRINGTABLE
BEGIN
1, "Demo Screensaver"
END

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.

    03-08-2018: Draw to surface size of screen then scale to WinHandle dimensions.
  }
interface
  uses windows, graphics, classes, sysutils, mmsystem, registry;

  type
    sshut_record = record
      TextString: string; { text string on screen }
      delay: DWord;  { delay between instances }
    end;
  var
    config_rec: sshut_record;
    MyCanvas: TCanvas;
    MyBitmap: TBitmap;
    WinRect: TRect;
    posx, posy: integer;
    tw, th: integer;
    start_time: Longint;

  procedure read_values(var ssr: sshut_record);
  procedure write_values(ssr: sshut_record);

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

implementation

  procedure SS_Init(WinHandle: Integer);
    { initializes screen saver action }
    begin
      // set up drawing surface
      MyBitmap := TBitmap.Create;
      MyBitmap.Width := GetSystemMetrics(SM_CXSCREEN);
      MyBitmap.Height := GetSystemMetrics(SM_CYSCREEN);
      // set surface for WinHandle
      MyCanvas := TCanvas.Create;
      MyCanvas.Handle := GetDC(Winhandle);
      GetClientRect(WinHandle, WinRect);

      // screen saver draw initializations.
      MyBitmap.Canvas.Font.Name := 'Arial Black';
      MyBitmap.Canvas.Font.Height := MyBitmap.Height div 8;
      randomize;
      start_time := timeGetTime;
      SS_Draw(WinHandle);
    end;

  procedure SS_Draw(WinHandle: Integer);
    // draw one step.
    begin
      if (timeGetTime - Start_Time) >= config_rec.Delay then
        begin
          with MyBitMap.Canvas do
            begin
              Brush.Color := clBlack;
              FillRect(Rect(0, 0, MyBitmap.Width, MyBitmap.Height));
              Font.Color := Random($7FFFFF) + $7FFFFF;
              tw := TextWidth(config_rec.textstring);
              th := TextHeight(config_rec.textstring);
              posx := Random(MyBitmap.Width-tw) + 1;
              posy := Random(MyBitmap.Height-th) + 1;
              TextOut(posx, posy, config_rec.TextString);
            end;
          MyCanvas.StretchDraw(WinRect, MyBitmap);
          start_time := timeGetTime;
        end;
    end;

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

  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;
end.