Solved

Screen Saver

Posted on 1998-08-16
5
280 Views
Last Modified: 2010-04-04
I want to create a screen saver that will show bitmaps.

How can I create this?  (I'm working with Delphi3).
0
Comment
Question by:tktk
5 Comments
 
LVL 4

Expert Comment

by:erajoj
ID: 1335948
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
0
 

Author Comment

by:tktk
ID: 1335949
can you sent me an example?

talklein@ort.org.il
0
 
LVL 4

Expert Comment

by:erajoj
ID: 1335950
What do you think I did?!

/// John
0
 
LVL 1

Expert Comment

by:BlackDeath
ID: 1335951
haha, that 1 really hit the ground at zero!

Black Death.

0
 
LVL 1

Accepted Solution

by:
jcasteel earned 100 total points
ID: 1335952
Check this TI out,
http://www.inprise.com/devsupport/delphi/ti_list/TI3335.html

The rest is all your own imagination how to show bitmaps
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

791 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question