pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

CalLite: Fix compilation with FPC 3.3.1. This is a code-breaking change in applications which rely on TDayOfWeek beginning at 1. Issue #39048.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8656 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-12-18 18:52:00 +00:00
parent 71c3888fd4
commit fe385f8a66
6 changed files with 58 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/callite/demo1/main.lfm
View File

@ -9,5 +9,5 @@ object Form1: TForm1
KeyPreview = True KeyPreview = True
OnCreate = FormCreate OnCreate = FormCreate
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.7' LCLVersion = '2.3.0.0'
end end

3
components/callite/demo1/main.pas
View File

@ -42,7 +42,8 @@ begin
Height := self.Height - 2*Top; Height := self.Height - 2*Top;
Date := Now(); Date := Now();
DisplayTexts := '"Today is",dd/mm/yyyy,"Holidays during","There are no holidays set for"'; DisplayTexts := '"Today is",dd/mm/yyyy,"Holidays during","There are no holidays set for"';
WeekendDays := [dowSaturday]; WeekendDays := [dowSaturday, dowSunday];
StartingDayOfWeek := dowMonday;
Anchors := [akLeft, akTop, akRight, akBottom]; Anchors := [akLeft, akTop, akRight, akBottom];
end; end;
end; end;

47
components/callite/demo2/umaintestcallite.lfm
View File

@ -9,7 +9,7 @@ object Form1: TForm1
Color = clWindow Color = clWindow
Font.CharSet = ANSI_CHARSET Font.CharSet = ANSI_CHARSET
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '2.1.0.0' LCLVersion = '2.3.0.0'
object PSettings: TPanel object PSettings: TPanel
Left = 0 Left = 0
Height = 432 Height = 432
@ -61,7 +61,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 112 Top = 112
Width = 169 Width = 167
Caption = 'Ignore OnGetHolidays event' Caption = 'Ignore OnGetHolidays event'
OnChange = cbUseHolidaysChange OnChange = cbUseHolidaysChange
TabOrder = 1 TabOrder = 1
@ -72,6 +72,7 @@ object Form1: TForm1
Top = 8 Top = 8
Width = 318 Width = 318
Caption = 'Various calendar property settings can be changed below:' Caption = 'Various calendar property settings can be changed below:'
Color = clDefault
Font.CharSet = ANSI_CHARSET Font.CharSet = ANSI_CHARSET
Font.Style = [fsBold] Font.Style = [fsBold]
ParentColor = False ParentColor = False
@ -83,6 +84,7 @@ object Form1: TForm1
Top = 52 Top = 52
Width = 32 Width = 32
Caption = 'Width' Caption = 'Width'
Color = clDefault
ParentColor = False ParentColor = False
end end
object seWidth: TSpinEdit object seWidth: TSpinEdit
@ -113,6 +115,7 @@ object Form1: TForm1
Top = 81 Top = 81
Width = 36 Width = 36
Caption = 'Height' Caption = 'Height'
Color = clDefault
ParentColor = False ParentColor = False
end end
object rgLanguage: TRadioGroup object rgLanguage: TRadioGroup
@ -208,6 +211,7 @@ object Form1: TForm1
Top = 13 Top = 13
Width = 67 Width = 67
Caption = 'ArrowBorder' Caption = 'ArrowBorder'
Color = clDefault
ParentColor = False ParentColor = False
end end
object Label3: TLabel object Label3: TLabel
@ -216,6 +220,7 @@ object Form1: TForm1
Top = 37 Top = 37
Width = 32 Width = 32
Caption = 'Arrow' Caption = 'Arrow'
Color = clDefault
ParentColor = False ParentColor = False
end end
object CbBackground: TColorButton object CbBackground: TColorButton
@ -246,6 +251,7 @@ object Form1: TForm1
Top = 61 Top = 61
Width = 64 Width = 64
Caption = 'Background' Caption = 'Background'
Color = clDefault
ParentColor = False ParentColor = False
end end
object Label5: TLabel object Label5: TLabel
@ -254,6 +260,7 @@ object Form1: TForm1
Top = 85 Top = 85
Width = 35 Width = 35
Caption = 'Border' Caption = 'Border'
Color = clDefault
ParentColor = False ParentColor = False
end end
object CbDayLine: TColorButton object CbDayLine: TColorButton
@ -284,6 +291,7 @@ object Form1: TForm1
Top = 109 Top = 109
Width = 42 Width = 42
Caption = 'Day line' Caption = 'Day line'
Color = clDefault
ParentColor = False ParentColor = False
end end
object Label7: TLabel object Label7: TLabel
@ -292,6 +300,7 @@ object Form1: TForm1
Top = 133 Top = 133
Width = 46 Width = 46
Caption = 'Holidays' Caption = 'Holidays'
Color = clDefault
ParentColor = False ParentColor = False
end end
object CbPastMonth: TColorButton object CbPastMonth: TColorButton
@ -322,6 +331,7 @@ object Form1: TForm1
Top = 157 Top = 157
Width = 89 Width = 89
Caption = 'Past/next month' Caption = 'Past/next month'
Color = clDefault
ParentColor = False ParentColor = False
end end
object Label9: TLabel object Label9: TLabel
@ -330,6 +340,7 @@ object Form1: TForm1
Top = 181 Top = 181
Width = 70 Width = 70
Caption = 'Selected date' Caption = 'Selected date'
Color = clDefault
ParentColor = False ParentColor = False
end end
object CbText: TColorButton object CbText: TColorButton
@ -360,6 +371,7 @@ object Form1: TForm1
Top = 205 Top = 205
Width = 21 Width = 21
Caption = 'Text' Caption = 'Text'
Color = clDefault
ParentColor = False ParentColor = False
end end
object Label11: TLabel object Label11: TLabel
@ -368,6 +380,7 @@ object Form1: TForm1
Top = 229 Top = 229
Width = 65 Width = 65
Caption = 'Today frame' Caption = 'Today frame'
Color = clDefault
ParentColor = False ParentColor = False
end end
object CbTopRow: TColorButton object CbTopRow: TColorButton
@ -398,6 +411,7 @@ object Form1: TForm1
Top = 253 Top = 253
Width = 42 Width = 42
Caption = 'Top row' Caption = 'Top row'
Color = clDefault
ParentColor = False ParentColor = False
end end
object Label13: TLabel object Label13: TLabel
@ -406,6 +420,7 @@ object Form1: TForm1
Top = 277 Top = 277
Width = 65 Width = 65
Caption = 'Top row text' Caption = 'Top row text'
Color = clDefault
ParentColor = False ParentColor = False
end end
object CbWeekend: TColorButton object CbWeekend: TColorButton
@ -425,6 +440,7 @@ object Form1: TForm1
Top = 301 Top = 301
Width = 49 Width = 49
Caption = 'Weekend' Caption = 'Weekend'
Color = clDefault
ParentColor = False ParentColor = False
end end
end end
@ -432,7 +448,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 184 Top = 184
Width = 144 Width = 142
Caption = 'Override font of 1st day' Caption = 'Override font of 1st day'
OnChange = CbPrepareCanvasChange OnChange = CbPrepareCanvasChange
TabOrder = 7 TabOrder = 7
@ -450,7 +466,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 208 Top = 208
Width = 161 Width = 159
Caption = 'Owner draw (icon, Nov 11)' Caption = 'Owner draw (icon, Nov 11)'
OnChange = CbDrawCellChange OnChange = CbDrawCellChange
TabOrder = 9 TabOrder = 9
@ -459,7 +475,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 136 Top = 136
Width = 152 Width = 150
Caption = 'Add holiday name to cell' Caption = 'Add holiday name to cell'
OnChange = CbAddHolidayNameToCellChange OnChange = CbAddHolidayNameToCellChange
TabOrder = 10 TabOrder = 10
@ -468,7 +484,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 232 Top = 232
Width = 92 Width = 90
Caption = 'CbShowHints' Caption = 'CbShowHints'
Checked = True Checked = True
OnChange = CbShowHintsChange OnChange = CbShowHintsChange
@ -479,7 +495,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 256 Top = 256
Width = 81 Width = 79
Caption = 'Multi select' Caption = 'Multi select'
OnChange = CbMultiSelectChange OnChange = CbMultiSelectChange
TabOrder = 12 TabOrder = 12
@ -497,7 +513,7 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 19 Height = 19
Top = 160 Top = 160
Width = 153 Width = 151
Caption = 'Use built-in popup menu' Caption = 'Use built-in popup menu'
Checked = True Checked = True
OnChange = CbUseBuiltinPopupChange OnChange = CbUseBuiltinPopupChange
@ -510,6 +526,7 @@ object Form1: TForm1
Top = 52 Top = 52
Width = 66 Width = 66
Caption = 'Buttonwidth' Caption = 'Buttonwidth'
Color = clDefault
ParentColor = False ParentColor = False
end end
object seButtonWidth: TSpinEdit object seButtonWidth: TSpinEdit
@ -528,6 +545,7 @@ object Form1: TForm1
Top = 81 Top = 81
Width = 70 Width = 70
Caption = 'Buttonheight' Caption = 'Buttonheight'
Color = clDefault
ParentColor = False ParentColor = False
end end
object seButtonHeight: TSpinEdit object seButtonHeight: TSpinEdit
@ -634,18 +652,19 @@ object Form1: TForm1
Top = 408 Top = 408
Width = 34 Width = 34
Caption = 'Label1' Caption = 'Label1'
Color = clDefault
ParentColor = False ParentColor = False
end end
end end
object FontDialog: TFontDialog object FontDialog: TFontDialog
MinFontSize = 0 MinFontSize = 0
MaxFontSize = 0 MaxFontSize = 0
left = 408 Left = 408
top = 416 Top = 416
end end
object ImageList1: TImageList object ImageList1: TImageList
left = 336 Left = 336
top = 432 Top = 432
Bitmap = { Bitmap = {
4C7A010000001000000010000000330200000000000078DA9D92DF6B526118C7 4C7A010000001000000010000000330200000000000078DA9D92DF6B526118C7
BDCAABEEFA13BC09BAE82FD85DD445D045C56E828211A3CB8C42486ACD1A04B5 BDCAABEEFA13BC09BAE82FD85DD445D045C56E828211A3CB8C42486ACD1A04B5
@ -669,8 +688,8 @@ object Form1: TForm1
} }
end end
object PopupMenu1: TPopupMenu object PopupMenu1: TPopupMenu
left = 117 Left = 117
top = 465 Top = 465
object MenuItem1: TMenuItem object MenuItem1: TMenuItem
Caption = 'Dummy item' Caption = 'Dummy item'
end end

