Chip: Shareware for Win 95/Chip-Shareware-Win95.bin/ostatni/delphi/delphi2/datetime.exe/32BIT/DATETIME.PAS

Pascal/Delphi Source File | 1996-10-14 | 33.3 KB | 1,308 lines

unit Datetime;

{************************************************************}
{*  TDateTime and TDBDateTime components (32 bit version)   *}
{*  Completed: 14 October 1996                              *}
{*  Developed By: John Stathakis                            *}
{*  E-Mail: [e-mail]                         *}
{*  read the readme.txt file for more info                  *}
{************************************************************}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, spin, ExtCtrls, Calendar, db, dbTables,
  StdComps;

type
  TIncrementScale = (Year, Month, Week, Day, Hour, Minute, Second);
  TButtonOption = (btnCalendar, btnClock, btnIncrement);
  TButtonOptions = Set of TButtonOption;

  TFormSetIncrement = class(TForm)
    BtnClose: TBitBtn;
    SEIncrementBy: TSpinEdit;
    CBIncrementScale: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure BtnCloseClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure SetIncrementScale(IncScale: TIncrementScale);
    procedure SetIncrementBy(incBy: Integer);
    function GetIncrementScale: TIncrementScale;
    function GetIncrementBy: Integer;
  end;

  TFormClock = class(TForm)
    Panel3: TPanel;
    BtnSelect: TBitBtn;
    BtnCancel: TBitBtn;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SEHour: TSpinEdit;
    SEDmin: TSpinEdit;
    SEDsec: TSpinEdit;
    EditAmPm: TEdit;
    SBAmPm: TSpinButton;
    PBClock: TPaintBox;
    SEMin: TSpinEdit;
    SESec: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure SBAmPmDownClick(Sender: TObject);
    procedure SEDsecChange(Sender: TObject);
    procedure SEHourChange(Sender: TObject);
    procedure SEDminChange(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure BtnSelectClick(Sender: TObject);
    procedure SEMinChange(Sender: TObject);
    procedure SESecChange(Sender: TObject);
  private
    FPen: TPen;
    CentrePt : TPoint;
    {Clock Centre}
    Radius : integer;
    {Clock Radius}
    RectWidth : integer;
    {Width of Clock rectangles}
    ClockTime, SelectedTime: TDateTime;
    {Internal Clock time and selected clock time}
    function MinuteAngle(Min: word): real;
    {Minute Hand angle}
    function HourAngle(Hour, Min: word): real;
    {Hour Hand angle}
    procedure CalculateAngles;
    procedure DrawMinBlocks;
    procedure DrawClockFace;
    {Draw clock face on window}
    procedure DrawHand(Angle, Scale : real; AWidth : integer);
    {Draw a clock hand}
    procedure DrawHands;
    {Draw clock Hands}
    procedure SetTime;
    {The following procedures rectify overflow on the
     spin edits}
    procedure FixHour;
    procedure FixDmin;
    procedure FixMin;
    procedure FixDsec;
    procedure FixSec;
  public
    function GetClkTime: TDateTime;
    {Get clock time}
    procedure SetClkTime(H, M, S: Word);
    {Set Clock Time}
    procedure SetClkDateTime(ClkTime: TDateTime);
    {Set Clock Time from TDateTime}
  end;


  TFormCalendar = class(TForm)
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    CBMonth: TComboBox;
    Panel1: TPanel;
    Calendar1: TCalendar;
    Panel3: TPanel;
    BtnSelect: TBitBtn;
    SEYear: TSpinEdit;
    BtnCancel: TBitBtn;
    procedure SEYearChange(Sender: TObject);
    procedure CBMonthChange(Sender: TObject);
    procedure Calendar1DblClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnSelectClick(Sender: TObject);
    procedure UpdateDate(Y, M, D: Word);
    procedure BtnCancelClick(Sender: TObject);
  private
    SelectedDateTime: TDateTime;
    procedure SelectDate;
  public
    procedure SetDate(Y, M, D: Word);
    procedure SetDateTime(DT: TDateTime);
    function GetDateTime:TDateTime;
  end;


  TDateTimeDlg = class(TEdit)
  private
    FAbout: TAbout;
    {Dummy for about property editor}
    {
    Buttons}
    FButtons: TButtonOptions;

    FUpButton: TComponentButton;
    FDownButton: TComponentButton;
    FCalendarButton: TComponentButton;
    FClockButton: TComponentButton;
    FFocusedButton: TComponentButton;

    FEnableEditor: Boolean;
    FIncrementScale: TIncrementScale;
    FIncrementBy: Integer;
    FIncrementBtns: Boolean;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
                 Shift: TShiftState; X, Y: Integer);

    procedure SetFocusBtn (Btn: TComponentButton);
    {
    Setting & getting properties}
    procedure SetUpGlyph(Value: TBitmap);
    procedure SetDownGlyph(Value: TBitmap);
    procedure SetCalendarGlyph(Value: TBitmap);
    procedure SetClockGlyph(Value: TBitmap);
    function GetUpGlyph: TBitmap;
    function GetDownGlyph: TBitmap;
    function GetCalendarGlyph: TBitmap;
    function GetClockGlyph: TBitmap;
    procedure SetNumUpGlyphs(Value: TNumGlyphs);
    procedure SetNumDownGlyphs(Value: TNumGlyphs);
    procedure SetNumCalendarGlyphs(Value: TNumGlyphs);
    procedure SetNumClockGlyphs(Value: TNumGlyphs);
    function GetNumUpGlyphs: TNumGlyphs;
    function GetNumDownGlyphs: TNumGlyphs;
    function GetNumCalendarGlyphs: TNumGlyphs;
    function GetNumClockGlyphs: TNumGlyphs;
    procedure SetButtons(Value: TButtonOptions);
    function GetButtons: TButtonOptions;
    procedure SetEnableEditor(Value: Boolean);
    procedure SetIncrementBtns(Value: Boolean);
    procedure SetIncrementBy(Value: Integer);
    {
    For sizing and redrawing}
    procedure DrawButtons;
    function GetMinHeight: Integer;
    procedure SetEditRect;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    {
    Cutting and Pasting}
    procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
    procedure WMCut(var Message: TWMCut);   message WM_CUT;
    {
    increment}
    procedure IncDateTime(Down: Boolean);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure UpClick (Sender: TObject); virtual;
    procedure DownClick (Sender: TObject); virtual;
    procedure CalendarClick (Sender: TObject); virtual;
    procedure ClockClick (Sender: TObject); virtual;
    procedure IncOnMouseDown(Sender: TObject; Button: TMouseButton;
                 Shift: TShiftState; X, Y: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About: TAbout read FAbout;
    property BtnUpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
    property BtnDownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
    property BtnCalendarGlyph: TBitmap read GetCalendarGlyph write SetCalendarGlyph;
    property BtnClockGlyph: TBitmap read GetClockGlyph write SetClockGlyph;
    property NumUpGlyphs: TNumGlyphs read GetNumUpGlyphs write SetNumUpGlyphs;
    property NumDownGlyphs: TNumGlyphs read GetNumDownGlyphs write SetNumDownGlyphs;
    property NumCalendarGlyphs: TNumGlyphs read GetNumCalendarGlyphs write SetNumCalendarGlyphs;
    property NumClockGlyphs: TNumGlyphs read GetNumClockGlyphs write SetNumClockGlyphs;
    property Buttons: TButtonOptions read GetButtons write SetButtons default [btnCalendar];
    property EnableEditor: Boolean read FEnableEditor write SetEnableEditor;
    property IncrementScale: TIncrementScale read FIncrementScale write FIncrementScale;
    property IncrementBy: Integer read FIncrementBy write SetIncrementBy;
  end;

  TDBDateTimeDlg = class(TDateTimeDlg)
  private
    FDataLink: TFieldDataLink;
    Procedure DataChange(sender:Tobject);
    function getDataField: String;
    Function GetDataSource : TDataSource;
    Procedure SetDataField(const value:String);
    Procedure SetDataSource(value : TDataSource);
    Procedure UpdateData(Sender:Tobject);
  protected
    Procedure KeyDown(Var Key:Word;Shift:TShiftState); override;
    procedure Change; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpClick (Sender: TObject); override;
    procedure DownClick (Sender: TObject); override;
    procedure CalendarClick (Sender: TObject); override;
    procedure ClockClick (Sender: TObject); override;
  published
    Property DataField : string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;


procedure Register;

implementation
{$R DateTime}
{$R Clockdlg.dfm}
{$R Calendlg.dfm}
{$R SetInc.DFM}

{32 bit variables}
const
BtnOffset = 3;   {Offset on buttons to compensate for 32 bit environment}

procedure Register;
begin
  RegisterComponents('John', [TDateTimeDlg]);
  RegisterComponents('John', [TDBDateTimeDlg]);
end;

{TFormSetIncrement Implementation}
procedure TFormSetIncrement.BtnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TFormSetIncrement.SetIncrementScale(IncScale: TIncrementScale);
begin
  Case IncScale of
  Year: CBIncrementScale.ItemIndex := 0;
  Month: CBIncrementScale.ItemIndex := 1;
  Week: CBIncrementScale.ItemIndex := 2;
  Day: CBIncrementScale.ItemIndex := 3;
  Hour: CBIncrementScale.ItemIndex := 4;
  Minute: CBIncrementScale.ItemIndex := 5;
  Second: CBIncrementScale.ItemIndex := 6;
  end;
end;

procedure TFormSetIncrement.SetIncrementBy(incBy: Integer);
begin
  SEIncrementBy.Value := IncBy;
end;

function TFormSetIncrement.GetIncrementBy;
begin
  Result := SEIncrementBy.Value;
end;

function TFormSetIncrement.GetIncrementScale: TIncrementScale;
begin
  Case CBIncrementScale.ItemIndex of
  0: Result := Year;
  1: Result := Month;
  2: Result := Week;
  3: Result := Day;
  4: Result := Hour;
  5: Result := Minute;
  6: Result := Second;
  end;
end;

{TFormClock Implementation}
procedure TFormClock.FormCreate(Sender: TObject);
begin
  {Create Pen}
  FPen := TPen.Create;
  SelectedTime := 0;
end;

procedure TFormClock.FormDestroy(Sender: TObject);
begin
  FPen.Free;
end;

function TFormClock.GetClkTime: TDateTime;
{Get clock time}
begin
  If trunc(SelectedTime) = 0
  then Result := SelectedTime + Date
  else Result := SelectedTime;
end;

procedure TFormClock.SetClkTime(H, M, S: Word);
var
  MS: Word;
begin
  If (H > 11) or (H < 0)
  then begin
    MessageDlg('Invalid Hour', mtError, [mbOK], 0);
    exit;
  end;
  If (M > 59) or (M < 0)
  then begin
    MessageDlg('Invalid Minute', mtError, [mbOK], 0);
    exit;
  end;
  If (S > 59) or (S < 0)
  then begin
    MessageDlg('Invalid Second', mtError, [mbOK], 0);
    exit;
  end;

  {Set Spin Edit Values}
  SEHour.Value := H;
  SEDmin.Value := M div 10;
  SEMin.Value := M mod 10;
  SEDsec.Value := S div 10;
  SESec.Value := S mod 10;

  ClockTime := EncodeTime(H, M, S, MS);
  SelectedTime := ClockTime;
  invalidate;
end;

procedure TFormClock.SetClkDateTime(ClkTime: TDateTime);
var
  H, M, S, MS: Word;
begin
  ClockTime := ClkTime;
  SelectedTime := ClkTime;
  DecodeTime(ClkTime, H, M, S, ms);

  {Convert from 24 mode to 12 hr mode}
  If H > 12
  then begin
    EditAmPm.Text := 'pm';
    H := H - 12;
  end;

  {Set Spin Edit Values}
  SEHour.Value := H;
  SEDmin.Value := M div 10;
  SEMin.Value := M mod 10;
  SEDsec.Value := S div 10;
  SESec.Value := S mod 10;

  invalidate;
end;

function TFormClock.MinuteAngle( Min : word) : real;
begin
  MinuteAngle := Min*Pi/30;
end;

function TFormClock.HourAngle( Hour, Min : word) : real;
begin
 HourAngle := (Hour MOD 12)*Pi/6 + MinuteAngle(Min)/12;
end;

procedure TFormClock.DrawHand(Angle, Scale : real; AWidth : integer);
var ScreenPos: real;
begin
  with PBClock.Canvas do
  begin
    Pen.Width := AWidth;
    MoveTo(CentrePt.X, CentrePt.Y);
    ScreenPos := Scale*Radius;
    LineTo(trunc(ScreenPos*sin(Angle))+CentrePt.X,
           trunc(-ScreenPos*cos(Angle))+CentrePt.Y);
  end;
end;

procedure TFormClock.DrawHands;
var
  H, M, S, ms : word;
  ARect: TRect;
begin
  FPen.Color := ClHighlight;
  with PBClock.Canvas do
  begin
    Pen := FPen;
    Brush.Color := ClBtnFace;
  end;

  DecodeTime(ClockTime, H, M, S, ms);
  DrawHand(MinuteAngle(S), 1, 1);
  DrawHand(MinuteAngle(M), 0.95, 3);
  DrawHand(HourAngle(H, M), 0.60, 6);
  PBClock.Canvas.Pen.Color := clHighlightText;
  DrawHand(MinuteAngle(M), 0.95, 1);
  DrawHand(HourAngle(H, M), 0.60, 1);

  ARect.Left := CentrePt.X-5;
  ARect.Right := CentrePt.X+5;
  ARect.Top := CentrePt.Y-5;
  ARect.Bottom := CentrePt.Y+5;

  Frame3D(PBClock.Canvas, ARect, clHighlight, clBtnShadow, 6);
end;

procedure TFormClock.CalculateAngles;
begin
  { Calc Center of clock face}
  CentrePt := Point( PBClock.Width DIV 2, PBClock.Height DIV 2 );
  { Calc Radius of clock}
  with CentrePt do
    if X <= Y then Radius := X
    else           Radius := Y;

  RectWidth := Radius DIV 8;
  if RectWidth < 6 then RectWidth := 6;

  dec( Radius, RectWidth + 2);
end;

procedure TFormClock.DrawMinBlocks;
var
  OfsX, OfsY : integer;
  MinCounter : word;
  CurPt : TPoint;
  TmpRect : TRect;
  RadOff, Ang : real;
begin
  OfsX := RectWidth DIV 2; OfsY := OfsX;
  for MinCounter := 0 to 11 do
  begin
    RadOff := Radius + OfsX;
    Ang := MinuteAngle(MinCounter*5);
    CurPt := Point(
        trunc(RadOff*sin(Ang))+CentrePt.X, trunc(-RadOff*cos(Ang))+CentrePt.Y);
    Case MinCounter*5 of
    0,30:TmpRect := Rect(CurPt.X-4, CurPt.Y-10, CurPt.X+4, CurPt.Y+10);
    15,45:TmpRect := Rect(CurPt.X-10, CurPt.Y-4, CurPt.X+10, CurPt.Y+4);
    else
      TmpRect := Rect(CurPt.X-2, CurPt.Y-2, CurPt.X+2, CurPt.Y+2);
    end;
    Frame3D(PBClock.Canvas, TmpRect, clHighlight, clBtnShadow, 6);
  end;
end;

procedure TFormClock.DrawClockFace;
{Draw minute points on Panel}
begin
  with PBClock.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := ClBtnFace;
    FillRect( ClipRect);
  end;
  DrawMinBlocks;
end;

procedure TFormClock.FormPaint(Sender: TObject);
begin
  CalculateAngles;
  DrawClockFace;
  DrawHands;
end;

procedure TFormClock.SetTime;
var
  Hr24: Word;
begin
  {Ensure date part is not lost}
  If (EditAmPm.Text = 'pm')
  then Hr24 := SEHour.Value + 12
  else Hr24 := SEHour.Value;
  ClockTime := EncodeTime(Hr24, (10*SEDmin.Value)+(SEMin.Value),
        (10*SEDsec.Value)+(SESec.Value), 0) + Trunc(ClockTime);
  Invalidate;
end;

procedure TFormClock.FixHour;
{Rectifies overflow on hour counter}
begin
  If SEHour.Value = 12
  then begin
    SEHour.Value := 0;
    If EditAmPm.text = 'am'
    then EditAmPm.text := 'pm'
    else EditAmPm.text := 'am';
  end;
end;

procedure TFormClock.FixDmin;
{Rectifies overflow on ten minute counter}
begin
  If SEDmin.Value = 6
  then begin
    SEDmin.Value := 0;
    SEHour.Value := SEHour.Value + 1;
    FixHour;
  end;
end;

procedure TFormClock.FixMin;
{Rectifies overflow on minute counter}
begin
  If SEMin.Value = 10
  then begin
    SEMin.Value := 0;
    SEDmin.Value := SEDmin.Value + 1;
    FixDmin;
  end;
end;

procedure TFormClock.FixDsec;
{Rectifies overflow on 10 second counter}
begin
  If SEDsec.Value = 6
  then begin
    SEDsec.Value := 0;
    SEMin.Value := SEMin.Value + 1;
    FixMin;
  end;
end;

procedure TFormClock.FixSec;
{Rectifies overflow on second counter}
begin
  If SESec.Value = 10
  then begin
    SESec.Value := 0;
    SEDsec.Value := SEDsec.Value + 1;
    FixDsec;
  end;
end;

procedure TFormClock.SEHourChange(Sender: TObject);
begin
  FixHour;
  SetTime;
end;

procedure TFormClock.SEDminChange(Sender: TObject);
begin
  FixDmin;
  SetTime;
end;

procedure TFormClock.SEMinChange(Sender: TObject);
begin
  FixMin;
  SetTime;
end;

procedure TFormClock.SEDsecChange(Sender: TObject);
begin
  FixDsec;
  SetTime;
end;

procedure TFormClock.SESecChange(Sender: TObject);
begin
  FixSec;
  SetTime;
end;


procedure TFormClock.SBAmPmDownClick(Sender: TObject);
begin
  If EditAmPm.text = 'am'
    then EditAmPm.text := 'pm'
    else EditAmPm.text := 'am';
  SetTime;
end;

procedure TFormClock.BtnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TFormClock.BtnSelectClick(Sender: TObject);
begin
  SelectedTime := ClockTime;
  Close;
end;


{TFormCalendar Implementation}

procedure TFormCalendar.UpdateDate(Y, M, D: Word);
begin
  try
    SEYear.Value := Y;
    CBMonth.ItemIndex := M - 1;
    Calendar1.Year := Y;
    Calendar1.Month := M;
    Calendar1.Day := D;
  except
    MessageDlg('Invalid Date', mtError, [mbOK], 0);
  end;
end;

procedure TFormCalendar.SetDate(Y, M, D: Word);
begin
  UpdateDate(Y, M, D);
  {Set Initial Date}
  SelectedDateTime := EncodeDate(Y, M, D);
end;

procedure TFormCalendar.SetDateTime(DT: TDateTime);
var
  Year, Month, Day: Word;
begin
  {Set Initial Date}
  SelectedDateTime := DT;
  If DT > 0
  then DecodeDate(DT, Year, Month, Day)
  else DecodeDate(Date, Year, Month, Day);
  UpdateDate(Year, Month, Day)
end;

function TFormCalendar.GetDateTime: TDateTime;
begin
  Result := SelectedDateTime;
end;

procedure TFormCalendar.SEYearChange(Sender: TObject);
begin
  UpdateDate(SEYear.Value, Calendar1.Month, Calendar1.Day);
end;

procedure TFormCalendar.CBMonthChange(Sender: TObject);
begin
  UpdateDate(Calendar1.Year, CBMonth.ItemIndex + 1, Calendar1.Day);
end;

procedure TFormCalendar.SelectDate;
begin
  {If date/time already set, then change only the date part}
  SelectedDateTime := EncodeDate(Calendar1.Year, Calendar1.Month,
                             Calendar1.Day) + Frac(SelectedDateTime);
end;

procedure TFormCalendar.Calendar1DblClick(Sender: TObject);
begin
  SelectDate;
  Close;
end;

procedure TFormCalendar.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN)
  then begin
    SelectDate;
    Close;
  end;
