TCoolMemo

TCoolMemo

关注
发信
关注(28)粉丝(399)

TCoolMemo

我们先起个名字叫做TCoolMemo。以上篇已经讲了很多组件的技术，这里就只说出几个重点。其余不多说了。

首先，该Memo从CustomMemo继承，它有这样外观：属于平面的，边框是可以设置颜色的线，对应的颜色变量为FEdgeColor，另外，离边框以内的两个象素处，还有另一个框，当鼠标进入Memo时，这个框会显示，当鼠标离开时，为个框消失，同样也可以设置颜色，对应变量为FEnterColor。

那么鼠标进入和离开怎么判断呢，这里Memo将截获两个Delphi的内部消息：
//下面两个获得Delphi的内部消息,鼠标进入和离开时发生
     procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
     procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;

其实父类已经截获了这两个消息，并作了相应处理，所以TCoolMemo中的消息处理函数要
Inherited;再作自己的处理。这里又用到了一个变量
MouseIn：Boolean;//标识鼠标是否进入组件

接下来TCoolMemo还要截获两个消息：
procedure WMPaint (var Message: TMessage); message WM_PAINT;
procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;

第一个很熟悉，当需要重画时，触发该消息，
第二个是当窗体需要计算位置和尺寸时触发，消息中包含了窗口客户区的大小，我们用这个的目的主要是将客户区缩小三个象素，以便画组件时不会画到客户区。

procedure TCoolMemo.WMNCCalcSize (var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

而上面几个消息处理函数，CM_MOUSEENTER和CM_MOUSELEAVE;将引起TCoolMemo的外观变化，WM_PAINT保存其外观不被擦去。所以要用到一个画组件的函数，即：
drawBorder;

里面用到了几个API的GDI函数。我在代码中有详细的说明，加上自己看帮助，应该是可以看懂的。

另外，相比于Memo，它的扩展了这样的功能：设置边距和获得光标的位置。这两个对应的性属为Margin，Position。他们都是Public的，不可以在对象察看器中看到。

我们一个个来说

边距设置
property Margin:byte read FMargin write setMargin default 0;
其中setMargin函数中发送了两个消息：
//该消息取得输入区的尺寸
SendMessage(Handle, EM_GETRECT, 0, Longint(@Rect));
//该消息设定输入区的大小
SendMessage(Handle, EM_SETRECT, 0, Longint(@Rect));

光标的位置：
property Position:TPosition read getPosition;
TPostion是一个结构，其中有行和列两个值：
TPosition=record  //指定光标的行和列
     row:longint;
     col:longint;
   end;
getPosition;中还要处理中文的问题，代码有详细说明，如果文本中有中文，一样也可以得到正确的行和列。

最后增加了两个事件
property OnEnter;
property OnExit;
都是从父类中显化出来的，其实就是CM_MOUSEENTER和CM_MOUSELEAVE;消息引起的。，当你想作一个三态按钮，这两个事件很有作用。

好了，重点就是上面那几个了，以下是源代码，其中也有详细的说明：

unit CoolMemo;

interface

uses

   Windows, Messages, Classes, Forms,Controls, Graphics, StdCtrls;

type

    //用设定边缘的空白

   TPosition=record  //指定光标的行和列

     row:longint;

     col:longint;

   end;

   TCoolMemo=class(TCustomMemo)

   private

     FMargin:byte;  //边距的大小

     FEdgeColor:TColor;//边框的颜色

     FEnterColor:TColor;//鼠标进入时边框内侧的框颜色

     MouseIn: Boolean; //标识鼠标是否进入

     function getPosition:TPosition;//光标的行和列

     procedure setMargin(value:byte);

     procedure setEdgeColor(Value:TColor);

     procedure setEnterColor(Value:TColor);

     //下面两个获得Delphi的内部消息,鼠标进入和离开时发生

     procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;

     procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;

     //当一个窗口的外观必须被画时,应用程序发送这个消息给该窗口

     procedure WMPaint (var Message: TMessage); message WM_PAINT;

     //窗体需要计算位置和尺寸时触发

     //我们用这个的目的主要是将客户区缩小三个象素，以便画组件时不会画到客户区。

  procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;

   protected

   //画窗体的边框,使其看起来更美观.

     procedure drawBorder;

   public

     constructor Create (AOwner: TComponent); override;

     property Position:TPosition read getPosition;

     property Margin:byte read FMargin write setMargin default 0;

   published

    property EdgeColor:TColor read FEdgeColor write SetEdgeColor default $ff0000;

    property EnterColor:TColor read FEnterColor write SetEnterColor default $0000ff;

    //显式化父类的属性

    property Align;

    property Alignment;

    property DragCursor;

    property DragMode;

    property Enabled;

    property Color;

    property Font;

    property Lines;

    property MaxLength;

    property OEMConvert;

    property ParentFont;

    property ParentShowHint;

    property PopupMenu;

    property ReadOnly;

    property ShowHint;

    property ScrollBars;

    property TabOrder;

    property TabStop;

    property Visible;

    property WantReturns;

    property WantTabs;

    property WordWrap;

    property OnChange;

    property OnClick;

    property OnDblClick;

    property OnDragDrop;

    property OnDragOver;

    property OnEndDrag;

    //增加这两个事件，处理鼠标进入和离开

    property OnEnter;

    property OnExit;

    property OnKeyDown;

    property OnKeyPress;

    property OnKeyUp;

    property OnMouseDown;

    property OnMouseMove;

    property OnMouseUp;

    property OnStartDrag;

   end;

procedure Register;

implementation

procedure Register;

begin

  RegisterComponents('Samples', [TCoolMemo]);

end;

constructor TCoolMemo.Create(AOwner:TComponent);

begin

  inherited Create(Aowner);

  ControlStyle := ControlStyle - [csFramed];

  ParentFont := True;

  FEdgeColor := $ff0000;

  FEnterColor := $0000ff;

  //设定外观,平面无边形

  Ctl3D := False;

  FMargin:=0;

  BorderStyle:=bsNone;

  height:=150;

  width:=200;

end;

procedure TCoolMemo.setMargin(Value:byte);

var

  Rect: TRect;

begin

//该消息取得客户区的尺寸

  SendMessage(Handle, EM_GETRECT, 0, Longint(@Rect));

  //以下是重新确定尺寸

  Rect.Top := Value;

  Rect.Left := Value;

  Rect.Right := Width -Value;

  Rect.Bottom := Height -Value;

//该消息设定客户区的大小

  SendMessage(Handle, EM_SETRECT, 0, Longint(@Rect));

  Fmargin:=value;

end;

function TCoolMemo.getPosition:TPosition;

var

  row,Col:longint;

  CBLines:longint;

  str:WideString;

begin

//该消息取得光标所在的行,

  row:= SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);

  //该消息取得光标所在行开始的位置,位置从第一行的0开始计数,

  //每过一个字符增加1,

  CBLines:=SendMessage(Handle,EM_LINEINDEX,row,0);

  //得到光标的所在行的所在列

  Col:=SelStart-CBLines;

  //为了解决中文的问题,需要用宽字符型来取得光标所在行

  //,行中光标所在列之前的字符串,这样可以解决中文列数的确定问题.

  str:=Copy(Lines[row],1,col);

  col:=Length(Str)+1;

  result.row:=row+1;

  result.col:=col;

