Oppure

Loading
10/05/11 19:33
Goblin
non vorrei fare il pignolo :blush::heehee: ma gli anni bisestili ???
Ibis redibis non morieris in bello
11/05/11 17:46
Phi
Giusto.
Eccoti servito:
function numdata(s:string): longword;
var
 i,p,nn,tot, g, m, a:longword;
 ns :string;
 bisestile:boolean;
procedure trovann;
 begin
  p := pos('/', s);
  ns:=copy(s, 1, p-1);
  val(ns,nn);
  delete(s,1,p);
 end;
begin
numdata:=0;
if s='' then exit;
trovann;
g:=nn;
if s='' then exit;
trovann;
if (s='') or (nn>12) or (nn<1) then exit;
m:=nn;
val(s,a);
tot:=g;
bisestile:=(((nn div 4)=0) and (((nn div 100)<>0)or((nn div 400)=0)));
if bisestile giornimese[2]:=29;
if (g<0)or(g>giornimese[m]) then exit;
for i := 1 to nn do tot:=tot+giornimese[i];
tot:=tot+365*nn+(nn div 4)-(nn div 100)+(nn div 400);
if bisestile then begin
 giornimese[2]:=28;
 tot:=tot-1;
end; 
end;


Mi pare sia giusto. Ma non l'ho testato.
Funziona con il calendario Gregoriano.

Logicamente tutto questo è "didattico".
Conviene logicamente fare con sysutils.
Ultima modifica effettuata da Phi 11/05/11 17:47
aaa
11/05/11 23:31
Goblin
io userei un approccio un po' diverso.. più strutturato, ovviamente sono punti di vista

Ho usato la modalità console di delphi

program CalcDate;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  aLastGiorno = array [1..12] of integer;
  TDataRec=record
    gg: integer;
    mm: integer;
    yy: integer;
  end;
Const
  aLastDay:aLastGiorno = (31,28,31,30,31,30,31,31,30,31,30,31);
var sData1, sData2, sExit: String;
    oDataInizio, odataFine: TDataRec;
    nTotDay, x:Integer;

function StrExtractAt(const S:String; Seperator: Char; At: Integer): String;
var
  j,i: Integer;
begin
  Result:='';
  j := 1;
  i := 0;
  while (i <= At ) and (j <= Length(S)) do
  begin
    if S[j]=Seperator then
       Inc(i)
    else if i = At then
       Result:=Result+S[j];
    Inc(j);
  end;
end;

Function IsLeap(nYear:Integer):Boolean;
// Stabilisce se un anno è bisestile
begin
  if (nyear mod 4) <> 0 then
    Result := False
  else
  begin
    if (nyear mod 400) <> 0 then
    begin
      if (nyear mod 100) <> 0 then
        Result := True
      else
        Result := False;
    end
    else
      Result := True;
  end;
end;

Procedure ExtractDataToRecord(Var oRec:TDataRec; s: string);
begin
  oRec.gg := StrToInt(StrExtractAt(s,'/',0));
  oRec.mm := StrToInt(StrExtractAt(s,'/',1));
  oRec.yy := StrToInt(StrExtractAt(s,'/',2));
end;

Function CalcDayYear(nMeseInizio: Integer; IsLeap:Boolean):Integer;
begin
  Result := 0;
  While not (nMeseInizio>12) do
  begin
    if (Isleap) and (nMeseInizio=2) then  // bisestile
      Result := Result + 29
    else
      Result := Result + aLastDay[nMeseInizio];
    inc(nMeseinizio);
  end;
end;

Function calcoladatetime:Integer;
  Var dDataI, dDataF: TDateTime;
begin
  dDataI := StrTodate(sdata1);
  dDataF := StrTodate(sData2);
  Result := Trunc(dDataF - dDataI);
end;

begin
  try
  while True do
  begin
    Writeln('Data di partenza: (gg/mm/yyy)');
    Readln(sData1);
    ExtractDataToRecord(oDataInizio, sData1);
    Writeln('Data di arrivo (> data di partenza): (gg/mm/yyy)');
    Readln(sData2);
    ExtractDataToRecord(oDataFine, sData2);
  // ho riempito i 2 record con le date... adesso devo iniziare i calcoli
    nTotDay :=0;

    if oDataInizio.mm<12 then
      nTotDay :=nTotDay + CalcDayYear(oDataInizio.mm+1, IsLeap(oDataInizio.yy));
    if (IsLeap(oDataInizio.yy)) and (oDataInizio.mm=2) then
      nTotDay :=  29 - oDataInizio.gg
    else
      nTotDay :=  nTotDay+aLastDay[oDataInizio.mm] - oDataInizio.gg;

    for x := oDataInizio.yy+1 to oDataFine.yy - 1 do  // calcolo anni dal successivo al precedente
      nTotDay :=nTotDay + CalcDayYear(1, IsLeap(x));

    if oDataFine.yy>oDataInizio.yy then
    begin
      if oDataFine.mm>1 then
      begin
        for x:= 1 to oDataFine.mm - 1 do
        begin
          if (IsLeap(oDataFine.yy)) and (x=2) then
            nTotDay := nTotDay+ 29
          else
            nTotDay :=  nTotDay+aLastDay[x];
        end;
      end ;
      nTotDay :=  nTotDay + oDataFine.gg;
    end;

    Writeln('giorni calcolati a mano = ', nTotDay);
    nTotDay := Calcoladatetime;
    Writeln('giorni calcolati TDateTime = ', nTotDay);
    readln(sExit);
    if sExit='X'  then
      break;
  end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.



Ho fatto 2 prove e sembra funzionare, chi ne ha voglia lo metta sotto stress e nel caso apporti le opportune modifiche :D

G.
Ibis redibis non morieris in bello
30/05/11 12:38
Petenausen
gli anni bisestili li eliminiamo
aaa
30/05/11 14:06
Goblin
Postato originariamente da Petenausen:

gli anni bisestili li eliminiamo


Già che ci siamo eliminiamo anche gli anni dispari :heehee: .. tanto portano jella :rofl:

Solo un piccolo commento ...
IO (stato ita(g)liano :rotfl: ) ti commissiono un programmino che deve calcolare quanti giorni hai lavorato, in modo da dirti quanto ti manca alla pensione, se mi dai un programma che non conta gli anni bisestili cosa succede ??
G.
Ibis redibis non morieris in bello