end;

procedure TFormCalendar.BtnSelectClick(Sender: TObject);
begin
  SelectDate;
  Close;
end;

procedure TFormCalendar.BtnCancelClick(Sender: TObject);
begin
  Close;
end;


{TDateTimeDlg Implementation}

constructor TDateTimeDlg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Buttons := [btnCalendar];

  FUpButton := TComponentButton.Create (Self, 'Increase Date/Time');
  FUpButton.OnClick := UpClick;
  FUpButton.OnMouseDown := IncOnMouseDown;
  FUpButton.Width := Height div 2;
  FUpButton.Height := (Height-BtnOffset) div 2;
  FUpButton.Parent := Self;
  FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'ARROWUP');
  FUpButton.NumGlyphs := 1;
  FUpButton.Invalidate;

  FDownButton := TComponentButton.Create (Self, 'Decrease Date/Time');
  FDownButton.OnClick := DownClick;
  FDownButton.OnMouseDown := IncOnMouseDown;
  FDownButton.Width := Height div 2;
  FDownButton.Height := (Height-BtnOffset) div 2;
  FDownButton.Parent := Self;
  FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'ARROWDOWN');
  FDownButton.NumGlyphs := 1;
  FDownButton.Invalidate;

  FCalendarButton := TComponentButton.Create (Self, 'Select Date');
  FCalendarButton.OnClick := CalendarClick;
  FCalendarButton.Left := Width - 15;
  FCalendarButton.Top := 0;
  FCalendarButton.Width := 15;
  FCalendarButton.Height := Height - BtnOffset;
  FCalendarButton.Parent := Self;
  FCalendarButton.Glyph.Handle := LoadBitmap(HInstance, 'CALENDAR');
  FCalendarButton.NumGlyphs := 1;
  FCalendarButton.Invalidate;

  FClockButton := TComponentButton.Create (Self, 'Select Time');
  FClockButton.OnClick := ClockClick;
  FClockButton.Width := 15;
  FClockButton.Height := Height - BtnOffset;
  FClockButton.Parent := Self;
  FClockButton.Glyph.Handle := LoadBitmap(HInstance, 'CLOCK');
  FClockButton.NumGlyphs := 1;
  FClockButton.Invalidate;


  FFocusedButton := FCalendarButton;

  EnableEditor := False;
  IncrementScale := Day;
  IncrementBy := 1;
end;

destructor TDateTimeDlg.Destroy;
begin
  FUpButton.Free;
  FDownButton.Free;
  FCalendarButton.Free;
  FClockButton.Free;
  inherited Destroy;
end;

procedure TDateTimeDlg.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TDateTimeDlg.SetEditRect;
var
  Loc: TRect;
  TotBtnWidth: Integer;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  Loc.Bottom := ClientHeight + 1;  {+1 is workaround for windows paint bug}

  {Set Buttons for Calendar and timer buttons}
  TotBtnWidth := Integer(btnCalendar in FButtons)*FCalendarButton.Width +
       Integer(btnClock in FButtons)*FClockButton.Width +
       Integer(btnIncrement in FButtons)*FUpButton.Width + BtnOffset;

  Loc.Right := ClientWidth - TotBtnWidth - 2;
  Loc.Top := 0;
  Loc.Left := 0;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));  {debug}
end;

procedure TDateTimeDlg.CreateWnd;
var
  Loc: TRect;
begin
  inherited CreateWnd;
  SetEditRect;
end;

function TDateTimeDlg.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;


procedure TDateTimeDlg.DrawButtons;
var
  IncHeight, NumBtns, ClockHeight, CalendarHeight: Integer;
begin
  {Set Buttons for Calendar and timer buttons}
  NumBtns := 0;
  ClockHeight := 0;
  CalendarHeight := 0;
  IncHeight := 0;

  If (btnCalendar in FButtons)
  then begin
    NumBtns := 1;
    ClockHeight := 0;
    CalendarHeight := Height - BtnOffset;
  end;
  If (btnClock in FButtons)
  then begin
    NumBtns := 1;
    ClockHeight := Height - BtnOffset;
    CalendarHeight := 0;
  end;
  If (btnCalendar in FButtons) and (btnClock in FButtons)
  then begin
    NumBtns := 2;
    ClockHeight := Height - BtnOffset;
    CalendarHeight := Height - BtnOffset;
  end;
  If (btnIncrement in FButtons)
  then IncHeight := (Height-BtnOffset) div 2
  else IncHeight := 0;

  if FUpButton <> nil then
    FUpButton.SetBounds (Width-IncHeight-(NumBtns*Height)-BtnOffset, 0,
                         IncHeight, IncHeight);
  if FDownButton <> nil then
    FDownButton.SetBounds (Width-IncHeight-(NumBtns*Height)-BtnOffset,
                           IncHeight, IncHeight, IncHeight);
  if FCalendarButton <> nil then
    FCalendarButton.SetBounds (Width-(NumBtns*Height)-BtnOffset, 0,
                               Height, CalendarHeight);
  if FClockButton <> nil then
    FClockButton.SetBounds (Width - Height-BtnOffset, 0, Height, ClockHeight);
