lunarcal.pas

DELPHI编写的商场收银POS机源代码

unit LunarCal;

interface

uses Classes, Controls, Messages, Windows, Forms, Graphics, StdCtrls,
  Grids, SysUtils;

type
  TDayOfWeek = 0..6;

  TLunarCal = class(TCustomGrid)
  private
    FDate: TDateTime;
    FLunarYear: Integer;
    FHintDate: THintWindow;
    FMonthOffset: Integer;
    FOnChange: TNotifyEvent;
    FReadOnly: Boolean;
    FStartOfWeek: TDayOfWeek;
    FShowGregDate: Boolean;
    FShowNavigator: Boolean;
    FUpdating: Boolean;    
    FUseCurrentDate: Boolean;
    function GetCellText(ACol, ARow: Integer): string;
    function GetDateElement(Index: Integer): Integer;
    function GetGregYear(GYear, LYear: Word; LMonth: SmallInt): Word;
    procedure SetCalendarDate(Value: TDateTime);
    procedure SetDateElement(Index: Integer; Value: Integer);
    procedure SetShowNavigator(Value: Boolean);
    procedure SetStartOfWeek(Value: TDayOfWeek);
    procedure SetUseCurrentDate(Value: Boolean);
    function StoreCalendarDate: Boolean;
  protected
    procedure Change; dynamic;
    procedure ChangeMonth(Delta: Integer);
    procedure Click; override;
    function DaysPerLunarMonth(GYear, LYear, AMonth: Integer): Integer; virtual;
    function LunarDaysThisMonth: Integer; virtual;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property CalendarDate: TDateTime  read FDate write SetCalendarDate stored StoreCalendarDate;
    property CellText[ACol, ARow: Integer]: string read GetCellText;
    property LunarYear: Integer read FLunarYear;
    procedure NextMonth;
    procedure NextYear;
    procedure PrevMonth;
    procedure PrevYear;
    procedure UpdateCalendar; virtual;
  published
    property Align;
    property Anchors;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property GridLineWidth default 0;
    property LunarDay: Integer index 3  read GetDateElement write SetDateElement stored False;
    property LunarMonth: Integer index 2  read GetDateElement write SetDateElement stored False;
    property GregYear: Integer index 1  read GetDateElement write SetDateElement stored False;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property ShowHint;
    property ShowGregDate: Boolean read FShowGregDate write FShowGregDate default True;
    property ShowNavigator: Boolean read FShowNavigator write SetShowNavigator default True;
    property StartOfWeek: TDayOfWeek read FStartOfWeek write SetStartOfWeek;
    property TabOrder;
    property TabStop;
    property UseCurrentDate: Boolean read FUseCurrentDate write SetUseCurrentDate default True;
    property Visible;
    property OnClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses CSPUtils, Dialogs, Consts;

constructor TLunarCal.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { defaults }
  FUseCurrentDate := True;
  FShowGregDate := True;
  FShowNavigator := True;
  FHintDate := THintWindow.Create(Self);
  FixedCols := 0;
  FixedRows := 2;
  ColCount := 7;
  RowCount := 8;
  GridLineWidth := 0;
  Height := 155;
  Width := 335;
  ScrollBars := ssNone;
  Options := Options - [goRangeSelect] + [goDrawFocusSelected];
  FDate := Date;
  UpdateCalendar;
end;

destructor TLunarCal.Destroy;
begin
  FHintDate.Free;
  Inherited;
end;

procedure TLunarCal.WndProc(var Message: TMessage);
var
  P: TPoint;
  LunarRect: TRect;
begin
  inherited;
  if Assigned(FHintDate) and (Parent <> nil) 
     and Focused and FShowGregDate then
  begin
    if not GetCursorPos(P) then Exit;
    LunarRect := ClientRect;
    LunarRect.TopLeft := ClientToScreen(LunarRect.TopLeft);
    LunarRect.BottomRight := ClientToScreen(LunarRect.BottomRight);
    if (P.X < LunarRect.Left) or (P.X > LunarRect.Right) or
       (P.Y > LunarRect.Bottom) then
      FHintDate.ReleaseHandle;
  end;
end;

procedure TLunarCal.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TLunarCal.Click;
var
  TheCellText: string;
begin
  inherited Click;
  TheCellText := CellText[Col, Row];
  if TheCellText <> '' then LunarDay := StrToInt(TheCellText);
end;

function TLunarCal.DaysPerLunarMonth(GYear, LYear, AMonth: Integer): Integer;
var
  daterec: TDateRec;
begin
  daterec.GregYear := GYear;
  daterec.LunarYear := LYear;
  daterec.wMonth := AMonth;
  daterec.wDay := 0;
  Result := DaysInLunarMonth(@daterec);
end;

function TLunarCal.LunarDaysThisMonth: Integer;
var
  daterec: TDateRec;
begin
  daterec.GregYear := GetGregYear(GregYear, LunarYear, LunarMonth);
  daterec.LunarYear := LunarYear;
  daterec.wMonth := LunarMonth;
  daterec.wDay := 0;
  Result := DaysInLunarMonth(@daterec);
end;

procedure TLunarCal.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: string;
begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
end;

function TLunarCal.GetCellText(ACol, ARow: Integer): string;
var
  DayNum: Integer;
begin
  case ARow of
    0: begin
         case ACol of
           0: if FShowNavigator then 
                Result := '<'
              else  Result := '';
           2: Result := LunarYearName(LunarYear) + '年';
           3: if LunarMonth > 0 then
                Result := ShortMonthNames[LunarMonth]
              else
                Result := '闰' + ShortMonthNames[Abs(LunarMonth)];
           6: if FShowNavigator then
                Result := '>'
              else  Result := '';
         else
           Result := '';
         end;
       end;
    1: begin  { day names at tops of columns }
         Result := ShortDayNames[(StartOfWeek + ACol) mod 7 + 1]
       end;
  else 
      DayNum := FMonthOffset + ACol + (ARow - 2) * 7;
      if (DayNum < 1) or (DayNum > LunarDaysThisMonth) then Result := ''
      else Result := IntToStr(DayNum);
  end;
end;

function TLunarCal.SelectCell(ACol, ARow: Longint): Boolean;
begin
  if ((not FUpdating) and FReadOnly) or (CellText[ACol, ARow] = '') then
    Result := False
  else Result := inherited SelectCell(ACol, ARow);
end;

procedure TLunarCal.SetCalendarDate(Value: TDateTime);
begin
  FDate := Value;
  UpdateCalendar;
  Change;
end;

procedure TLunarCal.SetShowNavigator(Value: Boolean);
begin
  if Value <> FShowNavigator then
  begin
    FShowNavigator := Value;
    Invalidate;
  end;
end;

function TLunarCal.StoreCalendarDate: Boolean;
begin
  Result := not FUseCurrentDate;
end;

function TLunarCal.GetDateElement(Index: Integer): Integer;
var
  AYear, ADay, GMonth: Word;
  AMonth: SmallInt;
begin
  DecodeLunarDate(FDate, AYear, AMonth, ADay);
  case Index of
    1: begin
         FLunarYear := AYear;
         DecodeDate(FDate, AYear, GMonth, Aday);
         Result := AYear;
       end;
    2: Result := AMonth;
    3: Result := ADay;
    else Result := -1;