Improve company productivity with a Business Account.Sign Up

x
?
Solved

Screen Saver

Posted on 1998-08-16
5
Medium Priority
?
296 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 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

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

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…
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…
Watch the video to know how one can repair corrupt Exchange OST file effortlessly and convert OST emails to MS Outlook PST file format by using Kernel for OST to PST converter tool. It can convert OST to MSG, MBOX, EML to access them. It can migrate…
From store locators to asset tracking and route optimization, learn how leading companies are using Google Maps APIs throughout the customer journey to increase checkout conversions, boost user engagement, and optimize order fulfillment. Powered …

595 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