end;

procedure TDateTimeDlg.WMSize(var Message: TWMSize);
var
  MinHeight: Integer;
begin
  inherited;
  MinHeight := GetMinHeight;
    { text edit bug: if size to less than minheight, then edit ctrl does
      not display the text }
  if Height < MinHeight
  then Height := MinHeight
  else begin
    DrawButtons;
    SetEditRect;
  end;
end;

procedure TDateTimeDlg.IncDateTime(Down: Boolean);
var
  IncAmount: Double;
  ADate, BDate: TDateTime;
  Y,M,D: Word;
  Mnth, AnInc: Integer;
begin
  If Length(Text) > 0
  then begin
    {Get initial Values}
    If btnClock in FButtons
    then begin
      If btnCalendar in FButtons
      then ADate := StrToDateTime(Text)
      else ADate := StrToTime(Text);
    end
    else ADate := StrToDate(Text);

    If Down
    then AnInc := -FIncrementBy
    else AnInc := FIncrementBy;

    Case FIncrementScale of
    Year:
      begin
        DecodeDate(ADate, Y, M, D);
        Y := Y + AnInc;
        BDate := EncodeDate(Y, M, D) + Frac(ADate);
        IncAmount := BDate - ADate;
      end;
    Month:
      begin
        DecodeDate(ADate, Y, M, D);
        Mnth := M + AnInc;
        If Mnth > 0
        then begin
          Y := Y + (Mnth-1) div 12;
          If Mnth > 12 then Mnth := Mnth MOD 12;
          If Mnth = 0 then Mnth := 12;
        end
        else begin
          Y := Y - ((ABS(Mnth)+12) div 12);
          Mnth := 12 - (ABS(Mnth) MOD 12);
        end;
        M := Mnth;
        BDate := EncodeDate(Y, M, D) + Frac(ADate);
        IncAmount := BDate - ADate;
      end;
    Week: IncAmount := 7*AnInc;
    Day: IncAmount := 1*AnInc;
    Hour: IncAmount := AnInc/24;
    Minute: IncAmount := AnInc/(24*60);
    Second: IncAmount := AnInc/(24*60*60);
    end;

    If not (btnCalendar in FButtons)
    then begin
      {Cannot update date if only time is showing}
      If ABS(IncAmount) < 1
      then
        if StrToTime(Text)+IncAmount < 0
        then Text := TimeToStr(1+StrToTime(Text)+IncAmount)
        else Text := TimeToStr(StrToTime(Text)+IncAmount);
    end
    else Text := DateTimeToStr(StrToDateTime(Text)+IncAmount);
  end
  else MessageDlg('Select a date or time first', mtInformation, [mbOK], 0);
