⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wwdbdatetimepicker.pas

📁 胜天进销存源码,国产优秀的进销存
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    {$ifdef wwDelphi4Up}
    procedure WndProc(var Message: TMessage); override;
    {$endif}
    procedure InvalidateTransparentButton;
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
    property MouseInControl: boolean read FMouseInControl;

  public
    { Public declarations }
    Patch: Variant;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$ifdef wwdelphi4up}
    function ExecuteAction(Action: TBasicAction): Boolean; override; { 8/24/98 }
    function UpdateAction(Action: TBasicAction): Boolean; override; {8/24/98}
    {$endif}
    procedure Invalidate; override;  {NEW PW}
    procedure DropDown; virtual;
    procedure UpdateRecord;
    procedure RefreshText;
    procedure ClearDateTime;
    function isTransparentEffective: boolean;

    property Controller : TwwController read FController write SetController;
    property Calendar: TwwPopupCalendar read FCalendar;
    property DroppedDown: boolean read IsDroppedDown;
    property Field: TField read GetField;
    property Frame: TwwEditFrame read FFrame write FFrame;
    property ShowButton: boolean read FShowButton write SetShowButton;// default True;
    property Button: TwwComboButton read FButton;
    property DateTime: TDateTime read FDateTime write SetDateTime;
    property Options: TwwDTOptions read FOptions write FOptions default [wwDTOAutoAdvance];
    property Interval: TwwDTInterval read FInterval write FInterval;

    property AutoFillDateAndTime: Boolean read FAutoFillDateAndTime write FAutoFillDateAndTime default False;
    property CalendarAttributes: TwwCalendarOptions read FCalendarOptions write FCalendarOptions;
    property DataField: string read GetDataField write SetDataField;
    property DateFormat: TDTDateFormat read FDateFormat write SetDateFormat default dfShort;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Date: TDate read GetDate write SetDate;
    property Epoch: Integer read FEpoch write SetEpoch;
    property Time: TTime read GetTime write SetTime;
    property MaxDate: TDate read FMaxDate write SetMaxDate;
    property MinDate: TDate read FMinDate write SetMinDate;
    property UnboundDataType: TwwDTEditDataType read FUnboundDataType write SetUnboundDataType default wwDTEdtDateTime;
    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
    property OnCalcBoldDay: TCalcBoldDayEvent read FOnCalcBoldDay write FOnCalcBoldDay;
    property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property InfoPower: Boolean read FInfoPower;
    property ButtonStyle: TwwComboButtonStyle read FButtonStyle write SetButtonStyle;
    property ButtonEffects: TwwButtonEffects read FButtonEffects write FButtonEffects;
    property ButtonGlyph: TBitmap read GetButtonGlyph write SetButtonGlyph stored IsCustom;
    property ButtonWidth: integer read GetButtonWidth write SetButtonWidth default 0;

//    property ButtonFlat : boolean read GetFlatButton write SetFlatButton default False;
//    property ButtonTransparent: boolean read FFlatButtonTransparent write SetFlatButtonTransparent default False;
    
//    property Transparent: boolean read FTransparent write SetTransparent;

    property AutoSize;
    property BorderStyle;
    property Color;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Visible;
    property TokenPos : integer read FPos write FPos;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
 end;

 TwwDBDateTimePicker = class(TwwDBCustomDateTimePicker)
 published
    property Controller;
    property DisableThemes;
    {$ifdef wwDelphi4Up}
    property Anchors;
    property BiDiMode;  { 2/18/99 - Case sensitive name for Builder 4 }
    {$endif}
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;

    property AutoFillDateAndTime;
    property AutoSize;
    property BorderStyle;
    property CalendarAttributes;
    property Color;
    {$ifdef wwDelphi4Up}
    property Constraints;
    {$endif}
    property ButtonStyle default cbsDownArrow;
    property DataField;
    property DateFormat;
    property DataSource;
    property Date;
    property Epoch;
    property ButtonEffects;
