cxdateutils.pas
来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,765 行 · 第 1/5 页
PAS
1,765 行
6,3,16,3,28,4,10,2,20,6, // 1830
30,3,11,2,24,4,4,3,15,2, // 1835
25,6,8,1,19,2,29,6,9,3, // 1840
22,4,3,2,13,3,25,4,7,2, // 1845
17,3,27,6,9,1,21,5,1,3, // 1850
11,3,23,4,5,2,15,3,25,6, // 1855
6,2,19,1,29,6,10,2,22,4, // 1860
3,3,14,2,24,6,6,1,18,2, // 1865
28,6,8,3,20,4,2,2,12,3, // 1870
24,4,4,3,16,2,26,6,6,3, // 1875
17,2,0,4,10,3,22,4,3,2, // 1880
14,3,24,6,5,2,17,1,28,6, // 1885
9,2,21,4,1,3,13,2,23,6, // 1890
5,1,15,3,27,5,7,3,19,1, // 1895
0,5,10,3,22,4,2,3,13,2, // 1900
24,6,4,3,15,2,27,4,8,3, // 1905
20,4,1,2,11,3,22,6,3,2, // 1910
15,1,25,6,7,2,17,3,29,4, // 1915
10,2,21,6,1,3,13,1,24,5, // 1920
5,3,15,3,27,4,8,2,19,6, // 1925
1,1,12,2,22,6,3,3,14,2, // 1930
26,4,6,3,18,2,28,6,10,1, // 1935
20,6,2,2,12,3,24,4,5,2, // 1940
16,3,28,4,9,2,19,6,30,3, // 1945
12,1,23,5,3,3,14,3,26,4, // 1950
7,2,17,3,28,6,9,2,21,4, // 1955
1,3,13,2,25,4,5,3,16,2, // 1960
27,6,9,1,19,6,30,2,11,3, // 1965
23,4,4,2,14,3,27,4,7,3, // 1970
18,2,28,6,11,1,22,5,2,3, // 1975
12,3,25,4,6,2,16,3,26,6, // 1980
8,2,20,4,30,3,11,2,24,4, // 1985
4,3,15,2,25,6,8,1,18,3, // 1990
29,5,9,3,22,4,3,2,13,3, // 1995
23,6,6,1,17,2,27,6,7,3, // 2000 - 2004
20,4,1,2,11,3,23,4,5,2, // 2005 - 2009
15,3,25,6,6,2,19,1,29,6, // 2010
10,2,20,6,3,1,14,2,24,6, // 2015
4,3,17,1,28,5,8,3,20,4, // 2020
1,3,12,2,22,6,2,3,14,2, // 2025
26,4,6,3,17,2,0,4,10,3, // 2030
20,6,1,2,14,1,24,6,5,2, // 2035
15,3,28,4,9,2,19,6,1,1, // 2040
12,3,23,5,3,3,15,1,27,5, // 2045
7,3,17,3,29,4,11,2,21,6, // 2050
1,3,12,2,25,4,5,3,16,2, // 2055
28,4,9,3,19,6,30,2,12,1, // 2060
23,6,4,2,14,3,26,4,8,2, // 2065
18,3,0,4,10,3,22,5,2,3, // 2070
14,1,25,5,6,3,16,3,28,4, // 2075
9,2,20,6,30,3,11,2,23,4, // 2080
4,3,15,2,27,4,7,3,19,2, // 2085
29,6,11,1,21,6,3,2,13,3, // 2090
25,4,6,2,17,3,27,6,9,1, // 2095
20,5,30,3,10,3,22,4,3,2, // 2100
14,3,24,6,5,2,17,1,28,6, // 2105
9,2,21,4,1,3,13,2,23,6, // 2110
5,1,16,2,27,6,7,3,19,4, // 2115
30,2,11,3,23,4,3,3,14,2, // 2120
25,6,5,3,16,2,28,4,9,3, // 2125
21,4,2,2,12,3,23,6,4,2, // 2130
16,1,26,6,8,2,20,4,30,3, // 2135
11,2,22,6,4,1,14,3,25,5, // 2140
6,3,18,1,29,5,9,3,22,4, // 2145
2,3,13,2,23,6,4,3,15,2, // 2150
27,4,7,3,20,4,1,2,11,3, // 2155
21,6,3,2,15,1,25,6,6,2, // 2160
17,3,29,4,10,2,20,6,3,1, // 2165
13,3,24,5,4,3,17,1,28,5, // 2170
8,3,18,6,1,1,12,2,22,6, // 2175
2,3,14,2,26,4,6,3,17,2, // 2180
28,6,10,1,20,6,1,2,12,3, // 2185
24,4,5,2,15,3,28,4,9,2, // 2190
19,6,33,3,12,1,23,5,3,3, // 2195
13,3,25,4,6,2,16,3,26,6, // 2200
8,2,20,4,30,3,11,2,24,4, // 2205
4,3,15,2,25,6,8,1,18,6, // 2210
33,2,9,3,22,4,3,2,13,3, // 2215
25,4,6,3,17,2,27,6,9,1, // 2220
21,5,1,3,11,3,23,4,5,2, // 2225
15,3,25,6,6,2,19,4,33,3, // 2230
10,2,22,4,3,3,14,2,24,6, // 2235
6,1); // 2240 (Hebrew year: 6000)
cxHebrewLunarMonthLen: array [0..6,0..13] of Integer = (
(0,00,00,00,00,00,00,00,00,00,00,00,00,0),
(0,30,29,29,29,30,29,30,29,30,29,30,29,0), // 3 common year variations
(0,30,29,30,29,30,29,30,29,30,29,30,29,0),
(0,30,30,30,29,30,29,30,29,30,29,30,29,0),
(0,30,29,29,29,30,30,29,30,29,30,29,30,29), // 3 leap year variations
(0,30,29,30,29,30,30,29,30,29,30,29,30,29),
(0,30,30,30,29,30,30,29,30,29,30,29,30,29));
cxHebrewYearOf1AD = 3760;
cxHebrewFirstGregorianTableYear = 1583;
cxHebrewLastGregorianTableYear = 2239;
cxHebrewTableYear = cxHebrewLastGregorianTableYear - cxHebrewFirstGregorianTableYear;
type
TcxDateOrder = (doMDY, doDMY, doYMD);
TcxMonthView = (mvName, mvDigital, mvNone);
TcxYearView = (yvFourDigitals, yvTwoDigitals, yvNone);
function GetDateOrder(const ADateFormat: string): TcxDateOrder;
var
I: Integer;
begin
Result := doMDY;
I := 1;
while I <= Length(ADateFormat) do
begin
case Chr(Ord(ADateFormat[I]) and $DF) of
'E': Result := doYMD;
'Y': Result := doYMD;
'M': Result := doMDY;
'D': Result := doDMY;
else
Inc(I);
Continue;
end;
Exit;
end;
Result := doMDY;
end;
function cxDateToStrByFormat(const ADate: TDateTime; const ADateFormat: string; const ADateSeparator: Char): string;
function AddZeros(const S: string; ALength: Integer): string;
begin
Result := S;
if ALength <= Length(S) then
Exit;
Result := StringOfChar('0', ALength - Length(Result)) + Result;
end;
function GetCountChar(const S: string; Ch: Char; var APos: Integer): Integer;
begin
Result := APos;
while (APos <= Length(S)) and (S[APos] = Ch)do
Inc(APos);
Result := APos - Result;
end;
function GetMonthView(const ADateFormat: string; var APos: Integer): TcxMonthView;
var
ACount: Integer;
begin
ACount := GetCountChar(AnsiLowerCase(ADateFormat), 'm', APos);
if ACount = 4 then
Result := mvName
else
if ACount = 0 then
Result := mvNone
else
Result := mvDigital;
end;
function GetYearView(const ADateFormat: string; var APos: Integer): TcxYearView;
var
ACount: Integer;
begin
ACount := GetCountChar(AnsiLowerCase(ADateFormat), 'y', APos);
if ACount = 4 then
Result := yvFourDigitals
else
if ACount = 0 then
Result := yvNone
else
Result := yvTwoDigitals;
end;
function MonthToStr(AMonth: Integer; AView: TcxMonthView): string;
begin
case AView of
mvName:
Result := LongMonthNames[AMonth];
mvDigital:
Result := AddZeros(IntToStr(AMonth), 2);
else
Result := '';
end;
end;
function YearToStr(AYear: Integer; AView: TcxYearView): string;
begin
if AView = yvNone then
begin
Result := '';
Exit;
end;
Result := IntToStr(AYear);
if Length(Result) > 4 then
Result := Copy(Result, Length(Result) - 3, 4);
Result := AddZeros(Result, 4);
if AView = yvTwoDigitals then
Result := Copy(Result, Length(Result) - 1, 2);
end;
function FindNextAllowChar(const S: string; var APos: Integer): Boolean;
begin
while (APos <= Length(S)) and not (AnsiLowerCase(S[APos])[1] in ['d', 'm', 'y']) do
Inc(APos);
Result := (APos <= Length(S)) and (AnsiLowerCase(S[APos])[1] in ['d', 'm', 'y']);
end;
procedure AddToDateParth(var ADateString: string; const AParth: string; const ASeparator: string);
begin
if Length(ADateString) > 0 then
if ADateSeparator <> '' then
ADateString := ADateString + ADateSeparator
else
ADateString := ADateString + ASeparator;
ADateString := ADateString + AParth;
end;
var
ASystemDate: TSystemTime;
APos: Integer;
ACurrentSeparator: string;
ACountChar: Integer;
ADayOfWeek: Integer;
begin
DateTimeToSystemTime(ADate, ASystemDate);
ADayOfWeek := ASystemDate.wDayOfWeek;
Inc(ADayOfWeek);
if ADayOfWeek > 7 then
Dec(ADayOfWeek, 7);
APos := 1;
ACurrentSeparator := '';
FindNextAllowChar(ADateFormat, APos);
while APos <= Length(ADateFormat) do
begin
case AnsiLowerCase(ADateFormat[APos])[1] of
'd':
begin
ACountChar := GetCountChar(ADateFormat, 'd', APos);
if ACountChar = 3 then
AddToDateParth(Result, ShortDayNames[ADayOfWeek], ACurrentSeparator)
else
if ACountChar = 4 then
AddToDateParth(Result, LongDayNames[ADayOfWeek], ACurrentSeparator)
else
if ACountChar = 2 then
AddToDateParth(Result, AddZeros(IntToStr(ASystemDate.wDay), 2), ACurrentSeparator)
else
AddToDateParth(Result, IntToStr(ASystemDate.wDay), ACurrentSeparator);
ACurrentSeparator := '';
end;
'y':
begin
AddToDateParth(Result, YearToStr(ASystemDate.wYear, GetYearView(ADateFormat, APos)), ACurrentSeparator);
ACurrentSeparator := '';
end;
'm':
begin
AddToDateParth(Result, MonthToStr(ASystemDate.wMonth, GetMonthView(ADateFormat, APos)), ACurrentSeparator);
ACurrentSeparator := '';
end;
'e':
begin
FindNextAllowChar(ADateFormat, APos);
ACurrentSeparator := '';
end;
else
begin
ACurrentSeparator := ACurrentSeparator + ADateFormat[APos];
Inc(APos);
end;
end;
end;
end;
procedure ScanBlanks(const S: string; var APos: Integer);
var
I: Integer;
begin
I := APos;
while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
APos := I;
end;
function cxDateToLocalFormatStr(ADate: TDateTime): string;
var
ATime: TTime;
begin
cxGetDateFormat(ADate, Result, 0, cxGetLocalShortDateFormat);
ATime := TimeOf(ADate);
if ATime > 0 then
Result := Result + ' ' + TimeToStr(ATime);
end;
function cxDateToStr(ADate: TDateTime): string;
begin
Result := cxDateToStrByFormat(ADate, ShortDateFormat, DateSeparator);
end;
function cxDateToStr(ADate: TDateTime; AFormat: TFormatSettings): string;
begin
Result := cxDateToStrByFormat(ADate, AFormat.ShortDateFormat, AFormat.DateSeparator);
end;
function cxDayNumberToLocalFormatStr(ADate: TDateTime): string;
var
AOldFormatShortDate: string;
begin
if not cxGetDateFormat(ADate, Result, 0, 'd') then
begin
AOldFormatShortDate := ShortDateFormat;
ShortDateFormat := 'd';
try
Result := DateToStr(ADate);
finally
ShortDateFormat := AOldFormatShortDate;
end;
end;
end;
function cxDayNumberToLocalFormatStr(ADay: Integer; ACalendar: TcxCustomCalendarTable = nil): string;
var
ADate: TcxDate;
ANeedFreeAndNilCalendar: Boolean;
begin
if ACalendar = nil then
begin
ACalendar := cxGetLocalCalendar;
ANeedFreeAndNilCalendar := True;
end
else
ANeedFreeAndNilCalendar := False;
try
with ADate do
begin
Year := ACalendar.GetMinSupportedYear;
Month := 1;
Day := ADay;
end;
Result := cxDayNumberToLocalFormatStr(ACalendar.ToDateTime(ADate));
finally
if ANeedFreeAndNilCalendar then
FreeAndNil(ACalendar);
end;
end;
function cxGetCalendar(ACalendType: CALTYPE): TcxCustomCalendarTable;
begin
case ACalendType of
CAL_GREGORIAN, CAL_GREGORIAN_US, CAL_GREGORIAN_ME_FRENCH, CAL_GREGORIAN_ARABIC,
CAL_GREGORIAN_XLIT_ENGLISH, CAL_GREGORIAN_XLIT_FRENCH:
begin
Result := TcxGregorianCalendarTable.Create;
TcxGregorianCalendarTable(Result).GregorianCalendarType := TcxGregorianCalendarTableType(ACalendType);
end;
CAL_JAPAN:
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?