home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / SRCal.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-10-21  |  35.2 KB  |  1,221 lines
  1. unit SRCal;
  2.  
  3. { TSRCalendar (C)opyright 2001 Version 1.40
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Die Komponente TSRCalendar ist eine Weiterentwicklung der
  9.   TCalendar-Komponente aus den Beispielkomponenten der Delphi-VCL.
  10.   Sie enthΣlt viele Zusatzinformationen, wie Feiertage,
  11.   Sternzeichen und verschiedene astronomische Daten.
  12.  
  13.   Die Routinen aus der Unit TimeFunc stammen aus der TMoon-Komponente
  14.   von Andreas H÷rstemeier : http://www.westend.de/~hoerstemeier/index_d.htm
  15.   Andreas hat die Routinen aus dem Buch "Astronomical Algorithms" von Jean Meeus.
  16.  
  17.   Die GetWeekOfYear-Funktion, die die Wochennummer nach DIN 1355 ermittelt,
  18.   stammt von Christoph Kremer, Aachen.
  19.  
  20.   Vielen Dank auch an:
  21.   - Edmund Matzke <edmund_matzke@gmx.de> fⁿr die Korrektur der
  22.     Schleswig-Holsteinischen Feiertage,
  23.   - Matthias Frey <info@Matthias-Frey.de> fⁿr die Korrektur der
  24.     Advents-Berechnung.
  25.   - Robert Rossmair fⁿr seine rrColors-Unit!
  26.  
  27.   Diese Komponenten sind Public Domain, das Urheberrecht liegt aber beim Autor. }
  28.  
  29. interface
  30.  
  31. {$I SRDefine.inc}
  32.  
  33. uses {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, Menus, {$ENDIF}
  34.   Classes, Controls, Messages, Forms, Graphics, StdCtrls, Grids, SysUtils;
  35.  
  36. const
  37.   Feiertage : array [1..19] of string[25] =
  38.    ('Neujahr', 'Maifeiertag', 'Tag der deutschen Einheit', 'Allerheiligen',
  39.     'Totensonntag', 'Volkstrauertag', '1. Weihnachtstag', '2. Weihnachtstag',
  40.     'Karfreitag', 'Ostersonntag', 'Ostermontag', 'Christi Himmelfahrt',
  41.     'Pfingstsonntag', 'Pfingstmontag', 'Fronleichnam', 'Heilige 3 K÷nige',
  42.     'MariΣ Himmelfahrt', 'Reformationstag', 'Bu▀- und Bettag');
  43.   Sondertage : array [1..24] of string[25] =
  44.    ('MariΣ Lichtme▀', 'Valentinstag', 'Weiberfastnacht', 'Rosenmontag', 'Fastnacht',
  45.     'Aschermittwoch', 'MariΣ Verkⁿndigung', 'Palmsonntag', 'Grⁿndonnerstag', 'Muttertag',
  46.     'Peter und Paul', 'MariΣ Geburt', 'Erntedankfest', 'MariΣ EmpfΣngnis', 'Silvester',
  47.     '1. Advent', '2. Advent', '3. Advent', '4. Advent', 'Heiligabend', 'Frⁿhlingsanfang',
  48.     'Sommmeranfang', 'Herbstanfang', 'Winteranfang');
  49.   SternzNamen : array [0..11] of string[10] =
  50.    ('Wassermann', 'Fische', 'Widder', 'Stier', 'Zwilling', 'Krebs', 'L÷we', 'Jungfrau',
  51.     'Waage', 'Skorpion', 'Schⁿtze', 'Steinbock');
  52.   Bundeslaender : array [0..15] of string[25] =
  53.    ('Baden-Wⁿrttemberg', 'Bayern', 'Berlin', 'Brandenburg', 'Bremen', 'Hamburg',
  54.     'Hessen', 'Mecklenburg-Vorpommern', 'Niedersachsen', 'Nordrhein-Westfalen', 
  55.     'Rheinland-Pfalz', 'Saarland', 'Sachsen', 'Sachsen-Anhalt', 'Schleswig-Holstein', 
  56.     'Thⁿringen');
  57.   Laenge : array [0..15] of extended =
  58.    (-9, -11.5, -13.4, -13.4, -8.8, -10, -8.7, -12.2, -8.8, -7.5, -7.3, -7, -14, -11.7, -10.2, -11);
  59.   Breite : array [0..15] of extended =
  60.    (48.6, 48.8, 52.5, 52.5, 53.1, 53.5, 50.5, 53.7, 53.1, 51.6, 50.2, 49.2, 51, 52, 54.3, 51);
  61.  
  62. type
  63.   TBundesland =
  64.    (Baden_Wuerttemberg, Bayern, Berlin, Brandenburg, Bremen, Hamburg,
  65.     Hessen, Mecklenburg_Vorpommern, Niedersachsen, Nordrhein_Westfalen,
  66.     Rheinland_Pfalz, Saarland, Sachsen, Sachsen_Anhalt, Schleswig_Holstein,
  67.     Thueringen);
  68.   TCalendarDrawStyle = (cdsColorGrid, cdsMonoGrid, cdsButtons);
  69.   TCalendarOption = (coAutoDeleteMarks, coCalcAstroData, coCalcHolidays,
  70.                      coGridLines, coReadOnly, coFrameSelection, coShowMarks,
  71.                      coUseCurrentDate);
  72.   TCalendarOptions = set of TCalendarOption;
  73.   TDayOfWeek = 0..6;
  74.   THolidays = array [1..31] of integer;
  75.   TMarked = array [1..31] of boolean;
  76.   TMoonPhase = (Neumond, zunehmend, Vollmond, abnehmend);
  77.  
  78.   TCalendarColors = class(TPersistent)
  79.   private
  80.     FHeaders,
  81.     FHoliday,
  82.     FMarked,
  83.     FSelected,
  84.     FStandard,
  85.     FToday,
  86.     FWeekend   : TColor;
  87.   published
  88.     property Headers: TColor read FHeaders write FHeaders;
  89.     property Holiday: TColor read FHoliday write FHoliday;
  90.     property Marked: TColor read FMarked write FMarked;
  91.     property Selected: TColor read FSelected write FSelected;
  92.     property Standard: TColor read FStandard write FStandard;
  93.     property Today: TColor read FToday write FToday;
  94.     property Weekend: TColor read FWeekend write FWeekend;
  95.   end;
  96.  
  97.   TSRCalendar = class(TCustomGrid)
  98.   private
  99.     FBackgroundColors    : TCalendarColors;
  100.     FBundesland          : TBundesland;
  101.     FCalendarOptions     : TCalendarOptions;
  102.     FDate                : TDateTime;
  103.     FDaysThisMonth       : integer;
  104.     FDrawStyle           : TCalendarDrawStyle;
  105.     FHoliday             : string;
  106.     FHolidayNr           : integer;
  107.     FHolidays            : THolidays;
  108.     FMarked              : TMarked;
  109.     FMonthOffset         : Integer;
  110.     FMoonDistance        : extended;
  111.     FMoonPhase           : TMoonPhase;
  112.     FMoonRise,
  113.     FMoonSet,
  114.     FMoonTransit         : TDateTime;
  115.     FStartOfWeek         : TDayOfWeek;
  116.     FSternzeichen        : string;
  117.     FSternzeichenNr      : integer;
  118.     FSunDistance         : extended;
  119.     FSunRise,
  120.     FSunSet,
  121.     FSunTransit          : TDateTime;
  122.     FTextColors          : TCalendarColors;
  123.     FUpdating            : Boolean;
  124.     FWeekOfYear,
  125.     FDayOfYear           : integer;
  126.  
  127.     FOnBeforeChange,
  128.     FOnChange,
  129.     FOnMonthChange,
  130.     FOnYearChange        : TNotifyEvent;
  131.  
  132.     function GetCellText(ACol, ARow: Integer): string;
  133.     function GetDateElement(Index: Integer): Integer;
  134.     function GetHolidays(Index: integer): integer;
  135.     function GetMarked(Index: integer): boolean;
  136.     procedure GetMoonData(Dat:TDateTime);
  137.     function GetSternzeichenNr(Dat:TDateTime):integer;
  138.     procedure GetSunData(Dat:TDateTime);
  139.     procedure SetBackgroundColors(newValue: TCalendarColors);
  140.     procedure SetBundesland(NewValue: TBundesland);
  141.     procedure SetCalendarOptions(newValue: TCalendarOptions);
  142.     procedure SetDate(Value: TDateTime);
  143.     procedure SetDateElement(Index: Integer; Value: Integer);
  144.     procedure SetDrawStyle(newValue: TCalendarDrawStyle);
  145.     procedure SetHolidays(Index: integer; newValue: integer);
  146.     procedure SetMarked(Index: integer; newValue: boolean);
  147.     procedure SetStartOfWeek(Value: TDayOfWeek);
  148.     procedure SetTextColors(newValue: TCalendarColors);
  149.     function StoreDate: Boolean;
  150.  
  151.   protected
  152.     procedure BeforeChange; dynamic;
  153.     procedure Change; dynamic;
  154.     procedure ChangeMonth(Delta: Integer);
  155.     procedure Click; override;
  156.     procedure DrawButton(ACanvas:TCanvas;ARect:TRect;Pushed:boolean);
  157.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  158.     function GetDaysThisMonth: Integer; virtual;
  159.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  160.     procedure MonthChange; dynamic;
  161.     function SelectCell(ACol, ARow: Longint): Boolean; override;
  162.     procedure YearChange; dynamic;
  163.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  164.  
  165.   public
  166.     constructor Create(AOwner: TComponent); override;
  167.     destructor Destroy; override;
  168.     property CellText[ACol, ARow: Integer]: string read GetCellText;
  169.     property Date: TDateTime  read FDate write SetDate stored StoreDate;
  170.     property DayOfYear: integer read FDayOfYear;
  171.     property DaysThisMonth: integer read FDaysThisMonth;
  172.     function GetHoliday(WhatDate:TDateTime;Land:integer):integer;
  173.     property Holiday: string read FHoliday;
  174.     property HolidayNr: integer read FHolidayNr;
  175.     property Holidays[Index: integer]: integer read GetHolidays write SetHolidays;
  176.     property Marked[Index: integer]: boolean read GetMarked write SetMarked;
  177.     property MoonDistance: extended read FMoonDistance;
  178.     property MoonPhase: TMoonPhase read FMoonPhase;
  179.     property MoonRise: TDateTime read FMoonRise;
  180.     property MoonSet: TDateTime read FMoonSet;
  181.     property MoonTransit: TDateTime read FMoonTransit;
  182.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  183.     function MouseToDate(X, Y: Integer):TDateTime;
  184.     procedure NextMonth;
  185.     procedure NextYear;
  186.     procedure PrevMonth;
  187.     procedure PrevYear;
  188.     property SunDistance: extended read FSunDistance;
  189.     property SunRise: TDateTime read FSunRise;
  190.     property SunSet: TDateTime read FSunSet;
  191.     property SunTransit: TDateTime read FSunTransit;
  192.     property Sternzeichen: string read FSternzeichen;
  193.     property SternzeichenNr: integer read FSternzeichenNr;
  194.     procedure UpdateCalendar; virtual;
  195.     property WeekOfYear: integer read FWeekOfYear;
  196.  
  197.   published
  198.     property Align;
  199.     {$IFDEF SR_Delphi5_Up}
  200.     property Anchors;
  201.     {$ENDIF}
  202.     property BackgroundColors: TCalendarColors read FBackgroundColors write SetBackgroundColors;
  203.     property BorderStyle;
  204.     property Bundesland: TBundesland read FBundesland write SetBundesland;
  205.     property CalendarOptions: TCalendarOptions read FCalendarOptions write SetCalendarOptions;
  206.     property Ctl3D;
  207.     property Day: Integer index 3 read GetDateElement write SetDateElement stored False;
  208.     property DrawStyle: TCalendarDrawStyle read FDrawStyle write SetDrawStyle;
  209.     property Enabled;
  210.     property Font;
  211.     property Month: Integer index 2 read GetDateElement write SetDateElement stored False;
  212.     property ParentColor;
  213.     property ParentFont;
  214.     property ParentShowHint;
  215.     property PopupMenu;
  216.     property ShowHint;
  217.     property StartOfWeek: TDayOfWeek read FStartOfWeek write SetStartOfWeek;
  218.     property TabOrder;
  219.     property TabStop;
  220.     property TextColors: TCalendarColors read FTextColors write SetTextColors;
  221.     property Visible;
  222.     property Year: Integer index 1  read GetDateElement write SetDateElement stored False;
  223.  
  224.     property OnBeforeChange: TNotifyEvent read FOnBeforeChange write FOnBeforeChange;
  225.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  226.     property OnClick;
  227.     property OnDblClick;
  228.     property OnDragDrop;
  229.     property OnDragOver;
  230.     property OnEndDrag;
  231.     {$IFDEF SR_Delphi5_Up}
  232.     property OnEndDock;
  233.     {$ENDIF}
  234.     property OnEnter;
  235.     property OnExit;
  236.     property OnKeyDown;
  237.     property OnKeyPress;
  238.     property OnKeyUp;
  239.     property OnMonthChange: TNotifyEvent read FOnMonthChange write FOnMonthChange;
  240.     property OnMouseDown;
  241.     property OnMouseMove;
  242.     property OnMouseUp;
  243.     {$IFDEF SR_Delphi5_Up}
  244.     property OnStartDock;
  245.     {$ENDIF}
  246.     {$IFDEF SR_Delphi2_Up}
  247.     property OnStartDrag;
  248.     {$ENDIF}
  249.     property OnYearChange: TNotifyEvent read FOnYearChange write FOnYearChange;
  250.   end;
  251.  
  252.  
  253. procedure Register;
  254.  
  255. implementation
  256.  
  257. {$IFDEF SR_Delphi2_Up}
  258. {$R *.D32}
  259. uses SRUtils, rrColors, TimeFunc;
  260. {$ELSE}
  261. {$R *.D16}
  262. uses SRUtils, TimeFunc;
  263. {$ENDIF}
  264.  
  265. const
  266. {$IFDEF SR_Delphi2_Up}
  267.   DefaultWidth  = 192;
  268.   DefaultHeight = 115;
  269. {$ELSE}
  270.   DefaultWidth  = 191;
  271.   DefaultHeight = 114;
  272. {$ENDIF}
  273.   AU            = 149597869;
  274.  
  275. { Komponente TSRCalendar }
  276. constructor TSRCalendar.Create(AOwner: TComponent);
  277. begin
  278.   inherited Create(AOwner);
  279.   FBackgroundColors := TCalendarColors.Create;
  280.   FTextColors := TCalendarColors.Create;
  281.  
  282.   { defaults }
  283.   ColCount := 7;
  284.   GridLineWidth := 1;
  285.   DefaultDrawing := true;
  286.   with FBackgroundColors do begin
  287.     Headers := clBtnFace;
  288.     Holiday := clWindow;
  289.     Marked := clAqua;
  290.     Selected := clHighlight;
  291.     Standard := clWindow;
  292.     Today := clWindow;
  293.     Weekend := clWindow;
  294.   end;
  295.   FBundesland := Nordrhein_Westfalen;
  296.   FDrawStyle := cdsColorGrid;
  297.   FixedCols := 0;
  298.   FixedRows := 1;
  299.   FCalendarOptions := [coAutoDeleteMarks, coCalcAstroData, coCalcHolidays,
  300.                        coGridLines, coFrameSelection, coShowMarks, coUseCurrentDate];
  301.   with FTextColors do begin
  302.     Headers := clBtnText;
  303.     Holiday := clRed;
  304.     Marked := clWindowText;
  305.     Selected := clHighlightText;
  306.     Standard := clWindowText;
  307.     Today := clBlue;
  308.     Weekend := clMaroon;
  309.   end;
  310.   DefaultDrawing := false;
  311.   Height := DefaultHeight;
  312.   Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected];
  313.   RowCount := 7;
  314.   ScrollBars := ssNone;
  315.   Width := DefaultWidth;
  316.   FDate := Now;
  317.   UpdateCalendar;
  318. end;
  319.  
  320. destructor TSRCalendar.Destroy;
  321. begin
  322.   FBackgroundColors:=TCalendarColors.Create;
  323.   FTextColors:=TCalendarColors.Create;
  324.   inherited Destroy;
  325. end;
  326.  
  327. procedure TSRCalendar.BeforeChange;
  328. begin
  329.   if Assigned(FOnBeforeChange) then
  330.     FOnBeforeChange(Self);
  331. end;
  332.  
  333. procedure TSRCalendar.Change;
  334. begin
  335.   if Assigned(FOnChange) then
  336.     FOnChange(Self);
  337. end;
  338.  
  339. procedure TSRCalendar.ChangeMonth(Delta: Integer);
  340. var
  341.   AYear,
  342.   AMonth,
  343.   ADay    : Word;
  344.   CurDay  : Integer;
  345.   NewDate : TDateTime;
  346. begin
  347.   BeforeChange;
  348.   try
  349.     DecodeDate(FDate, AYear, AMonth, ADay);
  350.     CurDay := ADay;
  351.     if Delta > 0 then
  352.       ADay := GetDaysPerMonth(AYear, AMonth)
  353.     else
  354.       ADay := 1;
  355.     NewDate := EncodeDate(AYear, AMonth, ADay);
  356.     NewDate := NewDate + Delta;
  357.     DecodeDate(NewDate, AYear, AMonth, ADay);
  358.     if GetDaysPerMonth(AYear, AMonth) > CurDay then
  359.       ADay := CurDay
  360.     else
  361.       ADay := GetDaysPerMonth(AYear, AMonth);
  362.     FDate := EncodeDate(AYear, AMonth, ADay)+Time;
  363.     MonthChange;
  364.   except
  365.   end;
  366. end;
  367.  
  368. procedure TSRCalendar.Click;
  369. var
  370.   TheCellText: string;
  371. begin
  372.   inherited Click;
  373.   TheCellText := CellText[Col, Row];
  374.   if TheCellText <> '' then begin
  375.     try
  376.       Day := StrToInt(TheCellText);
  377.     except
  378.     end;
  379.   end;
  380. end;
  381.  
  382. procedure TSRCalendar.DrawButton(ACanvas:TCanvas;ARect:TRect;Pushed:boolean);
  383. begin
  384.   {$IFDEF SR_Delphi1}
  385.   with ACanvas do begin
  386.     Pen.Color:=clWindowFrame;
  387.     Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  388.     if Pushed then
  389.       Pen.Color:=clBtnShadow
  390.     else
  391.       Pen.Color:=clBtnHighlight;
  392.     MoveTo(ARect.Right-1, ARect.Top);
  393.     LineTo(ARect.Left, ARect.Top);
  394.     LineTo(ARect.Left, ARect.Bottom-1);
  395.     if Pushed then
  396.       Pen.Color:=clBtnHighlight
  397.     else
  398.       Pen.Color:=clBtnShadow;
  399.     LineTo(ARect.Right-1, ARect.Bottom-1);
  400.     LineTo(ARect.Right-1, ARect.Top);
  401.   end;
  402.   {$ELSE}
  403.   if Pushed then
  404.     DrawFrameControl(ACanvas.Handle,
  405.                      ARect,
  406.                      DFC_Button,
  407.                      DFCS_ButtonPush or DFCS_Pushed)
  408.   else
  409.     DrawFrameControl(ACanvas.Handle,
  410.                      ARect,
  411.                      DFC_Button,
  412.                      DFCS_ButtonPush);
  413.   {$ENDIF}
  414. end;
  415.  
  416. procedure TSRCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
  417. var
  418.   TheText    : string;
  419.   DoDrawRect : boolean;
  420.   CellDay    : integer;
  421.   CellDate   : TDateTime;
  422.   {$IFDEF SR_Delphi1}
  423.   PText      : array [0..2] of char;
  424.   {$ENDIF}
  425. begin
  426.   TheText:=CellText[ACol, ARow];
  427.   with Canvas do begin
  428.     Font.Style:=[];
  429.     if DrawStyle<>cdsMonoGrid then begin
  430.       CellDay:=0;
  431.       CellDate:=0;
  432.       if (TheText<>'') and (ARow>0) then begin
  433.         try
  434.           CellDay:=StrToInt(TheText);
  435.           if CellDay>0 then
  436.             CellDate:=EncodeDate(Year, Month, CellDay);
  437.         except
  438.         end;
  439.       end;
  440.       Brush.Color:=FBackgroundColors.Standard;
  441.       Font.Color:=FTextColors.Standard;
  442.       if (DrawStyle=cdsButtons) or (ARow=0) then begin
  443.         {Kalender im Button-Stil zeichnen}
  444.         Brush.Color:=FBackgroundColors.Headers;
  445.         Font.Color:=FTextColors.Headers;
  446.         FillRect(ARect);
  447.         if (ARow=0) or (trunc(CellDate)=trunc(Now)) then
  448.           Font.Style:=[fsBold]
  449.         else
  450.           Font.Style:=[];
  451.         {$IFNDEF SR_Delphi1}
  452.         ARect.Bottom:=ARect.Bottom+1;
  453.         {$ENDIF}
  454.         if (ARow>0) and (ACol=Col) and (ARow=Row) then
  455.           DrawButton(Canvas, ARect, true)
  456.         else
  457.           DrawButton(Canvas, ARect, false);
  458.         DoDrawRect:=false;
  459.       end
  460.       else
  461.         DoDrawRect:=true;
  462.       if DoDrawRect and (ACol=Col) and (ARow=Row) and (DrawStyle=cdsColorGrid) then begin
  463.         {Farben fⁿr gewΣhltes Datum}
  464.         if coFrameSelection in FCalendarOptions then begin
  465.           InflateRect(ARect, -1, -1);
  466.           Font.Color:=FTextColors.Standard;
  467.           Brush.Color:=FBackgroundColors.Standard;
  468.           Pen.Width:=2;
  469.           Pen.Color:=FBackgroundColors.Selected;
  470.           Rectangle(ARect.Left, ARect.Top, ARect.Right+1, ARect.Bottom+1);
  471.           InflateRect(ARect, -1, -1);
  472.         end
  473.         else begin
  474.           Font.Color:=FTextColors.Selected;
  475.           Brush.Color:=FBackgroundColors.Selected;
  476.           DoDrawRect:=false;
  477.         end;
  478.       end;
  479.       if DoDrawRect and (DayOfWeek(CellDate)=1) then begin
  480.         {Farben fⁿr Wochenende}
  481.         Font.Color:=FTextColors.Weekend;
  482.         Brush.Color:=FBackgroundColors.Weekend;
  483.       end;
  484.       if trunc(CellDate)=trunc(Now) then begin
  485.         {Farben fⁿr aktuelles Systemdatum}
  486.         Font.Style:=[fsBold];
  487.         if DoDrawRect then begin
  488.           Font.Color:=FTextColors.Today;
  489.           Brush.Color:=FBackgroundColors.Today;
  490.         end;
  491.       end;
  492.       if coCalcHolidays in FCalendarOptions then
  493.         FHolidays[CellDay]:=GetHoliday(CellDate, ord(FBundesland));
  494.       if FHolidays[CellDay]>0 then begin
  495.         {Farben fⁿr Feiertage}
  496.         Font.Style:=[fsBold];
  497.         if DoDrawRect then begin
  498.           Font.Color:=FTextColors.Holiday;
  499.           Brush.Color:=FBackgroundColors.Holiday;
  500.         end;
  501.       end;
  502.       if DoDrawRect and (coShowMarks in FCalendarOptions) then begin
  503.         {Farben fⁿr markierte Tage}
  504.         if (CellDay>0) and FMarked[Cellday] then begin
  505.           Font.Color:=FTextColors.Marked;
  506.           Brush.Color:=FBackgroundColors.Marked;
  507.         end;
  508.       end;
  509.       if (DrawStyle<>cdsButtons) and (ARow>0) then 
  510.         FillRect(ARect);
  511.     end;
  512.     Brush.Style:=bsClear;
  513.     {$IFDEF SR_Delphi1}
  514.     StrPCopy(PText, TheText);
  515.     DrawText(Handle,
  516.              PText,
  517.              length(TheText),
  518.              ARect,
  519.              DT_SingleLine or DT_NoPrefix or DT_Center or DT_VCenter);
  520.     {$ELSE}
  521.     DrawText(Handle,
  522.              PChar(TheText),
  523.              length(TheText),
  524.              ARect,
  525.              DT_SingleLine or DT_NoPrefix or DT_Center or DT_VCenter);
  526.     Brush.Style:=bsSolid;
  527.     {$ENDIF}
  528.   end;
  529. end;
  530.  
  531. function TSRCalendar.GetDaysThisMonth: Integer;
  532. begin
  533.   Result := GetDaysPerMonth(Year, Month);
  534. end;
  535.  
  536. function TSRCalendar.GetCellText(ACol, ARow: Integer): string;
  537. var DayNum: Integer;
  538. begin
  539.   if ARow = 0 then  { day names at tops of columns }
  540.     Result := ShortDayNames[(StartOfWeek + ACol) mod 7 + 1]
  541.   else begin
  542.     DayNum := FMonthOffset + ACol + (ARow - 1) * 7;
  543.     if (DayNum < 1) or (DayNum > GetDaysThisMonth) then
  544.       Result := ''
  545.     else begin
  546.       try
  547.         Result := IntToStr(DayNum);
  548.       except
  549.         Result:='';
  550.       end;
  551.     end;
  552.   end;
  553. end;
  554.  
  555. function TSRCalendar.GetDateElement(Index: Integer): Integer;
  556. var
  557.   AYear, AMonth, ADay: Word;
  558. begin
  559.   DecodeDate(FDate, AYear, AMonth, ADay);
  560.   case Index of
  561.     1: Result := AYear;
  562.     2: Result := AMonth;
  563.     3: Result := ADay;
  564.     else Result := -1;
  565.   end;
  566. end;
  567.  
  568. function TSRCalendar.GetHoliday(WhatDate:TDateTime;Land:integer):integer;
  569. var DoY,Y,M    : word;
  570.     D,dw,OM,aw : word;
  571.     Dat        : TDateTime;
  572.     Ostern     : TDateTime;
  573.     Weihnacht  : TDateTime;
  574.  
  575.   function EasterSunday(Y:word):TDateTime;
  576.   var a, b, c, d, e,
  577.       Tag, Monat : integer;
  578.   begin
  579.     a:=y mod 19 ;
  580.     b:=y mod 4;
  581.     c:=y mod 7;
  582.     d:=(19*a+24) mod 30;
  583.     e:=(2*b+4*c+6*d+5) mod 7;
  584.     Tag:=22+d+e;
  585.     Monat:=3;
  586.     if Tag>31 then begin
  587.       Tag:=d+e-9;
  588.       Monat:=4;
  589.     end;
  590.     if (Tag=26) and (Monat=4) then
  591.       Tag:=19;
  592.     if (Tag=25) and (Monat=4) and (d=28) and (e=6) and (a>10) then
  593.       Tag:=18;
  594.     try
  595.       Result:= EncodeDate(y, Monat, Tag);
  596.     except
  597.       Result:=0;
  598.     end;
  599.   end; { EasterSunday }
  600.  
  601. begin
  602.   Result:=0;
  603.   try
  604.     DecodeDate(WhatDate, Y, M, D);
  605.   except
  606.     Y:=0;
  607.   end;
  608.   if (D>=1) and (M>=1) and (M<=12) and (Y>=1900) then begin
  609.     DoY:=GetDayOfYear(WhatDate);
  610.     Ostern:=EasterSunday(Y);
  611.     try
  612.       DecodeDate(Ostern, Y, OM, D);
  613.     except
  614.       OM:=4;
  615.     end;
  616.     try
  617.       Weihnacht:=EncodeDate(Y, 12, 25);
  618.       if (DayOfWeek(Weihnacht)-1)=0 then
  619.         dw:=7
  620.       else
  621.         dw:=DayOfWeek(Weihnacht)-1;
  622.     except
  623.       Weihnacht:=-1;
  624.       dw:=0;
  625.     end;
  626.     { MariΣ Lichtme▀ }                     { Sondertage }
  627.     Dat:=EncodeDate(Y, 2, 2);
  628.     if DoY=GetDayOfYear(Dat) then
  629.       Result:=-1;
  630.     { Valentinstag }
  631.     Dat:=Encodedate(Y, 2, 14);
  632.     if DoY=GetDayOfYear(Dat) then
  633.       Result:=-2;
  634.     { Weiberfastnacht }
  635.     Dat:=Ostern-45;
  636.     while DayOfWeek(Dat)<>2 do
  637.       Dat:=Dat-1;
  638.     if DoY=GetDayOfYear(Dat-4) then
  639.       Result:=-3;
  640.     { Rosenmontag }
  641.     if DoY=GetDayOfYear(Dat) then
  642.       Result:=-4;
  643.     { Fastnacht }
  644.     if DoY=GetDayOfYear(Dat+1) then
  645.       Result:=-5;
  646.     { Aschermittwoch }
  647.     if DoY=GetDayOfYear(Dat+2) then
  648.       Result:=-6;
  649.     { MariΣ Verkⁿndigung }
  650.     Dat:=Encodedate(Y, 3, 25);
  651.     if DoY=GetDayOfYear(Dat) then
  652.       Result:=-7;
  653.     { Palmsonntag }
  654.     if DoY=GetDayOfYear(Ostern-7) then
  655.       Result:=-8;
  656.     { Grⁿndonnerstag }
  657.     if DoY=GetDayOfYear(Ostern-3) then
  658.       Result:=-9;
  659.     { Muttertag }
  660.     Dat:=EncodeDate(y, 4, 30);
  661.     aw:=DayOfWeek(Dat)-1;
  662.     Dat:=Dat-aw+14;
  663.     if Dat=(Ostern+49) then
  664.       Dat:=Dat-7;
  665.     if DoY=GetDayOfYear(Dat) then
  666.       Result:=-10;
  667.     { Peter und Paul }
  668.     Dat:=Encodedate(Y, 6, 29);
  669.     if DoY=GetDayOfYear(Dat) then
  670.       Result:=-11;
  671.     { MariΣ Geburt }
  672.     Dat:=Encodedate(Y, 9, 8);
  673.     if DoY=GetDayOfYear(Dat) then
  674.       Result:=-12;
  675.     { Erntedankfest }
  676.     Dat:=Encodedate(Y, 9, 29);
  677.     while DayOfWeek(Dat)<>1 do
  678.       Dat:=Dat+1;
  679.     if DoY=GetDayOfYear(Dat) then
  680.       Result:=-13;
  681.     { MariΣ EmpfΣngnis }
  682.     Dat:=Encodedate(Y, 12, 8);
  683.     if DoY=GetDayOfYear(Dat) then
  684.       Result:=-14;
  685.     { Silvester }
  686.     Dat:=Encodedate(Y, 12, 31);
  687.     if DoY=GetDayOfYear(Dat) then
  688.       Result:=-15;
  689.     { 1. Advent }
  690.     Dat:=Weihnacht-1;
  691.     while DayOfWeek(Dat)<>1 do
  692.       Dat:=Dat-1;
  693.     if DoY=GetDayOfYear(Dat-21) then
  694.       Result:=-16;
  695.     { 2. Advent }
  696.     if DoY=GetDayOfYear(Dat-14) then
  697.       Result:=-17;
  698.     { 3. Advent }
  699.     if DoY=GetDayOfYear(Dat-7) then
  700.       Result:=-18;
  701.     { 4. Advent }
  702.     if DoY=GetDayOfYear(Dat) then
  703.       Result:=-19;
  704.     { Heiligabend }
  705.     if DoY=GetDayOfYear(Weihnacht-1) then
  706.       Result:=-20;
  707.     { Frⁿhlingsanfang }
  708.     Dat:=StartSeason(Y, Spring);
  709.     if DoY=GetDayOfYear(Dat) then
  710.       Result:=-21;
  711.     { Sommmeranfang }
  712.     Dat:=StartSeason(Y, Summer);
  713.     if DoY=GetDayOfYear(Dat) then
  714.       Result:=-22;
  715.     { Herbstanfang }
  716.     Dat:=StartSeason(Y, Autumn);
  717.     if DoY=GetDayOfYear(Dat) then
  718.       Result:=-23;
  719.     { Winteranfang }
  720.     Dat:=StartSeason(Y, Winter);
  721.     if DoY=GetDayOfYear(Dat) then
  722.       Result:=-24;
  723.     { Neujahr }                     { Feiertage }
  724.     if DoY=1 then
  725.       Result:=1;
  726.     { Maifeiertag }
  727.     Dat:=EncodeDate(Y, 5, 1);
  728.     if DoY=GetDayOfYear(Dat) then
  729.       Result:=2;
  730.     { Tag der deutschen Einheit }
  731.     Dat:=EncodeDate(Y, 10, 3);
  732.     if DoY=GetDayOfYear(Dat) then
  733.       Result:=3;
  734.     { Allerheiligen }
  735.     if Land<>14 then begin
  736.       Dat:=EncodeDate(Y, 11, 1);
  737.       if DoY=GetDayOfYear(Dat) then
  738.         Result:=4;
  739.     end;
  740.     { Totensonntag }
  741.     if (Weihnacht>=0) and (DoY=GetDayOfYear(Weihnacht-dw-28)) then
  742.       Result:=5;
  743.     { Volkstrauertag }
  744.     if (Weihnacht>=0) and (DoY=GetDayOfYear(Weihnacht-dw-35)) then
  745.       Result:=6;
  746.     { 1. Weihnachtstag }
  747.     if (Weihnacht>=0) and (DoY=GetDayOfYear(Weihnacht)) then
  748.       Result:=7;
  749.     { 2. Weihnachtstag }
  750.     if (Weihnacht>=0) and (DoY=GetDayOfYear(Weihnacht+1)) then
  751.       Result:=8;
  752.     { Karfreitag }
  753.     if DoY=GetDayOfYear(Ostern-2) then
  754.       Result:=9;
  755.     { Ostersonntag }
  756.     if DoY=GetDayOfYear(Ostern) then
  757.       Result:=10;
  758.     { Ostermontag }
  759.     if DoY=GetDayOfYear(Ostern+1) then
  760.       Result:=11;
  761.     { Christi Himmelfahrt }
  762.     if DoY=GetDayOfYear(Ostern+39) then
  763.       Result:=12;
  764.     { Pfingstsonntag }
  765.     if DoY=GetDayOfYear(Ostern+49) then
  766.       Result:=13;
  767.     { Pfingstmontag }
  768.     if DoY=GetDayOfYear(Ostern+50) then
  769.       Result:=14;
  770.     { Fronleichnam }
  771.     if (Land<2) or ((Land>=9) and (Land<=12)) or (Land=15) then
  772.       if DoY=GetDayOfYear(Ostern+60) then
  773.         Result:=15;
  774.     { Heilige 3 K÷nige }
  775.     if (Land=0) or (Land=1) or (Land=13) then
  776.       if DoY=6 then
  777.         Result:=16;
  778.     { MariΣ Himmelfahrt }
  779.     if (Land=1) or (Land=11) then begin
  780.       Dat:=EncodeDate(Y, 8, 15);
  781.       if DoY=GetDayOfYear(Dat) then
  782.         Result:=17;
  783.     end;
  784.     { Reformationstag }
  785.     if (Land=3) or (Land=7) or (Land=12) or (Land=13) or (Land=15) then begin
  786.       Dat:=Encodedate(Y, 10, 31);
  787.       if DoY=GetDayOfYear(Dat) then
  788.         Result:=18;
  789.     end;
  790.     { Bu▀- und Bettag }
  791.     if (Weihnacht>=0) and (Land=12) and (DoY=GetDayOfYear(Weihnacht-dw-32)) then
  792.       Result:=19;
  793.   end;
  794. end;
  795.  
  796. function TSRCalendar.GetHolidays(Index: integer):integer;
  797. begin
  798.   Result:=FHolidays[Index];
  799. end;
  800.  
  801. function TSRCalendar.GetMarked(Index: integer):boolean;
  802. begin
  803.   Result:=FMarked[Index];
  804. end;
  805.  
  806. procedure TSRCalendar.GetMoonData(Dat:TDateTime);
  807. var TimeDiff         : extended;
  808.  
  809.   function LowestPhase(Dat:TDateTime):extended;
  810.   var Phase   : extended;
  811.       Std     : byte;
  812.   begin
  813.     Result:=Current_Phase(trunc(Dat));
  814.     for Std:=1 to 23 do begin
  815.       Phase:=Current_Phase(trunc(Dat)+Std/24);
  816.       if Phase<Result then
  817.         Result:=Phase;
  818.     end;
  819.   end; { LowestPhase }
  820.  
  821. begin
  822.   FMoonDistance:=Moon_Distance(Dat);
  823.   if LowestPhase(Dat-1)>LowestPhase(Dat) then begin
  824.     if LowestPhase(Dat+1)>LowestPhase(Dat) then
  825.       FMoonPhase:=Neumond
  826.     else
  827.       FMoonPhase:=abnehmend;
  828.   end
  829.   else begin
  830.     if LowestPhase(Dat+1)<LowestPhase(Dat) then
  831.       FMoonPhase:=Vollmond
  832.     else
  833.       FMoonPhase:=zunehmend;
  834.   end;
  835.   TimeDiff:=1/24;
  836.   if IsSummertime(Dat) then
  837.     TimeDiff:=TimeDiff+1/24;
  838.   FMoonRise:=Moon_Rise(Dat,Breite[ord(FBundesland)],Laenge[ord(FBundesland)])+TimeDiff;
  839.   FMoonSet:=Moon_Set(Dat,Breite[ord(FBundesland)],Laenge[ord(FBundesland)])+TimeDiff;
  840.   FMoonTransit:=Moon_Transit(Dat,Breite[ord(FBundesland)],Laenge[ord(FBundesland)])+TimeDiff;
  841. end;
  842.  
  843. function TSRCalendar.GetSternzeichenNr(Dat:TDateTime):integer;
  844. var TiJ : word;
  845. begin
  846.   Result:=0;
  847.   TiJ:=GetDayOfYear(Dat);
  848.   if (TiJ>=21) and (TiJ<=49) then
  849.     Result:=0;
  850.   if (TiJ>=50) and (TiJ<=79) then
  851.     Result:=1;
  852.   if (TiJ>=80) and (TiJ<=111) then
  853.     Result:=2;
  854.   if (TiJ>=112) and (TiJ<=141) then
  855.     Result:=3;
  856.   if (TiJ>=142) and (TiJ<=172) then
  857.     Result:=4;
  858.   if (TiJ>=173) and (TiJ<=204) then
  859.     Result:=5;
  860.   if (TiJ>=205) and (TiJ<=235) then
  861.     Result:=6;
  862.   if (TiJ>=236) and (TiJ<=266) then
  863.     Result:=7;
  864.   if (TiJ>=267) and (TiJ<=296) then
  865.     Result:=8;
  866.   if (TiJ>=297) and (TiJ<=326) then
  867.     Result:=9;
  868.   if (TiJ>=327) and (TiJ<=355) then
  869.     Result:=10;
  870.   if (TiJ>=355) or (TiJ<=20) then
  871.     Result:=11;
  872. end;
  873.  
  874. procedure TSRCalendar.GetSunData(Dat:TDateTime);
  875. var TimeDiff         : extended;
  876. begin
  877.   FSunDistance:=Sun_Distance(Dat)*au;
  878.   TimeDiff:=1/24;
  879.   if IsSummertime(Dat) then
  880.     TimeDiff:=TimeDiff+1/24;
  881.   FSunRise:=Sun_Rise(Dat,Breite[ord(FBundesland)],Laenge[ord(FBundesland)])+TimeDiff;
  882.   FSunSet:=Sun_Set(Dat,Breite[ord(FBundesland)],Laenge[ord(FBundesland)])+TimeDiff;
  883.   FSunTransit:=Sun_Transit(Dat,Breite[ord(FBundesland)],Laenge[ord(FBundesland)])+TimeDiff;
  884. end;
  885.  
  886. procedure TSRCalendar.KeyDown(var Key: Word; Shift: TShiftState);
  887. begin
  888.   if Key=VK_Left then begin
  889.     if Day=1 then begin
  890.       ChangeMonth(-1);
  891.       Day:=GetDaysThisMonth;
  892.       Key:=0;
  893.     end
  894.     else
  895.       if (Col=0) and (Row>1) then begin
  896.         Day:=Day-1;
  897.         Key:=0;
  898.       end;
  899.   end;
  900.   if Key=VK_Right then begin
  901.     if Day=GetDaysThisMonth then begin
  902.       Day:=1;
  903.       ChangeMonth(1);
  904.       Key:=0;
  905.     end
  906.     else
  907.       if (Col=6) and (Row<6) then begin
  908.         Day:=Day+1;
  909.         Key:=0;
  910.       end;
  911.   end;
  912.   if (Key=VK_Up) and (Row=1) then begin
  913.     ChangeMonth(-1);
  914.     Day:=GetDaysThisMonth;
  915.     Key:=0;
  916.   end;
  917.   if (Key=VK_Down) and (Row=6) then begin
  918.     ChangeMonth(1);
  919.     Day:=1;
  920.     Key:=0;
  921.   end;
  922.   inherited KeyDown(Key, Shift);
  923. end;
  924.  
  925. procedure TSRCalendar.MonthChange;
  926. var i : integer;
  927. begin
  928.   if coCalcHolidays in FCalendarOptions then
  929.     for i:=1 to 31 do
  930.       FHolidays[i]:=0;
  931.   if coAutoDeleteMarks in FCalendarOptions then
  932.     for i:=1 to 31 do
  933.       FMarked[i]:=false;
  934.   FDaysThisMonth:=GetDaysThisMonth;
  935.   if Assigned(FOnMonthChange) then
  936.     FOnMonthChange(Self);
  937. end;
  938.  
  939. procedure TSRCalendar.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  940. var Coord : TGridCoord;
  941. begin
  942.   Coord := MouseCoord(X, Y);
  943.   ACol := Coord.X;
  944.   ARow := Coord.Y;
  945. end;
  946.  
  947. function TSRCalendar.MouseToDate(X, Y: Integer):TDateTime;
  948. var ACol, ARow : longint;
  949.     ADay       : word;
  950. begin
  951.   MouseToCell(X, Y, ACol, ARow);
  952.   try
  953.     ADay := StrToInt(CellText[ACol, ARow]);
  954.     if (ADay>=1) and (Month>=1) and (Month<=12) and (Year>=1900) then
  955.       Result:=EncodeDate(Year, Month, ADay)
  956.     else
  957.       Result:=-1;
  958.   except
  959.     Result:=-1;
  960.   end;
  961. end;
  962.  
  963. procedure TSRCalendar.NextMonth;
  964. begin
  965.   ChangeMonth(1);
  966. end;
  967.  
  968. procedure TSRCalendar.NextYear;
  969. begin
  970.   if IsLeapYear(Year) and (Month = 2) and (Day = 29) then
  971.     Day := 28;
  972.   Year := Year + 1;
  973. end;
  974.  
  975. procedure TSRCalendar.PrevMonth;
  976. begin
  977.   ChangeMonth(-1);
  978. end;
  979.  
  980. procedure TSRCalendar.PrevYear;
  981. begin
  982.   if IsLeapYear(Year) and (Month = 2) and (Day = 29) then
  983.     Day := 28;
  984.   Year := Year - 1;
  985. end;
  986.  
  987. function TSRCalendar.SelectCell(ACol, ARow: Longint): Boolean;
  988. begin
  989.   if ((not FUpdating) and (coReadOnly in FCalendarOptions)) or (CellText[ACol, ARow] = '') then
  990.     Result := False
  991.   else
  992.     Result := inherited SelectCell(ACol, ARow);
  993. end;
  994.  
  995. procedure TSRCalendar.SetBackgroundColors(newValue: TCalendarColors);
  996. begin
  997.   with FBackgroundColors do begin
  998.     FHeaders:=NewValue.Headers;
  999.     FHoliday:=NewValue.Holiday;
  1000.     FMarked:=NewValue.Marked;
  1001.     FSelected:=NewValue.Selected;
  1002.     FStandard:=NewValue.Standard;
  1003.     FToday:=NewValue.Today;
  1004.     FWeekend:=NewValue.Weekend;
  1005.   end;
  1006.   Invalidate;
  1007. end;
  1008.  
  1009. procedure TSRCalendar.SetBundesland(newValue: TBundesland);
  1010. begin
  1011.   if FBundesland<>newValue then begin
  1012.     BeforeChange;
  1013.     FBundesland:=newValue;
  1014.     UpdateCalendar;
  1015.     Change;
  1016.   end;
  1017. end;
  1018.  
  1019. procedure TSRCalendar.SetCalendarOptions(newValue: TCalendarOptions);
  1020. begin
  1021.   if FCalendarOptions<>newValue then begin
  1022.     if (coUseCurrentDate in newValue) and not (coUseCurrentDate in FCalendarOptions) then
  1023.       FDate:=Now;
  1024.     if (coGridLines in newValue) and not (coGridLines in FCalendarOptions) then
  1025.       Options:=Options+[goVertLine, goHorzLine];
  1026.     if not (coGridLines in newValue) and (coGridLines in FCalendarOptions) then
  1027.       Options:=Options-[goVertLine, goHorzLine];
  1028.     FCalendarOptions:=newValue;
  1029.     UpdateCalendar;
  1030.     Repaint;
  1031.   end;
  1032. end;
  1033.  
  1034. procedure TSRCalendar.SetDate(Value: TDateTime);
  1035. var AYear,
  1036.     AMonth,
  1037.     ADay    : Word;
  1038.     MChange,
  1039.     YChange : boolean;
  1040. begin
  1041.   if trunc(Value)<>trunc(FDate) then begin
  1042.     BeforeChange;
  1043.     try
  1044.       DecodeDate(Value, AYear, AMonth, ADay);
  1045.       MChange:=AMonth<>Month;
  1046.       YChange:=AYear<>Year;
  1047.     except
  1048.       MChange:=false;
  1049.       YChange:=false;
  1050.     end;
  1051.     FDate:=Value;
  1052.     UpdateCalendar;
  1053.     Change;
  1054.     if MChange then
  1055.       MonthChange;
  1056.     if YChange then
  1057.       YearChange;
  1058.   end;
  1059. end;
  1060.  
  1061. procedure TSRCalendar.SetDateElement(Index: Integer; Value: Integer);
  1062. var
  1063.   AYear,
  1064.   AMonth,
  1065.   ADay    : Word;
  1066.   MChange,
  1067.   YChange : boolean;
  1068. begin
  1069.   if Value>0 then begin
  1070.     BeforeChange;
  1071.     DecodeDate(FDate, AYear, AMonth, ADay);
  1072.     MChange := false;
  1073.     YChange := false;
  1074.     case Index of
  1075.       1: if AYear <> Value then begin
  1076.            AYear := Value;
  1077.            MChange := true;
  1078.            YChange := true;
  1079.          end
  1080.          else
  1081.            Exit;
  1082.       2: if (Value <= 12) and (Value <> AMonth) then begin
  1083.            AMonth := Value;
  1084.            MChange := true;
  1085.          end
  1086.          else
  1087.            Exit;
  1088.       3: if (Value <= GetDaysThisMonth) and (Value <> ADay) then
  1089.            ADay := Value
  1090.          else
  1091.            Exit;
  1092.       else Exit;
  1093.     end;
  1094.     try
  1095.       FDate := EncodeDate(AYear, AMonth, ADay)+Time;
  1096.     except
  1097.     end;
  1098.     FCalendarOptions := FCalendarOptions - [coUseCurrentDate];
  1099.     UpdateCalendar;
  1100.     Change;
  1101.     if MChange then
  1102.       MonthChange;
  1103.     if YChange then
  1104.       YearChange;
  1105.   end;
  1106. end;
  1107.  
  1108. procedure TSRCalendar.SetDrawStyle(newValue: TCalendarDrawStyle);
  1109. begin
  1110.   if newValue<>FDrawStyle then begin
  1111.     FDrawStyle:=newValue;
  1112.     {$IFDEF SR_Delphi2_Up}
  1113.     DefaultDrawing:=FDrawStyle<>cdsButtons;
  1114.     {$ENDIF}
  1115.     Invalidate;
  1116.   end;
  1117. end;
  1118.  
  1119. procedure TSRCalendar.SetHolidays(Index: integer; newValue: integer);
  1120. begin
  1121.   FHolidays[Index]:=newValue;
  1122.   Invalidate;
  1123. end;
  1124.  
  1125. procedure TSRCalendar.SetMarked(Index: integer; newValue: boolean);
  1126. begin
  1127.   FMarked[Index]:=newValue;
  1128.   Invalidate;
  1129. end;
  1130.  
  1131. procedure TSRCalendar.SetStartOfWeek(Value: TDayOfWeek);
  1132. begin
  1133.   if Value <> FStartOfWeek then begin
  1134.     FStartOfWeek := Value;
  1135.     UpdateCalendar;
  1136.   end;
  1137. end;
  1138.  
  1139. procedure TSRCalendar.SetTextColors(newValue: TCalendarColors);
  1140. begin
  1141.   with FTextColors do begin
  1142.     FHeaders:=NewValue.Headers;
  1143.     FHoliday:=NewValue.Holiday;
  1144.     FMarked:=NewValue.Marked;
  1145.     FSelected:=NewValue.Selected;
  1146.     FStandard:=NewValue.Standard;
  1147.     FToday:=NewValue.Today;
  1148.     FWeekend:=NewValue.Weekend;
  1149.   end;
  1150.   Invalidate;
  1151. end;
  1152.  
  1153. function TSRCalendar.StoreDate: Boolean;
  1154. begin
  1155.   Result := not (coUseCurrentDate in FCalendarOptions);
  1156. end;
  1157.  
  1158. procedure TSRCalendar.UpdateCalendar;
  1159. var
  1160.   AYear,
  1161.   AMonth,
  1162.   ADay      : Word;
  1163.   FirstDate : TDateTime;
  1164. begin
  1165.   FUpdating := True;
  1166.   try
  1167.     DecodeDate(FDate, AYear, AMonth, ADay);
  1168.     FDayOfYear := GetDayOfYear(FDate);
  1169.     FWeekOfYear := GetWeekOfYear(FDate);
  1170.     FDaysThisMonth := GetDaysThisMonth;
  1171.     if coCalcHolidays in FCalendarOptions then begin
  1172.       FHolidayNr := GetHoliday(FDate, ord(FBundesland));
  1173.       if FHolidayNr=0 then
  1174.         FHoliday := '';
  1175.       if FHolidayNr>0 then
  1176.         FHoliday := Feiertage[FHolidayNr];
  1177.       if FHolidayNr<0 then
  1178.         FHoliday := Sondertage[abs(FHolidayNr)];
  1179.     end
  1180.     else
  1181.       FHoliday := '';
  1182.     FSternzeichenNr := GetSternzeichenNr(FDate);
  1183.     FSternzeichen := SternzNamen[FSternzeichenNr];
  1184.     if coCalcAstroData in FCalendarOptions then begin
  1185.       GetMoonData(FDate);
  1186.       GetSunData(FDate);
  1187.     end;
  1188.     FirstDate := EncodeDate(AYear, AMonth, 1);
  1189.     FMonthOffset := 2 - ((DayOfWeek(FirstDate) - StartOfWeek + 7) mod 7); {  day of week for 1st of month  }
  1190.     if FMonthOffset = 2 then
  1191.       FMonthOffset := -5;
  1192.     MoveColRow((ADay - FMonthOffset) mod 7, (ADay - FMonthOffset) div 7 + 1,
  1193.       False, False);
  1194.     Invalidate;
  1195.   finally
  1196.     FUpdating := False;
  1197.   end;
  1198. end;
  1199.  
  1200. procedure TSRCalendar.YearChange;
  1201. begin
  1202.   if Assigned(FOnYearChange) then
  1203.     FOnYearChange(Self);
  1204. end;
  1205.  
  1206. procedure TSRCalendar.WMSize(var Message: TWMSize);
  1207. var
  1208.   GridLines: Integer;
  1209. begin
  1210.   GridLines := 6 * GridLineWidth;
  1211.   DefaultColWidth := (Message.Width - GridLines) div 7;
  1212.   DefaultRowHeight := (Message.Height - GridLines) div 7;
  1213. end;
  1214.  
  1215. procedure Register;
  1216. begin
  1217.   RegisterComponents('Simon', [TSRCalendar]);
  1218. end;
  1219.  
  1220. end.
  1221.