Screen Saver

Hi,
I just whipped this together in order to get you started.
It will scan your fixed disks for BMP-files and show them...
When compiled, change extension to ".scr".
Separate into separate files:

<<<MYSAVER.DPR>>>
program MySaver;

uses
  Forms,
  SysUtils,
  Dialogs,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2};

{$E scr}

{$R *.RES}
{$D SCRNSAVE MyMagnificentSaver} //  <<< used by Win95?, not in NT!

begin
  Application.Initialize;
  if ( ParamCount = 0 ) or ( CompareText( '/c', Copy( ParamStr( 1 ), 1, 2 ) ) = 0 ) then
  begin
    Application.CreateForm(TForm2, Form2);
    Application.Run;
  end else
  if ( CompareText( '/a', Copy( ParamStr( 1 ), 1, 2 ) ) = 0 ) then
  begin
    // show password dlg...
    // handle in ParamStr(2)
  end else
  if ( CompareText( '/p', Copy( ParamStr( 1 ), 1, 2 ) ) = 0 ) then
  begin
    // show preview...
    // handle in ParamStr(2)
  end else begin
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
end.

<<<UNIT1.PAS>>>
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    m_bmpFromList: TBitmap;
    m_BMPList    : TStringList;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure ScanDiskForBMPs( sDiskRoot: string; List: TStrings );
var
  SR: TSearchRec;
begin
  if not Assigned( List ) then Exit;
  Application.ProcessMessages;
  if sDiskRoot[ Length( sDiskRoot )] <> '\' then AppendStr( sDiskRoot, '\' ); // fix dir
  // recursive part...
  if FindFirst( sDiskRoot + '*.*', faAnyFile, SR ) = 0 then repeat
    if ( SR.Attr and faDirectory ) <> faDirectory then
      if ( CompareText( ExtractFileExt( SR.Name ), '.bmp' ) = 0 )
      then List.Add( sDiskRoot+SR.Name ) else
    else
      if ( SR.Name[1] <> '.' )
      then ScanDiskForBMPs( sDiskRoot+SR.Name+'\', List );
  until FindNext( SR ) <> 0;
  FindClose( SR );
end;

procedure FindBitmaps( List: TStrings );
var
  chDrive: Char;
begin
  for chDrive := 'C' to 'Z' do begin
    if GetDriveType( PChar( chDrive + ':\' ) ) = DRIVE_FIXED then
    begin
      ScanDiskForBMPs( chDrive + ':\', List );
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with Screen do SetBounds( 0, 0, Width, Height );
  Screen.Cursor := crNone;  // hide mouse cursor
  Brush.Style   := bsClear;   // transparent form
  m_bmpFromList := TBitmap.Create;
  m_BMPList     := TStringList.Create;
  FindBitmaps( m_BMPList );
end;

procedure SafeClose;
begin
  Screen.Cursor := crDefault;  // show mouse cursor
  Application.Terminate;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  SafeClose;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  SafeClose;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  iEntry, iX, iY: Integer;
begin
  iEntry := Random( m_BMPList.Count );
  if iEntry = 0 then Exit;
  try
    m_bmpFromList.LoadFromFile( m_BMPList[ iEntry ] );
    m_bmpFromList.Dormant;             // Free up GDI resources
    iX := Random( Screen.Width - m_bmpFromList.Width );
    iY := Random( Screen.Height - m_bmpFromList.Height );
    Canvas.Brush.Color := clBlack;
    Canvas.FrameRect( Rect( iX - 1, iY - 1, iX + m_bmpFromList.Width + 1, iY + m_bmpFromList.Height + 1 ) );
    Canvas.Draw( iX, iY, m_bmpFromList );
    m_bmpFromList.ReleaseHandle;       // This will actually lose the bitmap;
  except
  end;
end;

end.

<<<UNIT1.DFM>>>
object Form1: TForm1
  Left = 280
  Top = 480
  BorderIcons = []
  BorderStyle = bsNone
  Caption = 'My own screen saver'
  ClientHeight = 345
  ClientWidth = 494
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnClick = FormClick
  OnCreate = FormCreate
  OnKeyPress = FormKeyPress
  PixelsPerInch = 96
  TextHeight = 13
  object Timer1: TTimer
    Interval = 250
    OnTimer = Timer1Timer
    Left = 12
    Top = 8
  end
end

<<<UNIT2.PAS>>>
unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.Button1Click(Sender: TObject);
begin
  Application.Terminate;
end;

end.

<<<UNIT2.DFM>>>
object Form2: TForm2
  Left = 371
  Top = 235
  BorderIcons = [biSystemMenu]
  BorderStyle = bsToolWindow
  Caption = 'Setup/config'
  ClientHeight = 182
  ClientWidth = 378
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 292
    Top = 148
    Width = 75
    Height = 25
    Caption = 'Done'
    TabOrder = 0
    OnClick = Button1Click
  end
end

Good luck!

/// John

can you sent me an example?

talklein@ort.org.il

What do you think I did?!

/// John

haha, that 1 really hit the ground at zero!

Black Death.