Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 09 - Project QSplash0

Project Structure

QSplash0.dpr
program QSplash0;

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: Integer): Boolean;
var
  Test: Integer;
begin
  IsPrime := True;
  for Test := 2 to N - 1 do
    if (N mod Test) = 0 then
    begin
      IsPrime := False;
      break; {jump out of the for loop}
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to 30000 do
    if IsPrime (I) then
      ListBox1.Items.Add (IntToStr (I));
 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;

type
  TAboutBox = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Image1: TImage;
    Label1: TLabel;
  private
    { Private declarations }
  end;

var
  AboutBox: TAboutBox;

implementation

{$R *.xfm}

end.
MainSpF.xfm
object Form1: TForm1
  Left = 99
  Top = 124
  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 = þÿ‹ð‰µˆ