adatectl.pas

来自「delphi编程控件」· PAS 代码 · 共 1,516 行 · 第 1/3 页

        begin
          R.Right := R.Left;
          R.Left := 0;
          SelectColor(MonthNameSelected);
          FillRect(R);
        end;
        if I = DaysPerMonth(AYear, AMonth) then
        begin
          R.Left := R.Right;
          R.Right := ClientWidth;
          SelectColor(IsSelected(ADate) and IsSelected(ADate + 1));
          FillRect(R);
        end;
      end;
    end;
  end;

begin
  inherited Paint;

  FirstYear := 0;
  FirstMonth := 0;
  LastYear := 0;
  LastMonth := 0;
  LastRow := 0;
  DecodeDate(FDate, Year, Month, Day);
  if TopRow >= 0 then
    repeat
      Inc(LastRow, MonthHeight(Year, Month, True));
      if (LastRow > TopRow) and (FirstMonth = 0) then
      begin
        FirstYear := Year;
        FirstMonth := Month;
      end;
      if LastRow > TopRow + VisibleRowCount then
      begin
        LastYear := Year;
        LastMonth := Month;
        Break;
      end;
      IncMonth(Year, Month);
    until False
  else
    repeat
      DecMonth(Year, Month);
      Dec(LastRow, MonthHeight(Year, Month, True));
      if LastRow <= TopRow then
      begin
        FirstYear := Year;
        FirstMonth := Month;
        repeat
          Inc(LastRow, MonthHeight(Year, Month, True));
          if LastRow > TopRow + VisibleRowCount then
          begin
            LastYear := Year;
            LastMonth := Month;
            Break;
          end;
          IncMonth(Year, Month);
        until False;
        Break;
      end;
    until False;
  Year := FirstYear;
  Month := FirstMonth;

  Bitmap := TBitmap.Create;
  Bitmap.Width := ClientWidth;
  Bitmap.Height := ClientHeight;
  with Bitmap.Canvas do
  begin
    Font := Self.Font;
    repeat
      DrawMonth(Year, Month);
      if (Year = LastYear) and (Month = LastMonth) then Break;
      IncMonth(Year, Month);
    until False;
  end;
  Canvas.Draw(0, 0, Bitmap);
  Bitmap.Free;

  with ScrollInfo do
  begin
    cbSize := SizeOf(ScrollInfo);
    fMask := SIF_ALL;
    nPage := VisibleRowCount;
    nMin := TopRow - 70;
    nMax := TopRow + 70 + nPage;
    nPos := TopRow;
  end;
  SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
end;

function TCustomAutoDateControl.PosOfDate(ADate: TDateTime): TPoint;
begin
  with Result do
  begin
    X := ColOfDate(ADate) * ColWidth - ColWidth div 2;
    Y := (RowOfDate(ADate) - TopRow) * RowHeight + RowHeight div 2;
  end;
end;

function TCustomAutoDateControl.RowOfDate(ADate: TDateTime): Integer;
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(ADate, AYear, AMonth, ADay);
  Result := MonthTop(AYear, AMonth) + 1;
  if ADay > FirstWeekDays(AYear, AMonth) then
    Inc(Result, 1 + (ADay - FirstWeekDays(AYear, AMonth) - 1) div 7);
end;

procedure TCustomAutoDateControl.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  SetSize;
end;

procedure TCustomAutoDateControl.SetSize;
begin
  if (not IsPopup and (Parent = nil)) or
    (csDestroying in ComponentState) then Exit;
  ColWidth := 5 + Canvas.TextWidth('00') + 5;
  RowHeight := 2 + Canvas.TextHeight('00') + 2;
  Width := GetWidth;
  RecreateWnd;
end;

procedure TCustomAutoDateControl.Hide;
begin
  if IsPopup then DestroyHandle
  else inherited Hide;
  if Assigned(FOnHide) then FOnHide(Self);
end;

procedure TCustomAutoDateControl.Show;
begin
  SetSize;
  if IsPopup then
  begin
    ShowWindow(Handle, SW_SHOW);
    SendMessage(TForm(Owner).Handle, WM_NCACTIVATE, Longint(True), 0);
  end
  else inherited Show;
end;

procedure TCustomAutoDateControl.ShowDate(ADate: TDateTime);
var
  Row: Integer;
begin
  Row := RowOfDate(ADate);
  if Row < TopRow then TopRow := Row;
  if Row >= TopRow + VisibleRowCount then
    TopRow := Row - (VisibleRowCount - 1);
end;

{$IFNDEF AOB_PS}

{ TDropDownButton }

type
  TDropDownButton = class(TSpeedButton)
  private
    IsShowingPopup: Boolean;
    procedure DateChange(Sender: TObject);
    procedure HidePopup(Sender: TObject);
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Click; override;
  end;

constructor TDropDownButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alRight;
  Cursor := crArrow;
  Width := GetSystemMetrics(SM_CXVSCROLL);
end;

