fixed exception during loading of TCalendar with different date format

git-svn-id: trunk@9357 -
This commit is contained in:
mattias 2006-05-26 14:50:32 +00:00
parent d85c27e3b9
commit d5f0c65a98
5 changed files with 41 additions and 14 deletions

View File

@ -191,7 +191,10 @@ begin
FDateAsString := AValue;
FDate := NewDate;
except
raise EInvalidDate.CreateFmt(rsInvalidDate, [AValue]);
if not (csLoading in ComponentState) then
raise EInvalidDate.CreateFmt(rsInvalidDate, [AValue])
else
exit;
end;
SetProps;
end;

View File

@ -300,7 +300,6 @@ type
FDialogTitle: TCaption;
FDisplaySettings: TDisplaySettings;
FOnAcceptDate: TAcceptDateEvent;
FOKCaption: TCaption;
FCancelCaption: TCaption;
FDate: TDateTime;
@ -1002,4 +1001,4 @@ Initialization
Finalization
end.
end.

View File

@ -1,10 +1,4 @@
object CalendarPopupForm: TCalendarPopupForm
Left = 635
Height = 153
Top = 259
Width = 162
HorzScrollBar.Page = 161
VertScrollBar.Page = 152
ActiveControl = Calendar
AutoSize = True
BorderIcons = [biMinimize, biMaximize]
@ -12,13 +6,21 @@ object CalendarPopupForm: TCalendarPopupForm
Caption = 'CalendarPopupForm'
OnClose = FormClose
OnDeactivate = FormDeactivate
PixelsPerInch = 112
HorzScrollBar.Page = 161
VertScrollBar.Page = 152
Left = 635
Height = 153
Top = 259
Width = 162
object Calendar: TCalendar
Height = 153
Width = 162
Date = '16-4-06'
DateTime = 38823
DisplaySettings = [dsShowHeadings, dsShowDayNames]
OnDblClick = CalendarDblClick
OnKeyDown = CalendarKeyDown
Tabstop = True
Height = 153
Width = 162
end
end

View File

@ -26,8 +26,8 @@ unit CalendarPopup;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Calendar,
LCLType;
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
Calendar, LCLType;
type
TReturnDateEvent = procedure (Sender: TObject;const Date: TDateTime) of object;

View File

@ -176,7 +176,8 @@ function StackTraceAsString(const AStack: TStackTracePointers;
UseCache: boolean): string;
function GetLineInfo(Addr: Pointer; UseCache: boolean): string;
procedure DebugLn(const S: String; Args: array of const);
procedure DebugLn(Args: array of const);
procedure DebugLn(const S: String; Args: array of const);// similar to Format(s,Args)
procedure DebugLn;
procedure DebugLn(const s: string);
procedure DebugLn(const s1,s2: string);
@ -1145,6 +1146,28 @@ begin
end;
end;
procedure DebugLn(Args: array of const);
var
i: Integer;
begin
for i:=Low(Args) to High(Args) do begin
case Args[i].VType of
vtInteger: DbgOut(dbgs(Args[i].vinteger));
vtBoolean: DbgOut(dbgs(Args[i].vboolean));
vtExtended: DbgOut(dbgs(Args[i].VExtended^));
vtCurrency: DbgOut(dbgs(Args[i].vcurrency));
vtString: DbgOut(Args[i].VString^);
vtAnsiString: DbgOut(AnsiString(Args[i].VAnsiString));
vtChar: DbgOut(Args[i].VChar);
vtPChar: DbgOut(Args[i].VPChar);
vtPWideChar: DbgOut(Args[i].VPWideChar);
vtWideChar: DbgOut(Args[i].VWideChar);
vtWidestring: DbgOut(WideString(Args[i].VWideString));
end;
end;
DebugLn;
end;
procedure DebugLn(const S: String; Args: array of const);
begin
DebugLn(Format(S, Args));