아래 수정 답변을 올립니다..
(디폴트값을 넣기는 좀 찝찝해서..)
아래의 방법이 너무 무식하다고 생각이 들면..
입력 시 EditMask를 사용하시지 마시고..
DisplayFormat만을 설정하시고..
TEBEdit말고 MaskEdit들을 사용하는 편법도 가능합니다..
여하튼 원하시는 작업을 그대로 하기위해..
TDBEdit 콤포넌트를 약간 수정하였으니 참고하시기 바랍니다..
요점은 TDBEdit의 OnExit는 이미 에러가 처리된 후..
발생한 이벤트 입니다..
이것을 수정하여 에러처리 이전에 이벤트를 발생하여..
에러 요인을 제거하면 에러 처리를 피해갈 수 있도록 한 것입니다..
잘 활용하면 업무에 도움이 되실 듯^^
From 류..
---------
* 에러의 요인
Unit DB;
....
procedure TDateTimeField.SetAsString(const Value: string);
var
DateTime: TDateTime;
begin
if Value = '' then Clear else
begin
case DataType of
{*** 여기서 Exception을 처리할 수 있어야 하는데 ***}
{*** 이 Unit을 수정하셔도 됩니다.. ***}
ftDate: DateTime := StrToDate(Value);
ftTime: DateTime := StrToTime(Value);
else
DateTime := StrToDateTime(Value);
end;
SetAsDateTime(DateTime);
end;
end;
* 프로그램 소스
var
Form1: TForm1;
implementation
{$R *.DFM}
Function DeleteNonNumericChar(stText:String):String;
Var
Loop : Integer;
Begin
Result:= '';
For Loop:= 1 to Length(stText) do
If stText[Loop] in ['0'..'9'] then Result:= Result+stText[Loop];
End;
procedure TForm1.RyuDBEdit1Exit(Sender: TObject);
begin
If DeleteNonNumericChar(RyuDBEdit1.Text) = '' then
RyuDBEdit1.Field.AsString:= '';
end;
또는
procedure TForm1.RyuDBEdit1Exit(Sender: TObject);
begin
Try
StrToDate(RyuDBEdit1.Text);
Except
RyuDBEdit1.Field.AsString:= '';
End;
end;
* 새로운 TDBEdit 콤포넌트
unit RyuDBEdit;
{$R-}
interface
uses Windows, SysUtils, Messages, Classes, Controls, Forms,
Graphics, Menus, StdCtrls, ExtCtrls, Mask, Buttons, ComCtrls, Db;
type
{ TFieldDataLink }
TRyuFieldDataLink = class(TDataLink)
private
FField: TField;
FFieldName: string;
FControl: TComponent;
FEditing: Boolean;
FModified: Boolean;
FOnDataChange: TNotifyEvent;
FOnEditingChange: TNotifyEvent;
FOnUpdateData: TNotifyEvent;
FOnActiveChange: TNotifyEvent;
function GetCanModify: Boolean;
procedure SetEditing(Value: Boolean);
procedure SetField(Value: TField);
procedure SetFieldName(const Value: string);
procedure UpdateField;
protected
procedure ActiveChanged; override;
procedure EditingChanged; override;
procedure FocusControl(Field: TFieldRef); override;
procedure LayoutChanged; override;
procedure RecordChanged(Field: TField); override;
procedure UpdateData; override;
public
function Edit: Boolean;
procedure Modified;
procedure Reset;
property CanModify: Boolean read GetCanModify;
property Control: TComponent read FControl write FControl;
property Editing: Boolean read FEditing;
property Field: TField read FField;
property FieldName: string read FFieldName write SetFieldName;
property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
property OnEditingChange: TNotifyEvent read FOnEditingChange write FOnEditingChange;
property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange;
end;
{ TDBEdit }
TRyuDBEdit = class(TCustomMaskEdit)
private
FDataLink: TRyuFieldDataLink;
FCanvas: TControlCanvas;
FAlignment: TAlignment;
FFocused: Boolean;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
function GetTextMargins: TPoint;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetFocused(Value: Boolean);
procedure SetReadOnly(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
function EditCanModify: Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Reset; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
published
property AutoSelect;
property AutoSize;
property BorderStyle;
property CharCase;
property Color;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
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
uses Clipbrd, DBConsts, Dialogs;
procedure Register;
begin
RegisterComponents('Ryu', [TRyuDBEdit]);
end;
{ TRyuFieldDataLink }
procedure TRyuFieldDataLink.SetEditing(Value: Boolean);
begin
if FEditing <> Value then
begin
FEditing := Value;
FModified := False;
if Assigned(FOnEditingChange) then FOnEditingChange(Self);
end;
end;
procedure TRyuFieldDataLink.SetFieldName(const Value: string);
begin
if FFieldName <> Value then
begin
FFieldName := Value;
UpdateField;
end;
end;
procedure TRyuFieldDataLink.SetField(Value: TField);
begin
if FField <> Value then
begin
FField := Value;
EditingChanged;
RecordChanged(nil);
end;
end;
procedure TRyuFieldDataLink.UpdateField;
begin
SetField(nil);
if Active and (FFieldName <> '') then
begin
if Assigned(FControl) then
SetField(GetFieldProperty(DataSource.DataSet, FControl, FFieldName)) else
SetField(DataSource.DataSet.FieldByName(FFieldName));
end;
end;
function TRyuFieldDataLink.Edit: Boolean;
begin
if CanModify then inherited Edit;
Result := FEditing;
end;
function TRyuFieldDataLink.GetCanModify: Boolean;
begin
Result := not ReadOnly and (Field <> nil) and Field.CanModify;
end;
procedure TRyuFieldDataLink.Modified;
begin
FModified := True;
end;
procedure TRyuFieldDataLink.Reset;
begin
RecordChanged(nil);
end;
procedure TRyuFieldDataLink.ActiveChanged;
begin
UpdateField;
if Assigned(FOnActiveChange) then FOnActiveChange(Self);
end;
procedure TRyuFieldDataLink.EditingChanged;
begin
SetEditing(inherited Editing and CanModify);
end;
procedure TRyuFieldDataLink.FocusControl(Field: TFieldRef);
begin
if (Field^ <> nil) and (Field^ = FField) and (FControl is TWinControl) then
if TWinControl(FControl).CanFocus then
begin
Field^ := nil;
TWinControl(FControl).SetFocus;
end;
end;
procedure TRyuFieldDataLink.RecordChanged(Field: TField);
begin
if (Field = nil) or (Field = FField) then
begin
if Assigned(FOnDataChange) then FOnDataChange(Self);
FModified := False;
end;
end;
procedure TRyuFieldDataLink.LayoutChanged;
begin
UpdateField;
end;
procedure TRyuFieldDataLink.UpdateData;
begin
if FModified then
begin
if (Field <> nil) and Assigned(FOnUpdateData) then FOnUpdateData(Self);
FModified := False;
end;
end;
{ TRyuDBEdit }
constructor TRyuDBEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited ReadOnly := True;
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TRyuFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
end;
destructor TRyuDBEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FCanvas.Free;
inherited Destroy;
end;
procedure TRyuDBEdit.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TRyuDBEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TRyuDBEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
FDataLink.Edit;
end;
procedure TRyuDBEdit.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
not FDataLink.Field.IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
case Key of
^H, ^V, ^X, #32..#255:
FDataLink.Edit;
#27:
begin
FDataLink.Reset;
SelectAll;
Key := #0;
end;
end;
end;
function TRyuDBEdit.EditCanModify: Boolean;
begin
Result := FDataLink.Edit;
end;
procedure TRyuDBEdit.Reset;
begin
FDataLink.Reset;
SelectAll;
end;
procedure TRyuDBEdit.SetFocused(Value: Boolean);
begin
if FFocused <> Value then
begin
FFocused := Value;
if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
FDataLink.Reset;
end;
end;
procedure TRyuDBEdit.Change;
begin
FDataLink.Modified;
inherited Change;
end;
function TRyuDBEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TRyuDBEdit.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
function TRyuDBEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TRyuDBEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TRyuDBEdit.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TRyuDBEdit.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TRyuDBEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TRyuDBEdit.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if FAlignment <> FDataLink.Field.Alignment then
begin
EditText := ''; {forces update}
FAlignment := FDataLink.Field.Alignment;
end;
EditMask := FDataLink.Field.EditMask;
if FFocused and FDataLink.CanModify then
Text := FDataLink.Field.Text
else
begin
EditText := FDataLink.Field.DisplayText;
if FDataLink.Editing and FDataLink.FModified then
Modified := True;
end;
end else
begin
FAlignment := taLeftJustify;
EditMask := '';
if csDesigning in ComponentState then
EditText := Name else
EditText := '';
end;
end;
procedure TRyuDBEdit.EditingChange(Sender: TObject);
begin
inherited ReadOnly := not FDataLink.Editing;
end;
procedure TRyuDBEdit.UpdateData(Sender: TObject);
begin
ValidateEdit;
FDataLink.Field.Text := Text;
end;
procedure TRyuDBEdit.WMPaste(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TRyuDBEdit.WMCut(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TRyuDBEdit.CMEnter(var Message: TCMEnter);
begin
SetFocused(True);
inherited;
if SysLocale.FarEast and FDataLink.CanModify then
inherited ReadOnly := False;
end;
procedure TRyuDBEdit.CMExit(var Message: TCMExit);
begin
// 옮겨진 위치
DoExit;
try
FDataLink.UpdateRecord;
except
SelectAll;
SetFocus;
raise;
end;
SetFocused(False);
CheckCursor;
// 원래의 위치
// DoExit;
end;
procedure TRyuDBEdit.WMPaint(var Message: TWMPaint);
var
Left: Integer;
Margins: TPoint;
R: TRect;
DC: HDC;
PS: TPaintStruct;
S: string;
begin
if ((FAlignment = taLeftJustify) or FFocused) and
not (csPaintCopy in ControlState) then
begin
inherited;
Exit;
end;
{ Since edit controls do not handle justification unless multi-line (and
then only poorly) we will draw right and center justify manually unless
the edit has the focus. }
if FCanvas = nil then
begin
FCanvas := TControlCanvas.Create;
FCanvas.Control := Self;
end;
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
FCanvas.Handle := DC;
try
FCanvas.Font := Font;
with FCanvas do
begin
R := ClientRect;
if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
begin
Brush.Color := clWindowFrame;
FrameRect(R);
InflateRect(R, -1, -1);
end;
Brush.Color := Color;
if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then
begin
S := FDataLink.Field.DisplayText;
case CharCase of
ecUpperCase: S := AnsiUpperCase(S);
ecLowerCase: S := AnsiLowerCase(S);
end;
end else
S := EditText;
if PasswordChar <> #0 then FillChar(S[1], Length(S), PasswordChar);
Margins := GetTextMargins;
case FAlignment of
taLeftJustify: Left := Margins.X;
taRightJustify: Left := ClientWidth - TextWidth(S) - Margins.X - 1;
else
Left := (ClientWidth - TextWidth(S)) div 2;
end;
TextRect(R, Left, Margins.Y, S);
end;
finally
FCanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end;
procedure TRyuDBEdit.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
function TRyuDBEdit.GetTextMargins: TPoint;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
if NewStyleControls then
begin
if BorderStyle = bsNone then I := 0 else
if Ctl3D then I := 1 else I := 2;
Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
Result.Y := I;
end else
begin
if BorderStyle = bsNone then I := 0 else
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4;
end;
Result.X := I;
Result.Y := I;
end;
end;
end.
|