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
Last Modified: 01-SEP-99