wwdbdatetimepicker.pas

胜天进销存源码,国产优秀的进销存

{
//
// Components : TwwDBDateTimePicker
//
// Copyright (c) 1998-2001 by Woll2Woll Software
// 7/29/98 pw Modified to allow Deletion of Time for CFormat Date Time fields
// 7/29/98 pw Added a check to clear the date if user hits delete on a date token.
//
// 8/14/98 Fixes for range-checking reported runtime errors
// 8/24/98 - Support Delphi 4 ActionLists
// 8/24/98 - Remov e check for uppercase as it prevents Alt- F4 from closing form
// 8/24/98 - Ignore Alt key sequences
// 8/24/98 - Respect DataSource AutoEdit Flag
// 8/26/98 - Support initialization of date after clearing with time not cleared
// 8/31/98 - Fix bug where leading zero months are not allowed.
// 8/31/98 - Fix mouse cursor bug when clicking on TComboBox
// 9/10/98 - Handled min/max date bugs and added beeps on invalid values.  PYW
//           Made some changes to handle Range Checking.
// 9/10/98 - Check Owner<>Nil in CMFontChanged
// 9/10/98 - Check for clearing of max date when mindate <> 0
// 9/29/98 - Fix bug when entering month and daysthismonth is not checked
// 10/6/98 - Support bidemode
// 10/22/98 - Handled Editing bug when dataset cancels or inserts.
// 10/29/98 - Drop-down would close in grid when encountering pageup, pagedown, vk_left
//            when using dgAlwaysShowEditor
// 10/29/98 - Text should be blank if datasource is not enabled
// 11/4/98 -  Reset modified in when entering unbound combo
// 11/5/98 -  Check if text is still blank
// 11/15/98 - Calling closeup immediately would cause problems from hook
// 11/15/98 - Add finally block in case of exception for method CloseUp
// 11/29/98 - Add check to handle 00 for month and days.
// 11/29/98 - Make sure Ctl3d is set to True to handle case when parent form's ctl3d is set to False.
// 12/1/98 - If this is a time only field then don't dropdown
// 12/1/98 - Turned off RangeChecking Compiler Switch because of operations on words.
// 12/2/98 - Added call to isDateTimeSeparator to correctly determine if a date or
//           time separator character was pressed.  TimeSeparator autoadvance case was
//           not working properly.
// 12/6/98 - Allow displayformat of days before month such as dd/mm/yyyy to allow
//           entering more days than current month.  By allowing, the month is changed
//           to be a month matching day range.
// 12/7/98 - Allow 3 to go to inplaceedit on months < 30
// 12/14/98 - Need to use the assign method when setting the font.
// 12/15/98 - Immediately update DateTime value after entering 1 or 2
//            digit year in KeyDown method.
// 12/16/98 - ShowCaret if null data (Code added to DataChange event and escape
//            processing).
// 12/17/98 - Don't auto fill time if digit encountered
// 12/17/98 - Prevent OnValidate from firing twice when datetimepicker is
//            in grid, and an exception occurs.
// 12/18/98 - Don't auto-fill minutes and seconds when entering hours.
// 1/8/98 - Added check to disable deleting while in digit edit mode.
// 1/8/98 - Handle Wrapping of day to max day of current month.
// 1/12/99 - Don't allow FDateTime to be beyond range
// 1/19/99 - Update FDateTime whenver in InPlaceEdit mode
// 1/21/99 - Fix bug introduced in 4.02F where leading zero generates exception
// 1/25/99 - Prevent grid's OnKeyDown from firing twice when encounter tab or cr
// 2/3/99  PYW   Use AnsiPos instead of Pos.  Otherwise, won't find 'M' correctly
// 3/3/99 - Day before month format did not allow entry if month format string was in
//          uppercase
// 3/8/99 - Allow Febrary 29th smooth data entry.  Previously required year be entered
//          before day if it was February 29th.
// 3/27/99 - If developer indirectly causes control to exit upon dropping down,
//           then FCalendar is nil.  Exit control in this case as it doesn't have
//           the focus
// 6/25/99 - Reset position on delete.  PYW
// 6/29/99 - Select all when closing up
// 7/31/99 - RSW - Fix bug where 00 cannot be entered into year if MinDate is greater than 1900
// 1/4/2000 - RSW - es_multiline style doesnt pass escape/returns to form so we pass it ourselves
// 1/4/2000 - PYW - Need to reset position when resetting Date Information
// 3/7/00 - Use clGrayText for disabled color
// 3/14/00 - MDI forms should check ActiveControl instead of focused
//          when button is clicked.  This fixes problem where
//          button click not recognized when switching back to mdi child
// 5/30/2000 - PYW - Make sure calendar is visible.
// 6/7/00 - RSW - If datetime field but date is 0, then still initialize
// 6/8/00 - RSW - Create message so that calendar is not destroyed within
//          calendar's LMouseUp processing.
// 7/31/00 - Makes sure modified is set in combo's change
// 8/16/00 - Fix problems with long day of week format during editing
// 8/17/00 - Fix AMPM getting reset when hour entered
// 10/6/2000 - Fix bug with button width not being used.
// 10/12/00 - Set to MinDate if not in valid range (PYW)
// 1/11/01 - Fix problem when entering 31/Jul, which yields 30/June
// 12/4/2001 - PYW-Check for ftTimeStamp datatype.
// 12/12/2001 - Make certain parent is visible before setting focus to it.
// 2/13/2002 - Add new property to autofill date and time.
// 3/3/2002 - PYW - Make sure that Date is integer type.
// 7/1/02 - Make day 1 if no day in date specification
// 7/17/02 (Don't return date only time) for GetTime
// 11/7/02 Fix problem where date reset back after setting datetime with button
}
unit wwdbdatetimepicker;
interface

