was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1547)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (127)
Strings (83)
System (268)
VCL (243)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

27 Visitors Online


 
...Datumsgrenze: Montag bis Freitag der aktuellen Woche ermitteln?
Autor: Loïs Bégué
[ Tip ausdrucken ]  

Tip Bewertung (5):  
     




{
  Data sometimes have to be filtered regarding to working days (Mo.-Fri.) of the
  current Week. Following procs set your TDateTimePicker automatically.

  Zur Filterung von Daten müssen oft Datumsgrenze ermittelt bzw. gesetzt werden.
  Hier geht's um Werkstage (Mo.-Fr.), z.B. zur Vorbelegung von TDateTimePicker.
}


function GetMonday(RefDay: TDate): TDate;
var
  
DoW: Integer;
  DateOffset: Integer;
begin
  
DoW := DayOfWeek(RefDay);
  // Montag der Woche
  
if DoW = 1 then DateOffset := -6 
  else 
    
DateOffset := Dow - 2;
  Result := RefDay - DateOffset;
end;

function GetFriday(RefDay: TDate): TDate;
var
  
DoW: Integer;
  DateOffset: Integer;
begin
  
DoW := DayOfWeek(RefDay);
     {
     Friday of current week
     Freitag der Woche
     }
  
if DoW = 1 then DateOffset := -2 
  else 
    
DateOffset := Dow - 6;
  Result := RefDay - DateOffset;
end;

procedure SetWorkingDaysFilter(S, E: TDateTimePicker);
var
  
N: TDate;
begin
  
N      := Now;
  S.Date := GetMonday(N);
  E.Date := GetFriday(N);
end;

{Just as short as simple}
{Einfach und kurz}


type
  
TForm1 = class(TForm)
    DStart: TDateTimePicker;
    DEnd: TDateTimePicker;
    btSetFilter: TButton;
    procedure btSetFilterClick(Sender: TObject);
  end;

procedure TForm1.btSetFilterClick(Sender: TObject);
begin
  
SetWorkingDaysFilter(DStart, DEnd);
end;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners