10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <Icon Value="0"/> 13 | </General> 14 | <i18n> 15 | <EnableI18N LFM="False"/> 16 | </i18n> 17 | <VersionInfo> 18 | <StringTable ProductVersion=""/> 19 | </VersionInfo> 20 | <MacroValues Count="1"> 21 | <Macro1 Name="LCLWidgetType" Value="win32"/> 22 | </MacroValues> 23 | <BuildModes Count="1"> 24 | <Item1 Name="Default" Default="True"/> 25 | <SharedMatrixOptions Count="1"> 26 | <Item1 ID="103262766600" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/> 27 | </SharedMatrixOptions> 28 | </BuildModes> 29 | <PublishOptions> 30 | <Version Value="2"/> 31 | </PublishOptions> 32 | <RunParams> 33 | <local> 34 | <FormatVersion Value="1"/> 35 | </local> 36 | </RunParams> 37 | <RequiredPackages Count="1"> 38 | <Item1> 39 | <PackageName Value="LCL"/> 40 | </Item1> 41 | </RequiredPackages> 42 | <Units Count="3"> 43 | <Unit0> 44 | <Filename Value="fastdatetime_test.lpr"/> 45 | <IsPartOfProject Value="True"/> 46 | </Unit0> 47 | <Unit1> 48 | <Filename Value="unit_main.pas"/> 49 | <IsPartOfProject Value="True"/> 50 | <ComponentName Value="FormTest"/> 51 | <HasResources Value="True"/> 52 | <ResourceBaseClass Value="Form"/> 53 | </Unit1> 54 | <Unit2> 55 | <Filename Value="..\Tee.FastDateTime.pas"/> 56 | <IsPartOfProject Value="True"/> 57 | </Unit2> 58 | </Units> 59 | </ProjectOptions> 60 | <CompilerOptions> 61 | <Version Value="11"/> 62 | <PathDelim Value="\"/> 63 | <Target> 64 | <Filename Value="fastdatetime_test"/> 65 | </Target> 66 | <SearchPaths> 67 | <IncludeFiles Value="$(ProjOutDir)"/> 68 | <OtherUnitFiles Value="C:\Root\GitHub_Public\FastDateTime\"/> 69 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 70 | </SearchPaths> 71 | <CodeGeneration> 72 | <Optimizations> 73 | <OptimizationLevel Value="3"/> 74 | </Optimizations> 75 | </CodeGeneration> 76 | <Linking> 77 | <Options> 78 | <Win32> 79 | <GraphicApplication Value="True"/> 80 | </Win32> 81 | </Options> 82 | </Linking> 83 | </CompilerOptions> 84 | <Debugging> 85 | <Exceptions Count="3"> 86 | <Item1> 87 | <Name Value="EAbort"/> 88 | </Item1> 89 | <Item2> 90 | <Name Value="ECodetoolError"/> 91 | </Item2> 92 | <Item3> 93 | <Name Value="EFOpenError"/> 94 | </Item3> 95 | </Exceptions> 96 | </Debugging> 97 | </CONFIG> 98 | -------------------------------------------------------------------------------- /Lazarus/fastdatetime_test.lpr: -------------------------------------------------------------------------------- 1 | program fastdatetime_test; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, unit_main; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | RequireDerivedFormResource:=True; 16 | Application.Initialize; 17 | Application.CreateForm(TFormTest, FormTest); 18 | Application.Run; 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /Lazarus/fastdatetime_test.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/davidberneda/FastDateTime/66705a763b435f00c079e72e5eb9b351ca6dfca0/Lazarus/fastdatetime_test.res -------------------------------------------------------------------------------- /Lazarus/unit_main.lfm: -------------------------------------------------------------------------------- 1 | object FormTest: TFormTest 2 | Left = 238 3 | Height = 320 4 | Top = 150 5 | Width = 365 6 | Caption = 'Tee FastDateTime Test' 7 | ClientHeight = 320 8 | ClientWidth = 365 9 | OnCreate = FormCreate 10 | LCLVersion = '1.7' 11 | Visible = False 12 | object Button1: TButton 13 | Left = 21 14 | Height = 25 15 | Top = 18 16 | Width = 75 17 | Caption = '&Test' 18 | OnClick = Button1Click 19 | TabOrder = 0 20 | end 21 | object Button2: TButton 22 | Left = 21 23 | Height = 25 24 | Top = 277 25 | Width = 75 26 | Caption = '&Verify' 27 | OnClick = Button2Click 28 | TabOrder = 1 29 | end 30 | object Memo1: TMemo 31 | Left = 24 32 | Height = 188 33 | Top = 62 34 | Width = 312 35 | TabOrder = 2 36 | end 37 | object LTest: TLabel 38 | Left = 110 39 | Height = 1 40 | Top = 284 41 | Width = 1 42 | ParentColor = False 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /Lazarus/unit_main.pas: -------------------------------------------------------------------------------- 1 | unit unit_main; 2 | 3 | //{$mode objfpc}{$H+} 4 | {$MODE Delphi} 5 | 6 | interface 7 | 8 | uses 9 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 10 | Tee.FastDateTime; 11 | 12 | type 13 | 14 | { TFormTest } 15 | 16 | TFormTest = class(TForm) 17 | Button1: TButton; 18 | Button2: TButton; 19 | LTest: TLabel; 20 | Memo1: TMemo; 21 | procedure Button1Click(Sender: TObject); 22 | procedure Button2Click(Sender: TObject); 23 | procedure FormCreate(Sender: TObject); 24 | private 25 | { private declarations } 26 | 27 | procedure TestDay(const D:TDateTime); 28 | procedure TestDayOfYear(const D:TDateTime); 29 | procedure TestMonth(const D:TDateTime); 30 | procedure TestYear(const D:TDateTime); 31 | public 32 | { public declarations } 33 | end; 34 | 35 | var 36 | FormTest: TFormTest; 37 | 38 | implementation 39 | 40 | {$R *.lfm} 41 | 42 | uses 43 | DateUtils; 44 | 45 | type 46 | 47 | { TStopWatch } 48 | 49 | TStopWatch=record 50 | private 51 | Old : Int64; 52 | public 53 | function ElapsedMilliseconds:Int64; 54 | class function StartNew:TStopWatch; static; 55 | end; 56 | 57 | { TStopWatch } 58 | 59 | function TStopWatch.ElapsedMilliseconds: Int64; 60 | begin 61 | result:=GetTickCount64-Old; 62 | end; 63 | 64 | class function TStopWatch.StartNew: TStopWatch; 65 | begin 66 | result.Old:=GetTickCount64; 67 | end; 68 | 69 | { TFormTest } 70 | 71 | function Diff(const ASlow,AFast:Int64):String; 72 | var tmp : Single; 73 | begin 74 | tmp:=100-(AFast*100/ASlow); 75 | 76 | result:='('+FormatFloat('0.##%',tmp)+' faster)'; 77 | end; 78 | 79 | const 80 | TestTimes=5000000; 81 | 82 | procedure TFormTest.TestYear(const D:TDateTime); 83 | var t1 : TStopwatch; 84 | t2,t3 : Int64; 85 | t : Integer; 86 | y : Word; 87 | begin 88 | t1:=TStopwatch.StartNew; 89 | 90 | for t:=1 to TestTimes do 91 | y:=YearOf(D); 92 | 93 | t2:=t1.ElapsedMilliseconds; 94 | 95 | Memo1.Lines.Add('YearOf: '+IntToStr(t2)+' msec '+IntToStr(y)); 96 | 97 | t1:=TStopwatch.StartNew; 98 | 99 | {$O-} 100 | for t:=1 to TestTimes do 101 | y:=TFastDateTime.YearOf(D); 102 | {$O+} 103 | 104 | t3:=t1.ElapsedMilliseconds; 105 | 106 | Memo1.Lines.Add('Fast YearOf: '+IntToStr(t3)+' msec '+IntToStr(y)+' '+Diff(t2,t3)); 107 | end; 108 | 109 | procedure TFormTest.TestMonth(const D:TDateTime); 110 | var t1 : TStopwatch; 111 | t2, t3 : Int64; 112 | t : Integer; 113 | day : Word; 114 | begin 115 | t1:=TStopwatch.StartNew; 116 | 117 | for t:=1 to TestTimes do 118 | day:=MonthOf(D); 119 | 120 | t2:=t1.ElapsedMilliseconds; 121 | 122 | Memo1.Lines.Add('MonthOf: '+IntToStr(t2)+' msec '+IntToStr(day)); 123 | 124 | t1:=TStopwatch.StartNew; 125 | 126 | for t:=1 to TestTimes do 127 | day:=TFastDateTime.MonthOf(D); 128 | 129 | t3:=t1.ElapsedMilliseconds; 130 | 131 | Memo1.Lines.Add('Fast MonthOf: '+IntToStr(t3)+' msec '+IntToStr(day)+' '+Diff(t2,t3)); 132 | end; 133 | 134 | procedure TFormTest.TestDay(const D:TDateTime); 135 | var t1 : TStopwatch; 136 | t2,t3 : Int64; 137 | t : Integer; 138 | day : Word; 139 | begin 140 | t1:=TStopwatch.StartNew; 141 | 142 | for t:=1 to TestTimes do 143 | day:=DayOf(D); 144 | 145 | t2:=t1.ElapsedMilliseconds; 146 | 147 | Memo1.Lines.Add('DayOf: '+IntToStr(t2)+' msec '+IntToStr(day)); 148 | 149 | t1:=TStopwatch.StartNew; 150 | 151 | for t:=1 to TestTimes do 152 | day:=TFastDateTime.DayOf(D); 153 | 154 | t3:=t1.ElapsedMilliseconds; 155 | 156 | Memo1.Lines.Add('Fast DayOf: '+IntToStr(t3)+' msec '+IntToStr(day)+' '+Diff(t2,t3)); 157 | end; 158 | 159 | procedure TFormTest.TestDayOfYear(const D:TDateTime); 160 | var t1 : TStopwatch; 161 | t2,t3 : Int64; 162 | t : Integer; 163 | day : Word; 164 | begin 165 | t1:=TStopwatch.StartNew; 166 | 167 | for t:=1 to TestTimes do 168 | day:=DayOfTheYear(D); 169 | 170 | t2:=t1.ElapsedMilliseconds; 171 | 172 | Memo1.Lines.Add('DayOfYear: '+IntToStr(t2)+' msec '+IntToStr(day)); 173 | 174 | t1:=TStopwatch.StartNew; 175 | 176 | for t:=1 to TestTimes do 177 | day:=TFastDateTime.DayOfTheYear(D); 178 | 179 | t3:=t1.ElapsedMilliseconds; 180 | 181 | Memo1.Lines.Add('Fast DayOfYear: '+IntToStr(t3)+' msec '+IntToStr(day)+' '+Diff(t2,t3)); 182 | end; 183 | 184 | procedure TFormTest.Button1Click(Sender: TObject); 185 | var D : TDateTime; 186 | begin 187 | Memo1.Clear; 188 | 189 | D:=Now; 190 | //D:=EncodeDate(1994,7,1); 191 | 192 | TestYear(D); 193 | 194 | Memo1.Lines.Add(''); 195 | 196 | TestMonth(D); 197 | 198 | Memo1.Lines.Add(''); 199 | 200 | TestDay(D); 201 | 202 | Memo1.Lines.Add(''); 203 | 204 | TestDayOfYear(D); 205 | end; 206 | 207 | procedure TFormTest.Button2Click(Sender: TObject); 208 | var t : Integer; 209 | y,m,d : Word; 210 | begin 211 | LTest.Caption:=''; 212 | 213 | for t:=1 to Round(EncodeDate(2100,12,31)) do 214 | begin 215 | DecodeDate(t,y,m,d); 216 | 217 | if y<>TFastDateTime.YearOf(t) then 218 | raise Exception.Create('Wrong year: '+DateTimeToStr(t)) 219 | else 220 | if m<>TFastDateTime.MonthOf(t) then 221 | raise Exception.Create('Wrong month: '+DateTimeToStr(t)) 222 | else 223 | if d<>TFastDateTime.DayOf(t) then 224 | raise Exception.Create('Wrong day: '+DateTimeToStr(t)) 225 | else 226 | if DayOfTheYear(t)<>TFastDateTime.DayOfTheYear(t) then 227 | raise Exception.Create('Wrong day of year: '+DateTimeToStr(t)) 228 | end; 229 | 230 | LTest.Caption:='Ok'; 231 | end; 232 | 233 | procedure TFormTest.FormCreate(Sender: TObject); 234 | begin 235 | Button1Click(Self); 236 | end; 237 | 238 | end. 239 | 240 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # FastDateTime 2 | Experimental optimized Delphi TDateTime functions 3 | 4 | Aproximate speed improvements, release-mode optimized compilation: 5 | 6 | 32-bit x86 CPU, Windows: 7 | 8 | | Function | RAD 10.1 Berlin | Lazarus / FreePascal | 9 | |----------|-----------------|----------------------| 10 | |YearOf |45% faster|35% faster| 11 | |MonthOf|31% faster|0% *| 12 | |DayOf |30% faster|0% *| 13 | |DayOfTheYear|55% faster|46% faster| 14 | 15 | * Lazarus RTL DateUtils functions are very fast, different algorithm 16 | 17 | 64-bit CPU, Windows: 18 | 19 | | Function | RAD 10.1 Berlin | Lazarus / FreePascal | 20 | |----------|-----------------|----------------------| 21 | |YearOf |69% faster|(slower, FPC 62% faster)| 22 | |MonthOf|45% faster|(slower, FPC 200% faster)| 23 | |DayOf |46% faster|(slower, FPC 200% faster)| 24 | |DayOfTheYear |68% faster|(similar speed)| 25 | 26 | * Lazarus 64bit compiler gives faster execution 27 | 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /Tee.FastDateTime.pas: -------------------------------------------------------------------------------- 1 | // Optimized DateTime routines for speed 2 | // David Berneda @davidberneda July-2016 3 | unit Tee.FastDateTime; 4 | 5 | {$IFDEF FPC} 6 | {$MODE Delphi} 7 | {$ENDIF} 8 | 9 | // Important for speed: 10 | // When not debugging, always compile this unit with Optimization ON, 11 | // Inlining ON, and Range-checking, Overflow-checking, Assertions OFF 12 | // {$O+,C-,R-,Q-} 13 | 14 | // Enable or disable fast methods 15 | {$DEFINE FASTDATE} 16 | 17 | {$IFDEF FASTDATE} 18 | 19 | {$IFDEF CPUX64} 20 | 21 | // 64bit 22 | 23 | {$IFDEF FPC} 24 | {$UNDEF FASTDATE} // FPC 64bit RTL is faster ! 25 | {$ELSE} 26 | {$DEFINE FASTDAYOF} 27 | {$DEFINE FASTMONTHOF} 28 | {$DEFINE FASTDAYOFYEAR} 29 | {$DEFINE FASTYEAROF} 30 | {$ENDIF} 31 | {$ELSE} 32 | 33 | // 32bit 34 | 35 | {$IFNDEF FPC} 36 | {$DEFINE FASTDAYOF} 37 | {$DEFINE FASTMONTHOF} 38 | {$ENDIF} 39 | 40 | {$DEFINE FASTDAYOFYEAR} 41 | {$DEFINE FASTYEAROF} 42 | {$ENDIF} 43 | 44 | {$ENDIF} 45 | 46 | interface 47 | 48 | uses 49 | {$IFDEF FPC}SysUtils{$ELSE}System.SysUtils{$ENDIF}; 50 | 51 | // Speed optimization, use only the Date part of timestamp 52 | {$DEFINE DATESTAMP} 53 | 54 | // Speed optimization, use lookup tables instead of loops 55 | {$DEFINE LOOKUP} 56 | 57 | type 58 | TFastDateTime=record 59 | private 60 | {$IFDEF FASTDATE} 61 | const 62 | D1 = 365; 63 | D4 = D1 * 4 + 1; 64 | D100 = D4 * 25 - 1; 65 | D400 = D100 * 4 + 1; 66 | 67 | class function CalcDayOfYear(T: Integer; out Y:Word): Word; static; 68 | class function CalcLeap(T: Integer; out D:Word): Boolean; static; 69 | 70 | {$IFDEF DATESTAMP} 71 | class function DateTimeToDateStamp(const DateTime: TDateTime): Integer; static; 72 | {$ENDIF} 73 | 74 | class function DayMonth(const T:Integer; out M:Byte): Word; overload; static; 75 | 76 | class function DayOf(const Date: Integer): Word; overload; static; 77 | class function DayOfTheYear(const Date: Integer): Word; overload; static; 78 | class function MonthOf(const Date: Integer): Byte; overload; static; 79 | class function YearOf(Date: Integer): Word; overload; static; 80 | {$ENDIF} 81 | public 82 | {$IFDEF FASTDATE} 83 | class function DayOf(const DateTime: TTimeStamp): Word; overload; inline; static; 84 | class function DayOfTheYear(const DateTime: TTimeStamp):Word; overload; inline; static; 85 | class function MonthOf(const DateTime: TTimeStamp): Byte; overload; inline; static; 86 | class function YearOf(const DateTime: TTimeStamp): Word; overload; inline; static; 87 | {$ENDIF} 88 | 89 | class function DayOf(const DateTime: TDateTime): Word; overload; inline; static; 90 | class function DayOfTheYear(const DateTime: TDateTime):Word; overload; inline; static; 91 | class function MonthOf(const DateTime: TDateTime): Byte; overload; inline; static; 92 | class function YearOf(const DateTime: TDateTime): Word; overload; inline; static; 93 | end; 94 | 95 | implementation 96 | 97 | uses 98 | {$IFDEF FPC}Math, DateUtils{$ELSE}System.Math{$ENDIF}; 99 | 100 | {$IFDEF FASTDATE} 101 | 102 | // Optimized from DateUtils.pas 103 | class function TFastDateTime.YearOf(Date: Integer): Word; 104 | var 105 | D, I: Word; 106 | begin 107 | if Date <= 0 then 108 | result:= 0 109 | else 110 | begin 111 | Dec(Date); 112 | result := 1; 113 | 114 | while Date >= D400 do 115 | begin 116 | Dec(Date, D400); 117 | Inc(result, 400); 118 | end; 119 | 120 | DivMod(Date, D100, I, D); 121 | 122 | if I>0 then 123 | begin 124 | if I = 4 then 125 | begin 126 | Dec(I); 127 | Inc(D, D100); 128 | end; 129 | 130 | Inc(result, I * 100); 131 | end; 132 | 133 | DivMod(D, D4, I, D); 134 | 135 | if I>0 then 136 | Inc(result, I * 4); 137 | 138 | I := D div D1; 139 | 140 | if I>0 then 141 | begin 142 | if I = 4 then 143 | Dec(I); 144 | 145 | Inc(result, I); 146 | end; 147 | end; 148 | end; 149 | 150 | class function TFastDateTime.YearOf(const DateTime: TTimeStamp): Word; 151 | begin 152 | result:=YearOf(DateTime.Date); 153 | end; 154 | 155 | class function TFastDateTime.CalcDayOfYear(T: Integer; out Y: Word): Word; 156 | var I : Word; 157 | begin 158 | Dec(T); 159 | 160 | //Y:=400*(T div D400); 161 | //T:=T mod D400; 162 | 163 | Y := 1; 164 | 165 | while T >= D400 do 166 | begin 167 | Dec(T, D400); 168 | Inc(Y, 400); 169 | end; 170 | 171 | DivMod(T, D100, I, result); 172 | 173 | if I>0 then 174 | begin 175 | if I = 4 then 176 | begin 177 | Dec(I); 178 | Inc(result, D100); 179 | end; 180 | 181 | Inc(Y, I * 100); 182 | end; 183 | 184 | DivMod(result, D4, I, result); 185 | 186 | if I>0 then 187 | Inc(Y, I * 4); 188 | 189 | DivMod(result, D1, I, result); 190 | 191 | if I>0 then 192 | begin 193 | if I = 4 then 194 | begin 195 | Dec(I); 196 | Inc(result, D1); 197 | end; 198 | 199 | Inc(Y, I); 200 | end; 201 | end; 202 | 203 | class function TFastDateTime.CalcLeap(T: Integer; out D:Word): Boolean; 204 | var Y : Word; 205 | begin 206 | D:=CalcDayOfYear(T,Y); 207 | result:=IsLeapYear(Y); 208 | end; 209 | 210 | {$IFDEF LOOKUP} 211 | type 212 | TLeapLookup=record 213 | public 214 | const Month:Array[0..365] of Byte= 215 | ( 216 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 217 | 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 218 | 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 219 | 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, 220 | 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 221 | 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 222 | 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 223 | 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 224 | 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 225 | 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, 226 | 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, 227 | 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12 228 | ); 229 | 230 | const Day:Array[0..365] of Byte= 231 | ( 232 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 233 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29, 234 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 235 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 236 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 237 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 238 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 239 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 240 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 241 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 242 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 243 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31 244 | ); 245 | end; 246 | 247 | TLookup=record 248 | public 249 | const Month:Array[0..364] of Byte= 250 | ( 251 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 252 | 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 253 | 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 254 | 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, 255 | 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 256 | 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 257 | 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 258 | 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 259 | 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 260 | 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, 261 | 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, 262 | 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12 263 | ); 264 | 265 | const Day:Array[0..364] of Byte= 266 | ( 267 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 268 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28, 269 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 270 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 271 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 272 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 273 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 274 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 275 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 276 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 277 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 278 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31 279 | ); 280 | end; 281 | 282 | {$ENDIF} 283 | 284 | class function TFastDateTime.DayMonth(const T: Integer; out M:Byte): Word; 285 | {$IFNDEF LOOKUP} 286 | type 287 | TDayTable = array[1..12] of Byte; 288 | 289 | const 290 | MonthDays: TDayTable = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 291 | LeapMonthDays: TDayTable = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 292 | 293 | var I: Byte; 294 | {$ENDIF} 295 | begin 296 | {$IFNDEF LOOKUP} 297 | M:=1; 298 | {$ENDIF} 299 | 300 | if CalcLeap(T,result) then 301 | begin 302 | {$IFDEF LOOKUP} 303 | M:=TLeapLookup.Month[result]; 304 | result:=TLeapLookup.Day[result]; 305 | {$ELSE} 306 | while True do 307 | begin 308 | I := LeapMonthDays[M]; 309 | if result < I then Break; 310 | Dec(result, I); 311 | Inc(M); 312 | end; 313 | {$ENDIF} 314 | end 315 | else 316 | begin 317 | {$IFDEF LOOKUP} 318 | M:=TLookup.Month[result]; 319 | result:=TLookup.Day[result]; 320 | {$ELSE} 321 | while True do 322 | begin 323 | I := MonthDays[M]; 324 | if result < I then Break; 325 | Dec(result, I); 326 | Inc(M); 327 | end; 328 | {$ENDIF} 329 | end; 330 | 331 | {$IFNDEF LOOKUP} 332 | Inc(result); 333 | {$ENDIF} 334 | end; 335 | 336 | class function TFastDateTime.MonthOf(const Date: Integer): Byte; 337 | begin 338 | if Date<=0 then 339 | result:=0 340 | else 341 | DayMonth(Date,result); 342 | end; 343 | 344 | class function TFastDateTime.MonthOf(const DateTime: TTimeStamp): Byte; 345 | begin 346 | result:=MonthOf(DateTime.Date); 347 | end; 348 | 349 | class function TFastDateTime.DayOf(const Date: Integer): Word; 350 | var M: Byte; 351 | begin 352 | if Date<=0 then 353 | result:=0 354 | else 355 | result:=DayMonth(Date,M); 356 | end; 357 | 358 | class function TFastDateTime.DayOf(const DateTime: TTimeStamp): Word; 359 | begin 360 | result:=DayOf(DateTime.Date); 361 | end; 362 | 363 | class function TFastDateTime.DayOfTheYear(const Date: Integer): Word; 364 | var Y: Word; 365 | begin 366 | if Date<=0 then 367 | result:=0 368 | else 369 | result:=CalcDayOfYear(Date,Y)+1; 370 | end; 371 | 372 | {$IFDEF DATESTAMP} 373 | class function TFastDateTime.DateTimeToDateStamp(const DateTime: TDateTime): Integer; 374 | const 375 | FMSecsPerDay: Single = MSecsPerDay; 376 | IMSecsPerDay: Integer = MSecsPerDay; 377 | 378 | begin 379 | Result := DateDelta + (Round(DateTime * FMSecsPerDay) div IMSecsPerDay); 380 | end; 381 | {$ENDIF} 382 | 383 | class function TFastDateTime.DayOfTheYear(const DateTime: TTimeStamp): Word; 384 | begin 385 | result:=DayOfTheYear(DateTime.Date); 386 | end; 387 | {$ENDIF} 388 | 389 | class function TFastDateTime.DayOf(const DateTime: TDateTime): Word; 390 | begin 391 | {$IFDEF FASTDAYOF} 392 | {$IFDEF DATESTAMP} 393 | result:=DayOf(DateTimeToDateStamp(DateTime)); 394 | {$ELSE} 395 | result:=DayOf(DateTimeToTimeStamp(DateTime).Date); 396 | {$ENDIF} 397 | {$ELSE} 398 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.DayOf(DateTime); 399 | {$ENDIF} 400 | end; 401 | 402 | class function TFastDateTime.DayOfTheYear(const DateTime: TDateTime): Word; 403 | begin 404 | {$IFDEF FASTDAYOFYEAR} 405 | {$IFDEF DATESTAMP} 406 | result:=DayOfTheYear(DateTimeToDateStamp(DateTime)); 407 | {$ELSE} 408 | result:=DayOfTheYear(DateTimeToTimeStamp(DateTime).Date); 409 | {$ENDIF} 410 | {$ELSE} 411 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.DayOfTheYear(DateTime); 412 | {$ENDIF} 413 | end; 414 | 415 | class function TFastDateTime.MonthOf(const DateTime: TDateTime): Byte; 416 | begin 417 | {$IFDEF FASTMONTHOF} 418 | {$IFDEF DATESTAMP} 419 | result:=MonthOf(DateTimeToDateStamp(DateTime)); 420 | {$ELSE} 421 | result:=MonthOf(DateTimeToTimeStamp(DateTime).Date); 422 | {$ENDIF} 423 | {$ELSE} 424 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.MonthOf(DateTime); 425 | {$ENDIF} 426 | end; 427 | 428 | class function TFastDateTime.YearOf(const DateTime: TDateTime): Word; 429 | begin 430 | {$IFDEF FASTYEAROF} 431 | {$IFDEF DATESTAMP} 432 | result:=YearOf(DateTimeToDateStamp(DateTime)); 433 | {$ELSE} 434 | result:=YearOf(DateTimeToTimeStamp(DateTime).Date); 435 | {$ENDIF} 436 | {$ELSE} 437 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.YearOf(DateTime); 438 | {$ENDIF} 439 | end; 440 | 441 | end. 442 | -------------------------------------------------------------------------------- /Unit_Fast_Test.dfm: -------------------------------------------------------------------------------- 1 | object FormTest: TFormTest 2 | Left = 0 3 | Top = 0 4 | Caption = 'FastDateTime Test' 5 | ClientHeight = 304 6 | ClientWidth = 340 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poOwnerFormCenter 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object LTest: TLabel 19 | Left = 112 20 | Top = 261 21 | Width = 3 22 | Height = 13 23 | end 24 | object Memo1: TMemo 25 | Left = 16 26 | Top = 56 27 | Width = 305 28 | Height = 177 29 | TabOrder = 0 30 | end 31 | object Button1: TButton 32 | Left = 16 33 | Top = 256 34 | Width = 75 35 | Height = 25 36 | Caption = '&Verify' 37 | TabOrder = 1 38 | OnClick = Button1Click 39 | end 40 | object Button2: TButton 41 | Left = 16 42 | Top = 15 43 | Width = 75 44 | Height = 25 45 | Caption = 'Test' 46 | TabOrder = 2 47 | OnClick = Button2Click 48 | end 49 | end 50 | -------------------------------------------------------------------------------- /Unit_Fast_Test.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Fast_Test; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | type 10 | TFormTest = class(TForm) 11 | Memo1: TMemo; 12 | Button1: TButton; 13 | LTest: TLabel; 14 | Button2: TButton; 15 | procedure FormCreate(Sender: TObject); 16 | procedure Button1Click(Sender: TObject); 17 | procedure Button2Click(Sender: TObject); 18 | private 19 | { Private declarations } 20 | 21 | procedure TestDay(const D:TDateTime); 22 | procedure TestDayOfYear(const D:TDateTime); 23 | procedure TestMonth(const D:TDateTime); 24 | procedure TestYear(const D:TDateTime); 25 | public 26 | { Public declarations } 27 | end; 28 | 29 | var 30 | FormTest: TFormTest; 31 | 32 | implementation 33 | 34 | {$R *.dfm} 35 | 36 | uses 37 | System.Diagnostics, Tee.FastDateTime, DateUtils; 38 | 39 | function Diff(const ASlow,AFast:Int64):String; 40 | var tmp : Single; 41 | begin 42 | tmp:=100-(AFast*100/ASlow); 43 | 44 | result:='('+FormatFloat('0.##%',tmp)+' faster)'; 45 | end; 46 | 47 | const 48 | TestTimes=5000000; 49 | 50 | procedure TFormTest.TestYear(const D:TDateTime); 51 | var t1 : TStopwatch; 52 | t2,t3 : Int64; 53 | t : Integer; 54 | y : Word; 55 | begin 56 | t1:=TStopwatch.StartNew; 57 | 58 | for t:=1 to TestTimes do 59 | y:=YearOf(D); 60 | 61 | t2:=t1.ElapsedMilliseconds; 62 | 63 | Memo1.Lines.Add('YearOf: '+t2.ToString+' msec '+y.ToString); 64 | 65 | t1:=TStopwatch.StartNew; 66 | 67 | for t:=1 to TestTimes do 68 | y:=TFastDateTime.YearOf(D); 69 | 70 | t3:=t1.ElapsedMilliseconds; 71 | 72 | Memo1.Lines.Add('Fast YearOf: '+t3.ToString+' msec '+y.ToString+' '+Diff(t2,t3)); 73 | end; 74 | 75 | procedure TFormTest.TestMonth(const D:TDateTime); 76 | var t1 : TStopwatch; 77 | t2, t3 : Int64; 78 | t : Integer; 79 | day : Word; 80 | begin 81 | t1:=TStopwatch.StartNew; 82 | 83 | for t:=1 to TestTimes do 84 | day:=MonthOf(D); 85 | 86 | t2:=t1.ElapsedMilliseconds; 87 | 88 | Memo1.Lines.Add('MonthOf: '+t2.ToString+' msec '+day.ToString); 89 | 90 | t1:=TStopwatch.StartNew; 91 | 92 | for t:=1 to TestTimes do 93 | day:=TFastDateTime.MonthOf(D); 94 | 95 | t3:=t1.ElapsedMilliseconds; 96 | 97 | Memo1.Lines.Add('Fast MonthOf: '+t3.ToString+' msec '+day.ToString+' '+Diff(t2,t3)); 98 | end; 99 | 100 | procedure TFormTest.TestDay(const D:TDateTime); 101 | var t1 : TStopwatch; 102 | t2,t3 : Int64; 103 | t : Integer; 104 | day : Word; 105 | begin 106 | t1:=TStopwatch.StartNew; 107 | 108 | for t:=1 to TestTimes do 109 | day:=DayOf(D); 110 | 111 | t2:=t1.ElapsedMilliseconds; 112 | 113 | Memo1.Lines.Add('DayOf: '+t2.ToString+' msec '+day.ToString); 114 | 115 | t1:=TStopwatch.StartNew; 116 | 117 | for t:=1 to TestTimes do 118 | day:=TFastDateTime.DayOf(D); 119 | 120 | t3:=t1.ElapsedMilliseconds; 121 | 122 | Memo1.Lines.Add('Fast DayOf: '+t3.ToString+' msec '+day.ToString+' '+Diff(t2,t3)); 123 | end; 124 | 125 | procedure TFormTest.TestDayOfYear(const D:TDateTime); 126 | var t1 : TStopwatch; 127 | t2,t3 : Int64; 128 | t : Integer; 129 | day : Word; 130 | begin 131 | t1:=TStopwatch.StartNew; 132 | 133 | for t:=1 to TestTimes do 134 | day:=DayOfTheYear(D); 135 | 136 | t2:=t1.ElapsedMilliseconds; 137 | 138 | Memo1.Lines.Add('DayOfYear: '+t2.ToString+' msec '+day.ToString); 139 | 140 | t1:=TStopwatch.StartNew; 141 | 142 | for t:=1 to TestTimes do 143 | day:=TFastDateTime.DayOfTheYear(D); 144 | 145 | t3:=t1.ElapsedMilliseconds; 146 | 147 | Memo1.Lines.Add('Fast DayOfYear: '+t3.ToString+' msec '+day.ToString+' '+Diff(t2,t3)); 148 | end; 149 | 150 | procedure TFormTest.Button1Click(Sender: TObject); 151 | var t : Integer; 152 | y,m,d : Word; 153 | begin 154 | LTest.Caption:=''; 155 | 156 | for t:=1 to Round(EncodeDate(2100,12,31)) do 157 | begin 158 | DecodeDate(t,y,m,d); 159 | 160 | if y<>TFastDateTime.YearOf(t) then 161 | raise Exception.Create('Wrong year: '+DateTimeToStr(t)) 162 | else 163 | if m<>TFastDateTime.MonthOf(t) then 164 | raise Exception.Create('Wrong month: '+DateTimeToStr(t)) 165 | else 166 | if d<>TFastDateTime.DayOf(t) then 167 | raise Exception.Create('Wrong day: '+DateTimeToStr(t)) 168 | else 169 | if DayOfTheYear(t)<>TFastDateTime.DayOfTheYear(t) then 170 | raise Exception.Create('Wrong day of year: '+DateTimeToStr(t)) 171 | end; 172 | 173 | LTest.Caption:='Ok'; 174 | end; 175 | 176 | procedure TFormTest.Button2Click(Sender: TObject); 177 | var D : TDateTime; 178 | begin 179 | Memo1.Clear; 180 | 181 | D:=Now; 182 | //D:=EncodeDate(1994,7,1); 183 | 184 | TestYear(D); 185 | 186 | Memo1.Lines.Add(''); 187 | 188 | TestMonth(D); 189 | 190 | Memo1.Lines.Add(''); 191 | 192 | TestDay(D); 193 | 194 | Memo1.Lines.Add(''); 195 | 196 | TestDayOfYear(D); 197 | end; 198 | 199 | procedure TFormTest.FormCreate(Sender: TObject); 200 | begin 201 | Button2Click(Self); 202 | end; 203 | 204 | end. 205 | --------------------------------------------------------------------------------