{$i wwIfDef.pas}
{$C PRELOAD}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask,wwmonthcalendar, commctrl, comctrls,db,
  dbCtrls,buttons,wwintl, wwsystem, wwcommon, grids, wwtypes,
  wwframe, wwcombobutton;

type
  TwwDTCalAlignment = (wwdtaLeft, wwdtaRight, wwdtaCenter);
  TwwDTEditDataType = (wwDTEdtDateTime, wwDTEdtDate, wwDTEdtTime);
  TwwDTOption = (wwDTOAutoAdvance);
  TwwDTOptions = set of TwwDTOption;
  TwwDTInterval = class(TPersistent)
  private
     FMinutesInterval: integer;
     FRoundMinutes: boolean;
  public
    constructor Create;
  published
     property MinutesInterval: integer read FMinutesInterval write FMinutesInterval default 1;
     property RoundMinutes: boolean read FRoundMinutes write FRoundMinutes default false; { 11/11/99 - Assign default }
  end;

  TwwDBDateTimePicker = class;

  TwwPopupCalendar = class(TwwMonthCalendar)
  private
    FCombo: TwwDBDateTimePicker;
  protected
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
//    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure GetFocus; override;
  public
    constructor Create(AOwner: TComponent); Override;
  end;

//  TwwDTMonthOption = mdoDayState..mdoMultiSelect;
//  TwwDTMonthOptions = set of TwwDTMonthOption;

  TwwCalendarOptions = class(TPersistent)
  private
     FAlignment: TwwDTCalAlignment;
     FColors:TwwDateTimeColors;
     FFont:TFont;
     FWidth:Integer;
     FHeight:Integer;
     FOptions: TwwMonthOptions;
     FPopupYearOptions:TwwPopupYearOptions;
     FFirstDayOfWeek: TwwCalDayOfWeek;
     procedure SetPopupYearOptions(Value: TwwPopupYearOptions);
     function GetHeight: Integer;
     procedure SetHeight(Value: Integer);
     function GetWidth: Integer;
     procedure SetWidth(Value: Integer);
     function GetFont: TFont;
     procedure SetFont(Value: TFont);
     procedure SetAlignment(Value: TwwDTCalAlignment);
     procedure SetColors(Value: TwwDateTimeColors);
     procedure SetFirstDayOfWeek(Value: TwwCalDayOfWeek);
  protected
     procedure SetOptions(Value: TwwMonthOptions);
  public
     constructor Create(AOwner: TComponent);
     destructor Destroy; override;
     property Width: Integer read GetWidth write SetWidth;
     property Height: Integer read GetHeight write SetHeight;
  published
     property Alignment: TwwDTCalAlignment read FAlignment write SetAlignment Default wwdtaLeft;
     property Colors: TwwDateTimeColors read FColors write SetColors;
     property Font: TFont read GetFont write SetFont;
     property Options : TwwMonthOptions read FOptions write SetOptions default [mdoDayState];
     property PopupYearOptions : TwwPopupYearOptions read FPopupYearOptions write SetPopupYearOptions;
     property FirstDayOfWeek: TwwCalDayOfWeek read FFirstDayOfWeek write SetFirstDayOfWeek
        default wwdowLocaleDefault;
  end;

  TwwDBCustomDateTimePicker = class(TCustomEdit)
  private
    { Private declarations }
    FAlignment: TAlignment;

    FCalendar: TwwPopupCalendar;
    FCalendarOptions : TwwCalendarOptions;
    FOnCalcBoldDay: TCalcBoldDayEvent;

    FDateFormat:TDTDateFormat;
    FMaxDate: TDate;
    FMinDate: TDate;

    FInCloseUp: Boolean;
    FOnCloseUp: TNotifyEvent;
    FOnDropDown: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;

    FOldDateTime : TDateTime;
    FDateTime : TDateTime;

    FDataLink: TFieldDataLink;

    FButton: TwwComboButton;
    FBtnControl:TWincontrol;
    FCanvas: TControlCanvas;
    FFocused: Boolean;
    FPos:Integer;
    FUnboundDataType:TwwDTEditDataType;
    FDisplayFormat: string;
    FInDigitEdit: Boolean;
    FIsCleared: Boolean;
    FTextMargin:Integer;
    FInfoPower: boolean;
    FEpoch:Integer;
    FOptions: TwwDTOptions;
    FMouseInControl: boolean;

    SkipDrawSetFocus: boolean;
    DateTimeBeforeDropDown: TDateTime;
    SkipEscapeReset: boolean;  { When closing up do not restore original value, but pre-dropped value }
    FShowButton:Boolean;
    FFrame: TwwEditFrame;
    FButtonEffects: TwwButtonEffects;
    FInterval: TwwDTInterval;
    FButtonStyle: TwwComboButtonStyle;
    FButtonWidth: integer;
    FAutoFillDateAndTime : Boolean;

