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

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

Delphi控件源码

开发平台：

Delphi

Child2.pas：源码内容
  1. unit Child2;
  3. interface
  5. uses
  6.   Windows, Classes, Graphics, Forms,
  7.   Controls, Menus, Dialogs, StdCtrls, ExtCtrls,
  8.   SysUtils;
  10. type
  11.   Directions = (up_right, down_right, down_left, up_left);
  13.   TBounceChildForm = class(TForm)
  14.     Timer1: TTimer;
  15.     Shape1: TShape;
  16.     MainMenu1: TMainMenu;
  17.     Square1: TMenuItem;
  18.     FillColor1: TMenuItem;
  19.     N1: TMenuItem;
  20.     GetPosition1: TMenuItem;
  21.     Movement1: TMenuItem;
  22.     Start1: TMenuItem;
  23.     Stop1: TMenuItem;
  24.     ColorDialog1: TColorDialog;
  25.     procedure Timer1Timer(Sender: TObject);
  26.     procedure FillColor1Click(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure GetPosition1Click(Sender: TObject);
  29.     procedure Start1Click(Sender: TObject);
  30.     procedure Stop1Click(Sender: TObject);
  31.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  32.   private
  33.     { Private declarations }
  34.     Dir : Directions;
  35.   public
  36.     { Public declarations }
  37.   end;
  39. implementation
  41. {$R *.DFM}
  43. procedure TBounceChildForm.Timer1Timer(Sender: TObject);
  44. begin
  45.   case Dir of
  46.     up_right:
  47.     begin
  48.       Shape1.Left := Shape1.Left + 3;
  49.       Shape1.Top := Shape1.Top - 3;
  50.       if Shape1.Top <= 0 then
  51.         Dir := down_right;
  52.       if Shape1.Left + Shape1.Width >= ClientWidth then
  53.         Dir := up_left;
  54.     end;
  55.     down_right:
  56.     begin
  57.       Shape1.Left := Shape1.Left + 3;
  58.       Shape1.Top := Shape1.Top + 3;
  59.       if Shape1.Top + Shape1.Height >= ClientHeight then
  60.         Dir := up_right;
  61.       if Shape1.Left + Shape1.Width >= ClientWidth then
  62.         Dir := down_left;
  63.     end;
  64.     down_left:
  65.     begin
  66.       Shape1.Left := Shape1.Left - 3;
  67.       Shape1.Top := Shape1.Top + 3;
  68.       if Shape1.Top + Shape1.Height >= ClientHeight then
  69.         Dir := up_left;
  70.       if Shape1.Left <= 0 then
  71.         Dir := down_right;
  72.     end;
  73.     up_left:
  74.     begin
  75.       Shape1.Left := Shape1.Left - 3;
  76.       Shape1.Top := Shape1.Top - 3;
  77.       if Shape1.Top <= 0 then
  78.         Dir := down_left;
  79.       if Shape1.Left <= 0 then
  80.         Dir := up_right;
  81.     end;
  82.   end;
  83. end;
  85. procedure TBounceChildForm.FillColor1Click(Sender: TObject);
  86. begin
  87.   if ColorDialog1.Execute then
  88.     Shape1.Brush.Color := ColorDialog1.Color;
  89. end;
  91. procedure TBounceChildForm.FormCreate(Sender: TObject);
  92. begin
  93.   ColorDialog1.Color := Shape1.Brush.Color;
  94.   Dir := down_left;
  95. end;
  97. procedure TBounceChildForm.GetPosition1Click(Sender: TObject);
  98. begin
  99.   MessageDlg ('The top-left corner of the square was in the position (' +
  100.     IntToStr (Shape1.Left) + ', ' + IntToStr (Shape1.Top) + ').',
  101.     mtInformation, [mbOk], 0);
  102. end;
  104. procedure TBounceChildForm.Start1Click(Sender: TObject);
  105. begin
  106.   Timer1.Enabled := True;
  107.   Start1.Enabled := False;
  108.   Stop1.Enabled := True;
  109. end;
  111. procedure TBounceChildForm.Stop1Click(Sender: TObject);
  112. begin
  113.   Timer1.Enabled := False;
  114.   Start1.Enabled := True;
  115.   Stop1.Enabled := False;
  116. end;
  118. procedure TBounceChildForm.FormClose(Sender: TObject;
  119.   var Action: TCloseAction);
  120. begin
  121.   Action := caFree;
  122. end;
  124. end.