├── .gitignore ├── Fast_DateTime_Test.dpr ├── Fast_DateTime_Test.dproj ├── Fast_DateTime_Test.res ├── LICENSE ├── Lazarus ├── fastdatetime_test.ico ├── fastdatetime_test.lpi ├── fastdatetime_test.lpr ├── fastdatetime_test.res ├── unit_main.lfm └── unit_main.pas ├── README.md ├── Tee.FastDateTime.pas ├── Unit_Fast_Test.dfm └── Unit_Fast_Test.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /Fast_DateTime_Test.dpr: -------------------------------------------------------------------------------- 1 | program Fast_DateTime_Test; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit_Fast_Test in 'Unit_Fast_Test.pas' {FormTest}, 6 | Tee.FastDateTime in 'Tee.FastDateTime.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | {$IFOPT D+} 12 | ReportMemoryLeaksOnShutdown:=True; 13 | {$ENDIF} 14 | Application.Initialize; 15 | Application.MainFormOnTaskbar := True; 16 | Application.CreateForm(TFormTest, FormTest); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /Fast_DateTime_Test.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {F8D4A8A7-007E-4636-AE1E-BDBB7444F561} 4 | 18.1 5 | VCL 6 | Fast_DateTime_Test.dpr 7 | True 8 | Release 9 | Win32 10 | 3 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | true 56 | Cfg_2 57 | true 58 | true 59 | 60 | 61 | Fast_DateTime_Test 62 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 63 | $(BDS)\bin\delphi_PROJECTICON.ico 64 | .\$(Platform)\$(Config) 65 | .\$(Platform)\$(Config) 66 | false 67 | false 68 | false 69 | false 70 | false 71 | 72 | 73 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 74 | $(BDS)\bin\default_app.manifest 75 | true 76 | DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;svnui;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;inetdb;VirtualTreesDR;emsedge;FireDACIBDriver;fmx;fmxdae;frx24;vclib;FireDACDBXDriver;dbexpress;IndyCore;FMXChartProTeeBI;vclx;dsnap;DataSnapCommon;emsclient;TeeBI;FireDACCommon;FMXTeeBI;bdertl;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;VCLChartProTeeBI;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;VCLTeeBI;soaprtl;DbxCommonDriver;ibxpress;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;vcldbx;FixInsight_10_1;frxe24;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;frxDB24;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) 77 | 1033 78 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 79 | 80 | 81 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 82 | $(BDS)\bin\default_app.manifest 83 | true 84 | DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;VirtualTreesDR;emsedge;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;TeeBI;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;VCLChartProTeeBI;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;VCLTeeBI;soaprtl;DbxCommonDriver;ibxpress;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) 85 | 1033 86 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 87 | 88 | 89 | DEBUG;$(DCC_Define) 90 | true 91 | false 92 | true 93 | true 94 | true 95 | 96 | 97 | true 98 | 1033 99 | true 100 | true 101 | true 102 | 3 103 | false 104 | false 105 | 106 | 107 | true 108 | 1033 109 | false 110 | true 111 | true 112 | true 113 | 114 | 115 | false 116 | RELEASE;$(DCC_Define) 117 | 0 118 | 0 119 | 120 | 121 | true 122 | true 123 | 124 | 125 | true 126 | true 127 | 128 | 129 | 130 | MainSource 131 | 132 | 133 | 134 | dfm 135 | 136 | 137 | 138 | Cfg_2 139 | Base 140 | 141 | 142 | Base 143 | 144 | 145 | Cfg_1 146 | Base 147 | 148 | 149 | 150 | Delphi.Personality.12 151 | Application 152 | 153 | 154 | 155 | Embarcadero C++Builder Office 2000 Servers Package 156 | Embarcadero C++Builder Office XP Servers Package 157 | Microsoft Office 2000 Sample Automation Server Wrapper Components 158 | Microsoft Office XP Sample Automation Server Wrapper Components 159 | 160 | 161 | Fast_DateTime_Test.dpr 162 | 163 | 164 | 165 | 166 | 167 | Fast_DateTime_Test.exe 168 | true 169 | 170 | 171 | 172 | 173 | Fast_DateTime_Test.exe 174 | true 175 | 176 | 177 | 178 | 179 | Fast_DateTime_Test.exe 180 | true 181 | 182 | 183 | 184 | 185 | 0 186 | .dll;.bpl 187 | 188 | 189 | 1 190 | .dylib 191 | 192 | 193 | Contents\MacOS 194 | 1 195 | .dylib 196 | 197 | 198 | 1 199 | .dylib 200 | 201 | 202 | 1 203 | .dylib 204 | 205 | 206 | 207 | 208 | Contents\Resources 209 | 1 210 | 211 | 212 | 213 | 214 | classes 215 | 1 216 | 217 | 218 | 219 | 220 | Contents\MacOS 221 | 0 222 | 223 | 224 | 1 225 | 226 | 227 | Contents\MacOS 228 | 1 229 | 230 | 231 | 232 | 233 | 1 234 | 235 | 236 | 1 237 | 238 | 239 | 1 240 | 241 | 242 | 243 | 244 | res\drawable-xxhdpi 245 | 1 246 | 247 | 248 | 249 | 250 | library\lib\mips 251 | 1 252 | 253 | 254 | 255 | 256 | 1 257 | 258 | 259 | 1 260 | 261 | 262 | 0 263 | 264 | 265 | 1 266 | 267 | 268 | Contents\MacOS 269 | 1 270 | 271 | 272 | library\lib\armeabi-v7a 273 | 1 274 | 275 | 276 | 1 277 | 278 | 279 | 280 | 281 | 0 282 | 283 | 284 | Contents\MacOS 285 | 1 286 | .framework 287 | 288 | 289 | 290 | 291 | 1 292 | 293 | 294 | 1 295 | 296 | 297 | 1 298 | 299 | 300 | 301 | 302 | 1 303 | 304 | 305 | 1 306 | 307 | 308 | 1 309 | 310 | 311 | 312 | 313 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 314 | 1 315 | 316 | 317 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 318 | 1 319 | 320 | 321 | 322 | 323 | 1 324 | 325 | 326 | 1 327 | 328 | 329 | 1 330 | 331 | 332 | 333 | 334 | 1 335 | 336 | 337 | 1 338 | 339 | 340 | 1 341 | 342 | 343 | 344 | 345 | library\lib\armeabi 346 | 1 347 | 348 | 349 | 350 | 351 | 0 352 | 353 | 354 | 1 355 | 356 | 357 | Contents\MacOS 358 | 1 359 | 360 | 361 | 362 | 363 | 1 364 | 365 | 366 | 1 367 | 368 | 369 | 1 370 | 371 | 372 | 373 | 374 | res\drawable-normal 375 | 1 376 | 377 | 378 | 379 | 380 | res\drawable-xhdpi 381 | 1 382 | 383 | 384 | 385 | 386 | res\drawable-large 387 | 1 388 | 389 | 390 | 391 | 392 | 1 393 | 394 | 395 | 1 396 | 397 | 398 | 1 399 | 400 | 401 | 402 | 403 | ..\ 404 | 1 405 | 406 | 407 | ..\ 408 | 1 409 | 410 | 411 | 412 | 413 | res\drawable-hdpi 414 | 1 415 | 416 | 417 | 418 | 419 | library\lib\armeabi-v7a 420 | 1 421 | 422 | 423 | 424 | 425 | Contents 426 | 1 427 | 428 | 429 | 430 | 431 | ..\ 432 | 1 433 | 434 | 435 | 436 | 437 | 1 438 | 439 | 440 | 1 441 | 442 | 443 | 1 444 | 445 | 446 | 447 | 448 | res\values 449 | 1 450 | 451 | 452 | 453 | 454 | res\drawable-small 455 | 1 456 | 457 | 458 | 459 | 460 | res\drawable 461 | 1 462 | 463 | 464 | 465 | 466 | 1 467 | 468 | 469 | 1 470 | 471 | 472 | 1 473 | 474 | 475 | 476 | 477 | 1 478 | 479 | 480 | 481 | 482 | res\drawable 483 | 1 484 | 485 | 486 | 487 | 488 | 0 489 | 490 | 491 | 0 492 | 493 | 494 | Contents\Resources\StartUp\ 495 | 0 496 | 497 | 498 | 0 499 | 500 | 501 | 0 502 | 503 | 504 | 0 505 | 506 | 507 | 508 | 509 | library\lib\armeabi-v7a 510 | 1 511 | 512 | 513 | 514 | 515 | 0 516 | .bpl 517 | 518 | 519 | 1 520 | .dylib 521 | 522 | 523 | Contents\MacOS 524 | 1 525 | .dylib 526 | 527 | 528 | 1 529 | .dylib 530 | 531 | 532 | 1 533 | .dylib 534 | 535 | 536 | 537 | 538 | res\drawable-mdpi 539 | 1 540 | 541 | 542 | 543 | 544 | res\drawable-xlarge 545 | 1 546 | 547 | 548 | 549 | 550 | res\drawable-ldpi 551 | 1 552 | 553 | 554 | 555 | 556 | 1 557 | 558 | 559 | 1 560 | 561 | 562 | 563 | 564 | 565 | 566 | 567 | 568 | 569 | 570 | 571 | 572 | True 573 | True 574 | 575 | 576 | 12 577 | 578 | 579 | 580 | 581 | 582 | -------------------------------------------------------------------------------- /Fast_DateTime_Test.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/davidberneda/FastDateTime/66705a763b435f00c079e72e5eb9b351ca6dfca0/Fast_DateTime_Test.res -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 David Berneda 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Lazarus/fastdatetime_test.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/davidberneda/FastDateTime/66705a763b435f00c079e72e5eb9b351ca6dfca0/Lazarus/fastdatetime_test.ico -------------------------------------------------------------------------------- /Lazarus/fastdatetime_test.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <Icon Value="0"/> 13 | </General> 14 | <i18n> 15 | <EnableI18N LFM="False"/> 16 | </i18n> 17 | <VersionInfo> 18 | <StringTable ProductVersion=""/> 19 | </VersionInfo> 20 | <MacroValues Count="1"> 21 | <Macro1 Name="LCLWidgetType" Value="win32"/> 22 | </MacroValues> 23 | <BuildModes Count="1"> 24 | <Item1 Name="Default" Default="True"/> 25 | <SharedMatrixOptions Count="1"> 26 | <Item1 ID="103262766600" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/> 27 | </SharedMatrixOptions> 28 | </BuildModes> 29 | <PublishOptions> 30 | <Version Value="2"/> 31 | </PublishOptions> 32 | <RunParams> 33 | <local> 34 | <FormatVersion Value="1"/> 35 | </local> 36 | </RunParams> 37 | <RequiredPackages Count="1"> 38 | <Item1> 39 | <PackageName Value="LCL"/> 40 | </Item1> 41 | </RequiredPackages> 42 | <Units Count="3"> 43 | <Unit0> 44 | <Filename Value="fastdatetime_test.lpr"/> 45 | <IsPartOfProject Value="True"/> 46 | </Unit0> 47 | <Unit1> 48 | <Filename Value="unit_main.pas"/> 49 | <IsPartOfProject Value="True"/> 50 | <ComponentName Value="FormTest"/> 51 | <HasResources Value="True"/> 52 | <ResourceBaseClass Value="Form"/> 53 | </Unit1> 54 | <Unit2> 55 | <Filename Value="..\Tee.FastDateTime.pas"/> 56 | <IsPartOfProject Value="True"/> 57 | </Unit2> 58 | </Units> 59 | </ProjectOptions> 60 | <CompilerOptions> 61 | <Version Value="11"/> 62 | <PathDelim Value="\"/> 63 | <Target> 64 | <Filename Value="fastdatetime_test"/> 65 | </Target> 66 | <SearchPaths> 67 | <IncludeFiles Value="$(ProjOutDir)"/> 68 | <OtherUnitFiles Value="C:\Root\GitHub_Public\FastDateTime\"/> 69 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 70 | </SearchPaths> 71 | <CodeGeneration> 72 | <Optimizations> 73 | <OptimizationLevel Value="3"/> 74 | </Optimizations> 75 | </CodeGeneration> 76 | <Linking> 77 | <Options> 78 | <Win32> 79 | <GraphicApplication Value="True"/> 80 | </Win32> 81 | </Options> 82 | </Linking> 83 | </CompilerOptions> 84 | <Debugging> 85 | <Exceptions Count="3"> 86 | <Item1> 87 | <Name Value="EAbort"/> 88 | </Item1> 89 | <Item2> 90 | <Name Value="ECodetoolError"/> 91 | </Item2> 92 | <Item3> 93 | <Name Value="EFOpenError"/> 94 | </Item3> 95 | </Exceptions> 96 | </Debugging> 97 | </CONFIG> 98 | -------------------------------------------------------------------------------- /Lazarus/fastdatetime_test.lpr: -------------------------------------------------------------------------------- 1 | program fastdatetime_test; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, unit_main; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | RequireDerivedFormResource:=True; 16 | Application.Initialize; 17 | Application.CreateForm(TFormTest, FormTest); 18 | Application.Run; 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /Lazarus/fastdatetime_test.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/davidberneda/FastDateTime/66705a763b435f00c079e72e5eb9b351ca6dfca0/Lazarus/fastdatetime_test.res -------------------------------------------------------------------------------- /Lazarus/unit_main.lfm: -------------------------------------------------------------------------------- 1 | object FormTest: TFormTest 2 | Left = 238 3 | Height = 320 4 | Top = 150 5 | Width = 365 6 | Caption = 'Tee FastDateTime Test' 7 | ClientHeight = 320 8 | ClientWidth = 365 9 | OnCreate = FormCreate 10 | LCLVersion = '1.7' 11 | Visible = False 12 | object Button1: TButton 13 | Left = 21 14 | Height = 25 15 | Top = 18 16 | Width = 75 17 | Caption = '&Test' 18 | OnClick = Button1Click 19 | TabOrder = 0 20 | end 21 | object Button2: TButton 22 | Left = 21 23 | Height = 25 24 | Top = 277 25 | Width = 75 26 | Caption = '&Verify' 27 | OnClick = Button2Click 28 | TabOrder = 1 29 | end 30 | object Memo1: TMemo 31 | Left = 24 32 | Height = 188 33 | Top = 62 34 | Width = 312 35 | TabOrder = 2 36 | end 37 | object LTest: TLabel 38 | Left = 110 39 | Height = 1 40 | Top = 284 41 | Width = 1 42 | ParentColor = False 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /Lazarus/unit_main.pas: -------------------------------------------------------------------------------- 1 | unit unit_main; 2 | 3 | //{$mode objfpc}{$H+} 4 | {$MODE Delphi} 5 | 6 | interface 7 | 8 | uses 9 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 10 | Tee.FastDateTime; 11 | 12 | type 13 | 14 | { TFormTest } 15 | 16 | TFormTest = class(TForm) 17 | Button1: TButton; 18 | Button2: TButton; 19 | LTest: TLabel; 20 | Memo1: TMemo; 21 | procedure Button1Click(Sender: TObject); 22 | procedure Button2Click(Sender: TObject); 23 | procedure FormCreate(Sender: TObject); 24 | private 25 | { private declarations } 26 | 27 | procedure TestDay(const D:TDateTime); 28 | procedure TestDayOfYear(const D:TDateTime); 29 | procedure TestMonth(const D:TDateTime); 30 | procedure TestYear(const D:TDateTime); 31 | public 32 | { public declarations } 33 | end; 34 | 35 | var 36 | FormTest: TFormTest; 37 | 38 | implementation 39 | 40 | {$R *.lfm} 41 | 42 | uses 43 | DateUtils; 44 | 45 | type 46 | 47 | { TStopWatch } 48 | 49 | TStopWatch=record 50 | private 51 | Old : Int64; 52 | public 53 | function ElapsedMilliseconds:Int64; 54 | class function StartNew:TStopWatch; static; 55 | end; 56 | 57 | { TStopWatch } 58 | 59 | function TStopWatch.ElapsedMilliseconds: Int64; 60 | begin 61 | result:=GetTickCount64-Old; 62 | end; 63 | 64 | class function TStopWatch.StartNew: TStopWatch; 65 | begin 66 | result.Old:=GetTickCount64; 67 | end; 68 | 69 | { TFormTest } 70 | 71 | function Diff(const ASlow,AFast:Int64):String; 72 | var tmp : Single; 73 | begin 74 | tmp:=100-(AFast*100/ASlow); 75 | 76 | result:='('+FormatFloat('0.##%',tmp)+' faster)'; 77 | end; 78 | 79 | const 80 | TestTimes=5000000; 81 | 82 | procedure TFormTest.TestYear(const D:TDateTime); 83 | var t1 : TStopwatch; 84 | t2,t3 : Int64; 85 | t : Integer; 86 | y : Word; 87 | begin 88 | t1:=TStopwatch.StartNew; 89 | 90 | for t:=1 to TestTimes do 91 | y:=YearOf(D); 92 | 93 | t2:=t1.ElapsedMilliseconds; 94 | 95 | Memo1.Lines.Add('YearOf: '+IntToStr(t2)+' msec '+IntToStr(y)); 96 | 97 | t1:=TStopwatch.StartNew; 98 | 99 | {$O-} 100 | for t:=1 to TestTimes do 101 | y:=TFastDateTime.YearOf(D); 102 | {$O+} 103 | 104 | t3:=t1.ElapsedMilliseconds; 105 | 106 | Memo1.Lines.Add('Fast YearOf: '+IntToStr(t3)+' msec '+IntToStr(y)+' '+Diff(t2,t3)); 107 | end; 108 | 109 | procedure TFormTest.TestMonth(const D:TDateTime); 110 | var t1 : TStopwatch; 111 | t2, t3 : Int64; 112 | t : Integer; 113 | day : Word; 114 | begin 115 | t1:=TStopwatch.StartNew; 116 | 117 | for t:=1 to TestTimes do 118 | day:=MonthOf(D); 119 | 120 | t2:=t1.ElapsedMilliseconds; 121 | 122 | Memo1.Lines.Add('MonthOf: '+IntToStr(t2)+' msec '+IntToStr(day)); 123 | 124 | t1:=TStopwatch.StartNew; 125 | 126 | for t:=1 to TestTimes do 127 | day:=TFastDateTime.MonthOf(D); 128 | 129 | t3:=t1.ElapsedMilliseconds; 130 | 131 | Memo1.Lines.Add('Fast MonthOf: '+IntToStr(t3)+' msec '+IntToStr(day)+' '+Diff(t2,t3)); 132 | end; 133 | 134 | procedure TFormTest.TestDay(const D:TDateTime); 135 | var t1 : TStopwatch; 136 | t2,t3 : Int64; 137 | t : Integer; 138 | day : Word; 139 | begin 140 | t1:=TStopwatch.StartNew; 141 | 142 | for t:=1 to TestTimes do 143 | day:=DayOf(D); 144 | 145 | t2:=t1.ElapsedMilliseconds; 146 | 147 | Memo1.Lines.Add('DayOf: '+IntToStr(t2)+' msec '+IntToStr(day)); 148 | 149 | t1:=TStopwatch.StartNew; 150 | 151 | for t:=1 to TestTimes do 152 | day:=TFastDateTime.DayOf(D); 153 | 154 | t3:=t1.ElapsedMilliseconds; 155 | 156 | Memo1.Lines.Add('Fast DayOf: '+IntToStr(t3)+' msec '+IntToStr(day)+' '+Diff(t2,t3)); 157 | end; 158 | 159 | procedure TFormTest.TestDayOfYear(const D:TDateTime); 160 | var t1 : TStopwatch; 161 | t2,t3 : Int64; 162 | t : Integer; 163 | day : Word; 164 | begin 165 | t1:=TStopwatch.StartNew; 166 | 167 | for t:=1 to TestTimes do 168 | day:=DayOfTheYear(D); 169 | 170 | t2:=t1.ElapsedMilliseconds; 171 | 172 | Memo1.Lines.Add('DayOfYear: '+IntToStr(t2)+' msec '+IntToStr(day)); 173 | 174 | t1:=TStopwatch.StartNew; 175 | 176 | for t:=1 to TestTimes do 177 | day:=TFastDateTime.DayOfTheYear(D); 178 | 179 | t3:=t1.ElapsedMilliseconds; 180 | 181 | Memo1.Lines.Add('Fast DayOfYear: '+IntToStr(t3)+' msec '+IntToStr(day)+' '+Diff(t2,t3)); 182 | end; 183 | 184 | procedure TFormTest.Button1Click(Sender: TObject); 185 | var D : TDateTime; 186 | begin 187 | Memo1.Clear; 188 | 189 | D:=Now; 190 | //D:=EncodeDate(1994,7,1); 191 | 192 | TestYear(D); 193 | 194 | Memo1.Lines.Add(''); 195 | 196 | TestMonth(D); 197 | 198 | Memo1.Lines.Add(''); 199 | 200 | TestDay(D); 201 | 202 | Memo1.Lines.Add(''); 203 | 204 | TestDayOfYear(D); 205 | end; 206 | 207 | procedure TFormTest.Button2Click(Sender: TObject); 208 | var t : Integer; 209 | y,m,d : Word; 210 | begin 211 | LTest.Caption:=''; 212 | 213 | for t:=1 to Round(EncodeDate(2100,12,31)) do 214 | begin 215 | DecodeDate(t,y,m,d); 216 | 217 | if y<>TFastDateTime.YearOf(t) then 218 | raise Exception.Create('Wrong year: '+DateTimeToStr(t)) 219 | else 220 | if m<>TFastDateTime.MonthOf(t) then 221 | raise Exception.Create('Wrong month: '+DateTimeToStr(t)) 222 | else 223 | if d<>TFastDateTime.DayOf(t) then 224 | raise Exception.Create('Wrong day: '+DateTimeToStr(t)) 225 | else 226 | if DayOfTheYear(t)<>TFastDateTime.DayOfTheYear(t) then 227 | raise Exception.Create('Wrong day of year: '+DateTimeToStr(t)) 228 | end; 229 | 230 | LTest.Caption:='Ok'; 231 | end; 232 | 233 | procedure TFormTest.FormCreate(Sender: TObject); 234 | begin 235 | Button1Click(Self); 236 | end; 237 | 238 | end. 239 | 240 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # FastDateTime 2 | Experimental optimized Delphi TDateTime functions 3 | 4 | Aproximate speed improvements, release-mode optimized compilation: 5 | 6 | 32-bit x86 CPU, Windows: 7 | 8 | | Function | RAD 10.1 Berlin | Lazarus / FreePascal | 9 | |----------|-----------------|----------------------| 10 | |YearOf |45% faster|35% faster| 11 | |MonthOf|31% faster|0% *| 12 | |DayOf |30% faster|0% *| 13 | |DayOfTheYear|55% faster|46% faster| 14 | 15 | * Lazarus RTL DateUtils functions are very fast, different algorithm 16 | 17 | 64-bit CPU, Windows: 18 | 19 | | Function | RAD 10.1 Berlin | Lazarus / FreePascal | 20 | |----------|-----------------|----------------------| 21 | |YearOf |69% faster|(slower, FPC 62% faster)| 22 | |MonthOf|45% faster|(slower, FPC 200% faster)| 23 | |DayOf |46% faster|(slower, FPC 200% faster)| 24 | |DayOfTheYear |68% faster|(similar speed)| 25 | 26 | * Lazarus 64bit compiler gives faster execution 27 | 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /Tee.FastDateTime.pas: -------------------------------------------------------------------------------- 1 | // Optimized DateTime routines for speed 2 | // David Berneda @davidberneda July-2016 3 | unit Tee.FastDateTime; 4 | 5 | {$IFDEF FPC} 6 | {$MODE Delphi} 7 | {$ENDIF} 8 | 9 | // Important for speed: 10 | // When not debugging, always compile this unit with Optimization ON, 11 | // Inlining ON, and Range-checking, Overflow-checking, Assertions OFF 12 | // {$O+,C-,R-,Q-} 13 | 14 | // Enable or disable fast methods 15 | {$DEFINE FASTDATE} 16 | 17 | {$IFDEF FASTDATE} 18 | 19 | {$IFDEF CPUX64} 20 | 21 | // 64bit 22 | 23 | {$IFDEF FPC} 24 | {$UNDEF FASTDATE} // FPC 64bit RTL is faster ! 25 | {$ELSE} 26 | {$DEFINE FASTDAYOF} 27 | {$DEFINE FASTMONTHOF} 28 | {$DEFINE FASTDAYOFYEAR} 29 | {$DEFINE FASTYEAROF} 30 | {$ENDIF} 31 | {$ELSE} 32 | 33 | // 32bit 34 | 35 | {$IFNDEF FPC} 36 | {$DEFINE FASTDAYOF} 37 | {$DEFINE FASTMONTHOF} 38 | {$ENDIF} 39 | 40 | {$DEFINE FASTDAYOFYEAR} 41 | {$DEFINE FASTYEAROF} 42 | {$ENDIF} 43 | 44 | {$ENDIF} 45 | 46 | interface 47 | 48 | uses 49 | {$IFDEF FPC}SysUtils{$ELSE}System.SysUtils{$ENDIF}; 50 | 51 | // Speed optimization, use only the Date part of timestamp 52 | {$DEFINE DATESTAMP} 53 | 54 | // Speed optimization, use lookup tables instead of loops 55 | {$DEFINE LOOKUP} 56 | 57 | type 58 | TFastDateTime=record 59 | private 60 | {$IFDEF FASTDATE} 61 | const 62 | D1 = 365; 63 | D4 = D1 * 4 + 1; 64 | D100 = D4 * 25 - 1; 65 | D400 = D100 * 4 + 1; 66 | 67 | class function CalcDayOfYear(T: Integer; out Y:Word): Word; static; 68 | class function CalcLeap(T: Integer; out D:Word): Boolean; static; 69 | 70 | {$IFDEF DATESTAMP} 71 | class function DateTimeToDateStamp(const DateTime: TDateTime): Integer; static; 72 | {$ENDIF} 73 | 74 | class function DayMonth(const T:Integer; out M:Byte): Word; overload; static; 75 | 76 | class function DayOf(const Date: Integer): Word; overload; static; 77 | class function DayOfTheYear(const Date: Integer): Word; overload; static; 78 | class function MonthOf(const Date: Integer): Byte; overload; static; 79 | class function YearOf(Date: Integer): Word; overload; static; 80 | {$ENDIF} 81 | public 82 | {$IFDEF FASTDATE} 83 | class function DayOf(const DateTime: TTimeStamp): Word; overload; inline; static; 84 | class function DayOfTheYear(const DateTime: TTimeStamp):Word; overload; inline; static; 85 | class function MonthOf(const DateTime: TTimeStamp): Byte; overload; inline; static; 86 | class function YearOf(const DateTime: TTimeStamp): Word; overload; inline; static; 87 | {$ENDIF} 88 | 89 | class function DayOf(const DateTime: TDateTime): Word; overload; inline; static; 90 | class function DayOfTheYear(const DateTime: TDateTime):Word; overload; inline; static; 91 | class function MonthOf(const DateTime: TDateTime): Byte; overload; inline; static; 92 | class function YearOf(const DateTime: TDateTime): Word; overload; inline; static; 93 | end; 94 | 95 | implementation 96 | 97 | uses 98 | {$IFDEF FPC}Math, DateUtils{$ELSE}System.Math{$ENDIF}; 99 | 100 | {$IFDEF FASTDATE} 101 | 102 | // Optimized from DateUtils.pas 103 | class function TFastDateTime.YearOf(Date: Integer): Word; 104 | var 105 | D, I: Word; 106 | begin 107 | if Date <= 0 then 108 | result:= 0 109 | else 110 | begin 111 | Dec(Date); 112 | result := 1; 113 | 114 | while Date >= D400 do 115 | begin 116 | Dec(Date, D400); 117 | Inc(result, 400); 118 | end; 119 | 120 | DivMod(Date, D100, I, D); 121 | 122 | if I>0 then 123 | begin 124 | if I = 4 then 125 | begin 126 | Dec(I); 127 | Inc(D, D100); 128 | end; 129 | 130 | Inc(result, I * 100); 131 | end; 132 | 133 | DivMod(D, D4, I, D); 134 | 135 | if I>0 then 136 | Inc(result, I * 4); 137 | 138 | I := D div D1; 139 | 140 | if I>0 then 141 | begin 142 | if I = 4 then 143 | Dec(I); 144 | 145 | Inc(result, I); 146 | end; 147 | end; 148 | end; 149 | 150 | class function TFastDateTime.YearOf(const DateTime: TTimeStamp): Word; 151 | begin 152 | result:=YearOf(DateTime.Date); 153 | end; 154 | 155 | class function TFastDateTime.CalcDayOfYear(T: Integer; out Y: Word): Word; 156 | var I : Word; 157 | begin 158 | Dec(T); 159 | 160 | //Y:=400*(T div D400); 161 | //T:=T mod D400; 162 | 163 | Y := 1; 164 | 165 | while T >= D400 do 166 | begin 167 | Dec(T, D400); 168 | Inc(Y, 400); 169 | end; 170 | 171 | DivMod(T, D100, I, result); 172 | 173 | if I>0 then 174 | begin 175 | if I = 4 then 176 | begin 177 | Dec(I); 178 | Inc(result, D100); 179 | end; 180 | 181 | Inc(Y, I * 100); 182 | end; 183 | 184 | DivMod(result, D4, I, result); 185 | 186 | if I>0 then 187 | Inc(Y, I * 4); 188 | 189 | DivMod(result, D1, I, result); 190 | 191 | if I>0 then 192 | begin 193 | if I = 4 then 194 | begin 195 | Dec(I); 196 | Inc(result, D1); 197 | end; 198 | 199 | Inc(Y, I); 200 | end; 201 | end; 202 | 203 | class function TFastDateTime.CalcLeap(T: Integer; out D:Word): Boolean; 204 | var Y : Word; 205 | begin 206 | D:=CalcDayOfYear(T,Y); 207 | result:=IsLeapYear(Y); 208 | end; 209 | 210 | {$IFDEF LOOKUP} 211 | type 212 | TLeapLookup=record 213 | public 214 | const Month:Array[0..365] of Byte= 215 | ( 216 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 217 | 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 218 | 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 219 | 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, 220 | 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 221 | 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 222 | 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 223 | 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 224 | 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 225 | 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, 226 | 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, 227 | 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12 228 | ); 229 | 230 | const Day:Array[0..365] of Byte= 231 | ( 232 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 233 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29, 234 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 235 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 236 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 237 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 238 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 239 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 240 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 241 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 242 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 243 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31 244 | ); 245 | end; 246 | 247 | TLookup=record 248 | public 249 | const Month:Array[0..364] of Byte= 250 | ( 251 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 252 | 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 253 | 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 254 | 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, 255 | 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 256 | 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 257 | 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 258 | 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 259 | 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 260 | 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10, 261 | 11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, 262 | 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12 263 | ); 264 | 265 | const Day:Array[0..364] of Byte= 266 | ( 267 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 268 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28, 269 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 270 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 271 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 272 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 273 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 274 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 275 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 276 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31, 277 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30, 278 | 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31 279 | ); 280 | end; 281 | 282 | {$ENDIF} 283 | 284 | class function TFastDateTime.DayMonth(const T: Integer; out M:Byte): Word; 285 | {$IFNDEF LOOKUP} 286 | type 287 | TDayTable = array[1..12] of Byte; 288 | 289 | const 290 | MonthDays: TDayTable = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 291 | LeapMonthDays: TDayTable = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 292 | 293 | var I: Byte; 294 | {$ENDIF} 295 | begin 296 | {$IFNDEF LOOKUP} 297 | M:=1; 298 | {$ENDIF} 299 | 300 | if CalcLeap(T,result) then 301 | begin 302 | {$IFDEF LOOKUP} 303 | M:=TLeapLookup.Month[result]; 304 | result:=TLeapLookup.Day[result]; 305 | {$ELSE} 306 | while True do 307 | begin 308 | I := LeapMonthDays[M]; 309 | if result < I then Break; 310 | Dec(result, I); 311 | Inc(M); 312 | end; 313 | {$ENDIF} 314 | end 315 | else 316 | begin 317 | {$IFDEF LOOKUP} 318 | M:=TLookup.Month[result]; 319 | result:=TLookup.Day[result]; 320 | {$ELSE} 321 | while True do 322 | begin 323 | I := MonthDays[M]; 324 | if result < I then Break; 325 | Dec(result, I); 326 | Inc(M); 327 | end; 328 | {$ENDIF} 329 | end; 330 | 331 | {$IFNDEF LOOKUP} 332 | Inc(result); 333 | {$ENDIF} 334 | end; 335 | 336 | class function TFastDateTime.MonthOf(const Date: Integer): Byte; 337 | begin 338 | if Date<=0 then 339 | result:=0 340 | else 341 | DayMonth(Date,result); 342 | end; 343 | 344 | class function TFastDateTime.MonthOf(const DateTime: TTimeStamp): Byte; 345 | begin 346 | result:=MonthOf(DateTime.Date); 347 | end; 348 | 349 | class function TFastDateTime.DayOf(const Date: Integer): Word; 350 | var M: Byte; 351 | begin 352 | if Date<=0 then 353 | result:=0 354 | else 355 | result:=DayMonth(Date,M); 356 | end; 357 | 358 | class function TFastDateTime.DayOf(const DateTime: TTimeStamp): Word; 359 | begin 360 | result:=DayOf(DateTime.Date); 361 | end; 362 | 363 | class function TFastDateTime.DayOfTheYear(const Date: Integer): Word; 364 | var Y: Word; 365 | begin 366 | if Date<=0 then 367 | result:=0 368 | else 369 | result:=CalcDayOfYear(Date,Y)+1; 370 | end; 371 | 372 | {$IFDEF DATESTAMP} 373 | class function TFastDateTime.DateTimeToDateStamp(const DateTime: TDateTime): Integer; 374 | const 375 | FMSecsPerDay: Single = MSecsPerDay; 376 | IMSecsPerDay: Integer = MSecsPerDay; 377 | 378 | begin 379 | Result := DateDelta + (Round(DateTime * FMSecsPerDay) div IMSecsPerDay); 380 | end; 381 | {$ENDIF} 382 | 383 | class function TFastDateTime.DayOfTheYear(const DateTime: TTimeStamp): Word; 384 | begin 385 | result:=DayOfTheYear(DateTime.Date); 386 | end; 387 | {$ENDIF} 388 | 389 | class function TFastDateTime.DayOf(const DateTime: TDateTime): Word; 390 | begin 391 | {$IFDEF FASTDAYOF} 392 | {$IFDEF DATESTAMP} 393 | result:=DayOf(DateTimeToDateStamp(DateTime)); 394 | {$ELSE} 395 | result:=DayOf(DateTimeToTimeStamp(DateTime).Date); 396 | {$ENDIF} 397 | {$ELSE} 398 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.DayOf(DateTime); 399 | {$ENDIF} 400 | end; 401 | 402 | class function TFastDateTime.DayOfTheYear(const DateTime: TDateTime): Word; 403 | begin 404 | {$IFDEF FASTDAYOFYEAR} 405 | {$IFDEF DATESTAMP} 406 | result:=DayOfTheYear(DateTimeToDateStamp(DateTime)); 407 | {$ELSE} 408 | result:=DayOfTheYear(DateTimeToTimeStamp(DateTime).Date); 409 | {$ENDIF} 410 | {$ELSE} 411 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.DayOfTheYear(DateTime); 412 | {$ENDIF} 413 | end; 414 | 415 | class function TFastDateTime.MonthOf(const DateTime: TDateTime): Byte; 416 | begin 417 | {$IFDEF FASTMONTHOF} 418 | {$IFDEF DATESTAMP} 419 | result:=MonthOf(DateTimeToDateStamp(DateTime)); 420 | {$ELSE} 421 | result:=MonthOf(DateTimeToTimeStamp(DateTime).Date); 422 | {$ENDIF} 423 | {$ELSE} 424 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.MonthOf(DateTime); 425 | {$ENDIF} 426 | end; 427 | 428 | class function TFastDateTime.YearOf(const DateTime: TDateTime): Word; 429 | begin 430 | {$IFDEF FASTYEAROF} 431 | {$IFDEF DATESTAMP} 432 | result:=YearOf(DateTimeToDateStamp(DateTime)); 433 | {$ELSE} 434 | result:=YearOf(DateTimeToTimeStamp(DateTime).Date); 435 | {$ENDIF} 436 | {$ELSE} 437 | result:={$IFNDEF FPC}System.{$ENDIF}DateUtils.YearOf(DateTime); 438 | {$ENDIF} 439 | end; 440 | 441 | end. 442 | -------------------------------------------------------------------------------- /Unit_Fast_Test.dfm: -------------------------------------------------------------------------------- 1 | object FormTest: TFormTest 2 | Left = 0 3 | Top = 0 4 | Caption = 'FastDateTime Test' 5 | ClientHeight = 304 6 | ClientWidth = 340 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poOwnerFormCenter 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object LTest: TLabel 19 | Left = 112 20 | Top = 261 21 | Width = 3 22 | Height = 13 23 | end 24 | object Memo1: TMemo 25 | Left = 16 26 | Top = 56 27 | Width = 305 28 | Height = 177 29 | TabOrder = 0 30 | end 31 | object Button1: TButton 32 | Left = 16 33 | Top = 256 34 | Width = 75 35 | Height = 25 36 | Caption = '&Verify' 37 | TabOrder = 1 38 | OnClick = Button1Click 39 | end 40 | object Button2: TButton 41 | Left = 16 42 | Top = 15 43 | Width = 75 44 | Height = 25 45 | Caption = 'Test' 46 | TabOrder = 2 47 | OnClick = Button2Click 48 | end 49 | end 50 | -------------------------------------------------------------------------------- /Unit_Fast_Test.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Fast_Test; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | type 10 | TFormTest = class(TForm) 11 | Memo1: TMemo; 12 | Button1: TButton; 13 | LTest: TLabel; 14 | Button2: TButton; 15 | procedure FormCreate(Sender: TObject); 16 | procedure Button1Click(Sender: TObject); 17 | procedure Button2Click(Sender: TObject); 18 | private 19 | { Private declarations } 20 | 21 | procedure TestDay(const D:TDateTime); 22 | procedure TestDayOfYear(const D:TDateTime); 23 | procedure TestMonth(const D:TDateTime); 24 | procedure TestYear(const D:TDateTime); 25 | public 26 | { Public declarations } 27 | end; 28 | 29 | var 30 | FormTest: TFormTest; 31 | 32 | implementation 33 | 34 | {$R *.dfm} 35 | 36 | uses 37 | System.Diagnostics, Tee.FastDateTime, DateUtils; 38 | 39 | function Diff(const ASlow,AFast:Int64):String; 40 | var tmp : Single; 41 | begin 42 | tmp:=100-(AFast*100/ASlow); 43 | 44 | result:='('+FormatFloat('0.##%',tmp)+' faster)'; 45 | end; 46 | 47 | const 48 | TestTimes=5000000; 49 | 50 | procedure TFormTest.TestYear(const D:TDateTime); 51 | var t1 : TStopwatch; 52 | t2,t3 : Int64; 53 | t : Integer; 54 | y : Word; 55 | begin 56 | t1:=TStopwatch.StartNew; 57 | 58 | for t:=1 to TestTimes do 59 | y:=YearOf(D); 60 | 61 | t2:=t1.ElapsedMilliseconds; 62 | 63 | Memo1.Lines.Add('YearOf: '+t2.ToString+' msec '+y.ToString); 64 | 65 | t1:=TStopwatch.StartNew; 66 | 67 | for t:=1 to TestTimes do 68 | y:=TFastDateTime.YearOf(D); 69 | 70 | t3:=t1.ElapsedMilliseconds; 71 | 72 | Memo1.Lines.Add('Fast YearOf: '+t3.ToString+' msec '+y.ToString+' '+Diff(t2,t3)); 73 | end; 74 | 75 | procedure TFormTest.TestMonth(const D:TDateTime); 76 | var t1 : TStopwatch; 77 | t2, t3 : Int64; 78 | t : Integer; 79 | day : Word; 80 | begin 81 | t1:=TStopwatch.StartNew; 82 | 83 | for t:=1 to TestTimes do 84 | day:=MonthOf(D); 85 | 86 | t2:=t1.ElapsedMilliseconds; 87 | 88 | Memo1.Lines.Add('MonthOf: '+t2.ToString+' msec '+day.ToString); 89 | 90 | t1:=TStopwatch.StartNew; 91 | 92 | for t:=1 to TestTimes do 93 | day:=TFastDateTime.MonthOf(D); 94 | 95 | t3:=t1.ElapsedMilliseconds; 96 | 97 | Memo1.Lines.Add('Fast MonthOf: '+t3.ToString+' msec '+day.ToString+' '+Diff(t2,t3)); 98 | end; 99 | 100 | procedure TFormTest.TestDay(const D:TDateTime); 101 | var t1 : TStopwatch; 102 | t2,t3 : Int64; 103 | t : Integer; 104 | day : Word; 105 | begin 106 | t1:=TStopwatch.StartNew; 107 | 108 | for t:=1 to TestTimes do 109 | day:=DayOf(D); 110 | 111 | t2:=t1.ElapsedMilliseconds; 112 | 113 | Memo1.Lines.Add('DayOf: '+t2.ToString+' msec '+day.ToString); 114 | 115 | t1:=TStopwatch.StartNew; 116 | 117 | for t:=1 to TestTimes do 118 | day:=TFastDateTime.DayOf(D); 119 | 120 | t3:=t1.ElapsedMilliseconds; 121 | 122 | Memo1.Lines.Add('Fast DayOf: '+t3.ToString+' msec '+day.ToString+' '+Diff(t2,t3)); 123 | end; 124 | 125 | procedure TFormTest.TestDayOfYear(const D:TDateTime); 126 | var t1 : TStopwatch; 127 | t2,t3 : Int64; 128 | t : Integer; 129 | day : Word; 130 | begin 131 | t1:=TStopwatch.StartNew; 132 | 133 | for t:=1 to TestTimes do 134 | day:=DayOfTheYear(D); 135 | 136 | t2:=t1.ElapsedMilliseconds; 137 | 138 | Memo1.Lines.Add('DayOfYear: '+t2.ToString+' msec '+day.ToString); 139 | 140 | t1:=TStopwatch.StartNew; 141 | 142 | for t:=1 to TestTimes do 143 | day:=TFastDateTime.DayOfTheYear(D); 144 | 145 | t3:=t1.ElapsedMilliseconds; 146 | 147 | Memo1.Lines.Add('Fast DayOfYear: '+t3.ToString+' msec '+day.ToString+' '+Diff(t2,t3)); 148 | end; 149 | 150 | procedure TFormTest.Button1Click(Sender: TObject); 151 | var t : Integer; 152 | y,m,d : Word; 153 | begin 154 | LTest.Caption:=''; 155 | 156 | for t:=1 to Round(EncodeDate(2100,12,31)) do 157 | begin 158 | DecodeDate(t,y,m,d); 159 | 160 | if y<>TFastDateTime.YearOf(t) then 161 | raise Exception.Create('Wrong year: '+DateTimeToStr(t)) 162 | else 163 | if m<>TFastDateTime.MonthOf(t) then 164 | raise Exception.Create('Wrong month: '+DateTimeToStr(t)) 165 | else 166 | if d<>TFastDateTime.DayOf(t) then 167 | raise Exception.Create('Wrong day: '+DateTimeToStr(t)) 168 | else 169 | if DayOfTheYear(t)<>TFastDateTime.DayOfTheYear(t) then 170 | raise Exception.Create('Wrong day of year: '+DateTimeToStr(t)) 171 | end; 172 | 173 | LTest.Caption:='Ok'; 174 | end; 175 | 176 | procedure TFormTest.Button2Click(Sender: TObject); 177 | var D : TDateTime; 178 | begin 179 | Memo1.Clear; 180 | 181 | D:=Now; 182 | //D:=EncodeDate(1994,7,1); 183 | 184 | TestYear(D); 185 | 186 | Memo1.Lines.Add(''); 187 | 188 | TestMonth(D); 189 | 190 | Memo1.Lines.Add(''); 191 | 192 | TestDay(D); 193 | 194 | Memo1.Lines.Add(''); 195 | 196 | TestDayOfYear(D); 197 | end; 198 | 199 | procedure TFormTest.FormCreate(Sender: TObject); 200 | begin 201 | Button2Click(Self); 202 | end; 203 | 204 | end. 205 | --------------------------------------------------------------------------------