7
components/callite/demo2/umaintestcallite.pp
View File

@ -177,7 +177,7 @@ begin
if (opt in demoCal.Options) then cgOptions.Checked[integer(opt)] := True; if (opt in demoCal.Options) then cgOptions.Checked[integer(opt)] := True;
seHeight.Value := demoCal.Height; seHeight.Value := demoCal.Height;
seWidth.Value := demoCal.Width; seWidth.Value := demoCal.Width;
rgStartingDOW.ItemIndex := integer(demoCal.StartingDayOfWeek)-1; rgStartingDOW.ItemIndex := ord(demoCal.StartingDayOfWeek);
copyCal:= TCalendarLite.Create(Self); copyCal:= TCalendarLite.Create(Self);
copyCal.Parent := Self; copyCal.Parent := Self;
@ -225,7 +225,7 @@ end;
procedure TForm1.rgStartingDOWClick(Sender: TObject); procedure TForm1.rgStartingDOWClick(Sender: TObject);
begin begin
demoCal.StartingDayOfWeek := TDayOfWeek(rgStartingDOW.ItemIndex + 1); demoCal.StartingDayOfWeek := TDayOfWeek(rgStartingDOW.ItemIndex);
end; end;
procedure TForm1.sbResetButtonHeightClick(Sender: TObject); procedure TForm1.sbResetButtonHeightClick(Sender: TObject);
@ -344,7 +344,8 @@ end;
procedure TForm1.CbPrepareCanvasChange(Sender: TObject); procedure TForm1.CbPrepareCanvasChange(Sender: TObject);
begin begin
if CbPrepareCanvas.Checked then if CbPrepareCanvas.Checked then
demoCal.OnPrepareCanvas := @PrepareCanvas else demoCal.OnPrepareCanvas := @PrepareCanvas
else
demoCal.OnPrepareCanvas := nil; demoCal.OnPrepareCanvas := nil;
demoCal.Invalidate; demoCal.Invalidate;
end; end;

4
components/callite/demo3/main.lpi
View File

@ -15,7 +15,6 @@
<XPManifest> <XPManifest>
<DpiAware Value="True"/> <DpiAware Value="True"/>
</XPManifest> </XPManifest>
<Icon Value="0"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>
@ -61,6 +60,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Linking> <Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>

30
components/callite/source/calendarlite.pas
View File

@ -61,12 +61,12 @@ type
TArrowhead = (ahSingle, ahDouble); TArrowhead = (ahSingle, ahDouble);
TArrowPoints = array[1..3] of TPoint; TArrowPoints = array[1..3] of TPoint;
TDayOfWeek = (dowSunday=1, dowMonday=2, dowTuesday=3, dowWednesday=4, TDayOfWeek = (dowSunday, dowMonday, dowTuesday, dowWednesday,
dowThursday=5, dowFriday=6, dowSaturday=7); dowThursday, dowFriday, dowSaturday);
TDaysOfWeek = set of TDayOfWeek; TDaysOfWeek = set of TDayOfWeek;
TDisplayText = (dtToday=0, dtTodayFormat=1, dtHolidaysDuring=2, TDisplayText = (dtToday, dtTodayFormat, dtHolidaysDuring,
dtNoHolidaysDuring=3, dtTodayFormatLong=4, dtCaptionFormat=5); dtNoHolidaysDuring, dtTodayFormatLong, dtCaptionFormat);
THolidays = DWord; THolidays = DWord;
TGetHolidaysEvent = procedure (Sender: TObject; AMonth, AYear: Integer; TGetHolidaysEvent = procedure (Sender: TObject; AMonth, AYear: Integer;
@ -884,7 +884,7 @@ var
continueDrawing: Boolean; continueDrawing: Boolean;
begin begin
todayDate := Date; todayDate := Date;
dow := DayOfWeek(FOwner.FDate); dow := DayOfWeek(FOwner.FDate) - 1; // DayOfWeek is 1-based, dow is 0-based !
c := dow - integer(FOwner.FStartingDayOfWeek); c := dow - integer(FOwner.FStartingDayOfWeek);
if (c < 0) then Inc(c, 7); if (c < 0) then Inc(c, 7);
startCol := Succ(c); startCol := Succ(c);
@ -931,7 +931,7 @@ begin
end else end else
{ Special case: override weekend } { Special case: override weekend }
if (coShowWeekend in FOwner.Options) and if (coShowWeekend in FOwner.Options) and
(TDayOfWeek(DayOfWeek(dt)) in FOwner.FWeekendDays) then (TDayOfWeek(DayOfWeek(dt) - 1) in FOwner.FWeekendDays) then
begin begin
FCanvas.Font.Color := FOwner.Colors.WeekendColor; FCanvas.Font.Color := FOwner.Colors.WeekendColor;
if coBoldWeekend in FOwner.Options then if coBoldWeekend in FOwner.Options then
@ -1021,11 +1021,11 @@ begin
FCanvas.Font.Style := FCanvas.Font.Style + [fsBold] FCanvas.Font.Style := FCanvas.Font.Style + [fsBold]
else else
FCanvas.Font.Style := FCanvas.Font.Style - [fsBold]; FCanvas.Font.Style := FCanvas.Font.Style - [fsBold];
map := Integer(FOwner.FStartingDayOfWeek); map := Integer(FOwner.FStartingDayOfWeek) + 1;
for c:= Low(TWeekNameArray) to High(TWeekNameArray) do for c:= Low(TWeekNameArray) to High(TWeekNameArray) do
begin begin
if (map > High(TWeekNameArray)) then map := Low(TWeekNameArray); if (map > High(TWeekNameArray)) then map := Low(TWeekNameArray);
lbls[c] := FOwner.GetDayName(TDayOfWeek(map)); lbls[c] := FOwner.GetDayName(TDayOfWeek(map - 1));
inc(map); inc(map);
end; end;
for c:= Low(FColPositions) to High(FColPositions) do for c:= Low(FColPositions) to High(FColPositions) do
@ -1069,7 +1069,7 @@ begin
s:= FOwner.GetDisplayText(dtToday); s:= FOwner.GetDisplayText(dtToday);
if pos('%s', s) = 0 then begin if pos('%s', s) = 0 then begin
if (coShowTodayName in FOwner.Options) then if (coShowTodayName in FOwner.Options) then
s := Format('%s %s',[s, FOwner.GetDayName(TDayOfWeek(DayOfWeek(Date())))]); s := Format('%s %s',[s, FOwner.GetDayName(TDayOfWeek(DayOfWeek(Date())-1))]);
AppendStr(s, ' ' + FormatDateTime(FOwner.GetDisplayText(dtTodayFormat), Date(), FOwner.FFormatSettings)); AppendStr(s, ' ' + FormatDateTime(FOwner.GetDisplayText(dtTodayFormat), Date(), FOwner.FFormatSettings));
end else begin end else begin
if coShowTodayName in FOwner.Options then if coShowTodayName in FOwner.Options then
@ -1637,7 +1637,7 @@ end;
function TCalendarLite.GetDayName(ADayOfWeek: TDayOfWeek): String; function TCalendarLite.GetDayName(ADayOfWeek: TDayOfWeek): String;
begin begin
Result := FFormatSettings.ShortDayNames[integer(ADayOfWeek)]; Result := FFormatSettings.ShortDayNames[integer(ADayOfWeek) + 1];
end; end;
function TCalendarLite.GetDayNames: String; function TCalendarLite.GetDayNames: String;
@ -2216,7 +2216,7 @@ var
d: Integer; d: Integer;
begin begin
if AValue = '' then exit; if AValue = '' then exit;
d := ord(ADayOfWeek); d := ord(ADayOfWeek) + 1; // TDayOfWeek is 0-based, FormatSettings.DayNames are 1-based.
p := pos('|', AValue); p := pos('|', AValue);
if p > 0 then begin if p > 0 then begin
FFormatSettings.LongDayNames[d] := Trim(Copy(AValue, 1, p-1)); FFormatSettings.LongDayNames[d] := Trim(Copy(AValue, 1, p-1));
@ -2230,15 +2230,15 @@ end;
procedure TCalendarLite.UseDayNames(const AValue: String); procedure TCalendarLite.UseDayNames(const AValue: String);
var var
L: TStrings; L: TStrings;
i, d: Integer; i, dow: Integer;
begin begin
L := TStringList.Create; L := TStringList.Create;
try try
L.CommaText := AValue; L.CommaText := AValue;
for i:=0 to L.Count-1 do begin for i:=0 to L.Count-1 do begin
d := succ(i); dow := i;
if d <= 7 then if dow < 7 then
UseDayName(TDayOfWeek(d), L[i]); UseDayName(TDayOfWeek(dow), L[i]);
end; end;
finally finally
L.Free; L.Free;