This TI shows how you can write a 32-bit screen saver in Delphi 3.
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!
- 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.
- Do a File | New | Form. Select Unit1 in the Code Editor. Do a
File | Save As, and save the new form as SSetup.pas.
- Do a File | New | Form. Select Unit2 in the Code Editor. Do a
File | Save As, and save the new form as SSave.pas.
- Do a File | New | Unit. Select Unit3 in the Code Editor. Do a
File | Save As, and save the new unit as Globals.pas.
- Do a File | New | Unit. Select Unit3 in the Code Editor. Do a
File | Save As, and save the new unit as CodeSpot.pas.
- 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.
- 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.
- Select the unit Globals.pas. Replace all the code with the code
for Globals.pas below.
- Select the unit CodeSpot.pas. Replace all the code with the code
for CodeSpot.pas below.
- Do a View | Project Source. Replace all the code with the code
for Simple.dpr below.
- Do a Project | Build All.
- 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.
- 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.
|