Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 09 - Project QSplash2

Project Structure

QSplash2.dpr
program QSplash2;

uses
  QForms,
  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
  Qt, SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  QMenus, QStdCtrls, QTypes;

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 *.xfm}

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 30000 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
  Qt, SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls, QButtons, QExtCtrls, QTypes;

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 *.xfm}

procedure TAboutBox.MakeSplash;
begin
  BorderStyle := fbsNone;
  FormStyle := fsStayOnTop;
  BitBtn1.Visible := False;
  Panel1.BorderWidth := 3;
  Show;
  Update;
end;

procedure TAboutBox.Timer1Timer(Sender: TObject);
begin
  Close;
  Release;
end;

end.
MainSpF.xfm
object Form1: TForm1
  Left = 75
  Top = 125
  Width = 600
  Height = 371
  ActiveControl = ListBox1
  Caption = 'Prime Numbers'
  Color = clButton
  Font.Color = clText
  Font.Height = 11
  Font.Name = 'MS Sans Serif'
  Font.Pitch = fpVariable
  Font.Style = []
  Font.Weight = 40
  Menu = MainMenu1
  ParentFont = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  TextWidth = 6
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 600
    Height = 348
    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.xfm
object AboutBox: TAboutBox
  Left = 305
  Top = 112
  Width = 302
  Height = 232
  ActiveControl = BitBtn1
  BorderStyle =