Kalender

[Alter Mann]

Hi,

auch wenn es scheinbar keiner Braucht, hier die DB-Anbindung.
Doch zuerst müssen wir die Kalender-Componente aktuallisieren:

Delphi-Quellcode:

  TCalendarControl = class(TCustomControl)
  private
  ...
    FDates        : Array of TDateTime;
    FMaxRecords   : Integer;
  ...
  protected
  ...
    procedure   DataChange(Sender: TObject);  virtual;
    function    DateInArray(aDate : TDateTime) : Boolean;
  ...
  end;

...

constructor TCalendarControl.Create(aOwner : TComponent);
begin
  ...
  SetLength(FDates, 31);
  FMaxRecords   := -1;
  ...
end;

...

procedure   TCalendarControl.DataChange(Sender: TObject);
begin
end;

function    TCalendarControl.DateInArray(aDate : TDateTime) : Boolean;
var
  I : Integer;
begin
  Result := False;
  for I := Low(FDates) to High(FDates) do
   if FDates[I] = aDate then
   begin
     Result := True;
     Break;
   end;
end;

...

procedure   TCalendarControl.DoDateChange(aOldDate, aNewDate : TDateTime);
begin
  SetLength(FDates, 0);
  SetLength(FDates, 31);
  FMaxRecords   := -1;
  DataChange(Self);
  if Assigned(FOnDateChange) then FOnDateChange(Self, aOldDate, aNewDate);
end;

...

procedure   TCalendarControl.Paint;
   ...
          if DateInArray(CE.EntryDate) then Font.Style := Font.Style + [fsBold]
                                       else Font.Style := Font.Style - [fsBold];
          if FOptions.TrailingDays then
   ...
end;

Delphi-Quellcode:

  TDBCalendarControl = class(TCalendarControl)
  private
    FDataLink   : TFieldDataLink;
    function  GetDataField: string;
    function  GetDataSource: TDataSource;
    function  GetField: TField;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    procedure DataChange(Sender: TObject);          override;
    function  IsDateTimeField : Boolean;
    procedure Loaded;                               override;
    procedure LoadDatesForMonth;
    procedure Notification(aComponent: TComponent;
                           Operation: TOperation);  override;
  public
    constructor Create(aOwner: TComponent);         override;
    destructor  Destroy;                            override;
    property Field: TField read GetField;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

...

{
************  TDBCalendarControl
}

(* public *)

constructor TDBCalendarControl.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FDataLink               := TFieldDataLink.Create;
  FDataLink.Control       := Self;
  FDataLink.OnDataChange  := DataChange;
end;

destructor  TDBCalendarControl.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;


(* private *)


procedure   TDBCalendarControl.DataChange(Sender: TObject);
begin
  if (FDataLink.Field <> nil) and not FDataLink.DataSourceFixed then
  begin
    if FMaxRecords <> FDataLink.DataSet.RecordCount - 1 then
    begin
      FMaxRecords := FDataLink.DataSet.RecordCount - 1;
      FDataLink.DataSourceFixed := True;
      LoadDatesForMonth;
    end;
  end;
end;

function    TDBCalendarControl.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

function    TDBCalendarControl.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function    TDBCalendarControl.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure   TDBCalendarControl.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

procedure   TDBCalendarControl.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure   TDBCalendarControl.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;


(* protected *)

function    TDBCalendarControl.IsDateTimeField : Boolean;
begin
  with FDataLink do
    Result := (Field <> nil) and (Field.DataType in [ftDateTime, ftTimeStamp]);
end;

procedure   TDBCalendarControl.LoadDatesForMonth;
var
  I : Integer;
  DT : TDateTime;
  Y1, Y2, M1, M2, D1, D2 : Word;
begin
  FDataLink.DataSet.First;
  for I := 0 to FDataLink.DataSet.RecordCount - 1 do
  begin
    if IsDateTimeField then
      DT := Trunc(FDataLink.Field.AsDateTime)
    else
      DT := Trunc(FDataLink.Field.AsDateTime);

    DecodeDate(DT, Y1, M1, D1);
    DecodeDate(FDate, Y2, M2, D2);
    if (Y1 = Y2) and (M1 = M2) then FDates[D1] := DT;
    FDataLink.DataSet.Next;
  end;
  Invalidate;
  FDataLink.DataSourceFixed := False;
end;

procedure   TDBCalendarControl.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then DataChange(Self);
end;

procedure   TDBCalendarControl.Notification(aComponent: TComponent;
                                            Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

Um die Sache Rund zu machen fehlt noch dies:

Delphi-Quellcode:

  TExDBCalendar = class(TDBCalendarControl)
  published
    property CalendarDate;
    property Colors;
    property DataField;
    property DataSource;
    property Font;
    property Options;
    property OnDayClick;
    property OnDateChange;
  end;

Das war es.


Gruss