paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 07:42:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

workaround for fpc fpu bug and added calendar debugging msg

Browse Source 
git-svn-id: trunk@5067 -
This commit is contained in:
mattias 2004-01-15 22:36:24 +00:00
parent 4a731be2a3
commit 0b706a8afe
2 changed files with 24 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lcl/calendar.pp
View File

@ -50,7 +50,7 @@ Type
EInvalidDate = class(Exception);
TCalendar = class(TCustomControl)
TCalendar = class(TWinControl)
private
FDate : String;
FDisplaySettings : TDisplaySettings;
@ -78,7 +78,7 @@ Type
procedure InitializeWnd; override;
procedure AddControl; override;
published
Property Date : String read GetDate write SetDate;
Property Date: String read GetDate write SetDate;
property DisplaySettings : TDisplaySettings read GetDisplaySettings write SetDisplaySettings;
property ReadOnly : Boolean read FReadOnly write SetReadOnly stored ReadOnlyIsStored;
property Visible;
@ -143,8 +143,12 @@ end;
procedure TCalendar.SetDate(const AValue: String);
begin
if FDate=AValue then exit;
try
StrtoDate(AValue); //test to see if valid date....
{$IFDEF VerboseCalenderSetDate}
writeln('TCalendar.SetDate AValue=',AValue,' ShortDateFormat=',ShortDateFormat);
{$ENDIF}
StrToDate(AValue); //test to see if date valid ....
FDate := AValue;
except
raise EInvalidDate.CreateFmt(rsInvalidDate, [AValue]);
@ -182,7 +186,7 @@ Procedure TCalendar.GetProps;
var
Temp : TLMCalendar;
begin
if HandleAllocated then
if HandleAllocated and (not (csLoading in ComponentState)) then
begin
CNSendMessage(LM_GETVALUE, Self, @temp); // Get the info
FDate := FormatDateTime(ShortDateFormat,Temp.Date);

17
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -7895,6 +7895,7 @@ var
Adjustment: PGtkAdjustment;
Scroll : PGTKWidget;
NewPolicy: Integer;
i: Integer;
begin
Result := 0;
if (Handle = 0) then exit;
@ -7940,7 +7941,18 @@ begin
with ScrollInfo, Adjustment^ do begin
//writeln('SetScrollInfo Value=',Value);
Result := RoundToInt(Value);
// workaround for strange floating point bug
for i:=0 to 2 do begin
try
Result := RoundToInt(Value);
break;
except
on e: Exception do begin
writeln('TgtkObject.SetScrollInfo Workaround for ',E.Message,' try: ',i);
Result:=0;
end;
end;
end;
//writeln('SetScrollInfo Result=',Result);
if (fMask and SIF_POS) <> 0
then Value := nPos;
@ -9214,6 +9226,9 @@ end;
{ =============================================================================
$Log$
Revision 1.317 2004/01/15 22:36:24 mattias
workaround for fpc fpu bug and added calendar debugging msg
Revision 1.316 2004/01/13 10:41:40 mattias
fixed statusbar updating all panels