Home: Code Repository: Mastering Delphi 5

Project CREDITS

Project Structure

CREDITS.DPR
USELESS.PAS
ABOUT.PAS
USELESS.DFM
ABOUT.DFM

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.

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.

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.

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

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