tntjvpickdate.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvPickDate.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s):
  Polaris Software

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvPickDate.pas,v 1.46 2005/02/17 10:20:45 marquardt Exp $

unit TntJvPickDate;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  Windows, Messages,
  Controls, TntControls, Graphics, TntGraphics, Forms, TntForms, Buttons, TntButtons, StdCtrls, TntStdCtrls, Grids, ExtCtrls, TntExtCtrls,
  {$IFDEF VisualCLX}
  QTypes,
  {$ENDIF VisualCLX}
  SysUtils, TntSysUtils, TntSysUtils2, Classes, TntClasses,
  JvTypes, JvExGrids, TntJvToolEdit, TntJvSpeedButton;

type
  TDayOfWeek = 0..6;

  TTntJvCalendar = class(TJvExCustomGrid)
  private
    FMinDate: TDateTime; // Polaris
    FMaxDate: TDateTime; // Polaris
    FDate: TDateTime;
    FMonthOffset: Integer;
    FOnChange: TNotifyEvent;
    FReadOnly: Boolean;
    FStartOfWeek: TDayOfWeekName;
    FUpdating: Boolean;
    FUseCurrentDate: Boolean;
    FWeekends: TDaysOfWeek;
    FWeekendColor: TColor;
    function GetCellText(ACol, ARow: Integer): WideString;
    function GetDateElement(Index: Integer): Integer;
    procedure SetCalendarDate(Value: TDateTime);
    procedure SetDateElement(Index: Integer; Value: Integer);
    procedure SetStartOfWeek(Value: TDayOfWeekName);
    procedure SetUseCurrentDate(Value: Boolean);
    procedure SetWeekendColor(Value: TColor);
    procedure SetWeekends(Value: TDaysOfWeek);
    function IsWeekend(ACol, ARow: Integer): Boolean;
    procedure CalendarUpdate(DayOnly: Boolean);
    function StoreCalendarDate: Boolean;
    //>Polaris
    procedure SetMinDate(Value: TDateTime);
    procedure SetMaxDate(Value: TDateTime);
    //<Polaris
  protected
    //>Polaris
    function GetCellDate(ACol, ARow: Integer): TDateTime;
    function CellInRange(ACol, ARow: Integer): Boolean;
    function DateInRange(ADate: TDateTime): Boolean;
    //<Polaris
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    {$ENDIF VCL}
    procedure Change; dynamic;
    procedure ChangeMonth(Delta: Integer);
    procedure Click; override;
    function DaysThisMonth: Integer;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure BoundsChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure NextMonth;
    procedure NextYear;
    procedure PrevMonth;
    procedure PrevYear;
    procedure UpdateCalendar; virtual;
    property CellText[ACol, ARow: Integer]: WideString read GetCellText;
  published
    property CalendarDate: TDateTime read FDate write SetCalendarDate
      stored StoreCalendarDate;
    property Day: Integer index 3 read GetDateElement write SetDateElement stored False;
    property Month: Integer index 2 read GetDateElement write SetDateElement stored False;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property StartOfWeek: TDayOfWeekName read FStartOfWeek write SetStartOfWeek default Mon;
    property UseCurrentDate: Boolean read FUseCurrentDate write SetUseCurrentDate default True;
    property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
    property Weekends: TDaysOfWeek read FWeekends write SetWeekends default [Sun];
    property Year: Integer index 1 read GetDateElement write SetDateElement stored False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;

    property MinDate: TDateTime read FMinDate write SetMinDate stored False; // polaris
    property MaxDate: TDateTime read FMaxDate write SetMaxDate stored False; // polaris
  end;

{ Calendar dialog }

function SelectDateW(Sender: TWinControl; var Date: TDateTime; const DlgCaption: TWideCaption;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TTntStrings;
  MinDate: TDateTime = 0;
  MaxDate: TDateTime = 0): Boolean; // Polaris
function SelectDateStrW(Sender: TWinControl; var StrDate: WideString; const DlgCaption: TWideCaption;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TTntStrings;
  MinDate: TDateTime = 0;
  MaxDate: TDateTime = 0): Boolean; // Polaris
