date.~pas

《Kylix程序设计》一书中附带的例程源代码

unit Date;

interface

uses
  SysUtils;

type
  TMonthType = 1 .. 12;
  TDayType = 1 .. 31;
  TMyDate = class( TObject )
  private
    { Private declarations }
    FYear: Integer;
    FMonth: TMonthType;
    FDay: TDayType;
  public
    { Public declarations }
    constructor Create(); overload;
    constructor Create(
      AYear: Integer; AMonth: TMonthType; ADay: TDayType ); overload;
    function IsLeapYear(): Boolean;
    procedure SetDate(
      AYear: Integer; AMonth: TMonthType; ADay: TDayType );
    procedure GetDate(
      var AYear: Integer; var AMonth: TMonthType; var ADay: TDayType );
    function GetDateAsText(): string;
    procedure Inc();
    procedure Dec();
    destructor Destroy(); override;
  end;

implementation

constructor TMyDate.Create();
begin
  FYear := 2000;
  FMonth := 1;
  FDay := 1;
end;

constructor TMyDate.Create(
  AYear: Integer; AMonth: TMonthType; ADay: TDayType );
begin
  FYear := AYear;
  FMonth := AMonth;
  FDay := ADay;
end;

function TMyDate.IsLeapYear(): Boolean;
begin
  if ( FYear mod 4 <> 0 ) then
    IsLeapYear := false
  else if ( FYear mod 100 <> 0 ) then
    IsLeapYear := true
  else if ( FYear mod 400 <>0 ) then
    IsLeapYear := false
  else
    IsLeapYear := true;
end;

procedure TMyDate.SetDate(
  AYear: Integer; AMonth: TMonthType; ADay: TDayType );
begin
  FYear := AYear;
  FMonth := AMonth;
  FDay := ADay;
end;

procedure TMyDate.GetDate(
  var AYear: Integer; var AMonth: TMonthType; var ADay: TDayType );
begin
  AYear := FYear;
  AMonth := FMonth;
  ADay := FDay;
end;

function TMyDate.GetDateAsText(): string;
begin
  Result := Format( '%4.4d%2.2d%2.2d', [ FYear, FMonth, FDay ] );
end;

procedure TMyDate.Inc();
begin
  case FMonth of
    1, 3, 5, 7, 8, 10:
    begin
      if FDay < 31 then
        System.Inc( FDay )
      else
      begin
        FDay := 1;
        System.Inc( FMonth );
      end;
    end;
    4, 6, 9, 11:
    begin
      if FDay < 30 then
        System.Inc( FDay )
      else
      begin
        FDay := 1;
        System.Inc( FMonth );
      end;
    end;
    2:
    begin
      if IsLeapYear() then
      begin
        if FDay < 29 then
          System.Inc( FDay )
        else
        begin
          FDay := 1;
          System.Inc( FMonth );
        end;
      end
      else
      begin
        if FDay < 28 then
          System.Inc( FDay )
        else
        begin
          FDay := 1;
          System.Inc( FMonth );
        end;
      end;
    end;
    12:
    begin
      if FDay < 31 then
        System.Inc( FDay )
      else
      begin
        FDay := 1;
        FMonth := 1;
        System.Inc( FYear );
      end;
    end;
  end;
end;

procedure TMyDate.Dec();
begin
  case FMonth of
    1:
    begin
      if FDay > 1 then
        System.Dec( FDay )
      else
      begin
        FDay := 31;
        FMonth := 12;
        System.Dec( FYear );
      end;
    end;
    2, 4, 6, 8, 9, 11:
    begin
      if FDay > 1 then
        System.Dec( FDay )
      else
      begin
        FDay := 31;
        System.Dec( FMonth );
      end;
    end;
    3:
    begin
      if IsLeapYear() then
      begin
        if FDay > 1 then
          System.Dec( FDay )
        else
        begin
          FDay := 29;
          System.Dec( FMonth );
        end;
      end
      else
      begin
        if FDay > 1 then
          System.Dec( FDay )
        else
        begin
          FDay := 28;
          System.Dec( FMonth );
        end;
      end;
    end;
    5, 7, 10, 12:
    begin
      if FDay > 1 then
        System.Dec( FDay )
      else
      begin
        FDay := 30;
        System.Dec( FMonth );
      end;
    end;
  end;
end;

destructor TMyDate.Destroy();
begin
  inherited Destroy();
end;

{ Classes.pas
  TCollection = class;

  TCollectionItem = class(TPersistent)
  private
    FCollection: TCollection;
    FID: Integer;
    function GetIndex: Integer;
    procedure SetCollection(Value: TCollection);
  protected
    procedure Changed(AllItems: Boolean);
    function GetOwner: TPersistent; override;
    function GetDisplayName: string; virtual;
    procedure SetIndex(Value: Integer); virtual;
    procedure SetDisplayName(const Value: string); virtual;
  public
    constructor Create(Collection: TCollection); virtual;
    destructor Destroy; override;
    function GetNamePath: string; override;
    property Collection: TCollection read FCollection write SetCollection;
    property ID: Integer read FID;
    property Index: Integer read GetIndex write SetIndex;
    property DisplayName: string read GetDisplayName write SetDisplayName;
  end;

  TCollectionItemClass = class of TCollectionItem;

  TCollection = class(TPersistent)
  private
    FItemClass: TCollectionItemClass;
    FItems: TList;
    FUpdateCount: Integer;
    FNextID: Integer;
    FPropName: string;
    function GetCount: Integer;
    function GetPropName: string;
    procedure InsertItem(Item: TCollectionItem);
    procedure RemoveItem(Item: TCollectionItem);
  protected
    procedure Added(var Item: TCollectionItem); virtual;
    procedure Deleting(Item: TCollectionItem); virtual;
    property NextID: Integer read FNextID;
    function GetAttrCount: Integer; dynamic;
    function GetAttr(Index: Integer): string; dynamic;
    function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
    procedure Changed;
    function GetItem(Index: Integer): TCollectionItem;
    procedure SetItem(Index: Integer; Value: TCollectionItem);
    procedure SetItemName(Item: TCollectionItem); virtual;
    procedure Update(Item: TCollectionItem); virtual;
    property PropName: string read GetPropName write FPropName;
    property UpdateCount: Integer read FUpdateCount;
  public
    constructor Create(ItemClass: TCollectionItemClass);
    destructor Destroy; override;
    function Owner: TPersistent;
    function Add: TCollectionItem;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate; virtual;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure EndUpdate; virtual;
    function FindItemID(ID: Integer): TCollectionItem;
    function GetNamePath: string; override;
    function Insert(Index: Integer): TCollectionItem;
    property Count: Integer read GetCount;
    property ItemClass: TCollectionItemClass read FItemClass;
    property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
  end;
}

end.