paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 08:20:19 +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); EInvalidDate = class(Exception);
TCalendar = class(TCustomControl) TCalendar = class(TWinControl)
private private
FDate : String; FDate : String;
FDisplaySettings : TDisplaySettings; FDisplaySettings : TDisplaySettings;
@ -78,7 +78,7 @@ Type
procedure InitializeWnd; override; procedure InitializeWnd; override;
procedure AddControl; override; procedure AddControl; override;
published published
Property Date : String read GetDate write SetDate; Property Date: String read GetDate write SetDate;
property DisplaySettings : TDisplaySettings read GetDisplaySettings write SetDisplaySettings; property DisplaySettings : TDisplaySettings read GetDisplaySettings write SetDisplaySettings;
property ReadOnly : Boolean read FReadOnly write SetReadOnly stored ReadOnlyIsStored; property ReadOnly : Boolean read FReadOnly write SetReadOnly stored ReadOnlyIsStored;
property Visible; property Visible;
@ -143,8 +143,12 @@ end;
procedure TCalendar.SetDate(const AValue: String); procedure TCalendar.SetDate(const AValue: String);
begin begin
if FDate=AValue then exit;
try 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; FDate := AValue;
except except
raise EInvalidDate.CreateFmt(rsInvalidDate, [AValue]); raise EInvalidDate.CreateFmt(rsInvalidDate, [AValue]);
@ -182,7 +186,7 @@ Procedure TCalendar.GetProps;
var var
Temp : TLMCalendar; Temp : TLMCalendar;
begin begin
if HandleAllocated then if HandleAllocated and (not (csLoading in ComponentState)) then
begin begin
CNSendMessage(LM_GETVALUE, Self, @temp); // Get the info CNSendMessage(LM_GETVALUE, Self, @temp); // Get the info
FDate := FormatDateTime(ShortDateFormat,Temp.Date); FDate := FormatDateTime(ShortDateFormat,Temp.Date);

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

@ -7895,6 +7895,7 @@ var
Adjustment: PGtkAdjustment; Adjustment: PGtkAdjustment;
Scroll : PGTKWidget; Scroll : PGTKWidget;
NewPolicy: Integer; NewPolicy: Integer;
i: Integer;
begin begin
Result := 0; Result := 0;
if (Handle = 0) then exit; if (Handle = 0) then exit;
@ -7940,7 +7941,18 @@ begin
with ScrollInfo, Adjustment^ do begin with ScrollInfo, Adjustment^ do begin
//writeln('SetScrollInfo Value=',Value); //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); //writeln('SetScrollInfo Result=',Result);
if (fMask and SIF_POS) <> 0 if (fMask and SIF_POS) <> 0
then Value := nPos; then Value := nPos;
@ -9214,6 +9226,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.316 2004/01/13 10:41:40 mattias
fixed statusbar updating all panels fixed statusbar updating all panels