AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Kein Streß mehr mit Datum & Zeit

Ein Thema von mz23 · begonnen am 11. Mär 2012
Antwort Antwort
mz23
(Gast)

n/a Beiträge
 
#1

Kein Streß mehr mit Datum & Zeit

  Alt 11. Mär 2012, 08:06
Guten Morgen liebe DP-Gemeinde,

mutig geworden durch lesen dieses Beitrages
http://www.delphipraxis.net/141399-d...unktionen.html

werde ich auch einiges hier reinsetzen, das ich mal in
Bezug auf Datum und Uhrzeit mir zusmmengeschrieben habe

Delphi-Quellcode:

unit FileDateTimeUnit;
{ written by Manfred Zenns Oct 2008 }
{ example values }
{ fTime = 33083, fDate = 14681 }
{ fDateTime = 962167099 }
{ Time: 16:09:54 }
{ Date: 25.10.08 }
{ DateTime: 25.10.08  16:09:54 }

interface

function _FileDateAndTime2Longint(fDate,fTime:word):longint;
function _FileLongint2TimeStr(fDateTime:longint):string;
function _FileLongint2DateStr(fDateTime:longint):string;
function _FileLongint2DateTimeStr(fDateTime:longint):string;

implementation
uses SysUtils;

function _FileDateAndTime2Longint(fDate,fTime:word):longint;
begin
try result:=(longint(fDate) shl 16)+longint(fTime);
except
    on EConvertError do result:=0;
end; {except}
end;

function _FileLongint2TimeStr(fDateTime:longint):string;
begin
try result:=TimeToStr(FileDateToDateTime(fDateTime));
except
    on EConvertError do result:='hh:mm:ss';
end; {except}
end;

function _FileLongint2DateStr(fDateTime:longint):string;
begin
try result:=DateToStr(FileDateToDateTime(fDateTime));
except
    on EConvertError do result:='dd.mm.yy';
end; {except}
end;

function _FileLongint2DateTimeStr(fDateTime:longint):string;
begin
try result:=DateTimeToStr(FileDateToDateTime(fDateTime));
except
    on EConvertError do result:='dd.mm.yy hh:mm:ss';
end; {except}
end;

end.
Eine vorherige Format-Angabe wäre nicht schlecht, um
Übereinstimmung zur Rückgabe der Funktionen mit den
vom Betriebssystem eingestelltem Zeitformat zu erreichen.


Delphi-Quellcode:

unit ProcedureDateTime;
{ ---------------------------------- }
{ written by Manfred Zenns 2008-2012 }
{ ---------------------------------- }
{ these f's and p's works from 1.1.0000 till 31.12.65535 }
{ note: year 02 means 0002 and not 2002, as 96 means 0096 and not 1996 }
{       the 1.st week of a year starts with a week have at least 4 days }
{       the 1.st day of a week is the monday }
{       some smileys if you try to calc ColumbusDay before 1492... }
{       or Christian holidays before 311... }
{ main target of this unit is NOT to use any other unit for its work - okay }
{---------------------------------------------------------------------------}
interface
// uses ProcedureUnit;

type __s2 = string[2];
     __s9 = string[9];
     __s11 = string[11];

