chinacalendar.~pa

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

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}

{ MyCalendar(Sender as TDBComboDlg);}
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
    begin
      sToday := Today;
      DateVal := StrToDate(IntToStr(StrToInt(LeftStr(sToday, 2)) + 1911) + '/' +
                                    SubStr(sToday, 4, 2) + '/' +
                                    RightStr(sToday, 2));
    end;
    DateVal :=  StrToDate(IntToStr(StrToInt(LeftStr(Edit.Text, 2)) + 1911) + '/' +
                                            SubStr(Edit.Text, 4, 2) + '/' +
                                            RightStr(Edit.Text, 2));
    with Edit do
    begin
      {Get the relative screen position of TDBEdit}
      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 calendar too far down, popup over wwDBComboDlg }
      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(Copy(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) + '