//    FFlatButton: boolean;
//    FFlatButtonTransparent: boolean;
//    FTransparent: boolean;
//    FCreateTransparent: boolean;

//    procedure SetTransparent(val: boolean);
    skipUpdate: boolean;
    FMouseInButtonControl: boolean;
    OldShowHint: boolean;
    SetModifiedInChangeEvent: boolean;
    CurrentDigitEditDateTime: TDatetime; { 8/16/00 }
    FController: TwwController;
    FDisableThemes: boolean;

    procedure SetController(Value: TwwController);
    function GetDate: TDate;
    function GetTime: TTime;
    procedure SetDate(Value: TDate);
    procedure SetTime(Value: TTime);
    procedure SetDateTime(Value: TDateTime);
    function GetField: TField;
    function GetDataField: string;
    procedure SetDataField(const Value: string);
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    procedure SetUnboundDataType(const Value: TwwDTEditDataType);

    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    {$ifndef wwDelphi4Up}
    procedure WndProc(var Message: TMessage); override;
    {$endif}
    procedure SetMaxDate(Value: TDate);
    procedure SetMinDate(Value: TDate);
    procedure SetDateFormat(Value: TDTDateFormat);
    procedure SetEpoch(Value: Integer);

    Procedure UpdateButtonPosition;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; {handle tab}
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
//    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    
//    procedure NonEditMouseDown(var Message: TWMLButtonDown);
    procedure SetFocused(Value: Boolean);

              {DateTime Format TokenHandling Routines}
    function  GetDatetimeToken(datetime1:TDateTime;index:integer;
              var pos,len:integer;var s:string):string;
    procedure GetCompleteToken(val:char;formatstr:string;
              var s:string;var pos:integer);
    function  GetFormatStr:string;
    function  isDateField:boolean;
    function  IsDateOnlyField:boolean;
    function  isTimeOnlyField:boolean;
    function  isDateTimeField:boolean;
    function  isAMPM(str:string):boolean;
    procedure InDigitEditUpdateRecord;
    function IscFormat:boolean;
    function TimeShowing:boolean;
    function GetMaxVisibleToken:Integer;
    function isvalid2year(newnum:integer):boolean;
    procedure ReEncodeDateTime(y,m,d,h,n,sec,msec:word);
    Function GetValidMaxDate:TDate;
    Function GetValidMinDate:TDate;
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
    procedure SetDisplayFormat(value: string);
    procedure SetButtonGlyph(Value: TBitmap);
    Function GetButtonGlyph: TBitmap;
    procedure SetButtonStyle(val: TwwComboButtonStyle);
    Procedure SetButtonWidth(val: integer);
    function GetButtonWidth: integer;
    Function GetNewHour(oldhour: integer; digit: integer): integer;
    function IsVistaComboNonEditable: boolean; virtual;
    
  protected
      { Protected declarations }
//    procedure AdjustHeight;
    property ControlCanvas:TControlCanvas read FCanvas;
//    procedure GlyphChanged(Sender: TObject); virtual;
    function IsCustom: Boolean; virtual;
    Procedure DrawButton(Canvas: TCanvas; R: TRect; State: TButtonState;
       ControlState: TControlState; var DefaultPaint: boolean); virtual;
    procedure Loaded; override;
    procedure CloseUp(Accept: Boolean); virtual;
    Function IsDroppedDown: boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Change; override; { RSW}

    procedure EnableEdit; dynamic;
    procedure HandleDropDownKeys(var Key: Word; Shift: TShiftState);
    procedure Notification(AComponent: TComponent;
        Operation: TOperation); override;
    procedure BtnClick(sender:tobject);
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
    function EditCanModify: Boolean; virtual;
    Procedure SetModified(val: boolean);
    procedure SetShowButton(sel: boolean); virtual;
    Function GetClientEditRect: TRect; virtual;
    procedure SetEditRect; virtual;
    procedure WMSize(var msg:twmsize); message wm_size;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    Function Editable: boolean; virtual;
    Procedure ShowText(ACanvas: TCanvas;
          ARect: TRect; indentLeft, indentTop: integer; AText: string);
    Function GetIconIndent: integer; dynamic;
    Function GetIconLeft: integer; dynamic;
    procedure HighlightToken(mDateTime:TDateTime);
    procedure CreateParams(var Params: TCreateParams); override;
    Procedure DoExit; override;
    procedure Reset;
    Function CanEdit:boolean;
    function GetEffectiveDisplayFormat(ExpandNativeFormat: boolean): string;
    procedure GetFirstLastDayOfWeek(var first:integer;var last:integer);
    function GetMaxTokens(formatstr:string):integer;
    Function GetDateTimeStoredText(ADateTime:TDateTime):string;
    Function GetDateTimeDisplayText(ADateTime:TDateTime):string;
    function DateTokenInString(formatStr:string):boolean;
    function TimeTokenInString(formatStr:string):boolean;
    Procedure UpdateButtonGlyph;
//    procedure GetEditRectForFrame(var Loc: TRect); virtual;
    procedure DrawFrame(Canvas: TCanvas); virtual;
    function Is3DBorder: boolean;
    procedure CreateWnd; override;