文档章节

Controls 属性与继承 TShape 类的小练习

涂孟超
 涂孟超
发布于 2014/09/26 15:36
字数 308
阅读 8
收藏 0
点赞 0
评论 0
本例效果图:



代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TMyShape = class(TShape)
  protected
    procedure CMMouseenter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  W = 50;
  H = 50;
var
  shape: TMyShape;
begin
  shape := TMyShape.Create(Self);
  shape.Parent := Panel1;
  shape.Width := W;
  shape.Height := H;
  Randomize;
  shape.Left := Random(Panel1.ClientWidth - W);
  shape.Top := Random(Panel1.ClientHeight - H);
  shape.Brush.Color := Random($FFFFFF);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: Integer;
begin
  if Panel1.ControlCount = 0 then Exit;
  Randomize;
  i := Random(Panel1.ControlCount - 1);
  Panel1.Controls[i].Free;
end;


{ TMyShape }

procedure TMyShape.CMMouseenter(var Message: TMessage);
const
  s = '当前 %s 的颜色值是: %.6x';
var
  WCtrl: TWinControl;
begin
  WCtrl := Parent;
  while WCtrl.HasParent do WCtrl := WCtrl.Parent;
  if WCtrl is TForm then TForm(WCtrl).Caption := Format(s, [ClassName,Brush.Color]);
  inherited;
end;

procedure TMyShape.CMMouseleave(var Message: TMessage);
const
  s = 'Form1';
var
  WCtrl: TWinControl;
begin
  WCtrl := Parent;
  while WCtrl.HasParent do WCtrl := WCtrl.Parent;
  if WCtrl is TForm then TForm(WCtrl).Caption := s;
  inherited;
end;

end.

 
 
 
 
 

 

 

  
窗体文件:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 212
  ClientWidth = 395
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 8
    Top = 8
    Width = 297
    Height = 193
    Caption = 'Panel1'
    TabOrder = 0
  end
  object Button1: TButton
    Left = 311
    Top = 40
    Width = 75
    Height = 25
    Caption = #28155#21152
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 311
    Top = 85
    Width = 75
    Height = 25
    Caption = #38543#26426#21024#38500
    TabOrder = 2
    OnClick = Button2Click
  end
end

 
 
 
 
 

 

 

  

本文转载自:http://www.cnblogs.com/del/archive/2008/10/23/1317926.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2004
码字总数 14107
作品 0
深圳
程序员
Silverlight MMORPG网页游戏开发课程[一期] 第十课:面向对象的重构

引言 在游戏的基本功能大体实现后适当的回过头来,重新审视当下的游戏框架并做一些有利于下阶段功能延伸的结构改进,以达到精简代码,优化性能,提高拓展性的目的;这就是本节我将要为课程示...

晨曦之光 ⋅ 2012/03/09 ⋅ 0

Objective-c 继承,多态,封装

.m文件 // // main.m // Objective-c 继承 // Created by 非凡 on 15/10/10. // Copyright (c) 2015年 非凡. All rights reserved. // #import <Foundation/Foundation.h> //引入其他类的头文......

_pioneer_ ⋅ 2015/10/12 ⋅ 0

练习项目06:解析XML(下)

练习项目06:解析XML(下) Python自动化运维2017-12-281 阅读 PythonXMLPython教程 这一篇教程,我们通过更好的方式对XML文件进行解析并生成网站结构与HTML文件。 一、因为需要创建目录,我...

Python自动化运维 ⋅ 2017/12/28 ⋅ 0

练习项目06:解析XML(下)

练习项目06:解析XML(下) Python自动化运维2017-12-281 阅读 PythonXMLPython教程 这一篇教程,我们通过更好的方式对XML文件进行解析并生成网站结构与HTML文件。 一、因为需要创建目录,我...

Python自动化运维 ⋅ 2017/12/28 ⋅ 0

关东升的《从零开始学Swift》第2版已经出版

关东升的《从零开始学Swift》第2版已经出版 大家好: 苹果2015WWDC大会发布了Swift2.0,它较之前的版本Swift1.x有很大的变化,所以我即将出版《从零开始学Swift》 《从零开始学Swift》将在《...

tony关东升 ⋅ 2016/02/24 ⋅ 0

关东升的《从零开始学Swift》3月9日已经上架

大家一直期盼的《从零开始学Swift》于3月9日已经上架,它是关东升老师历时8个月的呕心沥血所编著,全书600多页,此本书基于Swift 2.x,通过大量案例全面介绍苹果平台的应用开发。全书共分5 部...

tony关东升 ⋅ 2016/03/11 ⋅ 0

关东升的《从零开始学Swift》3月9日已经上架

大家一直期盼的《从零开始学Swift》于3月9日已经上架,它是关东升老师历时8个月的呕心沥血所编著,全书600多页,此本书基于Swift 2.x,通过大量案例全面介绍苹果平台的应用开发。全书共分5 部...

智捷课堂 ⋅ 2016/03/11 ⋅ 0

关东升的《《从零开始学Swift》即将出版

大家好: 苹果2015WWDC大会发布了Swift2.0,它较之前的版本Swift1.x有很大的变化,所以我即将出版《从零开始学Swift》《从零开始学Swift》将在《Swift开发指南》第1版的基础上添加Swift2.0的...

智捷课堂 ⋅ 2015/08/17 ⋅ 0

【iOS】Swift类的继承、构造方法、析构器等复习

构造方法内容会多一些,涉及Swift中构造的一些规则与概念。这次写了7个Person来复习,外加名人XiaoMing。 Mark:Playground真是个好东西,特别练习demo写Swift时,实时显示真是大赞! 一、继...

xn4545945 ⋅ 2014/09/23 ⋅ 0

python基础---面向对象编程

面向对象 面向过程与面向对象的对比: 面向过程:核心是过程二字,过程指的是问题的解决步骤,即先干什么再干什么,基于面向过程去设计程序就好比在设计一条流水线,是一种机械式的思维方式 ...

迟到的栋子 ⋅ 2017/08/31 ⋅ 0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

20.zip压缩 tar打包 打包并压缩

6月25日任务 6.5 zip压缩工具 6.6 tar打包 6.7 打包并压缩 6.5 zip压缩工具: zip支持压缩目录 zip压缩完之后原来的文件不删除 不同的文件内容其实压缩的效果不一样 文件内有很多重复的用xz压...

王鑫linux ⋅ 15分钟前 ⋅ 0

double类型数据保留四位小数的另一种思路

来源:透析公式处理,有时候数据有很长的小数位,有的时候由在四位以内,如果用一般的处理方法,那么不足四位的小树会补充0到第四位,这样子有点画蛇添足的感觉,不太好看。所以要根据小数的...

young_chen ⋅ 21分钟前 ⋅ 0

Python 优化 回溯下降算法

使用sympy构造表达式,实现回溯下降算法 画出函数图像,先使用暴力搜索,找到最小值约为2.5左右 然后选定初始点,开始进行回溯搜索,下降方向为负梯度方向 下降的误差与步数大致呈现下面的状...

阿豪boy ⋅ 26分钟前 ⋅ 0

Django配置163邮箱出现 authentication failed(535)错误解决方法

最近用Django写某网站,当配置163邮箱设置完成后,出现535错误即:smtplib.SMTPAuthenticationError: (535, b'Error: authentication failed') Django初始配置邮箱设置 EMAIL_HOST = "smtp.1...

陈墨轩_CJX ⋅ 27分钟前 ⋅ 0

用接口模拟可伸缩枚举(34)

1、枚举的可伸缩性最后证明都不是什么好点子 扩展类型的元素是基本类型实例,基本类型的实例却不是扩展类型的元素,很混乱 目前还没有很好的方法来枚举基本类型的所有元素,及其扩展 可伸缩性...

职业搬砖20年 ⋅ 31分钟前 ⋅ 0

Ubuntu18.04 IDEA快捷键无法使用

IDEA默认的回退到上一视图的快捷键是Ctrl + Alt + Left,在ubuntu中这个快捷键被占用了,在16.04中可以在界面中取消这个快捷键,但是18.04就看不到了,可以使用以下命令解决 gsettings set ...

Iceberg_XTY ⋅ 35分钟前 ⋅ 0

如何解决s权限位引发postfix及crontab异常

一、问题现象 业务反馈某台应用服务器,普通用户使用mutt程序发送邮件时,提示“postdrop warning: mail_queue_enter: create file maildrop/713410.6065: Permission denied”,而且普通用法...

问题终结者 ⋅ 47分钟前 ⋅ 0

Unable to load database on disk

由于磁盘空间满了以后,导致zookeeper异常退出,清理磁盘空间后,zk启动报错,信息如下: 2018-06-25 17:18:46,904 INFO org.apache.zookeeper.server.quorum.QuorumPeerConfig: Reading co...

刀锋 ⋅ 今天 ⋅ 0

css3 box-sizing:border-box 实现div一行多列

<!DOCTYPE html><html><head><style> div.container{ background:green; padding:10px 10px;}div.box{box-sizing:border-box;-moz-box-sizing:border-box; /* Fir......

qimh ⋅ 今天 ⋅ 0

Homebrew简介和基本使用

一、Homebrew是什么 Homebrew是一款Mac OS平台下的软件包管理工具,拥有安装、卸载、更新、查看、搜索等很多实用的功能。简单的一条指令,就可以实现包管理,而不用你关心各种依赖和文件路径...

说回答 ⋅ 今天 ⋅ 0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

返回顶部
顶部