Marco Cantù 1998, Mastering Delphi 4

Project: WORLD.DPR


Project Structure


WORLD.DPR

program World;

uses
  Forms,
  WorldF in 'WorldF.pas' {WorldForm};

{$R *.RES}

begin
  Application.CreateForm(TWorldForm, WorldForm);
  Application.Run;
end.

WORLDF.PAS

unit WorldF;

interface

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

type
  TWorldForm = class(TForm)
    WorldButton: TBitBtn;
    Timer1: TTimer;
    Label1: TLabel;
    PaintBox1: TPaintBox;
    procedure WorldButtonClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WorldButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure WorldButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    Count: Integer;
    BitmapsList: TList;
  public
    { Public declarations }
  end;

var
  WorldForm: TWorldForm;

implementation

{$R *.DFM}
{$R WORLDBMP.RES}

procedure TWorldForm.WorldButtonClick(Sender: TObject);
begin
  if Timer1.Enabled then
    begin
      Timer1.Enabled := False;
      WorldButton.Caption := '&Start';
    end
  else
    begin
      Timer1.Enabled := True;
      WorldButton.Caption := '&Stop';
    end;
end;

procedure TWorldForm.Timer1Timer(Sender: TObject);
begin
  Count := (Count mod 16) + 1;
  Label1.Caption := Format ('Displaying image %d', [Count]);

  {draw the current bitmap in the canvas
  placed over the bitmap button}
  PaintBox1.Canvas.Draw (1, 1,
    BitmapsList.Items[Count-1]);
end;

procedure TWorldForm.FormCreate(Sender: TObject);
var
  I: Integer;
  Bmp: TBitmap;
begin
  Count := 1;

  // load the bitmaps and add them to the list
  BitmapsList := TList.Create;
  for I := 1 to 16 do
  begin
    Bmp := TBitmap.Create;
    Bmp.LoadFromResourceName (HInstance,
      'W' + IntToStr (I));
    BitmapsList.Add (Bmp);
  end;

  {change the parent of the paintbox, placing it inside
  the button instead of inside the form}
  PaintBox1.Parent := WorldButton;
  PaintBox1.SetBounds (
    WorldButton.Margin,
    (WorldButton.Height - Bmp.Height) div 2,
    Bmp.Width + 2,
    Bmp.Height + 2);
end;

procedure TWorldForm.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  // free each element and the list itself
  for I := BitmapsList.Count - 1 downto 0 do
    TBitmap (BitmapsList [I]).Free;
  BitmapsList.Free;
end;

procedure TWorldForm.WorldButtonMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    // paint the current image over the button
    PaintBox1.Left := PaintBox1.Left + 2;
    PaintBox1.Top := PaintBox1.Top + 2;
    WorldButton.Glyph.Assign (
      BitmapsList.Items[Count-1]);
  end;
end;

procedure TWorldForm.WorldButtonMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    PaintBox1.Left := PaintBox1.Left - 2;
    PaintBox1.Top := PaintBox1.Top - 2;
    WorldButton.Glyph.Assign (
      BitmapsList.Items[Count-1]);
  end;
end;

end.

WORLDF.DFM

object WorldForm: TWorldForm
  Left = 249
  Top = 141
  Width = 285
  Height = 187
  ActiveControl = WorldButton
  Caption = 'World'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 78
    Top = 16
    Width = 118
    Height = 16
    Caption = 'Displaying image 1'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Arial'
    Font.Style = [fsBold, fsItalic]
    ParentFont = False
  end
  object PaintBox1: TPaintBox
    Left = 0
    Top = 0
    Width = 32
    Height = 32
    OnClick = WorldButtonClick
  end
  object WorldButton: TBitBtn
    Left = 68
    Top = 48
    Width = 149
    Height = 65
    Caption = '&Start'
    TabOrder = 0
    OnClick = WorldButtonClick
    OnMouseDown = WorldButtonMouseDown
    OnMouseUp = WorldButtonMouseUp
    Glyph.Data = {
      FE080000424DFE08000000000000360400002800000022000000220000000100
      080000000000C804000000000000000000000001000000000000000000000000
      80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
      A600FFF3FF0000006600000099000000CC000033000000333300003366000033
      99000033CC000033FF00006600000066330000666600006699000066CC000066
      FF000099330000996600009999000099CC000099FF0000CC000000CC330000CC
      660000CC990000CCCC0000CCFF0000FF330000FF660000FF990000FFCC003300
      00003300330033006600330099003300CC003300FF0033330000333333003333
      6600333399003333CC003333FF00336600003366330033666600336699003366
      CC003366FF00339900003399330033996600339999003399CC003399FF0033CC
      000033CC330033CC66000099000033CC990033CCCC0033CCFF0033FF000033FF
      330033FF660033FF990033FFCC0033FFFF006600000066003300660066006600
      99006600CC006600FF00663300006633330066336600663399006633CC006633
      FF00666600006666330066666600666699006666CC006666FF00669900006699
      330066996600669999006699CC006699FF0066CC000066CC330066CC660066CC
      990066CCCC0066CCFF0066FF000066FF330066FF660066FF990066FFCC0066FF
      FF00990000009900330099006600990099009900CC009900FF00993300009933
      330099336600993399009933CC009933FF009966000099663300996666009966
      99009966CC009966FF00999900009999330099996600999999009999CC009999
      FF0099CC000099CC330099CC660099CC990099CCCC0099CCFF0099FF000099FF
      330099FF660099FF990099FFCC0099FFFF00CC000000CC003300CC006600CC00
      9900CC00CC00CC00FF00CC330000CC333300CC336600CC339900CC33CC00CC33
      FF00CC660000CC663300CC666600CC669900CC66CC00CC66FF00CC990000CC99
      3300CC996600CC999900CC99CC00CC99FF00CCCC0000CCCC3300CCCC6600CCCC
      9900CCCCCC00CCCCFF00CCFF0000CCFF3300CCFF6600CCFF9900CCFFCC00CCFF
      FF00FF003300FF006600FF009900FF00CC00FF330000FF333300FF336600FF33
      9900FF33CC00FF33FF00FF660000FF663300FF666600FF669900FF66CC00FF66
      FF00FF990000FF993300FF996600FF999900FF99CC00FF99FF00FFCC0000FFCC
      3300FFCC6600FFCC9900FFCCCC00FFCCFF00FFFF3300FFFF6600FFFF9900FFFF
      CC007D7D7D0061285500249D2C0018008D006D79610091102C0034DA3400B24C
      9D00754C6500442038000000A5009D309100000095009D488D00004BB400004C
      B300004DB200004EB100004FB0000050AF000051AE000052AD000053AC000054
      AB000055AA000056A9000048B7000049B600F0FBFF00A4A0A000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FFFF
      FFFFFFFFFFFFFFFFFFFFFFFFFCFCFCFCFCFCFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000FFFFFFFFFFFFFFFFFFFFFFFCFCFCFCFCFCFCFCFCFCFCFCFFFFFFFFFFFFFF
      FFFFFFFF0000FFFFFFFFFFFFFFFFFFFCFCFCFCFCFCFCFCFC0707FCFCFCFCFCFF
      FFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFCFCFCFCFCFCFCFCFCFC07FAFCFC
      FCFCFCFCFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFCFCFCFCFCFCFCFCFCFCFCFC
      FCFA0707FCFCFCFCFCFCFFFFFFFFFFFF0000FFFFFFFFFFFCFCFCFCFCFCFCFCFC
      FCFCFCFCFCFAFAFA07FCFCFCFCFCFCFFFFFFFFFF0000FFFFFFFFFFFCFCFCFCFC
      FCFCFCFCFCFCFCFCFCFCFAFAFA07FCFCFCFCFCFFFFFFFFFF0000FFFFFFFFFCFC
      FCFCFCFCFCFCFCFCFCFCFCFCFCFCFAFAFAFA07FCFCFCFCFCFFFFFFFF0000FFFF
      FFFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFAFAFAFAFA07FCFCFCFCFCFFFFFF
      0000FFFFFFFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC07FAFAFAFAFAFA07FCFC
      FCFFFFFF0000FFFFFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC07FAFAFAFAFA
      FA07FCFC07FCFFFF0000FFFFFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFAFAFA
      FAFAFAFAFAFAFCFC07FCFFFF0000FFFFFCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC
      07FAFAFAFAFAFAFAFAFAFCFC07FAFFFF0000FFFCFCFCFCFCFCFCFCFCFCFCFCFC
      FCFCFCFAFAFAFAFAFAFAFAFAFAFAFCFC07FAFCFF0000FFFCFCFCFCFCFCFCFCFC
      FCFCFCFCFCFCFCFAFAFAFAFAFAFAFAFAFA07FCFC07FA07FF0000FFFCFCFCFCFC
      FCFCFCFCFCFCFCFCFCFCFC07FAFAFAFAFAFAFA07FCFCFCFC07FAFAFF0000FFFC
      FCFCFCFCFCFCFCFCFCFCFCFCFCFCFCFAFAFAFAFAFAFAFCFCFCFCFCFC07FAFAFF
      0000FFFCFCFCFCFCFCFCFCFCFCFCFCFCFCFC07FA0707FAFAFA07FCFCFCFCFCFC
      07FAFCFF0000FFFCFCFCFCFCFCFCFCFCFCFCFCFCFAFAFAFAFCFCFAFA07FCFCFC
      FCFCFCFCFAFAFCFF0000FFFFFC0707FCFCFCFCFCFC0707FAFAFAFA07FCFCFCFC
      FCFCFCFCFCFCFCFCFA07FFFF0000FFFFFCFAFAFCFCFCFCFCFCFAFAFAFA07FAFC
      FAFA07FCFCFCFCFCFCFCFCFCFAFCFFFF0000FFFFFCFCFCFCFCFCFCFCFA07FAFA
      07FCFCFC07070707FCFCFCFCFCFCFCFA07FCFFFF0000FFFFFFFCFCFCFCFCFC07
      FAFAFAFAFA0707FA07FCFCFCFCFCFCFCFCFC0707FCFFFFFF0000FFFFFFFCFCFC
      FCFCFCFAFAFAFAFAFAFAFAFA07FCFCFCFCFCFCFCFCFC07FCFCFFFFFF0000FFFF
      FFFFFCFCFCFCFCFAFAFAFAFAFAFAFAFAFAFA07FCFCFCFCFCFCFCFCFCFFFFFFFF
      0000FFFFFFFFFFFCFCFCFCFCFAFAFAFAFAFA07FAFAFAFAFCFCFCFCFCFCFCFCFF
      FFFFFFFF0000FFFFFFFFFFFC070707FCFAFAFAFAFAFA07FAFAFAFAFA07FCFCFC
      FCFCFCFFFFFFFFFF0000FFFFFFFFFFFFFC0707FAFAFAFAFAFAFAFAFAFA070707
      07FA07FCFCFCFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFCFC07FAFAFAFAFAFAFA
      07FC07FAFAFAFCFCFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFCFCFC0707
      0707070707FA070707FCFCFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF
      FFFCFCFCFCFCFCFCFCFCFCFCFCFFFFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFF
      FFFFFFFFFFFFFFFFFCFCFCFCFCFCFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FFFF
      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
      0000}
    Margin = 5
    Spacing = 25
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 300
    OnTimer = Timer1Timer
    Left = 8
    Top = 16
  end
end


Copyright Marco Cantù 1998