This screensaver does exactly what the name says. It looks for icons and have them bounce around the screen and leaving a trail behind them. They are randomly chosen from windows, system and cursors directory. It uses ExtractIcon function from shell32.dll to get the icon and number of icons.
unit iconscrnUnit1;
{$RESOURCE iconscreensaver.res}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, shellapi,
ExtCtrls, Menus;
const format_dword='%u';
switch_s='/s';
switch_p='/p';
appname='Icon Screensaver';
icontypes:array[0..6]of string=('exe','dll','cpl','scr','ico','ani','cur');
type
TScrnSave =class(TForm)
Timer1: TTimer;
Timer2: TTimer;
Timer3: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
private
{ Private declarations }
public
Movement,OldMouse,IconPos:tpoint;
PreviewRect:TRect;
{ Public declarations }
end;
var
IconFiles:tstringlist;
SelIcon:hicon;
ScrnSave: TScrnSave;
implementation
{$R *.DFM}
procedure findIcons(const dir:string);
var i:integer;
sr:tsearchrec;
begin
for i:=0to high(icontypes)do
if findfirst(dir+'\*.'+icontypes[i],faanyfile,sr)=0then begin
iconfiles.Append(sr.name);
while findnext(sr)=0do iconfiles.Append(sr.name);
findclose(sr);
end;
end;
procedure TScrnSave.FormCreate(Sender: TObject);
var searchdir:array[0..max_path]of char;
about:msgboxparams;
begin
iconfiles:=tstringlist.Create;
movement.x:=10;
movement.y:=10;
if comparetext(paramstr(1),switch_p)=0then
begin//checks to see if it is being previewed in control panel
windows.GetClientRect(strtoint(paramstr(2)),previewrect);
clientheight:=previewrect.Bottom;
clientwidth:=previewrect.Right;
zeromemory(@previewrect.topleft,sizeof(tpoint));
windows.SetParent(handle,strtoint(paramstr(2)));
end else
if comparetext(switch_s,paramstr(1))<>0then
begin
zeromemory(@about,sizeof(About));
about.cbSize:=sizeof(about);
about.hInstance:=hinstance;
about.lpszText:=
'delphijustin Icon Screensaver v1.0'#13#10'By Justin Roeder'#13#10'2021';
about.lpszCaption:='About';
about.dwStyle:=mb_usericon;
about.lpszIcon:='MAINICON';
messageboxindirect(about);
exitprocess(0);
end;
getwindowsdirectory(searchdir,max_path);
findicons(searchdir);
findicons(strcat(searchdir,'\Cursors'));
getsystemdirectory(searchdir,max_path);
findicons(searchdir);
randomize;
iconpos.y:=random(clientheight);
iconpos.x:=random(clientwidth);
getcursorpos(oldmouse);
timer1.Enabled:=true;
timer2timer(nil);
timer3timer(nil);
timer2.Enabled:=true;
end;
procedure TScrnSave.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if comparetext(switch_p,paramstr(1))=0then exit;
close;
end;
procedure TScrnSave.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if comparetext(switch_p,paramstr(1))=0then exit;
close;
end;
procedure TScrnSave.Timer1Timer(Sender: TObject);
//This function draws the icons and checks for mouse movements
var newmouse:tpoint;
begin
if comparetext(switch_p,paramstr(1))=0then
if not iswindow(strtoint(paramstr(2)))then exitprocess(0);
getcursorpos(newmouse);
if(comparetext(switch_p,paramstr(1))<>0)and((newmouse.x<>oldmouse.x)or(newmouse.y<>oldmouse.y))then close;
with iconpos do
begin
y:=y+movement.y;
x:=x+movement.x;
drawicon(canvas.handle,x,y,selIcon);
if (y>clientheight)or(y<0) then movement.y:=-movement.y;
if (x>ClientWidth)OR(x<0) then movement.x:=-movement.x;
end;
end;
procedure TScrnSave.Timer2Timer(Sender: TObject);
var index,count:integer;
label tryagain;
begin
tryagain:index:=random(iconfiles.Count);
count:=extracticon(hinstance,pchar(iconfiles[index]),UINT(-1));
if COUNT=0then begin
iconfiles.Delete(index);goto tryagain; end;
if selicon<>0then destroyicon(selicon);
selicon:=extracticon(hinstance,pchar(iconfiles[index]),random(count));
end;
procedure TScrnSave.Timer3Timer(Sender: TObject);
begin
color:=rgb(random(256),random(256),random(256));
end;
end.
unit iconscrnUnit1;
{$RESOURCE iconscreensaver.res}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, shellapi,
ExtCtrls, Menus;
const format_dword='%u';
switch_s='/s';
switch_p='/p';
appname='Icon Screensaver';
icontypes:array[0..6]of string=('exe','dll','cpl','scr','ico','ani','cur');
type
TScrnSave =class(TForm)
Timer1: TTimer;
Timer2: TTimer;
Timer3: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
private
{ Private declarations }
public
Movement,OldMouse,IconPos:tpoint;
PreviewRect:TRect;
{ Public declarations }
end;
var
IconFiles:tstringlist;
SelIcon:hicon;
ScrnSave: TScrnSave;
implementation
{$R *.DFM}
procedure findIcons(const dir:string);
var i:integer;
sr:tsearchrec;
begin
for i:=0to high(icontypes)do
if findfirst(dir+'\*.'+icontypes[i],faanyfile,sr)=0then begin
iconfiles.Append(sr.name);
while findnext(sr)=0do iconfiles.Append(sr.name);
findclose(sr);
end;
end;
procedure TScrnSave.FormCreate(Sender: TObject);
var searchdir:array[0..max_path]of char;
about:msgboxparams;
begin
iconfiles:=tstringlist.Create;
movement.x:=10;
movement.y:=10;
if comparetext(paramstr(1),switch_p)=0then
begin//checks to see if it is being previewed in control panel
windows.GetClientRect(strtoint(paramstr(2)),previewrect);
clientheight:=previewrect.Bottom;
clientwidth:=previewrect.Right;
zeromemory(@previewrect.topleft,sizeof(tpoint));
windows.SetParent(handle,strtoint(paramstr(2)));
end else
if comparetext(switch_s,paramstr(1))<>0then
begin
zeromemory(@about,sizeof(About));
about.cbSize:=sizeof(about);
about.hInstance:=hinstance;
about.lpszText:=
'delphijustin Icon Screensaver v1.0'#13#10'By Justin Roeder'#13#10'2021';
about.lpszCaption:='About';
about.dwStyle:=mb_usericon;
about.lpszIcon:='MAINICON';
messageboxindirect(about);
exitprocess(0);
end;
getwindowsdirectory(searchdir,max_path);
findicons(searchdir);
findicons(strcat(searchdir,'\Cursors'));
getsystemdirectory(searchdir,max_path);
findicons(searchdir);
randomize;
iconpos.y:=random(clientheight);
iconpos.x:=random(clientwidth);
getcursorpos(oldmouse);
timer1.Enabled:=true;
timer2timer(nil);
timer3timer(nil);
timer2.Enabled:=true;
end;
procedure TScrnSave.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if comparetext(switch_p,paramstr(1))=0then exit;
close;
end;
procedure TScrnSave.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if comparetext(switch_p,paramstr(1))=0then exit;
close;
end;
procedure TScrnSave.Timer1Timer(Sender: TObject);
//This function draws the icons and checks for mouse movements
var newmouse:tpoint;
begin
if comparetext(switch_p,paramstr(1))=0then
if not iswindow(strtoint(paramstr(2)))then exitprocess(0);
getcursorpos(newmouse);
if(comparetext(switch_p,paramstr(1))<>0)and((newmouse.x<>oldmouse.x)or(newmouse.y<>oldmouse.y))then close;
with iconpos do
begin
y:=y+movement.y;
x:=x+movement.x;
drawicon(canvas.handle,x,y,selIcon);
if (y>clientheight)or(y<0) then movement.y:=-movement.y;
if (x>ClientWidth)OR(x<0) then movement.x:=-movement.x;
end;
end;
procedure TScrnSave.Timer2Timer(Sender: TObject);
var index,count:integer;
label tryagain;
begin
tryagain:index:=random(iconfiles.Count);
count:=extracticon(hinstance,pchar(iconfiles[index]),UINT(-1));
if COUNT=0then begin
iconfiles.Delete(index);goto tryagain; end;
if selicon<>0then destroyicon(selicon);
selicon:=extracticon(hinstance,pchar(iconfiles[index]),random(count));
end;
procedure TScrnSave.Timer3Timer(Sender: TObject);
begin
color:=rgb(random(256),random(256),random(256));
end;
end.
Root
Back
Forward
Go to parent folder
Reload
Mount network volume
New folder
New file
Upload files
Open
Download
Select files
Undo
Redo
Copy
Cut
Paste
Delete
Empty the folder
Duplicate
Rename
Edit file
Resize & Rotate
Change mode
Select all
Select none
Invert selection
Preview
Get info
Extract files from archive
Create archive
View
Sort
About this software
Full Screen
Trash
by name
by size
by kind
by date
by permission
by mode
by owner
by group
Folders first
Also Treeview
Error
Unable to connect to backend. HTTP error 0
All programs are virus free. Some antivirus software might say its "suspicious" or a "Potentionaly Unwanted Program". Some of them rate them on what there code looks like no matter if theres a definition in the virus database. If any of them are detected any Antivirus I will zip the software with the password "justin" j is lowercase
Published by Justin Roeder
I am an electronics engineer and computer programmer that has autism. I learned by myself
View more posts
delphijustin Industries is an Autism Supported Business