jahlxx Posted July 27, 2016 Share Posted July 27, 2016 Hi. In my vcl apps, I use a component named TXDateEdit. The code is below. Is very useful for me, and I'd like to use it in my unigui apps. Can anyone help me to convert it to a new unigui component? Thanks in advance. This is the code: unit DateEdit;interfaceuses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls, Graphics;type TCheckDateEvent = function(Sender: TObject; Date: TDateTime): boolean of object; TXDateEdit = class(TCustomEdit) private FLastValidDate: TDateTime; FUseOSDateFormat: boolean; FDateFormat: string; fEpoch: integer; FBlankDate: string; FColorOK, FColorInvalid: TColor; fZeroDateIsValid: boolean; fChangingColorOnly: boolean; FDoCheckDate: TCheckDateEvent; FDoInvalidDate: TNotifyEvent; procedure SetUseOSDateFormat(value: boolean); function GetDisplayedDate(out dt: TDateTime): boolean; procedure AdjustWidth; procedure ReformatText; function GetDateFormat: string; procedure SetDateFormat(const value: string); function GetDate: TDateTime; procedure SetDate(NewDate: TDateTime); procedure SetEpoch(value: integer); procedure CMExit(var Message: TCMExit); message CM_EXIT; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; protected function DoCheckDate(Date: TDatetime): boolean; virtual; procedure CreateWnd; override; procedure KeyPress(var Key: Char); override; procedure Change; override; public function IsValidDate: boolean; constructor Create(AOwner: TComponent); override; property Date: TDateTime read GetDate write SetDate; procedure Clear; override; property Epoch: integer read fEpoch write SetEpoch; //see history 190503 published property AutoSelect; property AutoSize; property BorderStyle; property Color; property ColorTextErr: TColor read fColorInvalid write fColorInvalid; property ColorTextOK: TColor read fColorOK write fColorOK; property Ctl3D; //DateFormat: can only be assigned when UseOSDateFormat property = false property DateFormat: string read GetDateFormat write SetDateFormat; property Enabled; property Font; property HideSelection; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder;// property Text: string read GetText write SetText; property UseOSDateFormat: boolean read FUseOSDateFormat write SetUseOSDateFormat; property Visible; property ZeroDateIsValid: boolean read fZeroDateIsValid write fZeroDateIsValid; //OnCheckDate: optional event to facilitate restricting the date range(s) property OnCheckDate: TCheckDateEvent read FDoCheckDate write FDoCheckDate; //see history 310503 //OnInvalidDate: optional event to customize invalid date notification property OnInvalidDate: TNotifyEvent read FDoInvalidDate write FDoInvalidDate; property OnChange; property OnClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; end;procedure Register;implementationresourcestring s_invalid_date = 'Invalid Date: '; s_invalid_integer = 'Invalid Integer';//------------------------------------------------------------------------------// Miscellaneous functions ...//------------------------------------------------------------------------------procedure Register;begin RegisterComponents('Samples', [TXDateEdit]);end;//------------------------------------------------------------------------------function strToWord(const str: string; startPos, len: integer): word;var i: integer;begin if (length(str) < startPos + len -1) or (len < 1) or (startPos < 1) then raise Exception.Create(s_invalid_integer); result := 0; for i := 1 to len do begin if not (str[startPos] in ['0'..'9']) then raise Exception.Create(s_invalid_integer); result := (result*10) + ord(str[startPos]) - ord('0'); inc(startPos); end;end;//------------------------------------------------------------------------------{$IFDEF VER100}//Unfortunatley, in Delphi3, the DoEncodeDate() function only has unit scope.function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;var I: Integer; DayTable: PDayTable;begin Result := False; DayTable := @MonthDays[isLeapYear(Year)]; if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and (Day >= 1) and (Day <= DayTable^[Month]) then begin for I := 1 to Month - 1 do Inc(Day, DayTable^); I := Year - 1; Date := I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta; Result := True; end;end;{$ENDIF}//------------------------------------------------------------------------------// TXDateEdit methods ...//------------------------------------------------------------------------------constructor TXDateEdit.Create(AOwner: TComponent);var yy,mm,dd: word;begin inherited Create(AOwner); fZeroDateIsValid := true; //FColorInvalid := clRed; FColorInvalid := clBlack; FColorOK := clBlack; DecodeDate(sysUtils.Date,yy,mm,dd); //Epoch is only read when dates are entered without a specified century. //eg if Epoch = 1920 then entering the date 1/1/20 will be rendered to //01/01/1920 and the date 1/1/19 will be rendered to 01/01/2019. fEpoch := round(yy /10)*10 - 80; SetDateFormat(formatsettings.ShortDateFormat); FUseOSDateFormat := true;// SetDate(sysUtils.date);end;//------------------------------------------------------------------------------procedure TXDateEdit.SetEpoch(value: integer);begin if (value < 1900) or (value > 2100) then exit; fEpoch := value;end;//------------------------------------------------------------------------------procedure TXDateEdit.Clear;begin //simply restore the last valid date ReformatText;end;//------------------------------------------------------------------------------function TXDateEdit.GetDateFormat: string;begin if FUseOSDateFormat then result := '' else result := FDateFormat;end;//------------------------------------------------------------------------------procedure TXDateEdit.SetDateFormat(const value: string);var ch: char;begin //if UseOSDateFormat = true then don't allow resetting of fDateFormat ... if not (csLoading in ComponentState) and FUseOSDateFormat then exit; if value = '' then ch := 'Y' else ch := upcase(value[1]); case ch of 'D': FDateFormat := 'dd/mm/yyyy'; 'M': FDateFormat := 'mm/dd/yyyy'; else FDateFormat := 'yyyy/mm/dd'; end; if FDateFormat[1] = 'y' then FBlankDate := format('0000%s00%0:s00',[formatsettings.dateSeparator]) else FBlankDate := format('00%s00%0:s0000',[formatsettings.dateSeparator]); ReformatText; AdjustWidth;end;//------------------------------------------------------------------------------procedure TXDateEdit.ReformatText;var dd,mm,yy: word;begin if (FLastValidDate = 0) then begin if (Owner is TCustomForm) and (TCustomForm(Owner).ActiveControl = self) then inherited text := FBlankDate else inherited text := ''; end else begin DecodeDate(FLastValidDate,yy,mm,dd); case FDateFormat[1] of 'd': inherited Text := Format('%2.2d%s%2.2d%1:s%3:4.4d',[dd,formatsettings.DateSeparator,mm,yy]); 'm': inherited Text := Format('%2.2d%s%2.2d%1:s%3:4.4d',[mm,formatsettings.DateSeparator,dd,yy]); else inherited Text := Format('%4.4d%s%2.2d%1:s%3:2.2d',[yy,formatsettings.DateSeparator,mm,dd]); end; end;end;//------------------------------------------------------------------------------//------------------------------------------------------------------------------function TXDateEdit.GetDisplayedDate(out dt: TDateTime): boolean;var dd,mm,yy: word; i, len: integer; hasCentury: boolean; tmpSep1, tmpSep2: integer;begin result := false; len := length(text); if (len = 0) then begin result := fZeroDateIsValid; dt := 0; exit; end; if len > 10 then exit; tmpSep1 := 0; tmpSep2 := 0; //validate the position of the date separators, if any, and //make sure only date separators and numerics are entered ... for i := 1 to len do if text = formatsettings.dateSeparator then begin if i = 1 then exit else if tmpSep1 = 0 then tmpSep1 := i else if (i = tmpSep1+1) or (tmpSep2 > 0) then exit else tmpSep2 := i; end else if not (text in ['0'..'9']) then exit; //check for other error conditions ... if ((tmpSep1 = 0) and not (len in [6,8])) or ((tmpSep1 > 0) and (tmpSep2 = 0)) or ((tmpSep1 > 0) and (tmpSep2 - tmpSep1 > 3)) or (tmpSep2 = len) then exit; hasCentury := ((tmpSep1 = 0) and (len = 8)) or //ddmmyyyy ((tmpSep1 = 5) and (FDateFormat[1] = 'y')) or //yyyy/mm/dd ((FDateFormat[1] <> 'y') and (tmpSep2 = len-4)); //dd/mm/yyyy try case FDateFormat[1] of 'y': if (tmpSep1 > 0) then begin if tmpSep1 = 4 then exit; //must be either y, yy or yyyy yy := strToWord(text,1,tmpSep1-1); mm := strToWord(text,tmpSep1+1,tmpSep2-tmpSep1-1); dd := strToWord(text,tmpSep2+1,len-tmpSep2); end else begin if hasCentury then i := 3 else i := 5; yy := strToWord(text,1,i-1); mm := strToWord(text,i,2); dd := strToWord(text,i+2,2); end; 'd': if (tmpSep1 > 0) then begin if tmpSep2 = len - 3 then exit; //must be either y, yy or yyyy dd := strToWord(text,1,tmpSep1-1); mm := strToWord(text,tmpSep1+1,tmpSep2-tmpSep1-1); yy := strToWord(text,tmpSep2+1,len-tmpSep2); end else begin dd := strToWord(text,1,2); mm := strToWord(text,3,2); yy := strToWord(text,5,len-4); end; else if (tmpSep1 > 0) then begin if tmpSep2 = len - 3 then exit; //must be either y, yy or yyyy mm := strToWord(text,1,tmpSep1-1); dd := strToWord(text,tmpSep1+1,tmpSep2-tmpSep1-1); yy := strToWord(text,tmpSep2+1,len-tmpSep2); end else begin mm := strToWord(text,1,2); dd := strToWord(text,3,2); yy := strToWord(text,5,len-4); end; end; if yy + mm + dd = 0 then begin result := fZeroDateIsValid; dt := 0; exit; end; if not hasCentury then begin if yy >= fEpoch mod 100 then inc(yy, (fEpoch div 100)*100) else inc(yy, (fEpoch div 100)*100 +100); end;// if yy=0 then yy := 2016; result := TryEncodeDate(yy,mm,dd,dt) and DoCheckDate(dt); except result := false; end;end;//------------------------------------------------------------------------------function TXDateEdit.IsValidDate: boolean;var tmpDt: TDateTime;begin Result := GetDisplayedDate(tmpDt);end;//------------------------------------------------------------------------------procedure TXDateEdit.SetUseOSDateFormat(value: boolean);begin if value = fUseOSDateFormat then exit; if value or (csDesigning in ComponentState) then begin fUseOSDateFormat := false; //otherwise SetDateFormat() wont do its stuff SetDateFormat(formatsettings.ShortDateFormat); end; fUseOSDateFormat := value;end;//------------------------------------------------------------------------------function TXDateEdit.GetDate: TDateTime;begin //nb: No error will be raised when reading the Date property if the displayed //date is invalid as the the date prior to editing will be returned. (Invalid //displayed dates are only possible while editing - ie while focused.) //The IsValidDate public method can be used to evaluate the 'displayed' date. if not GetDisplayedDate(result) then result := FLastValidDate;end;//------------------------------------------------------------------------------procedure TXDateEdit.SetDate(NewDate: TDateTime);begin if (NewDate = 0) and not fZeroDateIsValid then raise Exception.Create(s_invalid_date + FBlankDate) else if not DoCheckDate(NewDate) then raise Exception.Create(s_invalid_date + FormatDatetime(FDateFormat,NewDate)); FLastValidDate := NewDate; ReformatText;end;//------------------------------------------------------------------------------procedure TXDateEdit.CMExit(var Message: TCMExit);var dudStr: string; tmpDt: TDateTime; xxd, xxm, xxy: word;begin if length(text) = 4 then begin // se mete dia y mes DecodeDate(now, xxy, xxm, xxd); text:= text+inttostr(xxy); end; if (length(text) = 5) and (copy(text,3,1) = '/') then begin // se mete dia y mes DecodeDate(now, xxy, xxm, xxd); text:= text+'/'+inttostr(xxy); end; if GetDisplayedDate(tmpDt) then begin FLastValidDate := tmpDt; ReformatText; inherited; end else if assigned(FDoInvalidDate) then //either perform the custom error handling if it's assigned FDoInvalidDate(self) else begin //otherwise refocus the control and show the default error message dudStr := text; SetFocus; //redisplays the last valid date via CMEnter() method Font.Color := FColorOK; raise Exception.create(format('%s"%s"',[s_invalid_date,dudStr])); end;end;//------------------------------------------------------------------------------procedure TXDateEdit.CreateWnd;begin inherited CreateWnd; AdjustWidth;end;//------------------------------------------------------------------------------procedure TXDateEdit.CMFontChanged(var Message: TMessage);begin if not fChangingColorOnly then AdjustWidth; inherited;end;//------------------------------------------------------------------------------procedure TXDateEdit.AdjustWidth;var DC: HDC; SaveFont: HFont; Size: TSize;begin if not handleAllocated then exit; //adjust XDateEdit width... DC := GetDC(handle); try SaveFont := SelectObject(DC, Font.Handle); if gettextextentpoint32(DC,pchar(FBlankDate+'0'), length(FBlankDate)+1,Size) then clientwidth := Size.cx; SelectObject(DC, SaveFont); finally ReleaseDC(handle, DC); end;end;//------------------------------------------------------------------------------procedure TXDateEdit.KeyPress(var Key: Char);var tmpSelstart: integer;begin inherited KeyPress(Key); if key = #13 then begin date := now; key := #0; end; if key = #27 then begin //[ESC] reverts date to last valid date ReformatText; SelectAll; key := #0; end; if key < #32 then exit; //don't block these (eg ^C, ^V, ^X) if (key in ['+','-']) and not (FLastValidDate = 0) and IsValidDate then begin //allow + and - to increment and decrement the date respectively ... if (key = '+') and DoCheckDate(FLastValidDate +1) then Date := FLastValidDate +1 else if (key = '-') and DoCheckDate(FLastValidDate -1) then Date := FLastValidDate -1; Key := #0; SelectAll; end else if not (Key in [formatsettings.dateSeparator, '0'..'9']) then begin //reject invalid keys ... Key := #0; beep; end else if (sellength = 0) and (length(text) > 9) then begin //if the date string is too long the trash trailing chars ... tmpSelstart := selstart; inherited text := copy(text,1,selstart); selstart := tmpSelstart; //repositions caret for char entry end;end;//------------------------------------------------------------------------------procedure TXDateEdit.Change;begin inherited; if not handleallocated then exit; //see history 260503 fChangingColorOnly := true; try if not IsValidDate then Font.Color := FColorInvalid else Font.Color := FColorOK; finally fChangingColorOnly := false; end;end;//------------------------------------------------------------------------------function TXDateEdit.DoCheckDate(Date: TDatetime): boolean;begin if assigned(FDoCheckDate) then Result := FDoCheckDate(self, Date) else Result := true;end;//------------------------------------------------------------------------------end. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.