Marco Web Center |
|
Chapter 11 - 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 |