Delphi+XE2圆角矩形Edit代码.docx
《Delphi+XE2圆角矩形Edit代码.docx》由会员分享，可在线阅读，更多相关《Delphi+XE2圆角矩形Edit代码.docx（16页珍藏版）》请在冰豆网上搜索。
Delphi+XE2圆角矩形Edit代码
DelphiXE2圆角矩形Edit代码
{测测在XE2下可用}
unituAkanShapeEdit;
interface
uses
Winapi.Windows,Winapi.Messages,System.SysUtils,System.Variants,System.Classes,
Vcl.Graphics,
Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Vcl.StdCtrls,Vcl.ExtCtrls,math,
uJohnPNGButton;
Type
{TBoundShape}
TBoundShape=class（TGraphicControl）
private
FPen:
TPen;
FBrush:
TBrush;
FShape:
TShapeType;
FFocusControl:
TWinControl;
FSpacing:
Integer;
procedureSetBrush（Value:
TBrush）;
procedureSetPen（Value:
TPen）;
procedureSetShape（Value:
TShapeType）;
functionGetHeight:
Integer;
functionGetLeft:
Integer;
functionGetTop:
Integer;
functionGetWidth:
Integer;
procedureSetHeight（constValue:
Integer）;
procedureSetWidth（constValue:
Integer）;
procedureSetFocusControl（constValue:
TWinControl）;
protected
procedurePaint;override;
//add***
procedureAdjustBounds;dynamic;
propertyFocusControl:
TWinControlreadFFocusControlwriteSetFocusControl;
public
constructorCreate（AOwner:
TComponent）;override;
destructorDestroy;override;
published
procedureStyleChanged（Sender:
TObject）;
propertyAlign;
propertyAnchors;
propertyBrush:
TBrushreadFBrushwriteSetBrush;
propertyDragCursor;
propertyDragKind;
propertyDragMode;
propertyEnabled;
propertyConstraints;
propertyParentShowHint;
propertyPen:
TPenreadFPenwriteSetPen;
propertyShape:
TShapeTypereadFShapewriteSetShapedefaultstRectangle;
propertyShowHint;
propertyTouch;
propertyVisible;
propertyOnContextPopup;
propertyOnDragDrop;
propertyOnDragOver;
propertyOnEndDock;
propertyOnEndDrag;
propertyOnMouseActivate;
propertyOnMouseDown;
propertyOnMouseEnter;
propertyOnMouseLeave;
propertyOnMouseMove;
propertyOnMouseUp;
propertyOnGesture;
propertyOnStartDock;
propertyOnStartDrag;
//Add******
propertyLeft:
IntegerreadGetLeft;
propertyTop:
IntegerreadGetTop;
propertyHeight:
IntegerreadGetHeightwriteSetHeight;
propertyWidth:
IntegerreadGetWidthwriteSetWidth;
end;
{TCustomLabeledEdit}
TCustomShapedEdit=class（TCustomEdit）
private
FBoundShape:
TBoundShape;
FShapeSpacing:
Integer;
FFocusControl:
TWinControl;
FFocusEnabled:
boolean;
FPromptText:
string;
procedureSetShapePosition;
procedureSetShapeSpacing（constValue:
Integer）;
procedureSetFocusControl（constValue:
TWinControl）;
procedureSetPromptText（constValue:
string）;
protected
procedureSetParent（AParent:
TWinControl）;override;
procedureNotification（AComponent:
TComponent;Operation:
TOperation）;override;
procedureSetName（constValue:
TComponentName）;override;
procedureCMVisiblechanged（varMessage:
TMessage）;
messageCM_VISIBLECHANGED;
procedureCMEnabledchanged（varMessage:
TMessage）;
messageCM_ENABLEDCHANGED;
procedureCMBidimodechanged（varMessage:
TMessage）;
messageCM_BIDIMODECHANGED;
procedureCMEnter（varMessage:
TCMEnter）;messageCM_ENTER;
procedureCMExit（varMessage:
TCMExit）;messageCM_EXIT;
public
{Publicdeclarations}
constructorCreate（AOwner:
TComponent）;override;
procedureSetBounds（ALeft:
Integer;ATop:
Integer;AWidth:
Integer;AHeight:
Integer）;
override;
procedureSetupInternalShape;
propertyEditShape:
TBoundShapereadFBoundShape;
propertyShapeSpacing:
IntegerreadFShapeSpacingwriteSetShapeSpacingdefault3;
functionCanFocus:
Boolean;override;
//add*****
propertyPromptText:
stringreadFPromptTextwriteSetPromptText;
end;
{TShapedEdit}
TShapedEdit=class（TCustomShapedEdit）
published
propertyAlignment;
propertyAnchors;
propertyAutoSelect;
propertyAutoSize;
propertyBevelEdges;
propertyBevelInner;
propertyBevelKind;
propertyBevelOuter;
propertyBiDiMode;
propertyBorderStyle;
propertyCharCase;
propertyColor;
propertyConstraints;
propertyCtl3D;
propertyDoubleBuffered;
propertyDragCursor;
propertyDragKind;
propertyDragMode;
propertyEditShape;
propertyEnabled;
propertyFont;
propertyHideSelection;
propertyImeMode;
propertyImeName;
propertyShapeSpacing;
propertyMaxLength;
propertyOEMConvert;
propertyNumbersOnly;
propertyParentBiDiMode;
propertyParentColor;
propertyParentCtl3D;
propertyParentDoubleBuffered;
propertyParentFont;
propertyParentShowHint;
propertyPasswordChar;
propertyPopupMenu;
propertyReadOnly;
propertyShowHint;
propertyTabOrder;
propertyTabStop;
propertyText;
propertyTextHint;
propertyTouch;
propertyVisible;
propertyOnChange;
propertyOnClick;
propertyOnContextPopup;
propertyOnDblClick;
propertyOnDragDrop;
propertyOnDragOver;
propertyOnEndDock;
propertyOnEndDrag;
propertyOnEnter;
propertyOnExit;
propertyOnGesture;
propertyOnKeyDown;
propertyOnKeyPress;
propertyOnKeyUp;
propertyOnMouseActivate;
propertyOnMouseDown;
propertyOnMouseEnter;
propertyOnMouseLeave;
propertyOnMouseMove;
propertyOnMouseUp;
propertyOnStartDock;
propertyOnStartDrag;
//
propertyPromptText;
end;
procedureRegister;
implementation
procedureRegister;
begin
RegisterComponents（'EvoJohn',[TShapedEdit]）;
end;
{TBoundShape}
procedureTBoundShape.AdjustBounds;const
WordWraps:
array[Boolean]ofWord=（0,DT_WORDBREAK）;
var
DC:
HDC;
X:
Integer;
Rect:
TRect;
//AAlignment:
TAlignment;
begin
ifnot（csReadinginComponentState）then
begin
Rect:
=ClientRect;
DC:
=GetDC（0）;
try
Canvas.Handle:
=DC;
//DoDrawText（Rect,（DT_EXPANDTABSorDT_CALCRECT）or
WordWraps[FWordWrap]）;
Canvas.Handle:
=0;
finally
ReleaseDC（0,DC）;
end;
X:
=Left;
{AAlignment:
=FAlignment;
ifUseRightToLeftAlignmentthen
ChangeBiDiModeAlignment（AAlignment）;
ifAAlignment=taRightJustifythen
Inc（X,Width-Rect.Right）;}
SetBounds（X,Top,Rect.Right,Rect.Bottom）;
end;
//
ifOwnerisTCustomShapedEditthen
withOwnerasTCustomShapedEditdo
SetShapePosition;
end;
constructorTBoundShape.Create（AOwner:
TComponent）;
begin
inheritedCreate（AOwner）;
ControlStyle:
=ControlStyle+[csReplicatable];
Width:
=65;
Height:
=65;
FPen:
=TPen.Create;
FPen.OnChange:
=StyleChanged;
FBrush:
=TBrush.Create;
FBrush.OnChange:
=StyleChanged;
//Add***
Name:
='SubLabel';{donotlocalize}
SetSubComponent（True）;
ifAssigned（AOwner）then
Caption:
=AOwner.Name;
end;
destructorTBoundShape.Destroy;begin
FPen.Free;
FBrush.Free;
inheritedDestroy;
end;
functionTBoundShape.GetHeight:
Integer;
begin
Result:
=inheritedHeight;end;
functionTBoundShape.GetLeft:
Integer;begin
Result:
=inheritedLeft;
end;
functionTBoundShape.GetTop:
Integer;begin
Result:
=inheritedTop;
end;
functionTBoundShape.GetWidth:
Integer;begin
Result:
=inheritedWidth;end;
procedureTBoundShape.Paint;var
X,Y,W,H,S:
Integer;
R:
Trect;
i:
integer;
z,dz:
double;
begin
{withCanvasdo
begin
Pen:
=FPen;
Brush:
=FBrush;
X:
=Pen.Widthdiv2;
Y:
=X;
W:
=Width-Pen.Width+1;
H:
=Height-Pen.Width+1;
ifPen.Width=0then
begin
Dec（W）;
Dec（H）;
end;
ifW=WelseS:
=H;
ifFShapein[stSquare,stRoundSquare,stCircle]then
begin
Inc（X,（W-S）div2）;
Inc（Y,（H-S）div2）;
W:
=S;
H:
=S;
end;
caseFShapeof
stRectangle,stSquare:
Rectangle（X,Y,X+W,Y+H）;
stRoundRect,stRoundSquare:
RoundRect（X,Y,X+W,Y+H,Sdiv4,Sdiv4）;
stCircle,stEllipse:
Ellipse（X,Y,X+W,Y+H）;
end;
end;}
//
ifOwnerisTCustomShapedEditthen
with（OwnerasTCustomShapedEdit）,Canvasdo
begin
Pen:
=FPen;
Brush:
=FBrush;
X:
=Pen.Widthdiv2;
Y:
=X;
W:
=Width-Pen.Width+1+Fspacing*2;
H:
=Height-Pen.Width+1+Fspacing*2;
ifPen.Width=0then
begin
Dec（W）;
Dec（H）;
end;
ifW=WelseS:
=H;
RoundRect（X,Y,X+W,Y+H,Sdiv4,Sdiv4）;
{//测测色
dz:
=Fspacing/20;
z:
=0;
forI:
=20downto0do
begin
Brush.Color:
=clwhite-i;
Pen.Color:
=clwhite-i;
RoundRect（X+round（z+dz）,Y+round（z+dz）,X+W-round（z+dz）,Y+H-round（z+dz）,S
div4,Sdiv4）;
z:
=z+dz;
end;}
SetShapePosition;
end;
{r:
=Rect（0,0,self.Width,self.Height）;
Canvas.Brush.Color:
=clblack;
Canvas.Brush.Style:
=bsSolid;
canvas.FillRect（r）;}
end;
procedureTBoundShape.SetBrush（Value:
TBrush）;begin
FBrush.Assign（Value）;
end;
procedureTBoundShape.SetFocusControl（constValue:
TWinControl）;
begin
FFocusControl:
=Value;
end;
procedureTBoundShape.SetHeight（constValue:
Integer）;begin
SetBounds（Left,Top,Width,Value）;
end;
procedureTBoundShape.SetPen（Value:
TPen）;begin
FPen.Assign（Value）;
end;
procedureTBoundShape.SetShape（Value:
TShapeType）;begin
ifFShape<>Valuethen
begin
FShape:
=Value;
Invalidate;
end;
end;
procedureTBoundShape.SetWidth（constValue:
Integer）;begin
SetBounds（Left,Top,Value,Height）;end;
procedureTBoundShape.StyleChanged（Sender:
TObject）;begin
Invalidate;
end;
{TCustomShapedEdit}
functionTCustomShapedEdit.CanFocus:
Boolean;begin
result:
=false;
end;
procedureTCustomShapedEdit.CMBidimodechanged（varMessage:
TMessage）;
begin
inherited;
ifFBoundShape<>nilthen
FBoundShape.BiDiMode:
=BiDiMode;end;
procedureTCustomShapedEdit.CMEnabledchanged（varMessage:
TMessage）;
var
color:
Tcolor;
begin
Color:
=self.Font.Color;
inherited;
ifFBoundShape<>nilthen
FBoundShape.Enabled:
=Enabled;
self.Font.Color:
=Color;end;
procedureTCustomShapedEdit.CMEnter（varMessage:
TCMEnter）;
var
Form:
TCustomForm;
begin
inherited;
ifReadOnlythen
begin
Form:
=GetParentForm（Self）;
ifForm<>nilthenForm.DefocusControl（Self,false）;
endelse
begin
ifText=PromptTextthen
begin
Text:
='';
end
else
begin
end;
end;
end;
procedureTCustomShapedEdit.CMExit（varMessage:
TCMExit）;
begin
inherited;
ifText<>''then
begin
endelse
begin
Text:
=PromptText;
end;
end;
procedureTCustomShapedEdit.SetPromptText（constValue:
string）;
begin
FPromptText:
=Value;
Text:
=Value;
end;
procedureTCustomShapedEdit.CMVisiblechanged（varMessage:
TMessage）;
begin
inherited;
升级会员 