开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
Child.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

Child.pas：源码内容
  1. unit Child;
  3. interface
  5. uses Windows, Classes, Graphics, Forms, Controls, Menus,
  6.   Dialogs, SysUtils;
  8. type
  9.   TCircleChildForm = class(TForm)
  10.     MainMenu1: TMainMenu;
  11.     Circle1: TMenuItem;
  12.     FillColor1: TMenuItem;
  13.     BorderColor1: TMenuItem;
  14.     BorderSize1: TMenuItem;
  15.     N1: TMenuItem;
  16.     GetPosition1: TMenuItem;
  17.     ColorDialog1: TColorDialog;
  18.     procedure FormCreate(Sender: TObject);
  19.     procedure FormPaint(Sender: TObject);
  20.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  21.       Shift: TShiftState; X, Y: Integer);
  22.     procedure FillColor1Click(Sender: TObject);
  23.     procedure BorderColor1Click(Sender: TObject);
  24.     procedure BorderSize1Click(Sender: TObject);
  25.     procedure GetPosition1Click(Sender: TObject);
  26.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  27.   private
  28.     { Private declarations }
  29.     XCenter, YCenter: Integer;
  30.     BorderSize: Integer;
  31.     BorderColor, FillColor: TColor;
  32.   public
  33.     { Public declarations }
  34.   end;
  36. implementation
  38. {$R *.DFM}
  40. procedure TCircleChildForm.FormCreate(Sender: TObject);
  41. begin
  42.   XCenter := - 200;
  43.   YCenter := - 200;
  44.   BorderSize := 1;
  45.   BorderColor := clBlack;
  46.   FillColor := clYellow;
  47. end;
  49. procedure TCircleChildForm.FormPaint(Sender: TObject);
  50. begin
  51.   Canvas.Pen.Width := BorderSize;
  52.   Canvas.Pen.Color := BorderColor;
  53.   Canvas.Brush.Color := FillColor;
  54.   Canvas.Ellipse (XCenter-30, YCenter-30, XCenter+30, YCenter+30);
  55. end;
  57. procedure TCircleChildForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  58.   Shift: TShiftState; X, Y: Integer);
  59. begin
  60.   XCenter := X;
  61.   YCenter := Y;
  62.   Refresh;
  63. end;
  65. procedure TCircleChildForm.FillColor1Click(Sender: TObject);
  66. begin
  67.   ColorDialog1.Color := FillColor;
  68.   if ColorDialog1.Execute then
  69.     begin
  70.       FillColor := ColorDialog1.Color;
  71.       Repaint;
  72.     end;
  73. end;
  75. procedure TCircleChildForm.BorderColor1Click(Sender: TObject);
  76. begin
  77.   ColorDialog1.Color := BorderColor;
  78.   if ColorDialog1.Execute then
  79.     begin
  80.       BorderColor := ColorDialog1.Color;
  81.       Repaint;
  82.     end;
  83. end;
  85. procedure TCircleChildForm.BorderSize1Click(Sender: TObject);
  86. var
  87.   InputString: string;
  88. begin
  89.   InputString := IntToStr (BorderSize);
  90.   if InputQuery ('Border', 'Insert width', InputString) then
  91.     begin
  92.       BorderSize := StrToIntDef (InputString, BorderSize);
  93.       Repaint;
  94.     end;
  95. end;
  97. procedure TCircleChildForm.GetPosition1Click(Sender: TObject);
  98. begin
  99.   MessageDlg ('The center of the circle is in the position (' +
  100.     IntToStr (XCenter) + ', ' + IntToStr (YCenter) + ').',
  101.     mtInformation, [mbOk], 0);
  102. end;
  104. procedure TCircleChildForm.FormClose(Sender: TObject;
  105.   var Action: TCloseAction);
  106. begin
  107.   Action := caFree;
  108. end;
  110. end.