Home: Code Repository: Mastering Delphi 5

Project ARROWDEMO

Project Structure

ARROWDEMO.DPR
ARROWFORM.PAS
ARROWFORM.DFM

program ArrowDemo;

uses
  Forms,
  ArrowForm in 'ArrowForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit ArrowForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Spin, ExtCtrls, ComCtrls, MdArrow;

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    PenLabel: TLabel;
    SpinWidth: TSpinEdit;
    SpinHeight: TSpinEdit;
    SpinArrow: TSpinEdit;
    btnTurn: TButton;
    cbFilled: TCheckBox;
    btnBrush: TButton;
    btnPen: TButton;
    ColorDialog1: TColorDialog;
    trackPenWidth: TTrackBar;
    Arrow: TMdArrow;
    procedure btnTurnClick(Sender: TObject);
    procedure cbFilledClick(Sender: TObject);
    procedure btnBrushClick(Sender: TObject);
    procedure btnPenClick(Sender: TObject);
    procedure trackPenWidthChange(Sender: TObject);
    procedure ArrowDoubleClick (Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpinWidthChange(Sender: TObject);
    procedure SpinHeightChange(Sender: TObject);
    procedure SpinArrowChange(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnTurnClick(Sender: TObject);
begin
  if Arrow.Direction = High (TMdArrowDir) then
    Arrow.Direction := Low (TMdArrowDir)
  else
    Arrow.Direction := Succ (Arrow.Direction);
end;

procedure TForm1.cbFilledClick(Sender: TObject);
begin
  Arrow.Filled := not Arrow.Filled;
end;

procedure TForm1.btnBrushClick(Sender: TObject);
begin
  ColorDialog1.Color := Arrow.Brush.Color;
  if ColorDialog1.Execute then
    Arrow.Brush.Color := ColorDialog1.Color;
end;

procedure TForm1.btnPenClick(Sender: TObject);
begin
  ColorDialog1.Color := Arrow.Pen.Color;
  if ColorDialog1.Execute then
    Arrow.Pen.Color := ColorDialog1.Color;
end;

procedure TForm1.trackPenWidthChange(Sender: TObject);
begin
  PenLabel.Caption := 'Pen Width: ' +
    IntToStr (trackPenWidth.Position);
  Arrow.Pen.Width := trackPenWidth.Position;
end;

procedure TForm1.ArrowDoubleClick (Sender: TObject);
begin
  ShowMessage ('You have double clicked ' +
    'on the point of the arrow');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SpinWidth.Value := Arrow.Width;
  SpinHeight.Value := Arrow.Height;
  SpinArrow.Value := Arrow.ArrowHeight;
  cbFilled.Checked := Arrow.Filled;
  trackPenWidth.Position := Arrow.Pen.Width;
  PenLabel.Caption := 'Pen Width: ' +
    IntToStr (trackPenWidth.Position);
end;

procedure TForm1.SpinWidthChange(Sender: TObject);
begin
  Arrow.Width := SpinWidth.Value;
end;

procedure TForm1.SpinHeightChange(Sender: TObject);
begin
  Arrow.Height := SpinHeight.Value;
end;

procedure TForm1.SpinArrowChange(Sender: TObject);
begin
  Arrow.ArrowHeight := SpinArrow.Value;
end;

end.

object Form1: TForm1
  Left = 202
  Top = 109
  Width = 428
  Height = 323
  Caption = 'Arrow Test'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 8
    Top = 8
    Width = 225
    Height = 97
  end
  object Label1: TLabel
    Left = 24
    Top = 33
    Width = 28
    Height = 13
    Caption = 'Width'
  end
  object Label2: TLabel
    Left = 24
    Top = 68
    Width = 31
    Height = 13
    Caption = 'Height'
  end
  object Label3: TLabel
    Left = 128
    Top = 49
    Width = 27
    Height = 13
    Caption = 'Arrow'
  end
  object PenLabel: TLabel
    Left = 256
    Top = 90
    Width = 62
    Height = 13
    Caption = 'Pen Width: 1'
  end
  object Arrow: TMdArrow
    Left = 88
    Top = 152
    Width = 249
    Height = 97
    Direction = adLeft
    ArrowHeight = 30
    Pen.Width = 2
    OnArrowDblClick = ArrowDoubleClick
  end
  object SpinWidth: TSpinEdit
    Left = 64
    Top = 28
    Width = 49
    Height = 22
    Increment = 5
    MaxValue = 0
    MinValue = 0
    TabOrder = 0
    Value = 20
    OnChange = SpinWidthChange
  end
  object SpinHeight: TSpinEdit
    Left = 64
    Top = 63
    Width = 49
    Height = 22
    Increment = 5
    MaxValue = 0
    MinValue = 0
    TabOrder = 1
    Value = 30
    OnChange = SpinHeightChange
  end
  object SpinArrow: TSpinEdit
    Left = 168
    Top = 44
    Width = 49
    Height = 22
    Increment = 5
    MaxValue = 0
    MinValue = 0
    TabOrder = 2
    Value = 15
    OnChange = SpinArrowChange
  end
  object btnTurn: TButton
    Left = 248
    Top = 9
    Width = 65
    Height = 24
    Caption = 'Turn'
    TabOrder = 3
    OnClick = btnTurnClick
  end
  object cbFilled: TCheckBox
    Left = 256
    Top = 41
    Width = 49
    Height = 25
    Caption = 'Filled'
    TabOrder = 4
    OnClick = cbFilledClick
  end
  object btnBrush: TButton
    Left = 328
    Top = 8
    Width = 81
    Height = 25
    Caption = 'Brush Color...'
    TabOrder = 5
    OnClick = btnBrushClick
  end
  object btnPen: TButton
    Left = 328
    Top = 40
    Width = 81
    Height = 25
    Caption = 'Pen Color...'
    TabOrder = 6
    OnClick = btnPenClick
  end
  object trackPenWidth: TTrackBar
    Left = 328
    Top = 80
    Width = 81
    Height = 33
    Max = 8
    Min = 1
    Orientation = trHorizontal
    Frequency = 1
    Position = 1
    SelEnd = 0
    SelStart = 0
    TabOrder = 7
    TabStop = False
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = trackPenWidthChange
  end
  object ColorDialog1: TColorDialog
    Ctl3D = True
    Left = 24
    Top = 112
  end
end