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 ARROWDEMO

Project Structure


ARROWDEMO.DPR

program ArrowDemo;

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

{$R *.RES}

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

ARROWFORM.PAS

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.

ARROWFORM.DFM

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