一个可以改变边框颜色的 edit ，可以设定边框线条样式的控件,请大家看看怎么样 （看到 bbscom 的问题而做的一个,bbscom一定要进来看看呀^_^）

一个可以改变边框颜色的 edit ，可以设定边框线条样式的控件,请大家看看怎么样 （看到 bbscom 的问题而做的一个,bbscom一定要进来看看呀^_^） ( 积分: 50 )<br />{
可以改变边框的 edit
qi_jianzhou 2007-07

}
unit PenEdit;

interface
uses windows,messages,sysutils,controls,stdctrls,graphics,classes,forms,dialogs;

type
TPenEdit = class(TCustomEdit)
private
FPen:TPen;
FCanvas:TCanvas;
procedure FPenChange(sender:TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor create(aowner:TComponent);override;

destructor destroy; override;

procedure WPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMPaint(var message:TMessage); message wm_paint;
published
property Anchors;
property AutoSelect;
property AutoSize;
property Ctl3D;
property TabOrder;
property TabStop;
property Text;
property BorderStyle;
property Visible;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property Pen:TPen read FPen write FPen;
end;

procedure Register;
implementation
{$R PENEDIT.RES}
{ TPenEdit }

constructor TPenEdit.create(aowner: TComponent);
begin
inherited create(aowner);
//self.Ctl3D := false;
self.BorderStyle := bsNone;
self.ParentCtl3D := false;

FPen := TPen.Create;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := self;
FPen.Color := clblack;
FPen.Style := graphics.psSolid;
FPen.Mode := graphics.pmCopy;
FPen.Width := 1;
//FPen.OnChange := self.FPenChange;
FCanvas.Pen.Assign(FPen);
FPen.OnChange :=FPenChange;
// postmessage(Handle,EM_SETMARGINS,EC_LEFTMARGIN,makelong(30,Width-5));
end;

procedure TPenEdit.CreateParams(var Params: TCreateParams);
begin
inherited createParams(params);
params.ExStyle := params.ExStyle or WS_EX_WINDOWEDGE ;
params.Style := params.Style or ws_border;

end;

destructor TPenEdit.destroy;
begin
Fcanvas.Free;
FPen.Free;
inherited;
end;

procedure TPenEdit.FPenChange(sender: TObject);
begin


FCanvas.Pen.Assign(FPen);

postmessage(Handle,wm_paint,windows.GetDC(self.Handle),0);

end;

procedure TPenEdit.WMPaint(var message: TMessage);
begin
inherited;
wpaint(message);
end;

procedure TPenEdit.WPaint(var Message: TMessage);
var
rect:Trect;
begin
// inherited;
rect.Left := self.Left+1;
rect.Top := self.Top+1;
rect.Right := self.Width+self.Left-1;
rect.Bottom := self.Top + self.Height-1;


if classes.csDesigning in self.ComponentState then
begin
if windows.GetClientRect(self.Handle,rect) then
begin
//rect.Bottom := rect.Bottom-1;
//rect.Right := rect.Left-1;
FCanvas.MoveTo(rect.Left,rect.Top);
FCanvas.LineTo(rect.Right-1,rect.Top);
FCanvas.LineTo(rect.Right-1,rect.Bottom-1);
FCanvas.LineTo(rect.left,rect.Bottom-1);
FCanvas.LineTo(rect.left,rect.Top);

end;
end else
begin
if windows.GetClientRect(self.Handle,rect) then
begin
// rect.Left := rect.Left +1;
rect.Right := rect.Right-1;
// rect.Top := rect.Top+1;
rect.Bottom := rect.Bottom-1;
FCanvas.MoveTo(rect.Left,rect.Top);
FCanvas.LineTo(rect.Right,rect.Top);
FCanvas.LineTo(rect.Right,rect.Bottom);
FCanvas.LineTo(rect.left,rect.Bottom);
FCanvas.LineTo(rect.left,rect.Top);
end;
end;
end;


procedure Register;
begin
RegisterComponents('Standard',[TPenEdit]);
end;

end.