end;

procedure TCoolMemo.setEdgeColor(Value:TCOlor);

begin

 if FEdgeColor<>value then

 begin

  FEdgeColor:=value;

  drawBorder;

 end;

end;

procedure TCoolMemo.setEnterColor(Value:TColor);

begin

 if FEnterColor<>value then

 begin

   FEnterColor:=value;

   drawBorder;

 end;

end;

procedure TCoolMemo.CMMouseEnter(var Message: TMessage);

begin

  inherited;

    MouseIn:= True;

    drawBorder;

end;

procedure TCoolMemo.CMMouseLeave(var Message:TMessage);

begin

  inherited;

  MouseIn:=False;

  drawBorder;

end;

procedure TCoolMemo.WMPaint (var Message: TMessage);

begin

  inherited;

  drawBorder;

end;

procedure TCoolMemo.WMNCCalcSize (var Message: TWMNCCalcSize);

begin

  inherited;

  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);

end;

procedure TCoolMemo.drawBorder;

var

  DC: HDC;  //设备描述表

  R: TRect; //客户区

  EnterBrush,OuterBrush,BorderBrush:HBRUSH;  //画笔句柄，API

begin

  DC:= GetWindowDC(Handle);  //取得该组件的设备描述表

  try

    GetWindowRect(Handle, R);  //取得该组件的客户区尺寸

    OffsetRect(R, -R.Left, -R.Top); //左上偏移

    //创建画笔，两个，分别代码边框，边框内，白色画笔

    BorderBrush := CreateSolidBrush(ColorToRGB(FEdgeColor));

    EnterBrush:= CreateSolidBrush(ColorToRGB(FEnterColor));

    OuterBrush:=CreateSolidBrush(ColorToRGB(clWhite));

//not(csDesigning in ComponentState保证在设计期不变

    if (not(csDesigning in ComponentState)) and

    (MouseIn=true) then  //如果鼠标进入

    begin

      //画一个矩形框，用BorderBrush画笔

      FrameRect(DC, R, BorderBrush);

      //把R缩小一个象素

      InflateRect(R, -1, -1);

      //画一个矩形框，用outerBrush画笔

      FrameRect(DC, R, outerBrush);

      InflateRect(R, -1, -1);

      FrameRect(DC, R, EnterBrush);

    end

    else  //如果鼠标没有进入

    begin

      FrameRect(DC, R, BorderBrush);

      InflateRect(R, -1, -1);

      FrameRect(DC, R, outerBrush);

      InflateRect(R, -1, -1);

      FrameRect(DC, R, outerBrush);

    end;

  finally

    ReleaseDC(Handle, DC);  //释放设备描述表

  end;

  DeleteObject(BorderBrush);   //释放画笔

  DeleteObject(EnterBrush);

  DeleteObject(OuterBrush);

end;

end.

参考：
http://blog.csdn.net/iseekcode/article/details/4698412
http://www.delphixe.net/thread-5339-1-1.html

05-11 11:13
Powered by LMLPHP ©2024 TCoolMemo 0.066956