// on date, days, months, years
function isLeapYear(Y:word):boolean;
function getMonthDays(M,Y:word):longint;
function getYearDays(Y:word):longint;
function getTotalYearDays(D,M,Y:word):longint;
function getDaysSinceZero(D,M,Y:word):longint;
procedure getDateOfZeroDays(Days:longint; var D,M,Y:word);
function getDate1BeforeDate2(D1,M1,Y1,D2,M2,Y2:word):boolean;
function getDaysBetweenDates(D1,M1,Y1,D2,M2,Y2:word):longint;
procedure getDateAfterAddDMY(Days,Months,Years:longint; var D,M,Y:word);
procedure getDateAfterSubDMY(Days,Months,Years:longint; var D,M,Y:word);
// on time, hours, minutes, seconds
function getSecsSinceZero(H,M,S:word):longint;
procedure getTimeOfZeroSecs(Secs:longint; var H,M,S:word);
function getSecsBetweenTimes(H1,M1,S1,H2,M2,S2:word):longint;
procedure getTimeAfterAddHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
procedure getTimeAfterSubHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
// on weekdays, weeknumbers
function getDayOfWeek(D,M,Y:word):__s9;
function getIndexOfWeek(D,M,Y:word):longint;
procedure getDateFromWeekNumber(WeekNumber,Year:longint; var D,M,Y:word);
function getWeekNumberFromDate(D,M,Y:word):longint;
// on specials
function getZodiacSign(D,M,Y:word):__s11;
// on holidays
procedure getEastern(Year:word; var D,M,Y:word);
procedure getEasternAddDays(Year,AddDays:longint; var D,M,Y:word);
procedure getAshWednesday(Year:word; var D,M,Y:word);
procedure getGoodFriday(Year:word; var D,M,Y:word);
procedure getChristiAscension(Year:word; var D,M,Y:word);
procedure getWhitSunday(Year:word; var D,M,Y:word);
procedure getCorpusChristi(Year:word; var D,M,Y:word);
function getGermanHolidays:string;
procedure getXthWeekDayOfMonthYear(X:byte;WeekDay:__s2;Month,Year:word; var D,M,Y:word);
procedure getMartinLutherKingDay(Year:word; var D,M,Y:word);
procedure getPresidentsDay(Year:word; var D,M,Y:word);
procedure getMemorialDay(Year:word; var D,M,Y:word);
procedure getLabourDay(Year:word; var D,M,Y:word);
procedure getColumbusDay(Year:word; var D,M,Y:word);
procedure getThanksgivingDay(Year:word; var D,M,Y:word);
function getUSAHolidays:string;

implementation

function isLeapYear(Y:word):boolean;
begin
result:=False;
if (Y mod 4 = 0) then begin
   result:=True;
   if (Y mod 100 = 0) then begin
      result:=False;
      if (Y mod 400 = 0) then result:=True;
   end;
end;
end;

function getMonthDays(M,Y:word):longint;
begin
result:=-1;
case M of
  1,3,5,7,8,10,12: result:=31;
         4,6,9,11: result:=30;
                2: if isLeapYear(Y) then result:=29
                                    else result:=28;
end; {case}
end;

function getYearDays(Y:word):longint;
begin
result:=365-28+getMonthDays(2,Y);
end;

function getTotalYearDays(D,M,Y:word):longint;
var i, r : longint;
begin
r:=0;
for i:=1 to M-1 do inc(r,getMonthDays(i,Y));
inc(r,D);
result:=r;
end;

function getDaysSinceZero(D,M,Y:word):longint;
var i, r : longint;
begin
r:=getTotalYearDays(D,M,Y);
for i:=0 to Y-1 do inc(r,getYearDays(i));
result:=r;
end;

procedure getDateOfZeroDays(Days:longint; var D,M,Y:word);
var hD, hM, hY : longint;
begin
hY:=-1;
while (Days > 0) do begin
      inc(hY);
      dec(Days,getYearDays(hY));
end; {while}
inc(Days,getYearDays(hY));
hM:=0; Y:=hY;
while (Days > 0) do begin
      inc(hM);
      if (hM > 12) then break;
      dec(Days,getMonthDays(hM,Y));
end; {while}
if (hM <= 12) then inc(Days,getMonthDays(hM,Y));
hD:=Days;
D:=hD; M:=hM;
end;

function getDate1BeforeDate2(D1,M1,Y1,D2,M2,Y2:word):boolean;
begin {-is Date1 before Date2 then return true-}
result:=(getDaysSinceZero(D1,M1,Y1) > getDaysSinceZero(D2,M2,Y2));
end;

