TCoolMemo

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.