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.

The post Icon Screensaver first appeared on Delphijustin industries.