end;

procedure TDateTimeDlg.UpClick(Sender: TObject);
begin
  IncDateTime(False);
end;

procedure TDateTimeDlg.IncOnMouseDown(Sender: TObject; Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
var
  FormSetIncrement: TFormSetIncrement;
begin
  FormSetIncrement := TFormSetIncrement.Create(Self);
  With FormSetIncrement do
  begin
    SetIncrementScale(FIncrementScale);
    SetIncrementBy(FIncrementBy);
    if Button = mbRight then ShowModal;
    FIncrementBy := GetIncrementBy;
    FincrementScale := GetIncrementScale;
    Free;
  end;
end;

procedure TDateTimeDlg.DownClick(Sender: TObject);
begin
  IncDateTime(True);
end;

procedure TDateTimeDlg.ClockClick(Sender: TObject);
var
  ADate: TDateTime;
  FormClock: TFormClock;
begin
  FormClock := TFormClock.Create(Self);
  If Length(Text) > 1
  then
    try
      If not (btnCalendar in FButtons)
      then ADate := StrToTime(Text)
      else ADate := StrToDateTime(Text);
    except
      ADate := 0;
      MessageDlg(Text+' is not a valid time', mtError, [mbOK], 0);
    end
  else ADate := 0;
  FormClock.SetClkDateTime(ADate);
  FormClock.ShowModal;
  ADate := FormClock.GetClkTime;
  If ADate > 0
  then begin
    if btnCalendar in FButtons
    then Text := DateTimeToStr(ADate)
    else Text := TimeToStr(ADate);
  end;
  FormClock.Free;
end;

procedure TDateTimeDlg.CalendarClick(Sender: TObject);
var
  ADate: TDateTime;
  Y, M, D: Word;
  FormCalendar: TFormCalendar;
begin
  FormCalendar := TFormCalendar.Create(Self);
  If Length(Text) > 1 then
  Try
    ADate := StrToDateTime(Text);
    FormCalendar.SetDateTime(ADate);
  except
    MessageDlg(Text+' is not a valid date', mtError, [mbOK], 0);
    FormCalendar.SetDateTime(0);
  end
  else FormCalendar.SetDateTime(0);
  FormCalendar.ShowModal;

  ADate := FormCalendar.GetDateTime;
  If ADate > 0
  then begin
    if not (btnClock in FButtons)
    then Text := DateToStr(ADate)
    else Text := DateTimeToStr(ADate);
  end;
  FormCalendar.Free;
end;

procedure TDateTimeDlg.SetUpGlyph(Value: TBitmap);
begin
  FUpButton.Glyph := Value;
end;

procedure TDateTimeDlg.SetDownGlyph(Value: TBitmap);
begin
  FDownButton.Glyph := Value;
end;

procedure TDateTimeDlg.SetCalendarGlyph(Value: TBitmap);
begin
  FCalendarButton.Glyph := Value;
end;

procedure TDateTimeDlg.SetClockGlyph(Value: TBitmap);
begin
  FClockButton.Glyph := Value;
end;

function TDateTimeDlg.GetUpGlyph: TBitmap;
begin
  result := FUpButton.Glyph;
end;

function TDateTimeDlg.GetDownGlyph: TBitmap;
begin
  result := FDownButton.Glyph;
end;

function TDateTimeDlg.GetCalendarGlyph: TBitmap;
begin
  result := FCalendarButton.Glyph;
end;

function TDateTimeDlg.GetClockGlyph: TBitmap;
begin
  result := FClockButton.Glyph;
end;

procedure TDateTimeDlg.SetNumUpGlyphs(Value: TNumGlyphs);
begin
  FUpButton.NumGlyphs := Value;
end;

procedure TDateTimeDlg.SetNumDownGlyphs(Value: TNumGlyphs);
begin
  FDownButton.NumGlyphs := Value;
end;

procedure TDateTimeDlg.SetNumCalendarGlyphs(Value: TNumGlyphs);
begin
  FCalendarButton.NumGlyphs := Value;
end;

procedure TDateTimeDlg.SetNumClockGlyphs(Value: TNumGlyphs);
begin
  FClockButton.NumGlyphs := Value;
end;

function TDateTimeDlg.GetNumUpGlyphs: TNumGlyphs;
begin
  result := FUpButton.NumGlyphs;
end;

function TDateTimeDlg.GetNumDownGlyphs: TNumGlyphs;
begin
  result := FDownButton.NumGlyphs;
end;

function TDateTimeDlg.GetNumCalendarGlyphs: TNumGlyphs;
begin
  result := FCalendarButton.NumGlyphs;
end;

function TDateTimeDlg.GetNumClockGlyphs: TNumGlyphs;
begin
  result := FClockButton.NumGlyphs;
end;

procedure TDateTimeDlg.SetButtons(Value: TButtonOptions);
begin
  FButtons := Value;
  DrawButtons;
end;

function TDateTimeDlg.GetButtons: TButtonOptions;
begin
  result := FButtons;
end;

procedure TDateTimeDlg.SetIncrementBy(Value: Integer);
begin
  If (Value > -1) and (Value < 32767)
  then FIncrementBy := Value
  else MessageDlg('"Increment By" must be between 0 and 32767', mtWarning,
                     [mbOK], 0);
end;

procedure TDateTimeDlg.SetEnableEditor(Value: Boolean);
begin
  FEnableEditor := Value;
  ReadOnly := not Value;
end;

procedure TDateTimeDlg.SetIncrementBtns(Value: Boolean);
begin
  FIncrementBtns := Value;
  DrawButtons;
end;

procedure TDateTimeDlg.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
  VK_UP: If (btnIncrement in FButtons)
    then begin
      SetFocusBtn (FUpButton);
      IncDateTime(False);
    end;
  VK_DOWN: If (btnIncrement in FButtons)
    then begin
      SetFocusBtn (FDownButton);
      IncDateTime(False);
    end;
  end;
end;

procedure TDateTimeDlg.BtnMouseDown (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft
  then SetFocusBtn (TComponentButton(Sender));
end;

procedure TDateTimeDlg.SetFocusBtn (Btn: TComponentButton);
begin
  if TabStop and CanFocus and  (Btn <> FFocusedButton) then
  begin
    FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
    FFocusedButton := Btn;
    if (GetFocus = Handle) then
    begin
       FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
       Invalidate;
    end;
  end;
end;

procedure TDateTimeDlg.WMPaste(var Message: TWMPaste);
begin
  if not FEnableEditor then Exit;
  inherited;
end;

procedure TDateTimeDlg.WMCut(var Message: TWMPaste);
begin
  if not FEnableEditor then Exit;
  inherited;
end;

procedure TDateTimeDlg.CMEnter(var Message: TCMGotFocus);
begin
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited;
end;

{TDBDateTimeDlg Implementation}

constructor TDBDateTimeDlg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FdataLink:= TfieldDataLink.Create;
  FDataLink.Control := Self;
  Fdatalink.OnDataChange := DataChange;
  FdataLink.OnUpdateData := UpdateData;
end;

destructor TDBDateTimeDlg.Destroy;
begin
  FDataLink.OnDataChange := nil;
  Fdatalink.Free;
  inherited Destroy;
end;

procedure TDBDateTimeDlg.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

Procedure TDBDateTimeDlg.DataChange(sender: TObject);
begin
  If FdataLink.Field <> nil
  then Text := Fdatalink.Field.AsString
  else Text := '';
end;

Function TDBDateTimeDlg.GetDataField : String;
begin
  result := FdataLink.FieldName;
end;

Function TDBDateTimeDlg.GetDataSource : TDataSource;
begin
  Result := FdataLink.DataSource;
end;

Procedure TDBDateTimeDlg.SetDataField(const value : string);
begin
  FdataLink.FieldName:=Value;
end;

procedure TDBDateTimeDlg.SetDataSource(value : TDataSource);
begin
  FdataLink.DataSource:=Value;
end;

Procedure TDBDateTimeDlg.UpdateData(Sender: TObject);
begin
  if FDataLink.edit
  then FdataLink.Field.AsString := Text
  else Text := Fdatalink.Field.AsString;
end;

Procedure TDBDateTimeDlg.Change;
begin
  FdataLink.Modified;
  Inherited Change;
end;

procedure TDBDateTimeDlg.UpClick (Sender: TObject);
begin
  FDataLink.Edit;
  inherited UpClick(Sender);
end;

procedure TDBDateTimeDlg.DownClick (Sender: TObject);
begin
  FDataLink.Edit;
  inherited DownClick(Sender);
end;

procedure TDBDateTimeDlg.ClockClick (Sender: TObject);
begin
  FDataLink.Edit;
  inherited ClockClick(Sender);
end;

procedure TDBDateTimeDlg.CalendarClick (Sender: TObject);
begin
  FDataLink.Edit;
  inherited CalendarClick(Sender);
end;

Procedure TDBDateTimeDlg.KeyDown(Var Key:Word;Shift:TShiftState);
begin
  FDataLink.Edit;
  inherited KeyDown(Key, Shift);
end;

procedure TDBDateTimeDlg.CMExit(var Message: TCMExit);
begin
  UpdateData(Self);
  inherited;
end;

end.