Marco Cantù 1998, Mastering Delphi 4
Project: SPLASH.DPR
Project Structure
SPLASH.DPR
program Splash;
uses
Forms,
MainSpF in 'MainSpF.pas' {Form1},
AboutF in 'AboutF.pas' {AboutBox};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
MAINSPF.PAS
unit MainSpF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
MainMenu1: TMainMenu;
Help1: TMenuItem;
About1: TMenuItem;
File1: TMenuItem;
Exit1: TMenuItem;
procedure About1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses AboutF;
{$R *.DFM}
procedure TForm1.About1Click(Sender: TObject);
begin
if not Assigned (AboutBox) then
AboutBox := TAboutBox.Create (Application);
AboutBox.ShowModal;
end;
{function local to the unit}
function IsPrime (N: LongInt): Boolean;
var
Test: LongInt;
begin
IsPrime := True;
for Test := 2 to N - 1 do
begin
if (N mod Test) = 0 then
begin
IsPrime := False;
break; {jump out of the for loop}
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
SplashAbout: TAboutBox;
begin
// create and show the splash form
SplashAbout := TAboutBox.Create (Application);
SplashAbout.MakeSplash;
// standard code...
for I := 1 to 10000 do
if IsPrime (I) then
ListBox1.Items.Add (IntToStr (I));
// get rid of the splash form, after a while
SplashAbout.Timer1.Enabled := True;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
end.
ABOUTF.PAS
unit AboutF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
TAboutBox = class(TForm)
Panel1: TPanel;
BitBtn1: TBitBtn;
Image1: TImage;
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
procedure MakeSplash;
end;
var
AboutBox: TAboutBox;
implementation
{$R *.DFM}
procedure TAboutBox.MakeSplash;
begin
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
BitBtn1.Visible := False;
Panel1.BorderWidth := 3;
Show;
Update;
end;
procedure TAboutBox.Timer1Timer(Sender: TObject);
begin
Close;
Release;
end;
end.
MAINSPF.DFM
object Form1: TForm1
Left = 75
Top = 125
Width = 600
Height = 371
Caption = 'Prime Numbers'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ListBox1: TListBox
Left = 0
Top = 0
Width = 592
Height = 325
Align = alClient
Columns = 5
ItemHeight = 13
TabOrder = 0
end
object MainMenu1: TMainMenu
Left = 56
Top = 24
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About...'
OnClick = About1Click
end
end
end
end
ABOUTF.DFM
object AboutBox: TAboutBox
Left = 305
Top = 112
BorderStyle = bsDialog
Caption = 'AboutBox'
ClientHeight = 232
ClientWidth = 302
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 302
Height = 232
Align = alClient
BevelInner = bvLowered
Caption = 'Panel1'
TabOrder = 0
object Image1: TImage
Left = 2
Top = 2
Width = 298
Height = 204
Align = alClient
Picture.Data = {...skipped...}
Stretch = True
end
object Label1: TLabel
Left = 2
Top = 206
Width = 298
Height = 24
Align = alBottom
Alignment = taCenter
Caption = 'This is my program, version 1'
Color = clBlack
Font.Charset = ANSI_CHARSET
Font.Color = clSilver
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = False
ParentFont = False
end
object BitBtn1: TBitBtn
Left = 214
Top = 8
Width = 75
Height = 33
TabOrder = 0
Kind = bkOK
end
end
object Timer1: TTimer
Enabled = False
Interval = 3000
OnTimer = Timer1Timer
Left = 240
Top = 56
end
end
Copyright Marco Cantù 1998