Category

Development Platform
Home > SourceCode/Document > Delphi VCL > View Code
ArrowForm.pas
Package: delphi.rar　[view]
Upload User: fh681027
Upload Date: 2022-07-23
Package Size: 1959k
Code Size: 3k
Category:

Delphi VCL

Development Platform:

Delphi

ArrowForm.pas：Code Content
  1. unit ArrowForm;
  3. interface
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Spin, ExtCtrls, ComCtrls, MdArrow;
  9. type
  10.   TForm1 = class(TForm)
  11.     Bevel1: TBevel;
  12.     Label1: TLabel;
  13.     Label2: TLabel;
  14.     Label3: TLabel;
  15.     PenLabel: TLabel;
  16.     SpinWidth: TSpinEdit;
  17.     SpinHeight: TSpinEdit;
  18.     SpinArrow: TSpinEdit;
  19.     btnTurn: TButton;
  20.     cbFilled: TCheckBox;
  21.     btnBrush: TButton;
  22.     btnPen: TButton;
  23.     ColorDialog1: TColorDialog;
  24.     trackPenWidth: TTrackBar;
  25.     Arrow: TMdArrow;
  26.     procedure btnTurnClick(Sender: TObject);
  27.     procedure cbFilledClick(Sender: TObject);
  28.     procedure btnBrushClick(Sender: TObject);
  29.     procedure btnPenClick(Sender: TObject);
  30.     procedure trackPenWidthChange(Sender: TObject);
  31.     procedure ArrowDoubleClick (Sender: TObject);
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure SpinWidthChange(Sender: TObject);
  34.     procedure SpinHeightChange(Sender: TObject);
  35.     procedure SpinArrowChange(Sender: TObject);
  36.   end;
  38. var
  39.   Form1: TForm1;
  41. implementation
  43. {$R *.DFM}
  45. procedure TForm1.btnTurnClick(Sender: TObject);
  46. begin
  47.   if Arrow.Direction = High (TMdArrowDir) then
  48.     Arrow.Direction := Low (TMdArrowDir)
  49.   else
  50.     Arrow.Direction := Succ (Arrow.Direction);
  51. end;
  53. procedure TForm1.cbFilledClick(Sender: TObject);
  54. begin
  55.   Arrow.Filled := not Arrow.Filled;
  56. end;
  58. procedure TForm1.btnBrushClick(Sender: TObject);
  59. begin
  60.   ColorDialog1.Color := Arrow.Brush.Color;
  61.   if ColorDialog1.Execute then
  62.     Arrow.Brush.Color := ColorDialog1.Color;
  63. end;
  65. procedure TForm1.btnPenClick(Sender: TObject);
  66. begin
  67.   ColorDialog1.Color := Arrow.Pen.Color;
  68.   if ColorDialog1.Execute then
  69.     Arrow.Pen.Color := ColorDialog1.Color;
  70. end;
  72. procedure TForm1.trackPenWidthChange(Sender: TObject);
  73. begin
  74.   PenLabel.Caption := 'Pen Width: ' +
  75.     IntToStr (trackPenWidth.Position);
  76.   Arrow.Pen.Width := trackPenWidth.Position;
  77. end;
  79. procedure TForm1.ArrowDoubleClick (Sender: TObject);
  80. begin
  81.   ShowMessage ('You have double clicked ' +
  82.     'on the point of the arrow');
  83. end;
  85. procedure TForm1.FormCreate(Sender: TObject);
  86. begin
  87.   SpinWidth.Value := Arrow.Width;
  88.   SpinHeight.Value := Arrow.Height;
  89.   SpinArrow.Value := Arrow.ArrowHeight;
  90.   cbFilled.Checked := Arrow.Filled;
  91.   trackPenWidth.Position := Arrow.Pen.Width;
  92.   PenLabel.Caption := 'Pen Width: ' +
  93.     IntToStr (trackPenWidth.Position);
  94. end;
  96. procedure TForm1.SpinWidthChange(Sender: TObject);
  97. begin
  98.   Arrow.Width := SpinWidth.Value;
  99. end;
  101. procedure TForm1.SpinHeightChange(Sender: TObject);
  102. begin
  103.   Arrow.Height := SpinHeight.Value;
  104. end;
  106. procedure TForm1.SpinArrowChange(Sender: TObject);
  107. begin
  108.   Arrow.ArrowHeight := SpinArrow.Value;
  109. end;
  111. end.