H
hjp0214
Unregistered / Unconfirmed
GUEST, unregistred user!
unit AddMaskEdit;
interface
uses
Windows, Registry, Dialogs,Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
Clipbrd,Mask, Consts, Inifiles, ActiveX;
type
TLabelPosition = (lpLeftTop,lpLeftCenter,lpLeftBottom,lpTopLeft,lpBottomLeft,
lpLeftTopLeft,lpLeftCenterLeft,lpLeftBottomLeft,lpTopCenter,
lpBottomCenter);
TMaskCompleteEvent = procedure(Sender:TObject;value:string;var accept: Boolean) of object;
TAddMaskEdit = class(TCustomMaskEdit)
private
{ Private declarations }
FLabel:TLabel;
FAutoFocus : boolean;
FAutoTab: Boolean;
FReturnIsTab: Boolean;
FAlignment: TAlignment;
FFocusColor: TColor;
FFocusFontColor: TColor;
FNormalColor: TColor;
FLoadedColor: TColor;
FFontColor:TColor;
FModifiedColor:tcolor;
FShowModified: Boolean;
FLabelMargin: integer;
FLabelPosition: TLabelPosition;
FLabelTransparent: boolean;
FSelectFirstChar: boolean;
FFlat: boolean;
FOnMaskComplete:TMaskCompleteEvent;
FDisabledColor: TColor;
FOriginalValue: string;
FCanUndo: Boolean;
FLabelFont: TFont;
FLabelAlwaysEnabled: Boolean;
FFlatLineColor: TColor;
FSoftBorder: Boolean;
FFocusBorder: Boolean;
FMouseInControl: Boolean;
FBorder3D: Boolean;
FFlatParentColor: Boolean;
FOldBorder: TBorderStyle;
procedure SetAlignment(value:TAlignment);
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
procedure WMChar(var Msg:TWMKey); message WM_CHAR;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure WMPaint(var Msg:TWMPaint); message WM_PAINT;
procedure WMKeyDown(var Msg:TWMKeydown); message WM_KEYDOWN;
function GetLabelCaption: string;
procedure SetLabelCaption(const Value: string);
procedure SetLabelMargin(const Value: integer);
procedure SetLabelPosition(const Value: TLabelPosition);
procedure UpdateLabel;
procedure SetFlat(const Value: boolean);
function GetModified: boolean;
procedure SetModified(const Value: boolean);
procedure SetLabelTransparent(const Value: boolean);
procedure SetDisabledColor(const Value: TColor);
function GetEnabledEx: Boolean;
procedure SetEnabledEx(const Value: Boolean);
function GetColorEx: TColor;
procedure SetColorEx(const Value: TColor);
procedure SetLabelFont(const Value: TFont);
procedure LabelFontChanged(Sender: TObject);
function GetVisible: Boolean;
procedure SetVisible(const Value: Boolean);
procedure SetFlatLineColor(const Value: TColor);
procedure PaintEdit;
procedure SetSoftBorder(const Value: Boolean);
procedure DrawBorder;
procedure DrawControlBorder(DC: HDC);
function Is3DBorderButton: Boolean;
procedure SetBorder3D(const Value: Boolean);
procedure SetFlatRect(const Value: Boolean);
procedure SetFlatParentColor(const Value: Boolean);
protected
{ Protected declarations }
procedure AdjustHeight;virtual;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure DoEnter; override;
procedure CreateParams(var Params:TCreateParams); override;
procedure CreateWnd; override;
function CreateLabel: TLabel;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
destructor Destroy; override;
property Modified: Boolean read GetModified write SetModified;
procedure Loaded; override;
property Border3D: Boolean read FBorder3D write SetBorder3D;
published
{ Published declarations }
property AutoFocus: Boolean read fAutoFocus write fAutoFocus;
property AutoTab: Boolean read FAutoTab write FAutoTab default true;
property CanUndo: Boolean read FCanUndo write FCanUndo default false;
property Color:TColor read GetColorEx write SetColorEx;
property DisabledColor: TColor read FDisabledColor write SetDisabledColor;
property Enabled: Boolean read GetEnabledEx write SetEnabledEx;
property Flat: Boolean read FFlat write SetFlat;
property FlatLineColor: TColor read FFlatLineColor write SetFlatLineColor;
property FlatParentColor: Boolean read FFlatParentColor write SetFlatParentColor;
property ShowModified: boolean read FShowModified write fShowModified;
property FocusColor:TColor read FFocusColor write FFocusColor;
property FocusBorder: Boolean read FFocusBorder write FFocusBorder;
property FocusFontColor:TColor read FFocusFontColor write fFocusFontColor;
property LabelCaption:string read GetLabelCaption write SetLabelCaption;
property LabelAlwaysEnabled: Boolean read FLabelAlwaysEnabled write FLabelAlwaysEnabled;
property LabelPosition:TLabelPosition read FLabelPosition write SetLabelPosition;
property LabelMargin: Integer read FLabelMargin write SetLabelMargin;
property LabelTransparent: boolean read FLabelTransparent write SetLabelTransparent;
property LabelFont: TFont read FLabelFont write SetLabelFont;
property ModifiedColor:tcolor read FModifiedColor write fModifiedColor;
property ReturnIsTab: Boolean read FReturnIsTab write fReturnIsTab default True;
property SoftBorder: Boolean read FSoftBorder write SetSoftBorder default False;
property Alignement:TAlignment read FAlignment write SetAlignment default taLeftJustify;
property SelectFirstChar: boolean read fSelectFirstChar write fSelectFirstChar;
property Visible: Boolean read GetVisible write SetVisible;
property OnMaskComplete:TMaskCompleteEvent read fOnMaskComplete write fOnMaskComplete;
property Font;
property ReadOnly;
property Text;
end;
implementation
{TAddMaskEdit}
constructor TAddMaskEdit.Create(AOwner: TComponent);
begin
inherited Create(aOwner);
if NewStyleControls then
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight]
else
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight,csFramed];
FAutoTab := True; FLabelMargin := 4; FReturnIsTab := True; FFocusColor := clInfoBk;
FModifiedColor := clRed; FDisabledColor := clSilver; FLabelFont := TFont.Create;
FLabelFont.OnChange := LabelFontChanged; FFlatParentColor := True; FSoftBorder := True;//
FFlatParentColor := False;// FFlatLineColor := clNavy ;//
end;
procedure TAddMaskEdit.CreateWnd;
begin
inherited;
AdjustHeight; Flat := True; SetFlatRect(FFlat);
end;
procedure TAddMaskEdit.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(params);
if (PasswordChar = #0) then
begin
Params.Style := Params.Style or ES_MULTILINE;
end;
if (FAlignment = taRightJustify) then
begin
params.style := params.style and not (ES_LEFT) and not (ES_CENTER);
params.style := params.style or (ES_RIGHT);
params.style := params.style or (ES_MULTILINE);
end;
if (FAlignment = taCenter) then
begin
params.style := params.style and not (ES_LEFT) and not (ES_RIGHT);
params.style := params.style or (ES_CENTER);
params.style := params.style or (ES_MULTILINE);
end;
end;
//
procedure TAddMaskEdit.AdjustHeight;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
if NewStyleControls then
begin
if Ctl3D then I := 8 else I := 6;
I := GetSystemMetrics(SM_CYBORDER) * I;
end
else begin
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;
if Height < Metrics.tmHeight + I then
Height := Metrics.tmHeight + I
else
Height := 20;
end;
procedure TAddMaskEdit.Loaded;
var
FOldColor: TColor;
begin
inherited Loaded;
FFontColor := Font.Color;
FOldBorder := BorderStyle;
FFlat := not FFlat;
SetFlat(not FFlat);
if Assigned(FLabel) and not Enabled then
if not FLabelAlwaysEnabled then
FLabel.Enabled := False;
inherited Color := FLoadedColor;
FNormalColor := FLoadedColor;
if FlatParentColor and Flat then Color := (Parent as TWinControl).Brush.Color;
if not Enabled then
begin
FOldColor := Color;
Color := FDisabledColor;
FNormalColor := FOldColor;
end;
if FLabel <> nil then UpdateLabel;
end;
procedure TAddMaskEdit.SetAlignment(value:tAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;
procedure TAddMaskEdit.KeyUp(var Key: Word; Shift: TShiftState);
var
accept: Boolean;
begin
inherited keyUp(key,shift);
if (Pos(' ',self.text)=0) and (self.SelStart=Length(self.text)) and (self.editmask<>'') then
begin
accept:=true;
if assigned(fOnMaskComplete) then FOnMaskComplete(self,self.Text,accept);
if fAutoTab and accept then postmessage(self.handle,wm_keydown,VK_TAB,0);
end;
end;
procedure TAddMaskEdit.DoEnter;
begin
if (self.EditMask<>'') and fSelectFirstChar then
begin
self.SelStart:=0;
self.SelLength:=1;
end;
inherited DoEnter;
end;
procedure TAddMaskEdit.CMMouseEnter(var Msg: TMessage);
begin
if FAutoFocus then self.SetFocus;
if not FMouseInControl and Enabled then
begin
FMouseInControl := True;
if FFocusBorder then DrawBorder;
end;
end;
procedure TAddMaskEdit.CMMouseLeave(var Msg: TMessage);
begin
inherited;
if FMouseInControl and Enabled then
begin
FMouseInControl := False;
if FFocusBorder then Invalidate;
end;
end;
procedure TAddMaskEdit.WMKillFocus(var Msg: TWMKillFocus);
begin
inherited;
if csLoading in ComponentState then Exit;
inherited Color := FNormalColor;
Font.Color := FFontColor;
end;
procedure TAddMaskEdit.WMSetFocus(var Msg: TWMSetFocus);
begin
inherited;
if csLoading in ComponentState then Exit;
inherited Color := FFocusColor;
FOriginalValue := self.Text;
Font.Color := FocusFontColor;
if AutoSelect then SelectAll;
end;
procedure TAddMaskEdit.WMChar(var Msg: TWMKey);
begin
if (msg.charcode=vk_return) and (FReturnIsTab) then Exit;
inherited;
if FShowModified then self.Font.Color := FModifiedColor;
end;
function TAddMaskEdit.GetLabelCaption: string;
begin
if FLabel<>nil then Result := FLabel.caption else Result := '';
end;
procedure TAddMaskEdit.SetLabelCaption(const value: string);
begin
if FLabel=nil then FLabel:=CreateLabel;
FLabel.caption:=value;
UpdateLabel;
end;
function TAddMaskEdit.CreateLabel: TLabel;
begin
Result := TLabel.Create(Self);
Result.Parent := Self.Parent;
Result.FocusControl := Self;
Result.Font.assign(Self.Font);
end;
procedure TAddMaskEdit.SetLabelMargin(const Value: integer);
begin
FLabelMargin := Value;
if FLabel<>nil then UpdateLabel;
end;
procedure TAddMaskEdit.SetLabelTransparent(const Value: boolean);
begin
FLabelTransparent := Value;
if FLabel<>nil then UpdateLabel;
end;
procedure TAddMaskEdit.SetLabelPosition(const Value: TLabelPosition);
begin
FLabelPosition := Value;
if FLabel<>nil then UpdateLabel;
end;
procedure TAddMaskEdit.UpdateLabel;
begin
FLabel.Transparent := FLabeltransparent;
case FLabelPosition of
lpLeftTop:begin
FLabel.top:=self.top;
FLabel.left:=self.left-FLabel.canvas.textwidth(FLabel.caption)-FLabelMargin;
end;
lpLeftCenter:begin
FLabel.top:=self.top+((self.height-FLabel.height) shr 1);
FLabel.left:=self.left-FLabel.canvas.textwidth(FLabel.caption)-FLabelMargin;
end;
lpLeftBottom:begin
FLabel.top:=self.top+self.height-FLabel.height;
FLabel.left:=self.left-FLabel.canvas.textwidth(FLabel.caption)-FLabelMargin;
end;
lpTopLeft:begin
FLabel.top:=self.top-FLabel.height-FLabelMargin;
FLabel.left:=self.left;
end;
lpBottomLeft:begin
FLabel.top:=self.top+self.height+FLabelMargin;
FLabel.left:=self.left;
end;
lpLeftTopLeft:begin
FLabel.top:=self.top;
FLabel.left:=self.left-FLabelMargin;
end;
lpLeftCenterLeft:begin
FLabel.top:=self.top+((self.height-FLabel.height) shr 1);
FLabel.left:=self.left-FLabelMargin;
end;
lpLeftBottomLeft:begin
FLabel.top:=self.top+self.height-FLabel.height;
FLabel.left:=self.left-FLabelMargin;
end;
end;
FLabel.Font.Assign(FLabelFont);
FLabel.Visible := Visible;
end;
destructor TAddMaskEdit.Destroy;
begin
FLabelFont.Free;
if FLabel <> Nil then
begin
FLabel.Free;
FLabel := nil;
end;
inherited Destroy;
end;
procedure TAddMaskEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft,ATop,AWidth,AHeight);
if FLabel <> nil then UpdateLabel;
if FFlat then SetFlatRect(FFlat);
end;
procedure TAddMaskEdit.SetFlat(const Value: boolean);
begin
if FFlat <> Value then
begin
FFlat := Value;
if FFlat then
begin
if not (csLoading in ComponentState) then
if FFlatParentColor then Color := (Parent as TWinControl).Brush.Color;
Borderstyle := bsNone;
SetFlatRect(True);
end
else begin
Color := clWindow;
BorderStyle := FOldBorder;
SetFlatRect(False);
end;
Invalidate;
end;
end;
procedure TAddMaskEdit.CMFontChanged(var Message: TMessage);
begin
if (csDesigning in ComponentState) then
if FLabel<>nil then FLabel.Font.Assign(self.font);
inherited;
SetFlatRect(FFlat);
end;
procedure TAddMaskEdit.WMPaint(var Msg: TWMPaint);
begin
inherited;
PaintEdit;
if Border3D then DrawBorder;
end;
procedure TAddMaskEdit.WMKeyDown(var Msg: TWMKeydown);
begin
if (msg.CharCode = VK_RETURN) and (FReturnIsTab) then
begin
msg.CharCode := VK_TAB;
PostMessage(self.Handle,WM_KEYDOWN,VK_TAB,0);
end;
if (msg.CharCode = VK_ESCAPE) and (Alignement <> taLeftJustify) then
begin
if CanUndo then self.Text := FOriginalValue;
PostMessage(Parent.Handle,WM_KEYDOWN,VK_ESCAPE,0);
end;
inherited;
end;
function TAddMaskEdit.GetModified: boolean;
begin
Result := inherited Modified;
end;
procedure TAddMaskEdit.SetModified(const Value: boolean);
begin
if FShowModified then
begin
if Value = False then
self.Font.Color := FFontColor
else
self.Font.Color := FModifiedColor;
end;
inherited Modified := Value;
end;
procedure TAddMaskEdit.SetDisabledColor(const Value: TColor);
begin
FDisabledColor := Value;
Invalidate;
end;
function TAddMaskEdit.GetEnabledEx: Boolean;
begin
Result := inherited Enabled;
end;
procedure TAddMaskEdit.SetEnabledEx(const Value: Boolean);
var
OldValue: Boolean;
OldColor: TColor;
begin
OldValue := inherited Enabled;
inherited Enabled := Value;
if (csLoading in ComponentState) or (csDesigning in ComponentState) then Exit;
if (OldValue <> Value) then
begin
if value then
begin
Color := FNormalColor;
end
else begin
OldColor := Color;
Color := FDisabledColor;
FNormalColor := OldColor;
end;
end;
if Assigned(FLabel) then
if not FLabelAlwaysEnabled then
FLabel.Enabled := Value;
end;
function TAddMaskEdit.GetColorEx: TColor;
begin
Result := inherited Color;
end;
procedure TAddMaskEdit.SetColorEx(const Value: TColor);
begin
if csLoading in ComponentState then FLoadedColor := Value;
inherited Color := Value;
if not (csLoading in ComponentState) then FNormalColor := Value;
end;
procedure TAddMaskEdit.SetLabelFont(const Value: TFont);
begin
FLabelFont.Assign(Value);
if Assigned(FLabel) then
FLabel.Font.Assign(FLabelFont);
end;
procedure TAddMaskEdit.LabelFontChanged(Sender: TObject);
begin
if Assigned(FLabel) then
FLabel.Font.Assign(FLabelFont);
end;
function TAddMaskEdit.GetVisible: Boolean;
begin
Result := inherited Visible;
end;
procedure TAddMaskEdit.SetVisible(const Value: Boolean);
begin
inherited Visible := Value;
if (FLabel<>nil) then FLabel.Visible := Value;
end;
procedure TAddMaskEdit.DrawBorder;
var
DC: HDC;
begin
if not (FFlat or (FFocusBorder and FMouseInControl) or Border3D) then Exit;
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
finally
ReleaseDC(Handle,DC);
end;
end;
procedure TAddMaskEdit.DrawControlBorder(DC: HDC);
var
ARect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
if Is3DBorderButton then
BtnFaceBrush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
else
BtnFaceBrush := CreateSolidBrush(ColorToRGB((parent as TWinControl).Brush.color));
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
try
GetWindowRect(Handle, ARect);
OffsetRect(ARect, -ARect.Left, -ARect.Top);
if Is3DBorderButton then
begin
DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
FrameRect(DC, ARect, BtnFaceBrush);
end
else begin
FrameRect(DC, ARect, BtnFaceBrush);
InflateRect(ARect, -1, -1);
FrameRect(DC, ARect, BtnFaceBrush);
end;
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
function TAddMaskEdit.Is3DBorderButton: Boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FMouseInControl or (Screen.ActiveControl = Self);
Result := (Result and FFocusBorder) or (Border3D);
end;
procedure TAddMaskEdit.SetFlatLineColor(const Value: TColor);
begin
FFlatLineColor := Value;
Invalidate;
end;
procedure TAddMaskEdit.PaintEdit;
var
DC: HDC;
Oldpen: HPen;
Loc: TRect;
begin
if FFlat then
begin
DC := GetDC(Handle);
if FFocusBorder then
DrawControlBorder(DC)
else begin
OldPen := SelectObject(dc,CreatePen( PS_SOLID,1,ColorToRGB(FFlatLineColor)));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
if FSoftBorder then
begin
MovetoEx(DC,Loc.Left- 2,Height - 1,nil);
LineTo(DC,Width - 1,Height - 1);
LineTo(DC,Width - 1,Loc.Top - 4);
LineTo(DC,Loc.Left - 2,Loc.Top - 4);
LineTo(DC,Loc.Left - 2,Height - 1);
end
else begin
MovetoEx(DC,Loc.Left- 2,Height - 1,nil);
LineTo(DC,Width ,Height - 1);
end;
DeleteObject(SelectObject(DC,OldPen));
end;
ReleaseDC(Handle,DC);
end;
end;
procedure TAddMaskEdit.SetFlatRect(const Value: Boolean);
var
loc: TRect;
begin
if Value then
begin
loc.Left := 2;
loc.Top := 4;
loc.Right := Clientrect.Right - 2;
loc.Bottom := Clientrect.Bottom - 4;
end
else
begin
loc.Left := 0;
loc.Top := 0;
loc.Right := ClientRect.Right;
loc.Bottom := ClientRect.Bottom;
end;
SendMessage(self.Handle,EM_SETRECTNP,0,longint(@loc));
end;
procedure TAddMaskEdit.SetSoftBorder(const Value: Boolean);
begin
FSoftBorder := Value;
Invalidate;
end;
procedure TAddMaskEdit.SetBorder3D(const Value: Boolean);
begin
FBorder3D := Value;
end;
procedure TAddMaskEdit.SetFlatParentColor(const Value: Boolean);
begin
FFlatParentColor := Value;
Invalidate;
end;
end.
如果把窗体的字体设为宋体 9号，chinese_Gb23212时，把该控件放入该窗体时，控件边缘没有完全重画，但是随便移动控件，按F12键，控件又恢复了，我想把控件放入窗体时，就重画好。
这好象是哪一步没有重画，请各位来指点一下了。
interface
uses
Windows, Registry, Dialogs,Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
Clipbrd,Mask, Consts, Inifiles, ActiveX;
type
TLabelPosition = (lpLeftTop,lpLeftCenter,lpLeftBottom,lpTopLeft,lpBottomLeft,
lpLeftTopLeft,lpLeftCenterLeft,lpLeftBottomLeft,lpTopCenter,
lpBottomCenter);
TMaskCompleteEvent = procedure(Sender:TObject;value:string;var accept: Boolean) of object;
TAddMaskEdit = class(TCustomMaskEdit)
private
{ Private declarations }
FLabel:TLabel;
FAutoFocus : boolean;
FAutoTab: Boolean;
FReturnIsTab: Boolean;
FAlignment: TAlignment;
FFocusColor: TColor;
FFocusFontColor: TColor;
FNormalColor: TColor;
FLoadedColor: TColor;
FFontColor:TColor;
FModifiedColor:tcolor;
FShowModified: Boolean;
FLabelMargin: integer;
FLabelPosition: TLabelPosition;
FLabelTransparent: boolean;
FSelectFirstChar: boolean;
FFlat: boolean;
FOnMaskComplete:TMaskCompleteEvent;
FDisabledColor: TColor;
FOriginalValue: string;
FCanUndo: Boolean;
FLabelFont: TFont;
FLabelAlwaysEnabled: Boolean;
FFlatLineColor: TColor;
FSoftBorder: Boolean;
FFocusBorder: Boolean;
FMouseInControl: Boolean;
FBorder3D: Boolean;
FFlatParentColor: Boolean;
FOldBorder: TBorderStyle;
procedure SetAlignment(value:TAlignment);
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
procedure WMChar(var Msg:TWMKey); message WM_CHAR;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure WMPaint(var Msg:TWMPaint); message WM_PAINT;
procedure WMKeyDown(var Msg:TWMKeydown); message WM_KEYDOWN;
function GetLabelCaption: string;
procedure SetLabelCaption(const Value: string);
procedure SetLabelMargin(const Value: integer);
procedure SetLabelPosition(const Value: TLabelPosition);
procedure UpdateLabel;
procedure SetFlat(const Value: boolean);
function GetModified: boolean;
procedure SetModified(const Value: boolean);
procedure SetLabelTransparent(const Value: boolean);
procedure SetDisabledColor(const Value: TColor);
function GetEnabledEx: Boolean;
procedure SetEnabledEx(const Value: Boolean);
function GetColorEx: TColor;
procedure SetColorEx(const Value: TColor);
procedure SetLabelFont(const Value: TFont);
procedure LabelFontChanged(Sender: TObject);
function GetVisible: Boolean;
procedure SetVisible(const Value: Boolean);
procedure SetFlatLineColor(const Value: TColor);
procedure PaintEdit;
procedure SetSoftBorder(const Value: Boolean);
procedure DrawBorder;
procedure DrawControlBorder(DC: HDC);
function Is3DBorderButton: Boolean;
procedure SetBorder3D(const Value: Boolean);
procedure SetFlatRect(const Value: Boolean);
procedure SetFlatParentColor(const Value: Boolean);
protected
{ Protected declarations }
procedure AdjustHeight;virtual;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure DoEnter; override;
procedure CreateParams(var Params:TCreateParams); override;
procedure CreateWnd; override;
function CreateLabel: TLabel;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
destructor Destroy; override;
property Modified: Boolean read GetModified write SetModified;
procedure Loaded; override;
property Border3D: Boolean read FBorder3D write SetBorder3D;
published
{ Published declarations }
property AutoFocus: Boolean read fAutoFocus write fAutoFocus;
property AutoTab: Boolean read FAutoTab write FAutoTab default true;
property CanUndo: Boolean read FCanUndo write FCanUndo default false;
property Color:TColor read GetColorEx write SetColorEx;
property DisabledColor: TColor read FDisabledColor write SetDisabledColor;
property Enabled: Boolean read GetEnabledEx write SetEnabledEx;
property Flat: Boolean read FFlat write SetFlat;
property FlatLineColor: TColor read FFlatLineColor write SetFlatLineColor;
property FlatParentColor: Boolean read FFlatParentColor write SetFlatParentColor;
property ShowModified: boolean read FShowModified write fShowModified;
property FocusColor:TColor read FFocusColor write FFocusColor;
property FocusBorder: Boolean read FFocusBorder write FFocusBorder;
property FocusFontColor:TColor read FFocusFontColor write fFocusFontColor;
property LabelCaption:string read GetLabelCaption write SetLabelCaption;
property LabelAlwaysEnabled: Boolean read FLabelAlwaysEnabled write FLabelAlwaysEnabled;
property LabelPosition:TLabelPosition read FLabelPosition write SetLabelPosition;
property LabelMargin: Integer read FLabelMargin write SetLabelMargin;
property LabelTransparent: boolean read FLabelTransparent write SetLabelTransparent;
property LabelFont: TFont read FLabelFont write SetLabelFont;
property ModifiedColor:tcolor read FModifiedColor write fModifiedColor;
property ReturnIsTab: Boolean read FReturnIsTab write fReturnIsTab default True;
property SoftBorder: Boolean read FSoftBorder write SetSoftBorder default False;
property Alignement:TAlignment read FAlignment write SetAlignment default taLeftJustify;
property SelectFirstChar: boolean read fSelectFirstChar write fSelectFirstChar;
property Visible: Boolean read GetVisible write SetVisible;
property OnMaskComplete:TMaskCompleteEvent read fOnMaskComplete write fOnMaskComplete;
property Font;
property ReadOnly;
property Text;
end;
implementation
{TAddMaskEdit}
constructor TAddMaskEdit.Create(AOwner: TComponent);
begin
inherited Create(aOwner);
if NewStyleControls then
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight]
else
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight,csFramed];
FAutoTab := True; FLabelMargin := 4; FReturnIsTab := True; FFocusColor := clInfoBk;
FModifiedColor := clRed; FDisabledColor := clSilver; FLabelFont := TFont.Create;
FLabelFont.OnChange := LabelFontChanged; FFlatParentColor := True; FSoftBorder := True;//
FFlatParentColor := False;// FFlatLineColor := clNavy ;//
end;
procedure TAddMaskEdit.CreateWnd;
begin
inherited;
AdjustHeight; Flat := True; SetFlatRect(FFlat);
end;
procedure TAddMaskEdit.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(params);
if (PasswordChar = #0) then
begin
Params.Style := Params.Style or ES_MULTILINE;
end;
if (FAlignment = taRightJustify) then
begin
params.style := params.style and not (ES_LEFT) and not (ES_CENTER);
params.style := params.style or (ES_RIGHT);
params.style := params.style or (ES_MULTILINE);
end;
if (FAlignment = taCenter) then
begin
params.style := params.style and not (ES_LEFT) and not (ES_RIGHT);
params.style := params.style or (ES_CENTER);
params.style := params.style or (ES_MULTILINE);
end;
end;
//
procedure TAddMaskEdit.AdjustHeight;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
if NewStyleControls then
begin
if Ctl3D then I := 8 else I := 6;
I := GetSystemMetrics(SM_CYBORDER) * I;
end
else begin
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;
if Height < Metrics.tmHeight + I then
Height := Metrics.tmHeight + I
else
Height := 20;
end;
procedure TAddMaskEdit.Loaded;
var
FOldColor: TColor;
begin
inherited Loaded;
FFontColor := Font.Color;
FOldBorder := BorderStyle;
FFlat := not FFlat;
SetFlat(not FFlat);
if Assigned(FLabel) and not Enabled then
if not FLabelAlwaysEnabled then
FLabel.Enabled := False;
inherited Color := FLoadedColor;
FNormalColor := FLoadedColor;
if FlatParentColor and Flat then Color := (Parent as TWinControl).Brush.Color;
if not Enabled then
begin
FOldColor := Color;
Color := FDisabledColor;
FNormalColor := FOldColor;
end;
if FLabel <> nil then UpdateLabel;
end;
procedure TAddMaskEdit.SetAlignment(value:tAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;
procedure TAddMaskEdit.KeyUp(var Key: Word; Shift: TShiftState);
var
accept: Boolean;
begin
inherited keyUp(key,shift);
if (Pos(' ',self.text)=0) and (self.SelStart=Length(self.text)) and (self.editmask<>'') then
begin
accept:=true;
if assigned(fOnMaskComplete) then FOnMaskComplete(self,self.Text,accept);
if fAutoTab and accept then postmessage(self.handle,wm_keydown,VK_TAB,0);
end;
end;
procedure TAddMaskEdit.DoEnter;
begin
if (self.EditMask<>'') and fSelectFirstChar then
begin
self.SelStart:=0;
self.SelLength:=1;
end;
inherited DoEnter;
end;
procedure TAddMaskEdit.CMMouseEnter(var Msg: TMessage);
begin
if FAutoFocus then self.SetFocus;
if not FMouseInControl and Enabled then
begin
FMouseInControl := True;
if FFocusBorder then DrawBorder;
end;
end;
procedure TAddMaskEdit.CMMouseLeave(var Msg: TMessage);
begin
inherited;
if FMouseInControl and Enabled then
begin
FMouseInControl := False;
if FFocusBorder then Invalidate;
end;
end;
procedure TAddMaskEdit.WMKillFocus(var Msg: TWMKillFocus);
begin
inherited;
if csLoading in ComponentState then Exit;
inherited Color := FNormalColor;
Font.Color := FFontColor;
end;
procedure TAddMaskEdit.WMSetFocus(var Msg: TWMSetFocus);
begin
inherited;
if csLoading in ComponentState then Exit;
inherited Color := FFocusColor;
FOriginalValue := self.Text;
Font.Color := FocusFontColor;
if AutoSelect then SelectAll;
end;
procedure TAddMaskEdit.WMChar(var Msg: TWMKey);
begin
if (msg.charcode=vk_return) and (FReturnIsTab) then Exit;
inherited;
if FShowModified then self.Font.Color := FModifiedColor;
end;
function TAddMaskEdit.GetLabelCaption: string;
begin
if FLabel<>nil then Result := FLabel.caption else Result := '';
end;
procedure TAddMaskEdit.SetLabelCaption(const value: string);
begin
if FLabel=nil then FLabel:=CreateLabel;
FLabel.caption:=value;
UpdateLabel;
end;
function TAddMaskEdit.CreateLabel: TLabel;
begin
Result := TLabel.Create(Self);
Result.Parent := Self.Parent;
Result.FocusControl := Self;
Result.Font.assign(Self.Font);
end;
procedure TAddMaskEdit.SetLabelMargin(const Value: integer);
begin
FLabelMargin := Value;
if FLabel<>nil then UpdateLabel;
end;
procedure TAddMaskEdit.SetLabelTransparent(const Value: boolean);
begin
FLabelTransparent := Value;
if FLabel<>nil then UpdateLabel;
end;
procedure TAddMaskEdit.SetLabelPosition(const Value: TLabelPosition);
begin
FLabelPosition := Value;
if FLabel<>nil then UpdateLabel;
end;
procedure TAddMaskEdit.UpdateLabel;
begin
FLabel.Transparent := FLabeltransparent;
case FLabelPosition of
lpLeftTop:begin
FLabel.top:=self.top;
FLabel.left:=self.left-FLabel.canvas.textwidth(FLabel.caption)-FLabelMargin;
end;
lpLeftCenter:begin
FLabel.top:=self.top+((self.height-FLabel.height) shr 1);
FLabel.left:=self.left-FLabel.canvas.textwidth(FLabel.caption)-FLabelMargin;
end;
lpLeftBottom:begin
FLabel.top:=self.top+self.height-FLabel.height;
FLabel.left:=self.left-FLabel.canvas.textwidth(FLabel.caption)-FLabelMargin;
end;
lpTopLeft:begin
FLabel.top:=self.top-FLabel.height-FLabelMargin;
FLabel.left:=self.left;
end;
lpBottomLeft:begin
FLabel.top:=self.top+self.height+FLabelMargin;
FLabel.left:=self.left;
end;
lpLeftTopLeft:begin
FLabel.top:=self.top;
FLabel.left:=self.left-FLabelMargin;
end;
lpLeftCenterLeft:begin
FLabel.top:=self.top+((self.height-FLabel.height) shr 1);
FLabel.left:=self.left-FLabelMargin;
end;
lpLeftBottomLeft:begin
FLabel.top:=self.top+self.height-FLabel.height;
FLabel.left:=self.left-FLabelMargin;
end;
end;
FLabel.Font.Assign(FLabelFont);
FLabel.Visible := Visible;
end;
destructor TAddMaskEdit.Destroy;
begin
FLabelFont.Free;
if FLabel <> Nil then
begin
FLabel.Free;
FLabel := nil;
end;
inherited Destroy;
end;
procedure TAddMaskEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft,ATop,AWidth,AHeight);
if FLabel <> nil then UpdateLabel;
if FFlat then SetFlatRect(FFlat);
end;
procedure TAddMaskEdit.SetFlat(const Value: boolean);
begin
if FFlat <> Value then
begin
FFlat := Value;
if FFlat then
begin
if not (csLoading in ComponentState) then
if FFlatParentColor then Color := (Parent as TWinControl).Brush.Color;
Borderstyle := bsNone;
SetFlatRect(True);
end
else begin
Color := clWindow;
BorderStyle := FOldBorder;
SetFlatRect(False);
end;
Invalidate;
end;
end;
procedure TAddMaskEdit.CMFontChanged(var Message: TMessage);
begin
if (csDesigning in ComponentState) then
if FLabel<>nil then FLabel.Font.Assign(self.font);
inherited;
SetFlatRect(FFlat);
end;
procedure TAddMaskEdit.WMPaint(var Msg: TWMPaint);
begin
inherited;
PaintEdit;
if Border3D then DrawBorder;
end;
procedure TAddMaskEdit.WMKeyDown(var Msg: TWMKeydown);
begin
if (msg.CharCode = VK_RETURN) and (FReturnIsTab) then
begin
msg.CharCode := VK_TAB;
PostMessage(self.Handle,WM_KEYDOWN,VK_TAB,0);
end;
if (msg.CharCode = VK_ESCAPE) and (Alignement <> taLeftJustify) then
begin
if CanUndo then self.Text := FOriginalValue;
PostMessage(Parent.Handle,WM_KEYDOWN,VK_ESCAPE,0);
end;
inherited;
end;
function TAddMaskEdit.GetModified: boolean;
begin
Result := inherited Modified;
end;
procedure TAddMaskEdit.SetModified(const Value: boolean);
begin
if FShowModified then
begin
if Value = False then
self.Font.Color := FFontColor
else
self.Font.Color := FModifiedColor;
end;
inherited Modified := Value;
end;
procedure TAddMaskEdit.SetDisabledColor(const Value: TColor);
begin
FDisabledColor := Value;
Invalidate;
end;
function TAddMaskEdit.GetEnabledEx: Boolean;
begin
Result := inherited Enabled;
end;
procedure TAddMaskEdit.SetEnabledEx(const Value: Boolean);
var
OldValue: Boolean;
OldColor: TColor;
begin
OldValue := inherited Enabled;
inherited Enabled := Value;
if (csLoading in ComponentState) or (csDesigning in ComponentState) then Exit;
if (OldValue <> Value) then
begin
if value then
begin
Color := FNormalColor;
end
else begin
OldColor := Color;
Color := FDisabledColor;
FNormalColor := OldColor;
end;
end;
if Assigned(FLabel) then
if not FLabelAlwaysEnabled then
FLabel.Enabled := Value;
end;
function TAddMaskEdit.GetColorEx: TColor;
begin
Result := inherited Color;
end;
procedure TAddMaskEdit.SetColorEx(const Value: TColor);
begin
if csLoading in ComponentState then FLoadedColor := Value;
inherited Color := Value;
if not (csLoading in ComponentState) then FNormalColor := Value;
end;
procedure TAddMaskEdit.SetLabelFont(const Value: TFont);
begin
FLabelFont.Assign(Value);
if Assigned(FLabel) then
FLabel.Font.Assign(FLabelFont);
end;
procedure TAddMaskEdit.LabelFontChanged(Sender: TObject);
begin
if Assigned(FLabel) then
FLabel.Font.Assign(FLabelFont);
end;
function TAddMaskEdit.GetVisible: Boolean;
begin
Result := inherited Visible;
end;
procedure TAddMaskEdit.SetVisible(const Value: Boolean);
begin
inherited Visible := Value;
if (FLabel<>nil) then FLabel.Visible := Value;
end;
procedure TAddMaskEdit.DrawBorder;
var
DC: HDC;
begin
if not (FFlat or (FFocusBorder and FMouseInControl) or Border3D) then Exit;
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
finally
ReleaseDC(Handle,DC);
end;
end;
procedure TAddMaskEdit.DrawControlBorder(DC: HDC);
var
ARect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
if Is3DBorderButton then
BtnFaceBrush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
else
BtnFaceBrush := CreateSolidBrush(ColorToRGB((parent as TWinControl).Brush.color));
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
try
GetWindowRect(Handle, ARect);
OffsetRect(ARect, -ARect.Left, -ARect.Top);
if Is3DBorderButton then
begin
DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
FrameRect(DC, ARect, BtnFaceBrush);
end
else begin
FrameRect(DC, ARect, BtnFaceBrush);
InflateRect(ARect, -1, -1);
FrameRect(DC, ARect, BtnFaceBrush);
end;
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
function TAddMaskEdit.Is3DBorderButton: Boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FMouseInControl or (Screen.ActiveControl = Self);
Result := (Result and FFocusBorder) or (Border3D);
end;
procedure TAddMaskEdit.SetFlatLineColor(const Value: TColor);
begin
FFlatLineColor := Value;
Invalidate;
end;
procedure TAddMaskEdit.PaintEdit;
var
DC: HDC;
Oldpen: HPen;
Loc: TRect;
begin
if FFlat then
begin
DC := GetDC(Handle);
if FFocusBorder then
DrawControlBorder(DC)
else begin
OldPen := SelectObject(dc,CreatePen( PS_SOLID,1,ColorToRGB(FFlatLineColor)));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
if FSoftBorder then
begin
MovetoEx(DC,Loc.Left- 2,Height - 1,nil);
LineTo(DC,Width - 1,Height - 1);
LineTo(DC,Width - 1,Loc.Top - 4);
LineTo(DC,Loc.Left - 2,Loc.Top - 4);
LineTo(DC,Loc.Left - 2,Height - 1);
end
else begin
MovetoEx(DC,Loc.Left- 2,Height - 1,nil);
LineTo(DC,Width ,Height - 1);
end;
DeleteObject(SelectObject(DC,OldPen));
end;
ReleaseDC(Handle,DC);
end;
end;
procedure TAddMaskEdit.SetFlatRect(const Value: Boolean);
var
loc: TRect;
begin
if Value then
begin
loc.Left := 2;
loc.Top := 4;
loc.Right := Clientrect.Right - 2;
loc.Bottom := Clientrect.Bottom - 4;
end
else
begin
loc.Left := 0;
loc.Top := 0;
loc.Right := ClientRect.Right;
loc.Bottom := ClientRect.Bottom;
end;
SendMessage(self.Handle,EM_SETRECTNP,0,longint(@loc));
end;
procedure TAddMaskEdit.SetSoftBorder(const Value: Boolean);
begin
FSoftBorder := Value;
Invalidate;
end;
procedure TAddMaskEdit.SetBorder3D(const Value: Boolean);
begin
FBorder3D := Value;
end;
procedure TAddMaskEdit.SetFlatParentColor(const Value: Boolean);
begin
FFlatParentColor := Value;
Invalidate;
end;
end.
如果把窗体的字体设为宋体 9号，chinese_Gb23212时，把该控件放入该窗体时，控件边缘没有完全重画，但是随便移动控件，按F12键，控件又恢复了，我想把控件放入窗体时，就重画好。
这好象是哪一步没有重画，请各位来指点一下了。