function getDaysBetweenDates(D1,M1,Y1,D2,M2,Y2:word):longint;
var dsz1, dsz2 : longint;
begin
dsz1:=getDaysSinceZero(D1,M1,Y1);
dsz2:=getDaysSinceZero(D2,M2,Y2);
result:=abs(dsz1-dsz2);
end;

procedure getDateAfterAddDMY(Days,Months,Years:longint; var D,M,Y:word);
var dsz, hM : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
inc(dsz,Days);
getDateOfZeroDays(dsz,D,M,Y);
hM:=M; inc(hM,Months); inc(Y,Years);
while (hM > 12) do begin inc(Y); dec(hM,12); end;
M:=hM;
end;

procedure getDateAfterSubDMY(Days,Months,Years:longint; var D,M,Y:word);
var dsz, hM, hY : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
dec(dsz,Days);
if (dsz > 0) then begin
   getDateOfZeroDays(dsz,D,M,Y);
   hM:=M; hY:=Y; dec(hM,Months); dec(hY,Years);
   while (hM < 1) do begin dec(hY); inc(hM,12); end;
   if (hM > 0) then M:=hM else M:=0;
   if (hY > 0) then Y:=hY else Y:=0;
end else begin
   D:=0; M:=0; Y:=0;
end;
end;

//

function getSecsSinceZero(H,M,S:word):longint;
begin
result:=longint(H)*3600+
        longint(M)*60+
        longint(S);
end;

procedure getTimeOfZeroSecs(Secs:longint; var H,M,S:word);
var hH, hM : longint;
begin
Secs:=Secs mod 86400;
hH:=(Secs div 3600); dec(Secs,hH*3600); H:=hH;
hM:=(Secs div 60); dec(Secs,hM*60); M:=hM;
S:=Secs;
end;

function getSecsBetweenTimes(H1,M1,S1,H2,M2,S2:word):longint;
var ssz1, ssz2 : longint;
begin
ssz1:=getSecsSinceZero(H1,M1,S1);
ssz2:=getSecsSinceZero(H2,M2,S2);
result:=abs(ssz1-ssz2);
end;

procedure getTimeAfterAddHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
var ssz : longint;
begin
ssz:=getSecsSinceZero(H,M,S);
inc(ssz,Secs+Minutes*60+Hours*3600);
Ovf:=ssz div 86400;
ssz:=ssz mod 86400;
getTimeOfZeroSecs(ssz,H,M,S);
end;

procedure getTimeAfterSubHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
var ssz : longint;
begin
ssz:=getSecsSinceZero(H,M,S);
dec(ssz,Secs+Minutes*60+Hours*3600); Ovf:=0;
while (ssz < 0) do begin inc(Ovf); inc(ssz,86400); end;
getTimeOfZeroSecs(ssz,H,M,S);
end;

//

function getDayOfWeek(D,M,Y:word):__s9;
var dsz : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
dsz:=dsz mod 7;
case dsz of
  0: result:='Friday'; 1: result:='Saturday';
  2: result:='Sunday'; 3: result:='Monday';
  4: result:='Tuesday'; 5: result:='Wednesday';
  6: result:='Thursday';
end; {case}
end;

function getIndexOfWeek(D,M,Y:word):longint;
var dsz : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
result:=dsz mod 7; {0='Friday' .. 6='Thursday'}
end;

procedure getDateFromWeekNumber(WeekNumber,Year:longint; var D,M,Y:word);
var dow : string[2];
    days : longint;
