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


    本例效果图:



    代码文件:
    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
    
  • 相关阅读:
    Redis事务,持久化,缓存同步
    关于虚拟机初次安装出现32位问题
    解决nginx无法访问问题
    如何解决maven 打war,在tomcat下直接访问localhost:8080
    如何解决eclipse里面tomcat 8080端口被占用
    连接mysql出现Access denied for user ‘root’@’localhost’ (using password:YES)问题解决办法
    idea下面修改项目的访问路径
    wordpress主题乱码
    如何在Windows系统本地环境下使用phpstudy快速搭建wordpress平台
    小积累
  • 原文地址:https://www.cnblogs.com/del/p/1317926.html
Copyright © 2020-2023  润新知