chinacalendar.pas

一套融入了系统营销管理思想的管理软件产品

unit ChinaCalendar;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Grids, ExtCtrls, Buttons, Calendar, Db,
  DBTables, DBCtrls;

type
  TfmCalendar = class(TForm)
    Panel1: TPanel;
    MonthCombo: TComboBox;
    Calendar1: TCalendar;
    YearCombo: TComboBox;
    PriorMonthSB: TSpeedButton;
    NextMonthSB: TSpeedButton;
    OkButton: TBitBtn;
    CancelButton: TBitBtn;
    procedure MonthComboChange(Sender: TObject);
    procedure YearComboChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Calendar1Change(Sender: TObject);
    procedure Calendar1DblClick(Sender: TObject);
    procedure NextMonthSBClick(Sender: TObject);
    procedure PriorMonthSBClick(Sender: TObject);
  public
     DateVal:TDateTime;
  end;
  function MyCalendar(Edit: TDBEdit): Boolean;

implementation

uses PublicFunction, CheckData;

{$R *.DFM}

function MyCalendar(Edit: TDBEdit): Boolean;
var
  RectBox: TRect;
  UpperPoint, LowerPoint: TPoint;
  fmCalendar: TfmCalendar;
  sToday : String;
begin

  if not (Edit.DataSource.DataSet.State in [dsEdit, dsInsert]) then
    Abort;
  Screen.Cursor:= crHourGlass;

  fmCalendar:= TfmCalendar.Create(Application);

  if Trim(Edit.Text) = '' then
    Edit.Text := Today;
  with fmCalendar do
  begin
    Screen.Cursor:= crDefault;

    if not CheckDateNomal(Edit.Text) then
      sToday := Today
    else
      sToday := Edit.Text;

    DateVal := StrToDate(IntToStr(StrToInt(LeftStr(sToday, 2)) + 1911) + '/' +
                                  SubStr(sToday, 4, 2) + '/' +
                                  RightStr(sToday, 2));
    with Edit do
    begin
      RectBox := ClientRect;
      UpperPoint.X := rectBox.Left;
      UpperPoint.Y := rectBox.Top;
      UpperPoint := ClientToScreen( UpperPoint );
      LowerPoint.X := rectBox.Right;
      LowerPoint.Y := rectBox.Bottom;
      LowerPoint := ClientToScreen( LowerPoint );

      if UpperPoint.X + 1 + fmCalendar.Width > Screen.Width then
        fmCalendar.Left := Screen.Width - fmCalendar.Width - 1
      else
        fmCalendar.Left := UpperPoint.X + 1;

      if LowerPoint.Y + 1 + fmCalendar.Height > Screen.Height then
        fmCalendar.Top := UpperPoint.Y - fmCalendar.Height
      else
        fmCalendar.Top := LowerPoint.Y + 1;
    end;

    Result:= ShowModal = mrOK;
    if Result then

      Edit.DataSource.DataSet.FieldByName(Edit.DataField).AsString :=
                      RightStr('00' + IntToStr(Calendar1.Year - 1911), 2) + '-' +
                      RightStr('00' + IntToStr(Calendar1.Month), 2) + '-' +
                      RightStr('00' + IntToStr(Calendar1.Day), 2);

    Free;
   end
end;

procedure TfmCalendar.MonthComboChange(Sender: TObject);
begin

  Calendar1.Month := MonthCombo.ItemIndex + 1;
end;

procedure TfmCalendar.YearComboChange(Sender: TObject);
begin

  Calendar1.Year := StrToInt(SubStr(YearCombo.Items[YearCombo.ItemIndex], 2, 2)) + 1911;
end;

procedure TfmCalendar.FormActivate(Sender: TObject);
begin
   Calendar1.CalendarDate := DateVal;

   OkButton.Caption :='';
   CancelButton.Caption :='';

   MonthCombo.ItemIndex :=Calendar1.Month - 1;

   YearCombo.ItemIndex := YearCombo.Items.IndexOf(
                                    RightStr('00' + IntToStr(Calendar1.Year - 1911), 2) + '