自定义EDIT的外型(200分)

我想写一控件，他的所有属性和事件都是Tedit的（当然可加入canvas属性），但他的外表是一根下划线。曾有一网友用TMaskEdit指点过(代码付后)，但他只能显示一个下划线，当输入文字时，下划线就没了。我自认为他值200分
unit FlatEdit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask;

type
TFlatEdit = class(TMaskEdit)
private
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
published
property BorderStyle default bsNone;
property ParentColor default True;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Sample', [TFlatEdit]);
end;

{ TFlatEdit }

constructor TFlatEdit.Create(AOwner: TComponent);
begin
inherited;
BorderStyle := bsNone;
ParentColor := True;
Font.Style := [fsUnderline];
EditMask := '!aaaaaaaaaaaaaaaa;0';
end;

end.

呵呵
这个不就是把border设置为none
把字体风格设置为带下划线吗？
不是好办法

实在要这样的话
在输入的字符后面补空格

最好是去重载重画的函数

太简单了，从TEdit继承，聚合一个TShape,设置TEdit的BodyStyle=bsNone,
用TEdit遮住TShaple的上半部分，只六下面一个直线。淡然要写这个空间，还
是要写不少的代码.

有很多人写了形状不规则的TEdit控件，可以下载来看看源码就知道了。
搜索一下Delphi控件的网站。

g

仅作划线范例，毛病多多。
unit JFlatEdit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TJFlatEdit = class(TCustomControl)
private
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property TabStop;
property Text;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Croco', [TJFlatEdit]);
end;

constructor TJFlatEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetBounds(0, 0, 121, 21);
TabStop := True;
end;

procedure TJFlatEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'EDIT');
end;

procedure TJFlatEdit.Paint;
var
ARect: TRect;
S: String;
begin
ARect := Rect(0, 0, Width, Height);
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Canvas.Font := Font;
S := Text;
DrawText(Canvas.Handle, PChar(S), Length(S), ARect, DT_SINGLELINE or DT_NOPREFIX or DT_EDITCONTROL);
DrawEdge(Canvas.Handle, ARect, EDGE_ETCHED, BF_BOTTOM);
end;

end.

只想有下划线?以下这个可以让你自由选择Edit的四个边框中的几个.
匆忙之间,错误在所难免.

const
sdAllSides = [sdLeft, sdTop, sdRight, sdBottom];

type
TFrameStyle = (fsNone, fsFlat, fsGroove,
fsBump, fsLowered, fsButtonDown, fsRaised, fsButtonUp, fsStatus, fsPopup);

TSide = (sdLeft, sdTop, sdRight, sdBottom);
TSides = set of TSide;

TFrameEdit = class(TCustomMaskEdit)
private
FAlignment: TLeftRight;
FFrameColor: TColor;
FFrameFlat: Boolean;
FFrameFlatStyle: TFrameStyle;
FFrameFocusStyle: TFrameStyle;
FFrameSides: TSides;
FFrameStyle: TFrameStyle;
FFrameVisible: Boolean;
FUseFrameController: Boolean;
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;

// Message Handling Methods
{$IFDEF WIN32}
procedure WMNCPaint( var Msg: TWMNCPaint ); message WM_NCPAINT;
{$endif}
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure CMEnter(var Msg: TCMEnter); message CM_ENTER;
procedure CMExit(var Msg: TCMExit); message CM_EXIT;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
protected
FCanvas: TCanvas;
FOverControl: Boolean;

procedure UpdateFrame(ViaMouse, InFocus: Boolean ); virtual;
procedure RepaintFrame; virtual;

function GetRightJustifiedText: string; virtual;

{ Event Dispatch Methods }
procedure MouseEnter; dynamic;
procedure MouseLeave; dynamic;

procedure SetName(const Value: TComponentName); override;
procedure KeyPress(var Key: Char); override;

{ Property Access Methods }
procedure SetAlignment( Value: TLeftRight ); virtual;
function GetColor: TColor; virtual;
procedure SetColor( Value: TColor ); virtual;
procedure SetFrameColor( Value: TColor ); virtual;
procedure SetFrameFlat( Value: Boolean ); virtual;
procedure SetFrameFlatStyle( Value: TFrameStyle ); virtual;
procedure SetFrameFocusStyle( Value: TFrameStyle ); virtual;
procedure SetFrameSides( Value: TSides ); virtual;
procedure SetFrameStyle( Value: TFrameStyle ); virtual;
procedure SetFrameVisible( Value: Boolean ); virtual;

{ Property Declarations }

property Canvas: TCanvas read FCanvas;
property Alignment: TLeftRight
read FAlignment write SetAlignment default taLeftJustify;
property Color: TColor
read GetColor write SetColor default clWindow;
property FrameColor: TColor
read FFrameColor write SetFrameColor default clBtnShadow;
property FrameFlatStyle: TFrameStyle
read FFrameFlatStyle write SetFrameFlatStyle default fsStatus;
property FrameFocusStyle: TFrameStyle
read FFrameFocusStyle write SetFrameFocusStyle default fsLowered;
property FrameFlat: Boolean
read FFrameFlat write SetFrameFlat default False;
property FrameSides: TSides
read FFrameSides write SetFrameSides default sdAllSides;
property FrameStyle: TFrameStyle
read FFrameStyle write SetFrameStyle default fsFlat;
property FrameVisible: Boolean
read FFrameVisible write SetFrameVisible default False;
property UseFrameController: Boolean
read FUseFrameController write FUseFrameController default True;

property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
public
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
{$IFDEF D4_OR_HIGHER}
function GetControlsAlignment: TAlignment; override;
{$ENDIF}
end;


function DrawCtl3DBorderSides(
Canvas: TCanvas; Bounds: TRect; Lowered: Boolean; Sides: TSides): TRect;
const
Colors: array[1..4, Boolean] of TColor = (
(clBtnFace, clBtnShadow), (clBtnText, clBtnHighlight),
(clBtnHighlight, clBtnText), (clBtnShadow, clBtnFace));
begin
Bounds := DrawBevel(
Canvas, Bounds, Colors[1, Lowered], Colors[2, Lowered], 1, Sides);
Result := DrawBevel(
Canvas, Bounds, Colors[3, Lowered], Colors[4, Lowered], 1, Sides);
end;

function DrawButtonBorderSides(
Canvas: TCanvas; Bounds: TRect; Lowered: Boolean; Sides: TSides): TRect;
const
Colors: array[1..4, Boolean] of TColor = (
(clBtnHighlight, clBtnText), (clBtnText, clBtnText),
(clBtnFace, clBtnShadow), (clBtnShadow, clBtnShadow));
begin
Bounds := DrawBevel(
Canvas, Bounds, Colors[1, Lowered], Colors[2, Lowered], 1, Sides);
Result := DrawBevel(
Canvas, Bounds, Colors[3, Lowered], Colors[4, Lowered], 1, Sides);
end;

function DrawSides(Canvas: TCanvas;
Bounds: TRect; ULColor, LRColor: TColor; Sides: TSides): TRect;
begin
with Canvas, Bounds do
begin
Pen.Color := ULColor;
if sdLeft in Sides then
begin
MoveTo(Left, Top);
LineTo(Left, Bottom);
end;

if sdTop in Sides then
begin
MoveTo(Left, Top);
LineTo(Right, Top);
end;

Pen.Color := LRColor;
if sdRight in Sides then
begin
MoveTo(Right - 1, Top);
LineTo(Right - 1, Bottom);
end;

if sdBottom in Sides then
begin
MoveTo(Left, Bottom - 1);
LineTo(Right, Bottom - 1);
end;
end;

if sdLeft in Sides then Inc(Bounds.Left);
if sdTop in Sides then Inc(Bounds.Top);
if sdRight in Sides then Dec(Bounds.Right);
if sdBottom in Sides then Dec(Bounds.Bottom);

Result := Bounds;
end;

function DrawBevel(Canvas: TCanvas; Bounds: TRect;
ULColor, LRColor: TColor; Width: Integer; Sides: TSides): TRect;
var
I: Integer;
begin
Canvas.Pen.Width := 1;
for I := 1 to Width do { Loop through width of bevel }
begin
Bounds := DrawSides(Canvas, Bounds, ULColor, LRColor, Sides);
end;
Result := Bounds;
end;

function DrawBorderSides(
Canvas: TCanvas; Bounds: TRect; Style: TFrameStyle; Sides: TSides): TRect;
var
ULColor, LRColor: TColor;
R: TRect;
begin
ULColor := ULFrameColor[Style];
LRColor := LRFrameColor[Style];

{ Draw the Frame }
if Style <> fsNone then
begin
if Style in [ fsFlat, fsStatus, fsPopup ] then
Bounds := DrawSides( Canvas, Bounds, ULColor, LRColor, Sides )
else if Style in [ fsLowered, fsRaised ] then
Bounds := DrawCtl3DBorderSides( Canvas, Bounds, Style = fsLowered, Sides )
else if Style in [ fsButtonDown, fsButtonUp ] then
Bounds := DrawButtonBorderSides( Canvas, Bounds, Style = fsButtonDown, Sides )
else { Style must be fsGroove or fsBump }
begin
R := Bounds;
{ Fill in the gaps created by offsetting the rectangle }
{ Upper Right Gap }
if sdRight in Sides then
Canvas.Pixels[ R.Right - 1, R.Top ] := LRColor;
if ( sdTop in Sides ) and not ( sdRight in Sides ) then
Canvas.Pixels[ R.Right - 1, R.Top ] := ULColor;

{ Lower Left Gap }
if sdBottom in Sides then
Canvas.Pixels[ R.Left, R.Bottom - 1 ] := LRColor;
if ( sdLeft in Sides ) and not ( sdBottom in Sides ) then
Canvas.Pixels[ R.Left, R.Bottom - 1 ] := ULColor;

{ Upper Left Gaps }
if ( sdTop in Sides ) and not ( sdLeft in Sides ) then
Canvas.Pixels[ R.Left, R.Top + 1 ] := LRColor;
if not ( sdTop in Sides ) and ( sdLeft in Sides ) then
Canvas.Pixels[ R.Left + 1, R.Top ] := LRColor;

{ Lower Right Gaps }
if ( sdBottom in Sides ) and not ( sdRight in Sides ) then
Canvas.Pixels[ R.Right - 1, R.Bottom - 2 ] := ULColor;
if not ( sdBottom in Sides ) and ( sdRight in Sides ) then
Canvas.Pixels[ R.Right - 2, R.Bottom - 1 ] := ULColor;

Inc( R.Left );
Inc( R.Top );
DrawSides( Canvas, R, LRColor, LRColor, Sides );
OffsetRect( R, -1, -1 );
DrawSides( Canvas, R, ULColor, ULColor, Sides );
if sdLeft in Sides then
Inc( Bounds.Left, 2 );
if sdTop in Sides then
Inc( Bounds.Top, 2 );
if sdRight in Sides then
Dec( Bounds.Right, 2 );
if sdBottom in Sides then
Dec( Bounds.Bottom, 2 );
end;
end;
Result := Bounds;
end;

function DrawBorder(Canvas: TCanvas; Bounds: TRect; Style: TFrameStyle ): TRect;
begin
Result := DrawBorderSides(Canvas, Bounds, Style, sdAllSides);
end;

procedure DrawFrame(Canvas: TCanvas; Width, Height: Integer;
FrameStyle: TFrameStyle; EraseColor, FrameColor: TColor; FrameSides: TSides);
var
R: TRect;
begin
R := Rect(0, 0, Width, Height);
DrawBevel(Canvas, R, EraseColor, EraseColor, 2, sdAllSides);

if FrameStyle = fsFlat then
DrawSides(Canvas, R, FrameColor, FrameColor, FrameSides)
else DrawBorderSides(Canvas, R, FrameStyle, FrameSides);
end;

function GetMinFontHeight( Font: TFont ): Integer;
var
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC( 0 );
try
GetTextMetrics( DC, SysMetrics );
SaveFont := SelectObject( DC, Font.Handle );
GetTextMetrics( DC, Metrics );
SelectObject( DC, SaveFont );
finally
ReleaseDC( 0, DC );
end;

(*
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then
I := Metrics.tmHeight;
*)
Result := Metrics.tmHeight + 2 {I div 4};
end;


{ TFrameEdit Methods }
constructor TFrameEdit.Create( AOwner: TComponent );
begin
inherited Create( AOwner );

ControlStyle := ControlStyle - [ csSetCaption ];

FCanvas := TControlCanvas.Create;
TControlCanvas( FCanvas ).Control := Self;

FFrameColor := clBtnShadow;
FFrameFlat := False;
FFrameFlatStyle := fsStatus;
FFrameFocusStyle := fsLowered;
FFrameSides := sdAllSides;
FFrameStyle := fsFlat;
FFrameVisible := False;
FUseFrameController := True;
end;


destructor TFrameEdit.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;

{$IFDEF D4_OR_HIGHER}
function TFrameEdit.GetControlsAlignment: TAlignment;
begin
Result := FAlignment;
end;
{$ENDIF}

procedure TFrameEdit.SetAlignment( Value: TLeftRight );
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;

function TFrameEdit.GetColor: TColor;
begin
Result := inherited Color;
end;

procedure TFrameEdit.SetColor( Value: TColor );
begin
if Color <> Value then
begin
inherited Color := Value;
if FFrameVisible then
RepaintFrame;
end;
end;

procedure TFrameEdit.SetFrameColor( Value: TColor );
begin
if FFrameColor <> Value then
begin
FFrameColor := Value;
RepaintFrame;
end;
end;


procedure TFrameEdit.SetFrameFlat( Value: Boolean );
begin
if FFrameFlat <> Value then
begin
FFrameFlat := Value;
if FFrameFlat then
begin
FrameVisible := True;
FFrameSides := sdAllSides;
FFrameStyle := FFrameFlatStyle;
end;
RepaintFrame;
Invalidate;
end;
end;


procedure TFrameEdit.SetFrameFlatStyle( Value: TFrameStyle );
begin
if FFrameFlatStyle <> Value then
begin
FFrameFlatStyle := Value;
RepaintFrame;
end;
end;

procedure TFrameEdit.SetFrameFocusStyle( Value: TFrameStyle );
begin
if FFrameFocusStyle <> Value then
begin
FFrameFocusStyle := Value;
RepaintFrame;
end;
end;


procedure TFrameEdit.SetFrameSides( Value: TSides );
begin
if FFrameSides <> Value then
begin
FFrameSides := Value;
RepaintFrame;
end;
end;


procedure TFrameEdit.SetFrameStyle( Value: TFrameStyle );
begin
if FFrameStyle <> Value then
begin
FFrameStyle := Value;
RepaintFrame;
end;
end;

procedure TFrameEdit.SetFrameVisible( Value: Boolean );
begin
if FFrameVisible <> Value then
begin
FFrameVisible := Value;
{$IFDEF WIN32}
if FFrameVisible then
Ctl3D := True;
{$ELSE}
ParentCtl3D := not FFrameVisible;
Ctl3D := not FFrameVisible;
{$ENDIF}
RecreateWnd;
end;
end;


procedure TFrameEdit.CMEnter( var Msg: TCMEnter );
begin
if FAlignment <> taLeftJustify then
Invalidate;
UpdateFrame( False, True );
inherited;
end;

procedure TFrameEdit.CMExit( var Msg: TCMExit );
begin
inherited;
UpdateFrame( False, False );
if FAlignment <> taLeftJustify then
Invalidate;
end;

function TFrameEdit.GetRightJustifiedText: string;
begin
Result := Text;
end;

procedure TFrameEdit.RepaintFrame;
var
R: TRect;
begin
R := ClientRect;
RedrawWindow( Handle, @R, 0, rdw_Invalidate or rdw_UpdateNow or rdw_Frame );
end;


{$IFDEF WIN32}
procedure TFrameEdit.WMNCPaint( var Msg: TWMNCPaint );
var
DC: HDC;
begin
inherited; { Must call inherited so scroll bar show up }

if FFrameVisible then
begin
DC := GetWindowDC( Handle );
FCanvas.Handle := DC;
try
DrawFrame(FCanvas, Width, Height, FFrameStyle, Color, FFrameColor, FFrameSides);
finally
FCanvas.Handle := 0;
ReleaseDC( Handle, DC );
end;
Msg.Result := 0;
end;
end; {= TFrameEdit.WMNCPaint =}
{$ENDIF}

procedure TFrameEdit.WMPaint( var Msg: TWMPaint );
var
R: TRect;
S: string;
DC: HDC;
PS: TPaintStruct;
PaintNormal: Boolean;
begin
PaintNormal := ( ( FAlignment = taLeftJustify ) or Focused )
{$IFDEF WIN32} and not ( csPaintCopy in ControlState ) {$ENDIF};

if PaintNormal then
inherited
else
begin
DC := Msg.DC;
if DC = 0 then
DC := BeginPaint( Handle, PS );
FCanvas.Handle := DC;
try
{ Draw Right Justified Text }
if ( FAlignment = taRightJustify ) then
begin
FCanvas.Font := Font;
with FCanvas do
begin
//R := GetEditRect;
R := ClientRect;
{$IFNDEF WIN32}
if not FFrameVisible then
begin
Brush.Color := clWindowFrame;
FrameRect( R );
InflateRect( R, -1, -1 );
end;
{$ENDIF}
Brush.Color := Color;

S := GetRightJustifiedText;
TextRect( R, R.Right - TextWidth( S ) - 2, 2, S );
end;
end;

finally
FCanvas.Handle := 0;
if Msg.DC = 0 then
EndPaint( Handle, PS );
end;
end;

{$IFDEF VER80}
if FFrameVisible then
DrawFrame( FCanvas, Width, Height, FFrameStyle, Color, FFrameColor, FFrameSides );
{$ENDIF}
end; {= TFrameEdit.WMPaint =}


procedure TFrameEdit.UpdateFrame( ViaMouse, InFocus: Boolean );
begin
if ViaMouse then
FOverControl := InFocus;

if FFrameFlat then
begin
if Focused or FOverControl then
FFrameStyle := FFrameFocusStyle
else
FFrameStyle := FFrameFlatStyle;
RepaintFrame;
end;
end;

procedure TFrameEdit.SetName(const Value: TComponentName);
var
I: Integer;
begin
Inherited;
I := Pos('_', Value);
if I = 0 then FieldName := Value
else FieldName := Copy(Value, I + 1, 255);
end;

procedure TFrameEdit.MouseEnter;
begin
if Assigned( FOnMouseEnter ) then
FOnMouseEnter( Self );
end;

procedure TFrameEdit.CMMouseEnter( var Msg: TMessage );
begin
inherited;
UpdateFrame( True, True );
MouseEnter;
end;

procedure TFrameEdit.MouseLeave;
begin
if Assigned( FOnMouseLeave ) then
FOnMouseLeave( Self );
end;

procedure TFrameEdit.KeyPress(var Key: Char);
begin
if Key = Char(VK_RETURN) then
begin
PostMessage(Handle, WM_KEYDOWN, VK_TAB, 0);
end;
inherited;
end;

procedure TFrameEdit.CMMouseLeave( var Msg: TMessage );
begin
inherited;
UpdateFrame( True, False );
MouseLeave;
end;

procedure TFrameEdit.WMSize( var Msg: TWMSize );
begin
inherited;
if FFrameVisible then
RepaintFrame;
end;

Croco的答案我自己早已实现，如果以TCustomControl为祖先，还要写Tedit的所有
代码，至于xWolf的答案我还没有验证。沈前卫的方法我试过，但自己水平太菜，毛病太多，谢谢各位

如果只是下划线的话，可以重载 paint,
在下面画就是了。

SuperMMX:
愿闻其详

procedure Paint; override;

procedure xx.Paint
var
DC: HDC;
begin
DC := GetDC(Handle);
MoveTo(DC, 0, Height - 1);//可自己控制位置。
LineTo(DC, Width,Height -1);

ReleaseDC(Handle, DC);
end;

paint 不行， 闪的太厉害了，还是用 Change 吧，
效果还可以，

多人接受答案了。