function PopupDate(var Date: TDateTime; Edit: TWinControl;
  MinDate: TDateTime = 0;
  MaxDate: TDateTime = 0): Boolean;

{ Popup calendar }

function CreatePopupCalendarW(AOwner: TComponent;
  ABiDiMode: TBiDiMode = bdLeftToRight;
  MinDate: TDateTime = 0;
  MaxDate: TDateTime = 0): TWinControl;
procedure SetupPopupCalendarW(PopupCalendar: TWinControl;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TTntStrings; FourDigitYear: Boolean;
  MinDate: TDateTime = 0;
  MaxDate: TDateTime = 0);

const
  PopupCalendarSize: TPoint = (X: 187; Y: 124);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvPickDate.pas,v $';
    Revision: '$Revision: 1.46 $';
    Date: '$Date: 2005/02/17 10:20:45 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

type
  TTntJvPopupCalendar = class(TTntJvPopupWindow)
  private
    FCalendar: TTntJvCalendar;
    FTitleLabel: TTntLabel;
    FFourDigitYear: Boolean;
    FBtns: array [0..3] of TTntJvSpeedButton;
    procedure CalendarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PrevMonthBtnClick(Sender: TObject);
    procedure NextMonthBtnClick(Sender: TObject);
    procedure PrevYearBtnClick(Sender: TObject);
    procedure NextYearBtnClick(Sender: TObject);
    procedure CalendarChange(Sender: TObject);
    procedure TopPanelDblClick(Sender: TObject);
    //>Polaris
    //    function GetDate(Index: Integer): TDate;
    procedure SetDate(Index: Integer; Value: TDateTime);
    //<Polaris
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    function GetValue: Variant; override;
    procedure SetValue(const Value: Variant); override;
    //>Polaris
    procedure CheckButton;
    //<Polaris
  public
    constructor Create(AOwner: TComponent); override;
    //>Polaris
    procedure Invalidate; override;
    procedure Update; override;
    property MinDate: TDateTime index 0 {read GetDate} write SetDate;
    property MaxDate: TDateTime index 1 {read GetDate} write SetDate;
    //<Polaris
  end;

type
  TTntJvTimerSpeedButton = class(TTntJvSpeedButton)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AllowTimer default True;
    property Style default bsWin31;
  end;

implementation

uses
  Math, Consts,
  JvThemes, JvConsts, JvResources, JvJCLUtils, TntJvJCLUtils;

procedure FontSetDefault(AFont: TFont);
{$IFDEF VCL}
var
  NonClientMetrics: TNonClientMetrics;
{$ENDIF VCL}
begin
  {$IFDEF VCL}
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    AFont.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont)
  else
  {$ENDIF VCL}
    with AFont do
    begin
      Color := clWindowText;
      {$IFDEF VCL}
      Name := 'MS Sans Serif';
      Size := 8;
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      Name := 'Helvetica';
      Height := 11;
      {$ENDIF VisualCLX}
      Style := [];
    end;
end;

procedure CreateButtonGlyph(Glyph: TBitmap; Idx: Integer);
type
  TPointList = array [0..3] of TPoint;
const
  PointsLeft: TPointList =
   ((X: 2; Y: 0), (X: 2; Y: 5), (X: 0; Y: 3), (X: 0; Y: 2));
  PointsRight: TPointList =
   ((X: 0; Y: 0), (X: 0; Y: 5), (X: 2; Y: 3), (X: 2; Y: 2));
var
  Points: TPointList;

  function OffsetPoints(const Points: TPointList; Offs: Integer): TPointList;
  var
    I: Integer;
  begin
    Result := Points;
    for I := Low(TPointList) to High(TPointList) do
      Inc(Result[I].X, Offs);
  end;

