Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Screen Saver

Posted on 1998-08-16
5
Medium Priority
?
287 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 200 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: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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

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…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses

722 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