whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

33 Visitors Online


 
...get the dates for Monday - Friday of the current week?
Autor: Loïs Bégué
[ Print tip ]  

Tip Rating (6):  
     




{
  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;


 

Rate this tip:

poor
very good


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