Solved

Screen Saver

Posted on 1998-08-16
5
284 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Suggested Courses
Course of the Month6 days, 3 hours left to enroll

627 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