begin
  Glyph.Width := 8;
  Glyph.Height := 6;
  Glyph.PixelFormat := pf1bit;
  Glyph.Canvas.Brush.Color := clBtnFace;
  Glyph.Canvas.FillRect(Rect(0, 0, 8, 6));
  Glyph.Transparent := True;
  Glyph.Canvas.Brush.Color := clBtnText;
  Glyph.Canvas.Pen.Color := clBtnText;
  case Idx of
    0:
      begin
        Glyph.Canvas.Polygon(PointsLeft);
        Points := OffsetPoints(PointsLeft, 4);
        Glyph.Canvas.Polygon(Points);
      end;
    1:
      begin
        Points := OffsetPoints(PointsLeft, 2);
        Glyph.Canvas.Polygon(Points);
      end;
    2:
      begin
        Points := OffsetPoints(PointsRight, 3);
        Glyph.Canvas.Polygon(Points);
      end;
    3:
      begin
        Points := OffsetPoints(PointsRight, 1);
        Glyph.Canvas.Polygon(Points);
        Points := OffsetPoints(PointsRight, 5);
        Glyph.Canvas.Polygon(Points);
      end;
  end;
end;

//=== { TTntJvTimerSpeedButton } ================================================

constructor TTntJvTimerSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := bsWin31;
  AllowTimer := True;
  ControlStyle := ControlStyle + [csReplicatable];
end;

//=== { TTntJvCalendar } ========================================================

{ TTntJvCalendar implementation copied from Borland CALENDAR.PAS sample unit
  and modified }

constructor TTntJvCalendar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //>Polaris
  FMinDate := NullDate;
  FMaxDate := NullDate;
  //<Polaris
  FUseCurrentDate := True;
  FStartOfWeek := Mon;
  FWeekends := [Sun];
  FWeekendColor := clRed;
  FixedCols := 0;
  FixedRows := 1;
  ColCount := 7;
  RowCount := 7;
  ScrollBars := ssNone;
  Options := Options - [goRangeSelect] + [goDrawFocusSelected];
  ControlStyle := ControlStyle + [csFramed];
  FDate := Date;
  UpdateCalendar;
end;

{$IFDEF VCL}
procedure TTntJvCalendar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_BORDER;
  Params.ExStyle := Params.ExStyle and not WS_EX_CLIENTEDGE;
  AddBiDiModeExStyle(Params.ExStyle);
end;
{$ENDIF VCL}

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

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

function TTntJvCalendar.DaysThisMonth: Integer;
begin
  Result := DaysPerMonth(Year, Month);
end;

procedure TTntJvCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: WideString;

  //>Polaris
  procedure DefaultDraw;
  begin
    if TheText <> '' then
      with ARect, Canvas do
      begin
        Brush.Style := bsClear;
        WideCanvasTextRect(Canvas, ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
          Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
      end;
  end;

  procedure PoleDraw;
  begin
    with ARect, Canvas do
    begin
      if (ARow > 0) and ((FMinDate <> NullDate) or (FMaxDate <> NullDate)) then
        if not CellInRange(ACol, ARow) then
          if TheText <> '' then
          begin
            Font.Color := clBtnFace;
            if Color = clBtnFace then
            begin
              Font.Color := clBtnHighlight;
              WideCanvasTextRect(Canvas, ARect, Left + (Right - Left - TextWidth(TheText)) div 2 + 1,
                Top + (Bottom - Top - TextHeight(TheText)) div 2 + 1, TheText);
              Font.Color := clBtnShadow;
            end;
          end;
      DefaultDraw;
    end;
  end;
  //<Polaris

begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
  begin
    if IsWeekend(ACol, ARow) and not (gdSelected in AState) then
      Font.Color := WeekendColor;

    PoleDraw;
    {
          TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
            Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);

    }
  end;
end;

function TTntJvCalendar.GetCellText(ACol, ARow: Integer): WideString;
var
  DayNum: Integer;
begin
  if ARow = 0 then { day names at tops of columns }
    Result := ShortDayNamesW[(Ord(StartOfWeek) + ACol) mod 7 + 1]
  else
  begin
    DayNum := FMonthOffset + ACol + (ARow - 1) * 7;
    if (DayNum < 1) or (DayNum > DaysThisMonth) then
      Result := ''
    else
      Result := IntToStr(DayNum);
  end;
end;

//>Polaris

procedure TTntJvCalendar.SetMinDate(Value: TDateTime);
begin
  if FMinDate <> Value then
  begin