发信人: teleme(PassWord) 
整理人: teleme(2001-02-10 23:13:40), 站内信件
 | 
 
 
怎样编写自己的控件(基础篇) 
 
   作为一个Delphi程序员要进一步提高编程水平就必须掌握控件的编写方法,本篇文章是为初学编写控件的人所写,通过一个具体的简单的例子来介绍编写控件的一些基本的方法和模式。这个例子控件叫TLeiLabel,是在TLabel的基础上增加两个实用的功能:一是使文字具有立体形状,二是使文字具有超链接属性。 
 
 一、使文字具有立体形状 
 
 首先定义一个类型:T3DEffect = (Normal, Raised, Lowered, Shadowed);  
 
 四个值分别表示正常、凸起、凹进、阴影。 
 
 再定义一个属性Style3D如下: 
 
 property Style3D: T3DEffect read FStyle3D write SetStyle3D default Normal; 
 
 这是定义属性的标准格式,包括属性名、属性类型、读和写声明及一个预定义值。它必须放在published中以便使属性出现在Object Inspector中。 
 
 读声明表示在用这个属性的值时是直接去读变量FStyle3D的值,写声明表示在给这个属性赋值时调用这个写方法SetStyle3D()去改变这个变量的值。 
 
 Default值并不表示其默认值,而只是表示在保存DFM文件时,若属性的值与之相等则不保存,不相等则保存,属性的默认值要在Create()中设置。 
 
 FStyle3D是在private中定义的一个变量:FStyle3D:T3DEffect; 
 
 SetStyle3D()方法如下,这也是写方法的一般格式:  
 
     procedure TLeiLabel.SetStyle3D(Value: T3DEffect); 
     begin 
       if FStyle3D <> value then 
       begin 
         FStyle3D := value; 
         invalidate;   //表示控件将重画 
       end; 
     end; 
      
 另外对于带阴影的文字还要定义阴影的偏移量ShadeXOffSet、ShadeYOffSet: 
 
 property ShadowXOffSet: integer read FXOffSet write SetFXOffSet default 5; 
 
 property ShadowYOffSet: integer read FYOffSet write SetFYOffSet default -5; 
 
 写方法SetFXOffSet()、SetFYOffSet()和上面SetStyle3D()类似,略。 
 
 要重画控件一般要重载Paint方法,此处只是重画文字,只须重载DoDrawText方法(TLabel的DoDrawText的功能就是绘制文字)。 
 
 DoDrawText的声明放在Protected中:  
 
 procedure DoDrawText(var Rect: TRect; Flags: Longint); override; 
 
 此处DoDrawText()根据四种类型(正常、凸起、凹进、阴影)分别画出不同的文字:  
 
     procedure TLeiLabel.DoDrawText(var Rect: TRect; Flags: Longint); 
     var 
       Text: string; 
       TmpRect  : TRect; 
     begin 
       Text := GetLabelText; 
       if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and 
         (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' '; 
       if not ShowAccelChar then Flags := Flags or DT_NOPREFIX; 
       Flags := DrawTextBiDiModeFlags(Flags); 
       Canvas.Font := Font; 
 
       Case FStyle3D of 
         Raised: 
           begin 
             TmpRect := Rect; 
             OffsetRect( TmpRect, 1, 1 ); 
             Canvas.Font.Color := clGray; 
             DrawText(Canvas.Handle, PChar(Text), Length(Text), TmpRect, Flags); 
 
             TmpRect := Rect; 
             OffsetRect( TmpRect, -1, -1 ); 
             Canvas.Font.Color := clWhite; 
             DrawText(Canvas.Handle, PChar(Text), Length(Text), TmpRect, Flags); 
           end ; 
         Lowered: 
           begin 
             TmpRect := Rect; 
             OffsetRect( TmpRect, 1, 1 ); 
             Canvas.Font.Color := clWhite; 
             DrawText(Canvas.Handle, PChar(Text), Length(Text), TmpRect, Flags); 
 
             TmpRect := Rect; 
             OffsetRect( TmpRect, -1, -1 ); 
             Canvas.Font.Color := clGray; 
             DrawText(Canvas.Handle, PChar(Text), Length(Text), TmpRect, Flags); 
           end ; 
         Shadowed: 
           begin 
             TmpRect := Rect; 
             OffsetRect( TmpRect, FXOffSet, FYOffSet ); 
             Canvas.Font.Color := clGray; 
             DrawText(Canvas.Handle, PChar(Text), Length(Text), TmpRect, Flags); 
           end; 
       end; 
 
       if not Enabled then 
         Canvas.Font.Color := clGrayText 
       else 
         Canvas.Font.Color := Font.Color; 
 
       DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); 
     end; 
    
 二、使文字具有超链接属性 
 
 定义一个属性URL表示要链接的网址或Email地址。 
 
 Property URL : String read FURL write SetURL; 
 
 写方法SetURL如下: 
 
     procedure TLeiLabel.SetURL(Value: String); 
     Begin 
       if FURL <> Value then  FURL := Value ; 
       if FURL <> '' then  Cursor := crHandPoint ; 
     end; 
 
 当点击此Label时要打开浏览器或收发邮件工具,这便要重载Click方法。 
 
 Procedure Click; Override;  
 
     procedure TLeiLabel.Click; 
     var s: string; 
     Begin 
       Inherited Click; 
       if FURL = '' then exit; 
       if LowerCase(Copy(FURL,1,7)) = 'http://' then 
         s := FURL 
       else if Pos('@',FURL) <> 0 Then 
         s := 'mailto:' + FURL 
       else 
         s := 'http://' + FURL; 
       ShellExecute(Application.Handle, 'open', PChar(s), NIL, NIL, SW_SHOWNORMAL); 
     end; 
     
 一般的超链接当鼠标移上时文字的颜色发生变化。为此加上属性HoverColor,表示鼠标移入时文字的颜色。 
 
 Property HoverColor : TColor Read FHoverColor Write SetHoverColor default clRed; 
 
 还要定义两个接收Windows消息CM_MOUSEENTER和CM_MOUSELEAVE(鼠标移进和移出)的过程: 
 
 Procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; 
 
 Procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;  
 
     Procedure TLeiLabel.CMMouseEnter (Var Message: TMessage); 
     begin 
       If Enabled and Visible and getParentForm(Self).Active then 
       begin 
         FFontColor := Font.Color;   //将文字的颜色保存起来 
         Font.Color := FHoverColor;  //改变文字的颜色 
       End; 
     end; 
    
     Procedure TLeiLabel.CMMouseLeave (Var Message: TMessage); 
     begin 
       Font.Color:=FFontColor;    //恢复文字原来颜色 
     end; 
    
 为设置属性的默认值,还要重载构造Create()(经常还要重载析构Destroy())。 
 
 constructor Create(AOwner: TComponent); override; 
 
 // destructor Destroy; override; 
 
 重载构造时必须首先调用祖先类的构造,若要重载析构,则必须要在最后调用祖先类的析构。  
 
     constructor TLeiLabel.Create(AOwner: TComponent); 
     begin 
       inherited Create(AOwner);  //必须首先调用祖先类的构造 
       FStyle3D := Normal; 
       FXOffSet := 5; 
       FYOffSet := -5; 
       FHoverColor := clRed; 
     end; 
     
 最后,还必须为这个控件加上图标。可以用Delphi中的Image Editor来创建一个24×24的Bitmap位图,保存为一个DCR文件,文件名必须与控件的Pas文件名相同(此处为LeiLabel.pas和LeiLabel.dcr),位图名必须与控件名相同且全部大写(此处为TLEILABEL)。这样,一个完整的实用的控件就做好了。 
 
 [原文转载自北京社区delphi版]
 
  | 
 
 
 |