//    property ButtonTransparent;
//    property ButtonFlat;
    property Frame;
    property ButtonWidth;
    property ButtonGlyph;
    property Time;
    property DragMode;
    property DragCursor;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property MaxDate;
    property MinDate;
    property Interval;
    {$ifdef wwDelphi4Up}
    property ParentBiDiMode;  { 2/18/99 - Case sensitive name for Builder 4 }
    {$endif}
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property ShowButton;
    property TabOrder;
//    property Transparent;
    property UnboundDataType;
    property DisplayFormat;
    property Visible;
    property OnCalcBoldDay;
    property OnClick;
    property OnCloseUp;
    property OnChange;
    property OnDropDown;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnStartDrag;
    property InfoPower;
 end;


TwwDateComboButton = class(TwwComboButton)
  protected
    function IsVistaTransparentButton: boolean; override;
    function IsVistaComboNonEditable: boolean; override;
    function ParentMouseInControl: boolean; override;
    function ParentDroppedDown: boolean; override;
    procedure Paint; override;
  end;

//procedure Register;

implementation

uses comstrs,
     {$ifdef wwDelphi7Up}
     themes,
     {$endif}
     typinfo;

// 12/1/98 - Turned off RangeChecking Compiler Switch because of operations on words.
{$Q-}

{.$R *.RES}
{type TwwDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
     dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
     dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit,
     dgWordWrap, dgPerfectRowFit, dgMultiSelect);

type TwwDBGridOptions = set of TwwDBGridOption;
}
type
  TCheatGridCast = class(TCustomGrid);
//  TwwCheatGridCast = class(TwwDBGrid);

type
  TwwDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines,
    dgTabs, dgRowSelect, {dgRowSelectEditable,}
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit,
    dgWordWrap, dgPerfectRowFit, dgMultiSelect, dgShowFooter, dgFooter3DCells,
    dgNoLimitColSize,  dgTrailingEllipsis, dgShowCellHint, dgTabExitsOnLastCol,
    dgFixedResizable, dgFixedEditable, dgProportionalColResize, dgRowResize,
    dgRowLinesDisableFixed, dgColLinesDisableFixed, dgFixedProportionalResize,
    dgHideBottomDataLine);
  TwwDBGridOptions = set of TwwDBGridOption;

  TwwComboButtonEffects = class(TwwButtonEffects)
     protected
        procedure Refresh; override;
  end;

  Procedure TwwComboButtonEffects.Refresh;
  begin
      (Control as TwwDBDateTimePicker).Updatebuttonglyph;
  end;

var WM_DATEPICKER_DESTROYCALENDAR : UINT = 0;

function wwGetGridOptions(AControl:TControl): TwwDBGridOptions;
begin
  Result := [];
  if (AControl.Parent<>nil) and wwIsClass(AControl.Parent.ClassType, 'TwwDBGrid') then
    PChar(@result)^ := Char(wwGetOrdProp(AControl.Parent, 'Options'));
end;

Function HaveAnyRowLines(EditControl: TWinControl): boolean;
var Options: TwwDBGridOptions;
begin
   Options:= wwGetGridOptions(EditControl);
   result:= (dgRowLines in Options) or
       not (dgRowLinesDisableFixed in Options);
end;

constructor TwwDTInterval.Create;
begin
   FMinutesInterval:= 1;
end;

{$ifdef wwDelphi3up}
var wwHook: HHOOK;

function wwHookProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
var r1, r2: TRect;
begin
  result := CallNextHookEx(wwHook, nCode, wParam, lParam);
  with PMouseHookStruct(lParam)^ do
  begin
    if (wParam = WM_LBUTTONDOWN) or (wParam = WM_NCLBUTTONDOWN) then
    begin
      if (Screen.ActiveControl <> nil) and (Screen.ActiveControl is TwwDBCustomDateTimePicker) then
        with (Screen.ActiveControl as TwwDBCustomDateTimePicker) do
      begin
        { Auto-closeup if clicked outside of drop-down area }
        if isDroppedDown and (not FCalendar.IsPopupYearMonthShowing) then begin
           GetWindowRect(FCalendar.Handle, r1);
           GetWindowRect(Handle, r2);
           if (not PtInRect(r1, pt)) and (not PtInRect(r2, pt)) then
             { 11/15/98 - Calling closeup immediately would cause problems
              if user's OnCloseUp aborted }
             PostMessage(Handle, CM_CANCELMODE, 0, 0);
//           CloseUp(True);
        end
      end;
    end;
  end;
end;
{$endif}

Function max(x,y: integer): integer;
begin
  if x>y then result:= x else result:= y;
end;

function DaysThisMonth(Month,Year:integer): Integer;
const
  DaysPerMonth: array[1..12] of Integer =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);	    { usual numbers of days }
begin
  Result := DaysPerMonth[Month];                        { normally, just return number }
  if (Month = 2) and IsLeapYear(Year) then Inc(Result); { plus 1 in leap February }
end;

Function LessThanOrEqual(date1,date2:TDateTime):boolean;
begin
   result := Trunc(Date1) <= Trunc(Date2);
end;

function getcurmillenium:integer;
var curdate:TDate;
    curm,curd,cury:word;
begin
    curdate := Now;
    DecodeDate(curdate,cury,curm,curd);
    result := cury div 100;
end;

function IncMonth(const Date: TDateTime; NumberOfMonths: Integer): TDateTime;
var
  DayTable: PDayTable;
  Year, Month, Day: Word;
  Sign: Integer;
begin
  if NumberOfMonths >= 0 then Sign := 1 else Sign := -1;
  DecodeDate(Date, Year, Month, Day);
  Year := Year + (NumberOfMonths div 12);
  NumberOfMonths := NumberOfMonths mod 12;
  Inc(Month, NumberOfMonths);
  if Word(Month-1) > 11 then    // if Month <= 0, word(Month-1) > 11)
  begin
    Inc(Year, Sign);
    Inc(Month, -12 * Sign);
  end;
  DayTable := @MonthDays[IsLeapYear(Year)];
  if Day > DayTable^[Month] then Day := DayTable^[Month];
  if (Year > 9999) then begin
     DecodeDate(Date, Year, Month, Day);
  end;
  Result := EncodeDate(Year, Month, Day) + Frac(Date);
end;

function Get4DigitFrom2DigitYear(temp2year,m,d,FEpoch:Integer):Integer;
//var i:integer;
begin
  if temp2year >= (FEpoch mod 100) then
     result := ((FEpoch div 100)*100 + temp2Year)
  else
     result := (((FEpoch div 100)+1)*100 + temp2Year);
end;

Function ReplaceStrWithStr(str: string; removestr: string;replaceStr: string): string;
  var i: integer;
  begin
     Result := '';
     i:=1;
     while i<=length(str) do begin
        if (strlcomp(PChar(Copy(str,i,length(removestr))), PChar(removestr),
            length(removestr))<>0) then
        begin
           Result := Result + str[i];
           i:=i+1;
        end
        else begin
          Result:= Result + replaceStr;
          i:=i+length(removeStr);
        end;
     end;
  end;

{ Return true if class is derived from 'Name' }
{ This code is more code efficient than InheritsFrom or 'Is'
  as it does not require that the compiler link in the class }
function wwIsClass(ClassType: TClass; const Name: string): Boolean;
begin
  Result := True;
  while ClassType <> nil do
  begin
    if uppercase(ClassType.ClassName)=uppercase(Name) then Exit;
    ClassType := ClassType.ClassParent;
  end;
  Result := False;
end;

Function ParentGridFocused(dtp:TwwDBCustomDateTimePicker): boolean;
begin
   result:= False;
   if (dtp.fDataLink.Field <> nil) then begin
     if wwIsClass(dtp.Parent.classType, 'TwwDBGrid') then
        if dtp.parent.Focused then result:= True
   end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -