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 5

Project CREDITS

Project Structure


CREDITS.DPR

program Credits;

uses
  Forms,
  Useless in 'USELESS.PAS' {UselessForm},
  About in 'ABOUT.PAS' {AboutBox};

{$R *.RES}

begin
  Application.CreateForm(TUselessForm, UselessForm);
  Application.CreateForm(TAboutBox, AboutBox);
  Application.Run;
end.

USELESS.PAS

unit Useless;

interface

uses Windows, Classes, Graphics, Forms, Controls,
     Menus, About;

type
  TUselessForm = class(TForm)
    MainMenu1: TMainMenu;
    Help1: TMenuItem;
    Aboutthisprogram1: TMenuItem;
    procedure Aboutthisprogram1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  UselessForm: TUselessForm;

implementation

{$R *.DFM}

procedure TUselessForm.Aboutthisprogram1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

end.

ABOUT.PAS

unit About;

interface

uses
  SysUtils, Windows, Classes, Graphics, Forms,
  Controls, Buttons, StdCtrls, ExtCtrls;

type
  TAboutBox = class(TForm)
    BitBtn1: TBitBtn;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    PaintBox1: TPaintBox;
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AboutBox: TAboutBox;

implementation

{$R *.DFM}

procedure Delay (Seconds, MilliSec: Word);
var
  TimeOut: TDateTime;
begin
  TimeOut := Now + EncodeTime (0,
    Seconds div 60, Seconds mod 60, MilliSec);
  // wait until he TimeOut time
  while Now < TimeOut do
    Application.ProcessMessages;
end;

procedure TAboutBox.Label1MouseDown(Sender: TObject;
  Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I, LineH: Integer;
begin
  if (Button = mbRight) and (ssShift in Shift) then
  begin
    Panel1.Visible := False;
    LineH := PaintBox1.Canvas.TextHeight ('0');
    for I := 0 to 100 + LineH * 10 do
      with PaintBox1.Canvas do
      begin
        // empty lines are used to delete descendants
        TextOut (40, 100 - I,
          'CREDITS example from:');
        TextOut (40, 100 + LineH - I,
          '"Mastering Delphi"');
        TextOut (40, 100 + LineH * 2 - I,
          '                          ');
        TextOut (40, 100 + LineH * 4 - I,
          'Author: Marco Cantý');
        TextOut (40, 100 + LineH * 5 - I,
          'Publisher: Sybex');
        TextOut (40, 100 + LineH * 6 - I,
          '                          ');
        TextOut (40, 100 + LineH * 8 - I,
          'Dedicated with love');
        TextOut (40, 100 + LineH * 9 - I,
          'to my wife, Lella');
        TextOut (40, 100 + LineH * 10 - I,
          '                          ');
        // wait 5 milliseconds
        Delay (0, 5);
      end;
    Panel1.Visible := True;
  end;
end;

end.

USELESS.DFM

object UselessForm: TUselessForm
  Left = 227
  Top = 156
  Width = 225
  Height = 169
  Caption = 'Useless form'
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'System'
  Font.Style = []
  Menu = MainMenu1
  PixelsPerInch = 96
  TextHeight = 16
  object MainMenu1: TMainMenu
    Left = 24
    Top = 16
    object Help1: TMenuItem
      Caption = '&Help'
      object Aboutthisprogram1: TMenuItem
        Caption = 'About this program...'
        OnClick = Aboutthisprogram1Click
      end
    end
  end
end

ABOUT.DFM

object AboutBox: TAboutBox
  Left = 228
  Top = 182
  ActiveControl = BitBtn1
  BorderStyle = bsDialog
  Caption = 'About this program'
  ClientHeight = 178
  ClientWidth = 427
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 0
    Top = 8
    Width = 425
    Height = 121
    Font.Color = clBlack
    Font.Height = -19
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
  end
  object Panel1: TPanel
    Left = 9
    Top = 8
    Width = 409
    Height = 121
    TabOrder = 1
    object Label1: TLabel
      Left = 20
      Top = 16
      Width = 370
      Height = 57
      AutoSize = False
      Caption =
         'This program was written by Marco Cantý for the book "Mastering ' +
        'Delphi", published by Sybex, to demonstrate how to build a hidde' +
        'n credits screen. If you press the right mouse button on this te' +
        'xt by holding down the Shift key, the presentation will begin. '
      WordWrap = True
      OnMouseDown = Label1MouseDown
    end
    object Label2: TLabel
      Left = 20
      Top = 72
      Width = 370
      Height = 41
      AutoSize = False
      Caption =
         'Of course, you should not document how to reach the hidden credi' +
        't screen, or just give a generic hint. This text should be used ' +
        'for copyright information, version information, and similar stuf' +
        'f. '
      WordWrap = True
    end
  end
  object BitBtn1: TBitBtn
    Left = 173
    Top = 136
    Width = 81
    Height = 33
    TabOrder = 0
    Kind = bkOK
  end
end