procedure TDropDownButton.DateChange(Sender: TObject);
begin
  TCustomAutoDateEdit(Parent).Date := TCustomAutoDateControl(Sender).BeginDate;
  if TCustomAutoDateEdit(Parent).SelectPeriod then
    TCustomAutoDateEdit(Parent).EndDate := TCustomAutoDateControl(Sender).EndDate;
end;

procedure TDropDownButton.HidePopup(Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  if (GetAsyncKeyState(VK_LBUTTON) shr 15 = 0) or
    not PtInRect(ClientRect, P) then
    IsShowingPopup := False;
end;

procedure TDropDownButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if IsShowingPopup then IsShowingPopup := False
  else inherited;
end;

procedure TDropDownButton.Paint;
const
  EnabledStyles: array[Boolean] of Integer = (DFCS_INACTIVE, 0);
  DownStyles: array[Boolean] of Integer = (0, DFCS_PUSHED);
begin
  inherited Paint;
  with Canvas do
    DrawFrameControl(Handle, ClientRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or
      EnabledStyles[Parent.Enabled] or DownStyles[FState = bsDown]);
end;

procedure TDropDownButton.Click;
var
  P: TPoint;
  R: TRect;
begin
  if TCustomAutoDateEdit(Parent).ReadOnly then Exit;
  inherited Click;
  Parent.SetFocus;
  with Parent do
    P := Parent.ClientToScreen(Point(Left, Top + Height));
  with TCustomAutoDateControl.Create(GetParentForm(Self)) do
  begin
    IsPopup := True;
    Left := P.X;
    Top := P.Y;
    Height := TCustomAutoDateEdit(Self.Parent).DropDownHeight;
    Font := TCustomAutoDateEdit(Self.Parent).Font;
    SelectPeriod := TCustomAutoDateEdit(Self.Parent).SelectPeriod;
    BeginDate := TCustomAutoDateEdit(Self.Parent).BeginDate;
    EndDate := TCustomAutoDateEdit(Self.Parent).EndDate;
    Date := TCustomAutoDateEdit(Self.Parent).Date;
    OnDateChange := DateChange;
    OnBeginDateChange := DateChange;
    OnEndDateChange := DateChange;
    OnHide := HidePopup;
    SetSize;
    SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
    if Left < R.Left then Left := R.Left;
    if Left + Width > R.Right then
      Left := R.Right - Width;
    if Top + Height > R.Bottom then
      Top := Top - (Self.Parent.Height + Height);
    IsShowingPopup := True;
    Show;
  end;
end;

{ TCustomAutoDateEdit }

constructor TCustomAutoDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDropDownHeight := 200;
  SelectPeriod := False;
  DropDownButton := TDropDownButton.Create(Self);
  DropDownButton.Parent := Self;
  Date := SysUtils.Date;
end;

function TCustomAutoDateEdit.GetBeginDate: TDateTime;
begin
  if BeginDateStr[1] = ' ' then Result := NullDate
  else
    Result := StrToDate(BeginDateStr);
end;

function TCustomAutoDateEdit.GetDate: TDateTime;
begin
  Result := BeginDate;
end;

function TCustomAutoDateEdit.GetEndDate: TDateTime;
begin
  if SelectPeriod then
    Result := StrToDate(EndDateStr)
  else Result := BeginDate;
end;

procedure TCustomAutoDateEdit.SetBeginDate(Value: TDateTime);
var
  AEditText: string;
begin
  if Value <> NullDate then
  begin
    if BeginDate = NullDate then EndDate := Value;
    AEditText := FormatDateTime(DateFormat, Value);
    if SelectPeriod then AEditText := AEditText + '-' + EndDateStr;
    EditText := AEditText;
    if not SelectPeriod then EndDate := Value;
    DoBeginDateChange;
  end;
end;

procedure TCustomAutoDateEdit.SetDate(Value: TDateTime);
begin
  BeginDate := Value;
  DoDateChange;
end;

procedure TCustomAutoDateEdit.SetEndDate(Value: TDateTime);
begin
  if SelectPeriod then
  begin
    EditText := BeginDateStr + '-' + FormatDateTime(DateFormat, Value);
    DoEndDateChange;
  end;
end;

procedure TCustomAutoDateEdit.SetSelectPeriod(Value: Boolean);
var
  IsCreating: Boolean;
  OldBeginDate, OldEndDate: TDateTime;
  OldDefaultBlank: Char;
  NewEditMask: string;
  I: Integer;
begin
  if EditText = '' then IsCreating := True
  else
  begin
    IsCreating := False;
    OldBeginDate := BeginDate;
    OldEndDate := EndDate;
  end;
  FSelectPeriod := Value;
  OldDefaultBlank := DefaultBlank;
  DefaultBlank := ' ';

  if FSelectPeriod then
    NewEditMask := DateFormat + '-' + DateFormat
  else
    NewEditMask := DateFormat;
  for I := 1 to Length(NewEditMask) do
    if UpCase(NewEditMask[I]) in ['D', 'M', 'Y'] then
      NewEditMask[I] := '0';
  MaxLength := Length(NewEditMask);
  EditMask := NewEditMask;

  DefaultBlank := OldDefaultBlank;
  if IsCreating then
  begin
    BeginDate := SysUtils.Date;
    EndDate := SysUtils.Date;
  end
  else
  begin
    BeginDate := OldBeginDate;
    EndDate := OldEndDate;
  end;
end;

procedure TCustomAutoDateEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  R: TRect;
begin
  R := ClientRect;
  Dec(R.Right, GetSystemMetrics(SM_CXVSCROLL));
  FillRect(Message.DC, R, Brush.Handle);
  Message.Result := 1;
end;

function TCustomAutoDateEdit.BeginDateStr: string;
begin
  Result := Copy(EditText, 1, Length(DateFormat));
end;

procedure TCustomAutoDateEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or ES_MULTILINE;
end;

function TCustomAutoDateEdit.EditingPlace(var EndDateEditing: Boolean): TEditingPlace;
var
  S: string;
  Pos: Integer;
begin
  S := UpperCase(DateFormat);
  Pos := SelStart + 1;
  if Pos > MaxLength then Pos := MaxLength;
  EndDateEditing := SelectPeriod and (Pos > Length(S) + 1);
  if EndDateEditing then Dec(Pos, Length(S) + 1);
  case S[Pos] of
    'D': Result := epDay;
    'M': Result := epMonth;
    'Y': Result := epYear;
  else Result := epError;
  end;
end;

function TCustomAutoDateEdit.EndDateStr: string;
begin
  Result := Copy(EditText, Length(DateFormat) + 2, Length(DateFormat));
end;

procedure TCustomAutoDateEdit.KeyDown(var Key: Word; Shift: TShiftState);

  procedure ChangeValue(Delta: Integer);
  var
    OldSelStart, OldSelStop: Integer;
    AEditingPlace: TEditingPlace;
    EndDateEditing: Boolean;
    ADate: TDateTime;
    Year, Month, Day: Word;
  begin
    GetSel(OldSelStart, OldSelStop);
    AEditingPlace := EditingPlace(EndDateEditing);
    if EndDateEditing then ADate := EndDate
    else ADate := BeginDate;
    if AEditingPlace = epDay then
      ADate := ADate + Delta
    else
    begin
      DecodeDate(ADate, Year, Month, Day);
      if AEditingPlace = epMonth then
        if Delta = -1 then DecMonth(Year, Month)
        else IncMonth(Year, Month)
      else
        if AEditingPlace = epYear then Inc(Year, Delta)
        else Exit;
      if Day > DaysPerMonth(Year, Month) then
        Day := DaysPerMonth(Year, Month);
      ADate := EncodeDate(Year, Month, Day);
    end;
    if EndDateEditing then EndDate := ADate
    else BeginDate := ADate;
    SetSel(OldSelStart, OldSelStop);
  end;

begin
  if not ReadOnly then
    case Key of
      VK_DOWN:
        if Shift = [ssAlt] then DropDownButton.Click
        else ChangeValue(-1);
      VK_UP: ChangeValue(1);
      VK_F4: if Shift = [] then DropDownButton.Click;
    end;
  inherited KeyDown(Key, Shift);
end;

procedure TCustomAutoDateEdit.DoDateChange;
begin
  if Assigned(FOnDateChange) then FOnDateChange(Self);
end;

procedure TCustomAutoDateEdit.DoBeginDateChange;
begin
  if Assigned(FOnBeginDateChange) then FOnBeginDateChange(Self);
  DoDateChange;
end;

procedure TCustomAutoDateEdit.DoEndDateChange;
begin
  if Assigned(FOnEndDateChange) then FOnEndDateChange(Self);
end;

procedure TCustomAutoDateEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  R: TRect;
  W: Integer;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if HandleAllocated then
  begin
    Perform(EM_GETRECT, 0, Longint(@R));
    W := GetSystemMetrics(SM_CXVSCROLL);
    if BorderStyle = bsSingle then Dec(W);
    if (R.Right - R.Left <= ClientWidth - W) or
      (Width = 0) or (Height = 0) then Exit;
    Dec(R.Right, W);
    Perform(EM_SETRECT, 0, Longint(@R));
    DropDownButton.Height := ClientHeight;
  end;
end;

{$ENDIF}

var
  P, I: Integer;

initialization
  ScrollTimerID := -1;
  DateFormat := ShortDateFormat;
  // extends to min 2 char places for editing month and day
  P := 1;
  for I := 1 to Length(DateFormat) do
    if (DateFormat[I] = DateSeparator) and (I - P = 1) then
    begin
      Insert(DateFormat[I - 1], DateFormat, I);
      P := I + 2;
    end;
  // extends to 4 digit year editing field
//  if UpperCase(Copy(DateFormat, Length(DateFormat) - 3, 4)) <> 'YYYY' then
//    DateFormat := DateFormat + 'yy';

end.