begin
{first day of a week is the Monday}
{first week is a min 4 days week}
dec(WeekNumber); D:=1; M:=1; Y:=Year;
dow:=copy(getDayOfWeek(1,1,Year),1,2);
{the 1.1.year is monday...}
if (dow='Mo') then days:=7*WeekNumber else
   if (dow='Tu') then begin
      if (WeekNumber = 0) then begin
         D:=31; M:=12; dec(Y); exit;
      end else
         days:=7*WeekNumber-1;
   end else
      if (dow='We') then begin
         if (WeekNumber = 0) then begin
            D:=30; M:=12; dec(Y); exit;
         end else
            days:=7*WeekNumber-2;
      end else
         if (dow='Th') then begin
            if (WeekNumber = 0) then begin
               D:=29; M:=12; dec(Y); exit;
            end else
               days:=7*WeekNumber-3;
         end else
            {the 1.1.year is friday... now we have not longer a 4 days week}
            if (dow='Fr') then begin
               if (WeekNumber = 0) then begin
                  D:=4; exit;
               end else
                  days:=7*WeekNumber+3;
            end else
               if (dow='Sa') then begin
                  if (WeekNumber = 0) then begin
                     D:=3; exit;
                  end else
                     days:=7*WeekNumber+2;
               end else
                  if (dow='Su') then begin
                     if (WeekNumber = 0) then begin
                        D:=2; exit;
                     end else
                        days:=7*WeekNumber+1;
                  end;
getDateAfterAddDMY(days,0,0,D,M,Y);
end;

function getWeekNumberFromDate(D,M,Y:word):longint;
var dow : string[2];
    days, sub : longint;
begin
dow:=copy(getDayOfWeek(1,1,Y),1,2);
days:=getTotalYearDays(D,M,Y);
{the 1.1.year is monday...}
if (dow='Mo') then sub:=1 else
   if (dow='Tu') then sub:=0 else
      if (dow='We') then sub:=-1 else
         if (dow='Th') then sub:=-2 else
            {the 1.1.year is friday... now we have not longer a 4 days week}
            if (dow='Fr') then begin
               if ((M=1) and (D<4)) then begin
                  result:=getWeekNumberFromDate(28,12,Y-1); exit;
               end else
                  sub:=+4
            end else
               if (dow='Sa') then begin
                  if ((M=1) and (D<3)) then begin
                     result:=getWeekNumberFromDate(27,12,Y-1); exit;
                  end else
                     sub:=+3
               end else
                  if (dow='Su') then begin
                     if ((M=1) and (D<2)) then begin
                        result:=getWeekNumberFromDate(26,12,Y-1); exit;
                     end else
                        sub:=+2;
                  end;
{possible values 1..52, 53 -> 1}
result:=1+((days-sub) div 7);
if (result > 52) then result:=1;
end;

function getZodiacSign(D,M,Y:word):__s11;
var days : longint;
begin
days:=getTotalYearDays(D,M,Y);
if (days>= 21) and (days<= 49) then result:='Aquarius';
if (days>= 50) and (days<= 79) then result:='Pisces';
if (days>= 80) and (days<=111) then result:='Aries';
if (days>=112) and (days<=141) then result:='Taurus';
if (days>=142) and (days<=172) then result:='Gemini';
if (days>=173) and (days<=203) then result:='Cancer';
if (days>=204) and (days<=235) then result:='Leo';
if (days>=236) and (days<=266) then result:='Virgo';
if (days>=267) and (days<=296) then result:='Libra';
if (days>=297) and (days<=326) then result:='Scorpio';
if (days>=327) and (days<=355) then result:='Sagittarius';
if (days>=355) or (days<= 20) then result:='Capricorn';
end;

procedure getEastern(Year:word; var D,M,Y:word);
var a,b,c,v4,e,hD,hM,days : longint;
    dow : string[2];
begin
Y:=Year;
a:=y mod 19; b:=y mod 4; c:=y mod 7; v4:=(19*a+24) mod 30;
e:=(2*b+4*c+6*v4+5) mod 7; hD:=22+v4+e; hM:=3;
if (hD>31) then begin hD:=v4+e-9; hM:=4; end;
if ((hD=26) and (hM=4)) then hD:=19;
if ((hD=25) and (hM=4) and (v4=28) and (e=6) and (a>10)) then hD:=18;
D:=hD; M:=hM;
days:=getDaysSinceZero(D,M,Y);
dow:=copy(getDayOfWeek(D,M,Y),1,2);
if (dow='Su') then {okay} else
   if (dow='Mo') then dec(days) else
      if (dow='Tu') then dec(days,2) else
         if (dow='We') then dec(days,3) else
            if (dow='Th') then inc(days,3) else
               if (dow='Fr') then inc(days,2) else
                  if (dow='Sa') then inc(days);
getDateOfZeroDays(days,D,M,Y);
end;

procedure getEasternAddDays(Year,AddDays:longint; var D,M,Y:word);
var days : longint;
begin
getEastern(Year,D,M,Y);
days:=getDaysSinceZero(D,M,Y)+AddDays;
getDateOfZeroDays(days,D,M,Y);
end;

procedure getAshWednesday(Year:word; var D,M,Y:word);
begin {AscherMittwoch -46}
getEasternAddDays(Year,-46,D,M,Y);
end;

procedure getGoodFriday(Year:word; var D,M,Y:word);
begin {KarFreitag -2}
getEasternAddDays(Year,-2,D,M,Y);
end;

procedure getChristiAscension(Year:word; var D,M,Y:word);
begin {Christi Himmelfahrt +39}
getEasternAddDays(Year,+39,D,M,Y);
end;

procedure getWhitSunday(Year:word; var D,M,Y:word);
begin {PfingstSonntag +49}
getEasternAddDays(Year,+49,D,M,Y);
end;

procedure getCorpusChristi(Year:word; var D,M,Y:word);
begin {Fronleichnam +60}
getEasternAddDays(Year,+60,D,M,Y);
end;

function getGermanHolidays:string;
begin {}
result:='NeuJahr=1.1.,'+
        'MaiFeiertag=1.5.,'+
        'TagDerDeutschenEinheit=3.10.,'+
        'Reformationstag=31.10.,'+
        'Weihnachten=24-26.12.';
end;

procedure getXthWeekDayOfMonthYear(X:byte;WeekDay:__s2;Month,Year:word; var D,M,Y:word);
var f,lastf,i: byte;
    dow : __s2;
begin
f:=0; lastf:=0; M:=Month; Y:=Year;
for i:=1 to 31 do begin
    dow:=copy(getDayOfWeek(i,M,Y),1,2);
    if (dow=WeekDay) then begin inc(f); lastf:=i; end;
    if (f=X) then begin D:=i; break; end;
end;
D:=lastf; {force to return the last WeekDay for X > 5}
end;

procedure getMartinLutherKingDay(Year:word; var D,M,Y:word);
begin {MartinLutherKingDay is 3rd Monday in Jan}
getXthWeekDayOfMonthYear(3,'Mo',1,Year,D,M,Y);
end;

procedure getPresidentsDay(Year:word; var D,M,Y:word);
begin {PresidentsDay is 3rd Monday in Feb}
getXthWeekDayOfMonthYear(3,'Mo',2,Year,D,M,Y);
end;

procedure getMemorialDay(Year:word; var D,M,Y:word);
begin {PresidentsDay is LAST(255) Monday in May}
getXthWeekDayOfMonthYear(255,'Mo',5,Year,D,M,Y);
end;

procedure getLabourDay(Year:word; var D,M,Y:word);
begin {LabourDay is 1st Monday in Sep}
getXthWeekDayOfMonthYear(1,'Mo',9,Year,D,M,Y);
end;

procedure getColumbusDay(Year:word; var D,M,Y:word);
begin {ColumbusDay is 2nd Monday in Oct}
getXthWeekDayOfMonthYear(2,'Mo',10,Year,D,M,Y);
end;

procedure getThanksgivingDay(Year:word; var D,M,Y:word);
begin {ThanksgivingDay is 4th Thursday in Nov}
getXthWeekDayOfMonthYear(4,'Th',11,Year,D,M,Y);
end;

function getUSAHolidays:string;
begin {}
result:='NewYearsDay=1.1.,'+
        'VeteransDay=11.11.,'+
        'ChristmasDay=25.12.';
end;

end.
So, das war's auch schon - von meiner Seite

Viele Grüße von Manfred
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:50 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz