SXTOP

给控件加上一个红色的框

在Delphi之窗上面看见的效果,赞一个.使用过程中发现有保存,加了个判断解决了报错问题.

Type
  TForm1 = Class( TForm )
    btn1: TButton ;
    chk1: TCheckBox ;
    lbl1: TLabel ;
    lst1: TListBox ;
    cbb1: TComboBox ;
    Procedure FormCreate( Sender: TObject ) ;
  Private
    { Private declarations }
    shp1: TShape ;
    Procedure MyScreenActiveChange( s: TObject ) ;
  Public
    { Public declarations }
  End ;

Var
  Form1: TForm1 ;

Implementation

{$R *.dfm}

Procedure TForm1.FormCreate( Sender: TObject ) ;

Begin
  shp1 := TShape.Create( Self ) ;
  shp1.Shape := stRectangle ;
  shp1.Visible := false ;
  shp1.Brush.Style := bsClear ;
  shp1.Pen.Style := psDot ;
  shp1.Pen.Color := clRed ;
  shp1.Pen.Width := 1 ;
  Screen.OnActiveControlChange := MyScreenActiveChange ;
End ;

Procedure TForm1.MyScreenActiveChange( s: TObject ) ;
Begin
  With shp1 Do
  Begin
    If Assigned( Screen.ActiveControl ) And Assigned( Screen.ActiveControl.Parent ) Then
    Begin
      Parent := Screen.ActiveControl.Parent ;

      Top := Screen.ActiveControl.Top - 2 ;
      Height := Screen.ActiveControl.Height + 4 ;
      Left := Screen.ActiveControl.Left - 2 ;
      Width := Screen.ActiveControl.Width + 4 ;

      Visible := true ;
    End ;
  End ;

End ;
//本文来自Delphi之窗,原文地址:http: //www.52delphi.com
//
End.

posted on 2009-10-23 14:20  SXTOP  阅读(78)  评论(0)    收藏  举报